regexp: Implement class shorthand escapes in brackets
[jimtcl.git] / jim.c
blob7de75e654b9b6f6cb81ca024b9cc0c747ce8941f
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44 #ifndef _GNU_SOURCE
45 #define _GNU_SOURCE /* Mostly just for environ */
46 #endif
48 #include <stdio.h>
49 #include <stdlib.h>
51 #include <string.h>
52 #include <stdarg.h>
53 #include <ctype.h>
54 #include <limits.h>
55 #include <assert.h>
56 #include <errno.h>
57 #include <time.h>
58 #include <setjmp.h>
60 #include "jim.h"
61 #include "jimautoconf.h"
62 #include "utf8.h"
64 #ifdef HAVE_SYS_TIME_H
65 #include <sys/time.h>
66 #endif
67 #ifdef HAVE_BACKTRACE
68 #include <execinfo.h>
69 #endif
70 #ifdef HAVE_CRT_EXTERNS_H
71 #include <crt_externs.h>
72 #endif
74 /* For INFINITY, even if math functions are not enabled */
75 #include <math.h>
77 /* We may decide to switch to using $[...] after all, so leave it as an option */
78 /*#define EXPRSUGAR_BRACKET*/
80 /* For the no-autoconf case */
81 #ifndef TCL_LIBRARY
82 #define TCL_LIBRARY "."
83 #endif
84 #ifndef TCL_PLATFORM_OS
85 #define TCL_PLATFORM_OS "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PLATFORM
88 #define TCL_PLATFORM_PLATFORM "unknown"
89 #endif
90 #ifndef TCL_PLATFORM_PATH_SEPARATOR
91 #define TCL_PLATFORM_PATH_SEPARATOR ":"
92 #endif
94 /*#define DEBUG_SHOW_SCRIPT*/
95 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
96 /*#define DEBUG_SHOW_SUBST*/
97 /*#define DEBUG_SHOW_EXPR*/
98 /*#define DEBUG_SHOW_EXPR_TOKENS*/
99 /*#define JIM_DEBUG_GC*/
100 #ifdef JIM_MAINTAINER
101 #define JIM_DEBUG_COMMAND
102 #define JIM_DEBUG_PANIC
103 #endif
104 /* Enable this (in conjunction with valgrind) to help debug
105 * reference counting issues
107 /*#define JIM_DISABLE_OBJECT_POOL*/
109 /* Maximum size of an integer */
110 #define JIM_INTEGER_SPACE 24
112 const char *jim_tt_name(int type);
114 #ifdef JIM_DEBUG_PANIC
115 static void JimPanicDump(int fail_condition, const char *fmt, ...);
116 #define JimPanic(X) JimPanicDump X
117 #else
118 #define JimPanic(X)
119 #endif
121 #ifdef JIM_OPTIMIZATION
122 #define JIM_IF_OPTIM(X) X
123 #else
124 #define JIM_IF_OPTIM(X)
125 #endif
127 /* -----------------------------------------------------------------------------
128 * Global variables
129 * ---------------------------------------------------------------------------*/
131 /* A shared empty string for the objects string representation.
132 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
133 static char JimEmptyStringRep[] = "";
135 /* -----------------------------------------------------------------------------
136 * Required prototypes of not exported functions
137 * ---------------------------------------------------------------------------*/
138 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
139 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
140 int flags);
141 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
142 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
143 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
144 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
145 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
146 const char *prefix, const char *const *tablePtr, const char *name);
147 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
148 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
149 static int JimSign(jim_wide w);
150 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
151 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
152 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
155 /* Fast access to the int (wide) value of an object which is known to be of int type */
156 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
158 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
160 static int utf8_tounicode_case(const char *s, int *uc, int upper)
162 int l = utf8_tounicode(s, uc);
163 if (upper) {
164 *uc = utf8_upper(*uc);
166 return l;
169 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
170 #define JIM_CHARSET_SCAN 2
171 #define JIM_CHARSET_GLOB 0
174 * pattern points to a string like "[^a-z\ub5]"
176 * The pattern may contain trailing chars, which are ignored.
178 * The pattern is matched against unicode char 'c'.
180 * If (flags & JIM_NOCASE), case is ignored when matching.
181 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
182 * of the charset, per scan, rather than glob/string match.
184 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
185 * or the null character if the ']' is missing.
187 * Returns NULL on no match.
189 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
191 int not = 0;
192 int pchar;
193 int match = 0;
194 int nocase = 0;
196 if (flags & JIM_NOCASE) {
197 nocase++;
198 c = utf8_upper(c);
201 if (flags & JIM_CHARSET_SCAN) {
202 if (*pattern == '^') {
203 not++;
204 pattern++;
207 /* Special case. If the first char is ']', it is part of the set */
208 if (*pattern == ']') {
209 goto first;
213 while (*pattern && *pattern != ']') {
214 /* Exact match */
215 if (pattern[0] == '\\') {
216 first:
217 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
219 else {
220 /* Is this a range? a-z */
221 int start;
222 int end;
224 pattern += utf8_tounicode_case(pattern, &start, nocase);
225 if (pattern[0] == '-' && pattern[1]) {
226 /* skip '-' */
227 pattern++;
228 pattern += utf8_tounicode_case(pattern, &end, nocase);
230 /* Handle reversed range too */
231 if ((c >= start && c <= end) || (c >= end && c <= start)) {
232 match = 1;
234 continue;
236 pchar = start;
239 if (pchar == c) {
240 match = 1;
243 if (not) {
244 match = !match;
247 return match ? pattern : NULL;
250 /* Glob-style pattern matching. */
252 /* Note: string *must* be valid UTF-8 sequences
254 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
256 int c;
257 int pchar;
258 while (*pattern) {
259 switch (pattern[0]) {
260 case '*':
261 while (pattern[1] == '*') {
262 pattern++;
264 pattern++;
265 if (!pattern[0]) {
266 return 1; /* match */
268 while (*string) {
269 /* Recursive call - Does the remaining pattern match anywhere? */
270 if (JimGlobMatch(pattern, string, nocase))
271 return 1; /* match */
272 string += utf8_tounicode(string, &c);
274 return 0; /* no match */
276 case '?':
277 string += utf8_tounicode(string, &c);
278 break;
280 case '[': {
281 string += utf8_tounicode(string, &c);
282 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
283 if (!pattern) {
284 return 0;
286 if (!*pattern) {
287 /* Ran out of pattern (no ']') */
288 continue;
290 break;
292 case '\\':
293 if (pattern[1]) {
294 pattern++;
296 /* fall through */
297 default:
298 string += utf8_tounicode_case(string, &c, nocase);
299 utf8_tounicode_case(pattern, &pchar, nocase);
300 if (pchar != c) {
301 return 0;
303 break;
305 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
306 if (!*string) {
307 while (*pattern == '*') {
308 pattern++;
310 break;
313 if (!*pattern && !*string) {
314 return 1;
316 return 0;
320 * string comparison. Works on binary data.
322 * Returns -1, 0 or 1
324 * Note that the lengths are byte lengths, not char lengths.
326 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
328 if (l1 < l2) {
329 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
331 else if (l2 < l1) {
332 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
334 else {
335 return JimSign(memcmp(s1, s2, l1));
340 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
341 * (or end of string if 'maxchars' is -1).
343 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
345 * Note: does not support embedded nulls.
347 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
349 while (*s1 && *s2 && maxchars) {
350 int c1, c2;
351 s1 += utf8_tounicode_case(s1, &c1, nocase);
352 s2 += utf8_tounicode_case(s2, &c2, nocase);
353 if (c1 != c2) {
354 return JimSign(c1 - c2);
356 maxchars--;
358 if (!maxchars) {
359 return 0;
361 /* One string or both terminated */
362 if (*s1) {
363 return 1;
365 if (*s2) {
366 return -1;
368 return 0;
371 /* Search for 's1' inside 's2', starting to search from char 'index' of 's2'.
372 * The index of the first occurrence of s1 in s2 is returned.
373 * If s1 is not found inside s2, -1 is returned.
375 * Note: Lengths and return value are in bytes, not chars.
377 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
379 int i;
380 int l1bytelen;
382 if (!l1 || !l2 || l1 > l2) {
383 return -1;
385 if (idx < 0)
386 idx = 0;
387 s2 += utf8_index(s2, idx);
389 l1bytelen = utf8_index(s1, l1);
391 for (i = idx; i <= l2 - l1; i++) {
392 int c;
393 if (memcmp(s2, s1, l1bytelen) == 0) {
394 return i;
396 s2 += utf8_tounicode(s2, &c);
398 return -1;
401 /* Search for the last occurrence 's1' inside 's2', starting to search from char 'index' of 's2'.
402 * The index of the last occurrence of s1 in s2 is returned.
403 * If s1 is not found inside s2, -1 is returned.
405 * Note: Lengths and return value are in bytes, not chars.
407 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
409 const char *p;
411 if (!l1 || !l2 || l1 > l2)
412 return -1;
414 /* Now search for the needle */
415 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
416 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
417 return p - s2;
420 return -1;
423 #ifdef JIM_UTF8
425 * Per JimStringLast but lengths and return value are in chars, not bytes.
427 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
429 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
430 if (n > 0) {
431 n = utf8_strlen(s2, n);
433 return n;
435 #endif
438 * After an strtol()/strtod()-like conversion,
439 * check whether something was converted and that
440 * the only thing left is white space.
442 * Returns JIM_OK or JIM_ERR.
444 static int JimCheckConversion(const char *str, const char *endptr)
446 if (str[0] == '\0' || str == endptr) {
447 return JIM_ERR;
450 if (endptr[0] != '\0') {
451 while (*endptr) {
452 if (!isspace(UCHAR(*endptr))) {
453 return JIM_ERR;
455 endptr++;
458 return JIM_OK;
461 /* Parses the front of a number to determine its sign and base.
462 * Returns the index to start parsing according to the given base
464 static int JimNumberBase(const char *str, int *base, int *sign)
466 int i = 0;
468 *base = 10;
470 while (isspace(UCHAR(str[i]))) {
471 i++;
474 if (str[i] == '-') {
475 *sign = -1;
476 i++;
478 else {
479 if (str[i] == '+') {
480 i++;
482 *sign = 1;
485 if (str[i] != '0') {
486 /* base 10 */
487 return 0;
490 /* We have 0<x>, so see if we can convert it */
491 switch (str[i + 1]) {
492 case 'x': case 'X': *base = 16; break;
493 case 'o': case 'O': *base = 8; break;
494 case 'b': case 'B': *base = 2; break;
495 default: return 0;
497 i += 2;
498 /* Ensure that (e.g.) 0x-5 fails to parse */
499 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
500 /* Parse according to this base */
501 return i;
503 /* Parse as base 10 */
504 *base = 10;
505 return 0;
508 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
509 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
511 static long jim_strtol(const char *str, char **endptr)
513 int sign;
514 int base;
515 int i = JimNumberBase(str, &base, &sign);
517 if (base != 10) {
518 long value = strtol(str + i, endptr, base);
519 if (endptr == NULL || *endptr != str + i) {
520 return value * sign;
524 /* Can just do a regular base-10 conversion */
525 return strtol(str, endptr, 10);
529 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
530 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
532 static jim_wide jim_strtoull(const char *str, char **endptr)
534 #ifdef HAVE_LONG_LONG
535 int sign;
536 int base;
537 int i = JimNumberBase(str, &base, &sign);
539 if (base != 10) {
540 jim_wide value = strtoull(str + i, endptr, base);
541 if (endptr == NULL || *endptr != str + i) {
542 return value * sign;
546 /* Can just do a regular base-10 conversion */
547 return strtoull(str, endptr, 10);
548 #else
549 return (unsigned long)jim_strtol(str, endptr);
550 #endif
553 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
555 char *endptr;
557 if (base) {
558 *widePtr = strtoull(str, &endptr, base);
560 else {
561 *widePtr = jim_strtoull(str, &endptr);
564 return JimCheckConversion(str, endptr);
567 int Jim_StringToDouble(const char *str, double *doublePtr)
569 char *endptr;
571 /* Callers can check for underflow via ERANGE */
572 errno = 0;
574 *doublePtr = strtod(str, &endptr);
576 return JimCheckConversion(str, endptr);
579 static jim_wide JimPowWide(jim_wide b, jim_wide e)
581 jim_wide res = 1;
583 /* Special cases */
584 if (b == 1) {
585 /* 1 ^ any = 1 */
586 return 1;
588 if (e < 0) {
589 if (b != -1) {
590 return 0;
592 /* Only special case is -1 ^ -n
593 * -1^-1 = -1
594 * -1^-2 = 1
595 * i.e. same as +ve n
597 e = -e;
599 while (e)
601 if (e & 1) {
602 res *= b;
604 e >>= 1;
605 b *= b;
607 return res;
610 /* -----------------------------------------------------------------------------
611 * Special functions
612 * ---------------------------------------------------------------------------*/
613 #ifdef JIM_DEBUG_PANIC
614 static void JimPanicDump(int condition, const char *fmt, ...)
616 va_list ap;
618 if (!condition) {
619 return;
622 va_start(ap, fmt);
624 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
625 vfprintf(stderr, fmt, ap);
626 fprintf(stderr, "\n\n");
627 va_end(ap);
629 #ifdef HAVE_BACKTRACE
631 void *array[40];
632 int size, i;
633 char **strings;
635 size = backtrace(array, 40);
636 strings = backtrace_symbols(array, size);
637 for (i = 0; i < size; i++)
638 fprintf(stderr, "[backtrace] %s\n", strings[i]);
639 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
640 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
642 #endif
644 exit(1);
646 #endif
648 /* -----------------------------------------------------------------------------
649 * Memory allocation
650 * ---------------------------------------------------------------------------*/
652 void *Jim_Alloc(int size)
654 return size ? malloc(size) : NULL;
657 void Jim_Free(void *ptr)
659 free(ptr);
662 void *Jim_Realloc(void *ptr, int size)
664 return realloc(ptr, size);
667 char *Jim_StrDup(const char *s)
669 return strdup(s);
672 char *Jim_StrDupLen(const char *s, int l)
674 char *copy = Jim_Alloc(l + 1);
676 memcpy(copy, s, l + 1);
677 copy[l] = 0; /* Just to be sure, original could be substring */
678 return copy;
681 /* -----------------------------------------------------------------------------
682 * Time related functions
683 * ---------------------------------------------------------------------------*/
685 /* Returns current time in microseconds */
686 static jim_wide JimClock(void)
688 struct timeval tv;
690 gettimeofday(&tv, NULL);
691 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
694 /* -----------------------------------------------------------------------------
695 * Hash Tables
696 * ---------------------------------------------------------------------------*/
698 /* -------------------------- private prototypes ---------------------------- */
699 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
700 static unsigned int JimHashTableNextPower(unsigned int size);
701 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
703 /* -------------------------- hash functions -------------------------------- */
705 /* Thomas Wang's 32 bit Mix Function */
706 unsigned int Jim_IntHashFunction(unsigned int key)
708 key += ~(key << 15);
709 key ^= (key >> 10);
710 key += (key << 3);
711 key ^= (key >> 6);
712 key += ~(key << 11);
713 key ^= (key >> 16);
714 return key;
717 /* Generic hash function (we are using to multiply by 9 and add the byte
718 * as Tcl) */
719 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
721 unsigned int h = 0;
723 while (len--)
724 h += (h << 3) + *buf++;
725 return h;
728 /* ----------------------------- API implementation ------------------------- */
730 /* reset a hashtable already initialized */
731 static void JimResetHashTable(Jim_HashTable *ht)
733 ht->table = NULL;
734 ht->size = 0;
735 ht->sizemask = 0;
736 ht->used = 0;
737 ht->collisions = 0;
738 #ifdef JIM_RANDOMISE_HASH
739 /* This is initialised to a random value to avoid a hash collision attack.
740 * See: n.runs-SA-2011.004
742 ht->uniq = (rand() ^ time(NULL) ^ clock());
743 #else
744 ht->uniq = 0;
745 #endif
748 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
750 iter->ht = ht;
751 iter->index = -1;
752 iter->entry = NULL;
753 iter->nextEntry = NULL;
756 /* Initialize the hash table */
757 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
759 JimResetHashTable(ht);
760 ht->type = type;
761 ht->privdata = privDataPtr;
762 return JIM_OK;
765 /* Resize the table to the minimal size that contains all the elements,
766 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
767 void Jim_ResizeHashTable(Jim_HashTable *ht)
769 int minimal = ht->used;
771 if (minimal < JIM_HT_INITIAL_SIZE)
772 minimal = JIM_HT_INITIAL_SIZE;
773 Jim_ExpandHashTable(ht, minimal);
776 /* Expand or create the hashtable */
777 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
779 Jim_HashTable n; /* the new hashtable */
780 unsigned int realsize = JimHashTableNextPower(size), i;
782 /* the size is invalid if it is smaller than the number of
783 * elements already inside the hashtable */
784 if (size <= ht->used)
785 return;
787 Jim_InitHashTable(&n, ht->type, ht->privdata);
788 n.size = realsize;
789 n.sizemask = realsize - 1;
790 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
791 /* Keep the same 'uniq' as the original */
792 n.uniq = ht->uniq;
794 /* Initialize all the pointers to NULL */
795 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
797 /* Copy all the elements from the old to the new table:
798 * note that if the old hash table is empty ht->used is zero,
799 * so Jim_ExpandHashTable just creates an empty hash table. */
800 n.used = ht->used;
801 for (i = 0; ht->used > 0; i++) {
802 Jim_HashEntry *he, *nextHe;
804 if (ht->table[i] == NULL)
805 continue;
807 /* For each hash entry on this slot... */
808 he = ht->table[i];
809 while (he) {
810 unsigned int h;
812 nextHe = he->next;
813 /* Get the new element index */
814 h = Jim_HashKey(ht, he->key) & n.sizemask;
815 he->next = n.table[h];
816 n.table[h] = he;
817 ht->used--;
818 /* Pass to the next element */
819 he = nextHe;
822 assert(ht->used == 0);
823 Jim_Free(ht->table);
825 /* Remap the new hashtable in the old */
826 *ht = n;
829 /* Add an element to the target hash table */
830 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
832 Jim_HashEntry *entry;
834 /* Get the index of the new element, or -1 if
835 * the element already exists. */
836 entry = JimInsertHashEntry(ht, key, 0);
837 if (entry == NULL)
838 return JIM_ERR;
840 /* Set the hash entry fields. */
841 Jim_SetHashKey(ht, entry, key);
842 Jim_SetHashVal(ht, entry, val);
843 return JIM_OK;
846 /* Add an element, discarding the old if the key already exists */
847 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
849 int existed;
850 Jim_HashEntry *entry;
852 /* Get the index of the new element, or -1 if
853 * the element already exists. */
854 entry = JimInsertHashEntry(ht, key, 1);
855 if (entry->key) {
856 /* It already exists, so only replace the value.
857 * Note if both a destructor and a duplicate function exist,
858 * need to dup before destroy. perhaps they are the same
859 * reference counted object
861 if (ht->type->valDestructor && ht->type->valDup) {
862 void *newval = ht->type->valDup(ht->privdata, val);
863 ht->type->valDestructor(ht->privdata, entry->u.val);
864 entry->u.val = newval;
866 else {
867 Jim_FreeEntryVal(ht, entry);
868 Jim_SetHashVal(ht, entry, val);
870 existed = 1;
872 else {
873 /* Doesn't exist, so set the key */
874 Jim_SetHashKey(ht, entry, key);
875 Jim_SetHashVal(ht, entry, val);
876 existed = 0;
879 return existed;
882 /* Search and remove an element */
883 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
885 unsigned int h;
886 Jim_HashEntry *he, *prevHe;
888 if (ht->used == 0)
889 return JIM_ERR;
890 h = Jim_HashKey(ht, key) & ht->sizemask;
891 he = ht->table[h];
893 prevHe = NULL;
894 while (he) {
895 if (Jim_CompareHashKeys(ht, key, he->key)) {
896 /* Unlink the element from the list */
897 if (prevHe)
898 prevHe->next = he->next;
899 else
900 ht->table[h] = he->next;
901 Jim_FreeEntryKey(ht, he);
902 Jim_FreeEntryVal(ht, he);
903 Jim_Free(he);
904 ht->used--;
905 return JIM_OK;
907 prevHe = he;
908 he = he->next;
910 return JIM_ERR; /* not found */
913 /* Destroy an entire hash table and leave it ready for reuse */
914 int Jim_FreeHashTable(Jim_HashTable *ht)
916 unsigned int i;
918 /* Free all the elements */
919 for (i = 0; ht->used > 0; i++) {
920 Jim_HashEntry *he, *nextHe;
922 if ((he = ht->table[i]) == NULL)
923 continue;
924 while (he) {
925 nextHe = he->next;
926 Jim_FreeEntryKey(ht, he);
927 Jim_FreeEntryVal(ht, he);
928 Jim_Free(he);
929 ht->used--;
930 he = nextHe;
933 /* Free the table and the allocated cache structure */
934 Jim_Free(ht->table);
935 /* Re-initialize the table */
936 JimResetHashTable(ht);
937 return JIM_OK; /* never fails */
940 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
942 Jim_HashEntry *he;
943 unsigned int h;
945 if (ht->used == 0)
946 return NULL;
947 h = Jim_HashKey(ht, key) & ht->sizemask;
948 he = ht->table[h];
949 while (he) {
950 if (Jim_CompareHashKeys(ht, key, he->key))
951 return he;
952 he = he->next;
954 return NULL;
957 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
959 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
960 JimInitHashTableIterator(ht, iter);
961 return iter;
964 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
966 while (1) {
967 if (iter->entry == NULL) {
968 iter->index++;
969 if (iter->index >= (signed)iter->ht->size)
970 break;
971 iter->entry = iter->ht->table[iter->index];
973 else {
974 iter->entry = iter->nextEntry;
976 if (iter->entry) {
977 /* We need to save the 'next' here, the iterator user
978 * may delete the entry we are returning. */
979 iter->nextEntry = iter->entry->next;
980 return iter->entry;
983 return NULL;
986 /* ------------------------- private functions ------------------------------ */
988 /* Expand the hash table if needed */
989 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
991 /* If the hash table is empty expand it to the intial size,
992 * if the table is "full" double its size. */
993 if (ht->size == 0)
994 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
995 if (ht->size == ht->used)
996 Jim_ExpandHashTable(ht, ht->size * 2);
999 /* Our hash table capability is a power of two */
1000 static unsigned int JimHashTableNextPower(unsigned int size)
1002 unsigned int i = JIM_HT_INITIAL_SIZE;
1004 if (size >= 2147483648U)
1005 return 2147483648U;
1006 while (1) {
1007 if (i >= size)
1008 return i;
1009 i *= 2;
1013 /* Returns the index of a free slot that can be populated with
1014 * a hash entry for the given 'key'.
1015 * If the key already exists, -1 is returned. */
1016 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1018 unsigned int h;
1019 Jim_HashEntry *he;
1021 /* Expand the hashtable if needed */
1022 JimExpandHashTableIfNeeded(ht);
1024 /* Compute the key hash value */
1025 h = Jim_HashKey(ht, key) & ht->sizemask;
1026 /* Search if this slot does not already contain the given key */
1027 he = ht->table[h];
1028 while (he) {
1029 if (Jim_CompareHashKeys(ht, key, he->key))
1030 return replace ? he : NULL;
1031 he = he->next;
1034 /* Allocates the memory and stores key */
1035 he = Jim_Alloc(sizeof(*he));
1036 he->next = ht->table[h];
1037 ht->table[h] = he;
1038 ht->used++;
1039 he->key = NULL;
1041 return he;
1044 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1046 static unsigned int JimStringCopyHTHashFunction(const void *key)
1048 return Jim_GenHashFunction(key, strlen(key));
1051 static void *JimStringCopyHTDup(void *privdata, const void *key)
1053 return Jim_StrDup(key);
1056 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1058 return strcmp(key1, key2) == 0;
1061 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1063 Jim_Free(key);
1066 static const Jim_HashTableType JimPackageHashTableType = {
1067 JimStringCopyHTHashFunction, /* hash function */
1068 JimStringCopyHTDup, /* key dup */
1069 NULL, /* val dup */
1070 JimStringCopyHTKeyCompare, /* key compare */
1071 JimStringCopyHTKeyDestructor, /* key destructor */
1072 NULL /* val destructor */
1075 typedef struct AssocDataValue
1077 Jim_InterpDeleteProc *delProc;
1078 void *data;
1079 } AssocDataValue;
1081 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1083 AssocDataValue *assocPtr = (AssocDataValue *) data;
1085 if (assocPtr->delProc != NULL)
1086 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1087 Jim_Free(data);
1090 static const Jim_HashTableType JimAssocDataHashTableType = {
1091 JimStringCopyHTHashFunction, /* hash function */
1092 JimStringCopyHTDup, /* key dup */
1093 NULL, /* val dup */
1094 JimStringCopyHTKeyCompare, /* key compare */
1095 JimStringCopyHTKeyDestructor, /* key destructor */
1096 JimAssocDataHashTableValueDestructor /* val destructor */
1099 /* -----------------------------------------------------------------------------
1100 * Stack - This is a simple generic stack implementation. It is used for
1101 * example in the 'expr' expression compiler.
1102 * ---------------------------------------------------------------------------*/
1103 void Jim_InitStack(Jim_Stack *stack)
1105 stack->len = 0;
1106 stack->maxlen = 0;
1107 stack->vector = NULL;
1110 void Jim_FreeStack(Jim_Stack *stack)
1112 Jim_Free(stack->vector);
1115 int Jim_StackLen(Jim_Stack *stack)
1117 return stack->len;
1120 void Jim_StackPush(Jim_Stack *stack, void *element)
1122 int neededLen = stack->len + 1;
1124 if (neededLen > stack->maxlen) {
1125 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1126 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1128 stack->vector[stack->len] = element;
1129 stack->len++;
1132 void *Jim_StackPop(Jim_Stack *stack)
1134 if (stack->len == 0)
1135 return NULL;
1136 stack->len--;
1137 return stack->vector[stack->len];
1140 void *Jim_StackPeek(Jim_Stack *stack)
1142 if (stack->len == 0)
1143 return NULL;
1144 return stack->vector[stack->len - 1];
1147 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1149 int i;
1151 for (i = 0; i < stack->len; i++)
1152 freeFunc(stack->vector[i]);
1155 /* -----------------------------------------------------------------------------
1156 * Tcl Parser
1157 * ---------------------------------------------------------------------------*/
1159 /* Token types */
1160 #define JIM_TT_NONE 0 /* No token returned */
1161 #define JIM_TT_STR 1 /* simple string */
1162 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1163 #define JIM_TT_VAR 3 /* var substitution */
1164 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1165 #define JIM_TT_CMD 5 /* command substitution */
1166 /* Note: Keep these three together for TOKEN_IS_SEP() */
1167 #define JIM_TT_SEP 6 /* word separator (white space) */
1168 #define JIM_TT_EOL 7 /* line separator */
1169 #define JIM_TT_EOF 8 /* end of script */
1171 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1172 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1174 /* Additional token types needed for expressions */
1175 #define JIM_TT_SUBEXPR_START 11
1176 #define JIM_TT_SUBEXPR_END 12
1177 #define JIM_TT_SUBEXPR_COMMA 13
1178 #define JIM_TT_EXPR_INT 14
1179 #define JIM_TT_EXPR_DOUBLE 15
1180 #define JIM_TT_EXPR_BOOLEAN 16
1182 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1184 /* Operator token types start here */
1185 #define JIM_TT_EXPR_OP 20
1187 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1188 /* Can this token start an expression? */
1189 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1190 /* Is this token an expression operator? */
1191 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1194 * Results of missing quotes, braces, etc. from parsing.
1196 struct JimParseMissing {
1197 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\', '}' if incomplete */
1198 int line; /* Line number starting the missing token */
1201 /* Parser context structure. The same context is used to parse
1202 * Tcl scripts, expressions and lists. */
1203 struct JimParserCtx
1205 const char *p; /* Pointer to the point of the program we are parsing */
1206 int len; /* Remaining length */
1207 int linenr; /* Current line number */
1208 const char *tstart;
1209 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1210 int tline; /* Line number of the returned token */
1211 int tt; /* Token type */
1212 int eof; /* Non zero if EOF condition is true. */
1213 int inquote; /* Parsing a quoted string */
1214 int comment; /* Non zero if the next chars may be a comment. */
1215 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1218 static int JimParseScript(struct JimParserCtx *pc);
1219 static int JimParseSep(struct JimParserCtx *pc);
1220 static int JimParseEol(struct JimParserCtx *pc);
1221 static int JimParseCmd(struct JimParserCtx *pc);
1222 static int JimParseQuote(struct JimParserCtx *pc);
1223 static int JimParseVar(struct JimParserCtx *pc);
1224 static int JimParseBrace(struct JimParserCtx *pc);
1225 static int JimParseStr(struct JimParserCtx *pc);
1226 static int JimParseComment(struct JimParserCtx *pc);
1227 static void JimParseSubCmd(struct JimParserCtx *pc);
1228 static int JimParseSubQuote(struct JimParserCtx *pc);
1229 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1231 /* Initialize a parser context.
1232 * 'prg' is a pointer to the program text, linenr is the line
1233 * number of the first line contained in the program. */
1234 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1236 pc->p = prg;
1237 pc->len = len;
1238 pc->tstart = NULL;
1239 pc->tend = NULL;
1240 pc->tline = 0;
1241 pc->tt = JIM_TT_NONE;
1242 pc->eof = 0;
1243 pc->inquote = 0;
1244 pc->linenr = linenr;
1245 pc->comment = 1;
1246 pc->missing.ch = ' ';
1247 pc->missing.line = linenr;
1250 static int JimParseScript(struct JimParserCtx *pc)
1252 while (1) { /* the while is used to reiterate with continue if needed */
1253 if (!pc->len) {
1254 pc->tstart = pc->p;
1255 pc->tend = pc->p - 1;
1256 pc->tline = pc->linenr;
1257 pc->tt = JIM_TT_EOL;
1258 pc->eof = 1;
1259 return JIM_OK;
1261 switch (*(pc->p)) {
1262 case '\\':
1263 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1264 return JimParseSep(pc);
1266 pc->comment = 0;
1267 return JimParseStr(pc);
1268 case ' ':
1269 case '\t':
1270 case '\r':
1271 case '\f':
1272 if (!pc->inquote)
1273 return JimParseSep(pc);
1274 pc->comment = 0;
1275 return JimParseStr(pc);
1276 case '\n':
1277 case ';':
1278 pc->comment = 1;
1279 if (!pc->inquote)
1280 return JimParseEol(pc);
1281 return JimParseStr(pc);
1282 case '[':
1283 pc->comment = 0;
1284 return JimParseCmd(pc);
1285 case '$':
1286 pc->comment = 0;
1287 if (JimParseVar(pc) == JIM_ERR) {
1288 /* An orphan $. Create as a separate token */
1289 pc->tstart = pc->tend = pc->p++;
1290 pc->len--;
1291 pc->tt = JIM_TT_ESC;
1293 return JIM_OK;
1294 case '#':
1295 if (pc->comment) {
1296 JimParseComment(pc);
1297 continue;
1299 return JimParseStr(pc);
1300 default:
1301 pc->comment = 0;
1302 return JimParseStr(pc);
1304 return JIM_OK;
1308 static int JimParseSep(struct JimParserCtx *pc)
1310 pc->tstart = pc->p;
1311 pc->tline = pc->linenr;
1312 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1313 if (*pc->p == '\n') {
1314 break;
1316 if (*pc->p == '\\') {
1317 pc->p++;
1318 pc->len--;
1319 pc->linenr++;
1321 pc->p++;
1322 pc->len--;
1324 pc->tend = pc->p - 1;
1325 pc->tt = JIM_TT_SEP;
1326 return JIM_OK;
1329 static int JimParseEol(struct JimParserCtx *pc)
1331 pc->tstart = pc->p;
1332 pc->tline = pc->linenr;
1333 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1334 if (*pc->p == '\n')
1335 pc->linenr++;
1336 pc->p++;
1337 pc->len--;
1339 pc->tend = pc->p - 1;
1340 pc->tt = JIM_TT_EOL;
1341 return JIM_OK;
1345 ** Here are the rules for parsing:
1346 ** {braced expression}
1347 ** - Count open and closing braces
1348 ** - Backslash escapes meaning of braces but doesn't remove the backslash
1350 ** "quoted expression"
1351 ** - Unescaped double quote terminates the expression
1352 ** - Backslash escapes next char
1353 ** - [commands brackets] are counted/nested
1354 ** - command rules apply within [brackets], not quoting rules (i.e. brackets have their own rules)
1356 ** [command expression]
1357 ** - Count open and closing brackets
1358 ** - Backslash escapes next char
1359 ** - [commands brackets] are counted/nested
1360 ** - "quoted expressions" are parsed according to quoting rules
1361 ** - {braced expressions} are parsed according to brace rules
1363 ** For everything, backslash escapes the next char, newline increments current line
1367 * Parses a braced expression starting at pc->p.
1369 * Positions the parser at the end of the braced expression,
1370 * sets pc->tend and possibly pc->missing.
1372 static void JimParseSubBrace(struct JimParserCtx *pc)
1374 int level = 1;
1376 /* Skip the brace */
1377 pc->p++;
1378 pc->len--;
1379 while (pc->len) {
1380 switch (*pc->p) {
1381 case '\\':
1382 if (pc->len > 1) {
1383 if (*++pc->p == '\n') {
1384 pc->linenr++;
1386 pc->len--;
1388 break;
1390 case '{':
1391 level++;
1392 break;
1394 case '}':
1395 if (--level == 0) {
1396 pc->tend = pc->p - 1;
1397 pc->p++;
1398 pc->len--;
1399 return;
1401 break;
1403 case '\n':
1404 pc->linenr++;
1405 break;
1407 pc->p++;
1408 pc->len--;
1410 pc->missing.ch = '{';
1411 pc->missing.line = pc->tline;
1412 pc->tend = pc->p - 1;
1416 * Parses a quoted expression starting at pc->p.
1418 * Positions the parser at the end of the quoted expression,
1419 * sets pc->tend and possibly pc->missing.
1421 * Returns the type of the token of the string,
1422 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1423 * or JIM_TT_STR.
1425 static int JimParseSubQuote(struct JimParserCtx *pc)
1427 int tt = JIM_TT_STR;
1428 int line = pc->tline;
1430 /* Skip the quote */
1431 pc->p++;
1432 pc->len--;
1433 while (pc->len) {
1434 switch (*pc->p) {
1435 case '\\':
1436 if (pc->len > 1) {
1437 if (*++pc->p == '\n') {
1438 pc->linenr++;
1440 pc->len--;
1441 tt = JIM_TT_ESC;
1443 break;
1445 case '"':
1446 pc->tend = pc->p - 1;
1447 pc->p++;
1448 pc->len--;
1449 return tt;
1451 case '[':
1452 JimParseSubCmd(pc);
1453 tt = JIM_TT_ESC;
1454 continue;
1456 case '\n':
1457 pc->linenr++;
1458 break;
1460 case '$':
1461 tt = JIM_TT_ESC;
1462 break;
1464 pc->p++;
1465 pc->len--;
1467 pc->missing.ch = '"';
1468 pc->missing.line = line;
1469 pc->tend = pc->p - 1;
1470 return tt;
1474 * Parses a [command] expression starting at pc->p.
1476 * Positions the parser at the end of the command expression,
1477 * sets pc->tend and possibly pc->missing.
1479 static void JimParseSubCmd(struct JimParserCtx *pc)
1481 int level = 1;
1482 int startofword = 1;
1483 int line = pc->tline;
1485 /* Skip the bracket */
1486 pc->p++;
1487 pc->len--;
1488 while (pc->len) {
1489 switch (*pc->p) {
1490 case '\\':
1491 if (pc->len > 1) {
1492 if (*++pc->p == '\n') {
1493 pc->linenr++;
1495 pc->len--;
1497 break;
1499 case '[':
1500 level++;
1501 break;
1503 case ']':
1504 if (--level == 0) {
1505 pc->tend = pc->p - 1;
1506 pc->p++;
1507 pc->len--;
1508 return;
1510 break;
1512 case '"':
1513 if (startofword) {
1514 JimParseSubQuote(pc);
1515 continue;
1517 break;
1519 case '{':
1520 JimParseSubBrace(pc);
1521 startofword = 0;
1522 continue;
1524 case '\n':
1525 pc->linenr++;
1526 break;
1528 startofword = isspace(UCHAR(*pc->p));
1529 pc->p++;
1530 pc->len--;
1532 pc->missing.ch = '[';
1533 pc->missing.line = line;
1534 pc->tend = pc->p - 1;
1537 static int JimParseBrace(struct JimParserCtx *pc)
1539 pc->tstart = pc->p + 1;
1540 pc->tline = pc->linenr;
1541 pc->tt = JIM_TT_STR;
1542 JimParseSubBrace(pc);
1543 return JIM_OK;
1546 static int JimParseCmd(struct JimParserCtx *pc)
1548 pc->tstart = pc->p + 1;
1549 pc->tline = pc->linenr;
1550 pc->tt = JIM_TT_CMD;
1551 JimParseSubCmd(pc);
1552 return JIM_OK;
1555 static int JimParseQuote(struct JimParserCtx *pc)
1557 pc->tstart = pc->p + 1;
1558 pc->tline = pc->linenr;
1559 pc->tt = JimParseSubQuote(pc);
1560 return JIM_OK;
1563 static int JimParseVar(struct JimParserCtx *pc)
1565 /* skip the $ */
1566 pc->p++;
1567 pc->len--;
1569 #ifdef EXPRSUGAR_BRACKET
1570 if (*pc->p == '[') {
1571 /* Parse $[...] expr shorthand syntax */
1572 JimParseCmd(pc);
1573 pc->tt = JIM_TT_EXPRSUGAR;
1574 return JIM_OK;
1576 #endif
1578 pc->tstart = pc->p;
1579 pc->tt = JIM_TT_VAR;
1580 pc->tline = pc->linenr;
1582 if (*pc->p == '{') {
1583 pc->tstart = ++pc->p;
1584 pc->len--;
1586 while (pc->len && *pc->p != '}') {
1587 if (*pc->p == '\n') {
1588 pc->linenr++;
1590 pc->p++;
1591 pc->len--;
1593 pc->tend = pc->p - 1;
1594 if (pc->len) {
1595 pc->p++;
1596 pc->len--;
1599 else {
1600 while (1) {
1601 /* Skip double colon, but not single colon! */
1602 if (pc->p[0] == ':' && pc->p[1] == ':') {
1603 while (*pc->p == ':') {
1604 pc->p++;
1605 pc->len--;
1607 continue;
1609 /* Note that any char >= 0x80 must be part of a utf-8 char.
1610 * We consider all unicode points outside of ASCII as letters
1612 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1613 pc->p++;
1614 pc->len--;
1615 continue;
1617 break;
1619 /* Parse [dict get] syntax sugar. */
1620 if (*pc->p == '(') {
1621 int count = 1;
1622 const char *paren = NULL;
1624 pc->tt = JIM_TT_DICTSUGAR;
1626 while (count && pc->len) {
1627 pc->p++;
1628 pc->len--;
1629 if (*pc->p == '\\' && pc->len >= 1) {
1630 pc->p++;
1631 pc->len--;
1633 else if (*pc->p == '(') {
1634 count++;
1636 else if (*pc->p == ')') {
1637 paren = pc->p;
1638 count--;
1641 if (count == 0) {
1642 pc->p++;
1643 pc->len--;
1645 else if (paren) {
1646 /* Did not find a matching paren. Back up */
1647 paren++;
1648 pc->len += (pc->p - paren);
1649 pc->p = paren;
1651 #ifndef EXPRSUGAR_BRACKET
1652 if (*pc->tstart == '(') {
1653 pc->tt = JIM_TT_EXPRSUGAR;
1655 #endif
1657 pc->tend = pc->p - 1;
1659 /* Check if we parsed just the '$' character.
1660 * That's not a variable so an error is returned
1661 * to tell the state machine to consider this '$' just
1662 * a string. */
1663 if (pc->tstart == pc->p) {
1664 pc->p--;
1665 pc->len++;
1666 return JIM_ERR;
1668 return JIM_OK;
1671 static int JimParseStr(struct JimParserCtx *pc)
1673 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1674 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1675 /* Starting a new word */
1676 if (*pc->p == '{') {
1677 return JimParseBrace(pc);
1679 if (*pc->p == '"') {
1680 pc->inquote = 1;
1681 pc->p++;
1682 pc->len--;
1683 /* In case the end quote is missing */
1684 pc->missing.line = pc->tline;
1687 pc->tstart = pc->p;
1688 pc->tline = pc->linenr;
1689 while (1) {
1690 if (pc->len == 0) {
1691 if (pc->inquote) {
1692 pc->missing.ch = '"';
1694 pc->tend = pc->p - 1;
1695 pc->tt = JIM_TT_ESC;
1696 return JIM_OK;
1698 switch (*pc->p) {
1699 case '\\':
1700 if (!pc->inquote && *(pc->p + 1) == '\n') {
1701 pc->tend = pc->p - 1;
1702 pc->tt = JIM_TT_ESC;
1703 return JIM_OK;
1705 if (pc->len >= 2) {
1706 if (*(pc->p + 1) == '\n') {
1707 pc->linenr++;
1709 pc->p++;
1710 pc->len--;
1712 else if (pc->len == 1) {
1713 /* End of script with trailing backslash */
1714 pc->missing.ch = '\\';
1716 break;
1717 case '(':
1718 /* If the following token is not '$' just keep going */
1719 if (pc->len > 1 && pc->p[1] != '$') {
1720 break;
1722 /* fall through */
1723 case ')':
1724 /* Only need a separate ')' token if the previous was a var */
1725 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1726 if (pc->p == pc->tstart) {
1727 /* At the start of the token, so just return this char */
1728 pc->p++;
1729 pc->len--;
1731 pc->tend = pc->p - 1;
1732 pc->tt = JIM_TT_ESC;
1733 return JIM_OK;
1735 break;
1737 case '$':
1738 case '[':
1739 pc->tend = pc->p - 1;
1740 pc->tt = JIM_TT_ESC;
1741 return JIM_OK;
1742 case ' ':
1743 case '\t':
1744 case '\n':
1745 case '\r':
1746 case '\f':
1747 case ';':
1748 if (!pc->inquote) {
1749 pc->tend = pc->p - 1;
1750 pc->tt = JIM_TT_ESC;
1751 return JIM_OK;
1753 else if (*pc->p == '\n') {
1754 pc->linenr++;
1756 break;
1757 case '"':
1758 if (pc->inquote) {
1759 pc->tend = pc->p - 1;
1760 pc->tt = JIM_TT_ESC;
1761 pc->p++;
1762 pc->len--;
1763 pc->inquote = 0;
1764 return JIM_OK;
1766 break;
1768 pc->p++;
1769 pc->len--;
1771 return JIM_OK; /* unreached */
1774 static int JimParseComment(struct JimParserCtx *pc)
1776 while (*pc->p) {
1777 if (*pc->p == '\\') {
1778 pc->p++;
1779 pc->len--;
1780 if (pc->len == 0) {
1781 pc->missing.ch = '\\';
1782 return JIM_OK;
1784 if (*pc->p == '\n') {
1785 pc->linenr++;
1788 else if (*pc->p == '\n') {
1789 pc->p++;
1790 pc->len--;
1791 pc->linenr++;
1792 break;
1794 pc->p++;
1795 pc->len--;
1797 return JIM_OK;
1800 /* xdigitval and odigitval are helper functions for JimEscape() */
1801 static int xdigitval(int c)
1803 if (c >= '0' && c <= '9')
1804 return c - '0';
1805 if (c >= 'a' && c <= 'f')
1806 return c - 'a' + 10;
1807 if (c >= 'A' && c <= 'F')
1808 return c - 'A' + 10;
1809 return -1;
1812 static int odigitval(int c)
1814 if (c >= '0' && c <= '7')
1815 return c - '0';
1816 return -1;
1819 /* Perform Tcl escape substitution of 's', storing the result
1820 * string into 'dest'. The escaped string is guaranteed to
1821 * be the same length or shorter than the source string.
1822 * slen is the length of the string at 's'.
1824 * The function returns the length of the resulting string. */
1825 static int JimEscape(char *dest, const char *s, int slen)
1827 char *p = dest;
1828 int i, len;
1830 for (i = 0; i < slen; i++) {
1831 switch (s[i]) {
1832 case '\\':
1833 switch (s[i + 1]) {
1834 case 'a':
1835 *p++ = 0x7;
1836 i++;
1837 break;
1838 case 'b':
1839 *p++ = 0x8;
1840 i++;
1841 break;
1842 case 'f':
1843 *p++ = 0xc;
1844 i++;
1845 break;
1846 case 'n':
1847 *p++ = 0xa;
1848 i++;
1849 break;
1850 case 'r':
1851 *p++ = 0xd;
1852 i++;
1853 break;
1854 case 't':
1855 *p++ = 0x9;
1856 i++;
1857 break;
1858 case 'u':
1859 case 'U':
1860 case 'x':
1861 /* A unicode or hex sequence.
1862 * \x Expect 1-2 hex chars and convert to hex.
1863 * \u Expect 1-4 hex chars and convert to utf-8.
1864 * \U Expect 1-8 hex chars and convert to utf-8.
1865 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1866 * An invalid sequence means simply the escaped char.
1869 unsigned val = 0;
1870 int k;
1871 int maxchars = 2;
1873 i++;
1875 if (s[i] == 'U') {
1876 maxchars = 8;
1878 else if (s[i] == 'u') {
1879 if (s[i + 1] == '{') {
1880 maxchars = 6;
1881 i++;
1883 else {
1884 maxchars = 4;
1888 for (k = 0; k < maxchars; k++) {
1889 int c = xdigitval(s[i + k + 1]);
1890 if (c == -1) {
1891 break;
1893 val = (val << 4) | c;
1895 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1896 if (s[i] == '{') {
1897 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1898 /* Back up */
1899 i--;
1900 k = 0;
1902 else {
1903 /* Skip the closing brace */
1904 k++;
1907 if (k) {
1908 /* Got a valid sequence, so convert */
1909 if (s[i] == 'x') {
1910 *p++ = val;
1912 else {
1913 p += utf8_fromunicode(p, val);
1915 i += k;
1916 break;
1918 /* Not a valid codepoint, just an escaped char */
1919 *p++ = s[i];
1921 break;
1922 case 'v':
1923 *p++ = 0xb;
1924 i++;
1925 break;
1926 case '\0':
1927 *p++ = '\\';
1928 i++;
1929 break;
1930 case '\n':
1931 /* Replace all spaces and tabs after backslash newline with a single space*/
1932 *p++ = ' ';
1933 do {
1934 i++;
1935 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1936 break;
1937 case '0':
1938 case '1':
1939 case '2':
1940 case '3':
1941 case '4':
1942 case '5':
1943 case '6':
1944 case '7':
1945 /* octal escape */
1947 int val = 0;
1948 int c = odigitval(s[i + 1]);
1950 val = c;
1951 c = odigitval(s[i + 2]);
1952 if (c == -1) {
1953 *p++ = val;
1954 i++;
1955 break;
1957 val = (val * 8) + c;
1958 c = odigitval(s[i + 3]);
1959 if (c == -1) {
1960 *p++ = val;
1961 i += 2;
1962 break;
1964 val = (val * 8) + c;
1965 *p++ = val;
1966 i += 3;
1968 break;
1969 default:
1970 *p++ = s[i + 1];
1971 i++;
1972 break;
1974 break;
1975 default:
1976 *p++ = s[i];
1977 break;
1980 len = p - dest;
1981 *p = '\0';
1982 return len;
1985 /* Returns a dynamically allocated copy of the current token in the
1986 * parser context. The function performs conversion of escapes if
1987 * the token is of type JIM_TT_ESC.
1989 * Note that after the conversion, tokens that are grouped with
1990 * braces in the source code, are always recognizable from the
1991 * identical string obtained in a different way from the type.
1993 * For example the string:
1995 * {*}$a
1997 * will return as first token "*", of type JIM_TT_STR
1999 * While the string:
2001 * *$a
2003 * will return as first token "*", of type JIM_TT_ESC
2005 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
2007 const char *start, *end;
2008 char *token;
2009 int len;
2011 start = pc->tstart;
2012 end = pc->tend;
2013 len = (end - start) + 1;
2014 if (len < 0) {
2015 len = 0;
2017 token = Jim_Alloc(len + 1);
2018 if (pc->tt != JIM_TT_ESC) {
2019 /* No escape conversion needed? Just copy it. */
2020 memcpy(token, start, len);
2021 token[len] = '\0';
2023 else {
2024 /* Else convert the escape chars. */
2025 len = JimEscape(token, start, len);
2028 return Jim_NewStringObjNoAlloc(interp, token, len);
2031 /* -----------------------------------------------------------------------------
2032 * Tcl Lists parsing
2033 * ---------------------------------------------------------------------------*/
2034 static int JimParseListSep(struct JimParserCtx *pc);
2035 static int JimParseListStr(struct JimParserCtx *pc);
2036 static int JimParseListQuote(struct JimParserCtx *pc);
2038 static int JimParseList(struct JimParserCtx *pc)
2040 if (isspace(UCHAR(*pc->p))) {
2041 return JimParseListSep(pc);
2043 switch (*pc->p) {
2044 case '"':
2045 return JimParseListQuote(pc);
2047 case '{':
2048 return JimParseBrace(pc);
2050 default:
2051 if (pc->len) {
2052 return JimParseListStr(pc);
2054 break;
2057 pc->tstart = pc->tend = pc->p;
2058 pc->tline = pc->linenr;
2059 pc->tt = JIM_TT_EOL;
2060 pc->eof = 1;
2061 return JIM_OK;
2064 static int JimParseListSep(struct JimParserCtx *pc)
2066 pc->tstart = pc->p;
2067 pc->tline = pc->linenr;
2068 while (isspace(UCHAR(*pc->p))) {
2069 if (*pc->p == '\n') {
2070 pc->linenr++;
2072 pc->p++;
2073 pc->len--;
2075 pc->tend = pc->p - 1;
2076 pc->tt = JIM_TT_SEP;
2077 return JIM_OK;
2080 static int JimParseListQuote(struct JimParserCtx *pc)
2082 pc->p++;
2083 pc->len--;
2085 pc->tstart = pc->p;
2086 pc->tline = pc->linenr;
2087 pc->tt = JIM_TT_STR;
2089 while (pc->len) {
2090 switch (*pc->p) {
2091 case '\\':
2092 pc->tt = JIM_TT_ESC;
2093 if (--pc->len == 0) {
2094 /* Trailing backslash */
2095 pc->tend = pc->p;
2096 return JIM_OK;
2098 pc->p++;
2099 break;
2100 case '\n':
2101 pc->linenr++;
2102 break;
2103 case '"':
2104 pc->tend = pc->p - 1;
2105 pc->p++;
2106 pc->len--;
2107 return JIM_OK;
2109 pc->p++;
2110 pc->len--;
2113 pc->tend = pc->p - 1;
2114 return JIM_OK;
2117 static int JimParseListStr(struct JimParserCtx *pc)
2119 pc->tstart = pc->p;
2120 pc->tline = pc->linenr;
2121 pc->tt = JIM_TT_STR;
2123 while (pc->len) {
2124 if (isspace(UCHAR(*pc->p))) {
2125 pc->tend = pc->p - 1;
2126 return JIM_OK;
2128 if (*pc->p == '\\') {
2129 if (--pc->len == 0) {
2130 /* Trailing backslash */
2131 pc->tend = pc->p;
2132 return JIM_OK;
2134 pc->tt = JIM_TT_ESC;
2135 pc->p++;
2137 pc->p++;
2138 pc->len--;
2140 pc->tend = pc->p - 1;
2141 return JIM_OK;
2144 /* -----------------------------------------------------------------------------
2145 * Jim_Obj related functions
2146 * ---------------------------------------------------------------------------*/
2148 /* Return a new initialized object. */
2149 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2151 Jim_Obj *objPtr;
2153 /* -- Check if there are objects in the free list -- */
2154 if (interp->freeList != NULL) {
2155 /* -- Unlink the object from the free list -- */
2156 objPtr = interp->freeList;
2157 interp->freeList = objPtr->nextObjPtr;
2159 else {
2160 /* -- No ready to use objects: allocate a new one -- */
2161 objPtr = Jim_Alloc(sizeof(*objPtr));
2164 /* Object is returned with refCount of 0. Every
2165 * kind of GC implemented should take care to avoid
2166 * scanning objects with refCount == 0. */
2167 objPtr->refCount = 0;
2168 /* All the other fields are left uninitialized to save time.
2169 * The caller will probably want to set them to the right
2170 * value anyway. */
2172 /* -- Put the object into the live list -- */
2173 objPtr->prevObjPtr = NULL;
2174 objPtr->nextObjPtr = interp->liveList;
2175 if (interp->liveList)
2176 interp->liveList->prevObjPtr = objPtr;
2177 interp->liveList = objPtr;
2179 return objPtr;
2182 /* Free an object. Actually objects are never freed, but
2183 * just moved to the free objects list, where they will be
2184 * reused by Jim_NewObj(). */
2185 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2187 /* Check if the object was already freed, panic. */
2188 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2189 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2191 /* Free the internal representation */
2192 Jim_FreeIntRep(interp, objPtr);
2193 /* Free the string representation */
2194 if (objPtr->bytes != NULL) {
2195 if (objPtr->bytes != JimEmptyStringRep)
2196 Jim_Free(objPtr->bytes);
2198 /* Unlink the object from the live objects list */
2199 if (objPtr->prevObjPtr)
2200 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2201 if (objPtr->nextObjPtr)
2202 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2203 if (interp->liveList == objPtr)
2204 interp->liveList = objPtr->nextObjPtr;
2205 #ifdef JIM_DISABLE_OBJECT_POOL
2206 Jim_Free(objPtr);
2207 #else
2208 /* Link the object into the free objects list */
2209 objPtr->prevObjPtr = NULL;
2210 objPtr->nextObjPtr = interp->freeList;
2211 if (interp->freeList)
2212 interp->freeList->prevObjPtr = objPtr;
2213 interp->freeList = objPtr;
2214 objPtr->refCount = -1;
2215 #endif
2218 /* Invalidate the string representation of an object. */
2219 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2221 if (objPtr->bytes != NULL) {
2222 if (objPtr->bytes != JimEmptyStringRep)
2223 Jim_Free(objPtr->bytes);
2225 objPtr->bytes = NULL;
2228 /* Duplicate an object. The returned object has refcount = 0. */
2229 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2231 Jim_Obj *dupPtr;
2233 dupPtr = Jim_NewObj(interp);
2234 if (objPtr->bytes == NULL) {
2235 /* Object does not have a valid string representation. */
2236 dupPtr->bytes = NULL;
2238 else if (objPtr->length == 0) {
2239 /* Zero length, so don't even bother with the type-specific dup,
2240 * since all zero length objects look the same
2242 dupPtr->bytes = JimEmptyStringRep;
2243 dupPtr->length = 0;
2244 dupPtr->typePtr = NULL;
2245 return dupPtr;
2247 else {
2248 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2249 dupPtr->length = objPtr->length;
2250 /* Copy the null byte too */
2251 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2254 /* By default, the new object has the same type as the old object */
2255 dupPtr->typePtr = objPtr->typePtr;
2256 if (objPtr->typePtr != NULL) {
2257 if (objPtr->typePtr->dupIntRepProc == NULL) {
2258 dupPtr->internalRep = objPtr->internalRep;
2260 else {
2261 /* The dup proc may set a different type, e.g. NULL */
2262 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2265 return dupPtr;
2268 /* Return the string representation for objPtr. If the object's
2269 * string representation is invalid, calls the updateStringProc method to create
2270 * a new one from the internal representation of the object.
2272 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2274 if (objPtr->bytes == NULL) {
2275 /* Invalid string repr. Generate it. */
2276 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2277 objPtr->typePtr->updateStringProc(objPtr);
2279 if (lenPtr)
2280 *lenPtr = objPtr->length;
2281 return objPtr->bytes;
2284 /* Just returns the length (in bytes) of the object's string rep */
2285 int Jim_Length(Jim_Obj *objPtr)
2287 if (objPtr->bytes == NULL) {
2288 /* Invalid string repr. Generate it. */
2289 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2290 objPtr->typePtr->updateStringProc(objPtr);
2292 return objPtr->length;
2295 /* Just returns object's string rep */
2296 const char *Jim_String(Jim_Obj *objPtr)
2298 if (objPtr->bytes == NULL) {
2299 /* Invalid string repr. Generate it. */
2300 JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value."));
2301 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2302 objPtr->typePtr->updateStringProc(objPtr);
2304 return objPtr->bytes;
2307 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2309 objPtr->bytes = Jim_StrDup(str);
2310 objPtr->length = strlen(str);
2313 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2314 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2316 static const Jim_ObjType dictSubstObjType = {
2317 "dict-substitution",
2318 FreeDictSubstInternalRep,
2319 DupDictSubstInternalRep,
2320 NULL,
2321 JIM_TYPE_NONE,
2324 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2325 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2327 static const Jim_ObjType interpolatedObjType = {
2328 "interpolated",
2329 FreeInterpolatedInternalRep,
2330 DupInterpolatedInternalRep,
2331 NULL,
2332 JIM_TYPE_NONE,
2335 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2337 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2340 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2342 /* Copy the interal rep */
2343 dupPtr->internalRep = srcPtr->internalRep;
2344 /* Need to increment the key ref count */
2345 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2348 /* -----------------------------------------------------------------------------
2349 * String Object
2350 * ---------------------------------------------------------------------------*/
2351 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2352 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2354 static const Jim_ObjType stringObjType = {
2355 "string",
2356 NULL,
2357 DupStringInternalRep,
2358 NULL,
2359 JIM_TYPE_REFERENCES,
2362 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2364 JIM_NOTUSED(interp);
2366 /* This is a bit subtle: the only caller of this function
2367 * should be Jim_DuplicateObj(), that will copy the
2368 * string representaion. After the copy, the duplicated
2369 * object will not have more room in the buffer than
2370 * srcPtr->length bytes. So we just set it to length. */
2371 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2372 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2375 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2377 if (objPtr->typePtr != &stringObjType) {
2378 /* Get a fresh string representation. */
2379 if (objPtr->bytes == NULL) {
2380 /* Invalid string repr. Generate it. */
2381 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2382 objPtr->typePtr->updateStringProc(objPtr);
2384 /* Free any other internal representation. */
2385 Jim_FreeIntRep(interp, objPtr);
2386 /* Set it as string, i.e. just set the maxLength field. */
2387 objPtr->typePtr = &stringObjType;
2388 objPtr->internalRep.strValue.maxLength = objPtr->length;
2389 /* Don't know the utf-8 length yet */
2390 objPtr->internalRep.strValue.charLength = -1;
2392 return JIM_OK;
2396 * Returns the length of the object string in chars, not bytes.
2398 * These may be different for a utf-8 string.
2400 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2402 #ifdef JIM_UTF8
2403 SetStringFromAny(interp, objPtr);
2405 if (objPtr->internalRep.strValue.charLength < 0) {
2406 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2408 return objPtr->internalRep.strValue.charLength;
2409 #else
2410 return Jim_Length(objPtr);
2411 #endif
2414 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2415 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2417 Jim_Obj *objPtr = Jim_NewObj(interp);
2419 /* Need to find out how many bytes the string requires */
2420 if (len == -1)
2421 len = strlen(s);
2422 /* Alloc/Set the string rep. */
2423 if (len == 0) {
2424 objPtr->bytes = JimEmptyStringRep;
2426 else {
2427 objPtr->bytes = Jim_StrDupLen(s, len);
2429 objPtr->length = len;
2431 /* No typePtr field for the vanilla string object. */
2432 objPtr->typePtr = NULL;
2433 return objPtr;
2436 /* charlen is in characters -- see also Jim_NewStringObj() */
2437 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2439 #ifdef JIM_UTF8
2440 /* Need to find out how many bytes the string requires */
2441 int bytelen = utf8_index(s, charlen);
2443 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2445 /* Remember the utf8 length, so set the type */
2446 objPtr->typePtr = &stringObjType;
2447 objPtr->internalRep.strValue.maxLength = bytelen;
2448 objPtr->internalRep.strValue.charLength = charlen;
2450 return objPtr;
2451 #else
2452 return Jim_NewStringObj(interp, s, charlen);
2453 #endif
2456 /* This version does not try to duplicate the 's' pointer, but
2457 * use it directly. */
2458 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2460 Jim_Obj *objPtr = Jim_NewObj(interp);
2462 objPtr->bytes = s;
2463 objPtr->length = (len == -1) ? strlen(s) : len;
2464 objPtr->typePtr = NULL;
2465 return objPtr;
2468 /* Low-level string append. Use it only against unshared objects
2469 * of type "string". */
2470 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2472 int needlen;
2474 if (len == -1)
2475 len = strlen(str);
2476 needlen = objPtr->length + len;
2477 if (objPtr->internalRep.strValue.maxLength < needlen ||
2478 objPtr->internalRep.strValue.maxLength == 0) {
2479 needlen *= 2;
2480 /* Inefficient to malloc() for less than 8 bytes */
2481 if (needlen < 7) {
2482 needlen = 7;
2484 if (objPtr->bytes == JimEmptyStringRep) {
2485 objPtr->bytes = Jim_Alloc(needlen + 1);
2487 else {
2488 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2490 objPtr->internalRep.strValue.maxLength = needlen;
2492 memcpy(objPtr->bytes + objPtr->length, str, len);
2493 objPtr->bytes[objPtr->length + len] = '\0';
2495 if (objPtr->internalRep.strValue.charLength >= 0) {
2496 /* Update the utf-8 char length */
2497 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2499 objPtr->length += len;
2502 /* Higher level API to append strings to objects.
2503 * Object must not be unshared for each of these.
2505 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2507 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2508 SetStringFromAny(interp, objPtr);
2509 StringAppendString(objPtr, str, len);
2512 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2514 int len;
2515 const char *str = Jim_GetString(appendObjPtr, &len);
2516 Jim_AppendString(interp, objPtr, str, len);
2519 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2521 va_list ap;
2523 SetStringFromAny(interp, objPtr);
2524 va_start(ap, objPtr);
2525 while (1) {
2526 const char *s = va_arg(ap, const char *);
2528 if (s == NULL)
2529 break;
2530 Jim_AppendString(interp, objPtr, s, -1);
2532 va_end(ap);
2535 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2537 if (aObjPtr == bObjPtr) {
2538 return 1;
2540 else {
2541 int Alen, Blen;
2542 const char *sA = Jim_GetString(aObjPtr, &Alen);
2543 const char *sB = Jim_GetString(bObjPtr, &Blen);
2545 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2550 * Note. Does not support embedded nulls in either the pattern or the object.
2552 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2554 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2558 * Note: does not support embedded nulls for the nocase option.
2560 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2562 int l1, l2;
2563 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2564 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2566 if (nocase) {
2567 /* Do a character compare for nocase */
2568 return JimStringCompareLen(s1, s2, -1, nocase);
2570 return JimStringCompare(s1, l1, s2, l2);
2574 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2576 * Note: does not support embedded nulls
2578 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2580 const char *s1 = Jim_String(firstObjPtr);
2581 const char *s2 = Jim_String(secondObjPtr);
2583 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2586 /* Convert a range, as returned by Jim_GetRange(), into
2587 * an absolute index into an object of the specified length.
2588 * This function may return negative values, or values
2589 * greater than or equal to the length of the list if the index
2590 * is out of range. */
2591 static int JimRelToAbsIndex(int len, int idx)
2593 if (idx < 0)
2594 return len + idx;
2595 return idx;
2598 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2599 * into a form suitable for implementation of commands like [string range] and [lrange].
2601 * The resulting range is guaranteed to address valid elements of
2602 * the structure.
2604 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2606 int rangeLen;
2608 if (*firstPtr > *lastPtr) {
2609 rangeLen = 0;
2611 else {
2612 rangeLen = *lastPtr - *firstPtr + 1;
2613 if (rangeLen) {
2614 if (*firstPtr < 0) {
2615 rangeLen += *firstPtr;
2616 *firstPtr = 0;
2618 if (*lastPtr >= len) {
2619 rangeLen -= (*lastPtr - (len - 1));
2620 *lastPtr = len - 1;
2624 if (rangeLen < 0)
2625 rangeLen = 0;
2627 *rangeLenPtr = rangeLen;
2630 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2631 int len, int *first, int *last, int *range)
2633 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2634 return JIM_ERR;
2636 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2637 return JIM_ERR;
2639 *first = JimRelToAbsIndex(len, *first);
2640 *last = JimRelToAbsIndex(len, *last);
2641 JimRelToAbsRange(len, first, last, range);
2642 return JIM_OK;
2645 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2646 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2648 int first, last;
2649 const char *str;
2650 int rangeLen;
2651 int bytelen;
2653 str = Jim_GetString(strObjPtr, &bytelen);
2655 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2656 return NULL;
2659 if (first == 0 && rangeLen == bytelen) {
2660 return strObjPtr;
2662 return Jim_NewStringObj(interp, str + first, rangeLen);
2665 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2666 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2668 #ifdef JIM_UTF8
2669 int first, last;
2670 const char *str;
2671 int len, rangeLen;
2672 int bytelen;
2674 str = Jim_GetString(strObjPtr, &bytelen);
2675 len = Jim_Utf8Length(interp, strObjPtr);
2677 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2678 return NULL;
2681 if (first == 0 && rangeLen == len) {
2682 return strObjPtr;
2684 if (len == bytelen) {
2685 /* ASCII optimisation */
2686 return Jim_NewStringObj(interp, str + first, rangeLen);
2688 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2689 #else
2690 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2691 #endif
2694 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2695 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2697 int first, last;
2698 const char *str;
2699 int len, rangeLen;
2700 Jim_Obj *objPtr;
2702 len = Jim_Utf8Length(interp, strObjPtr);
2704 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2705 return NULL;
2708 if (last < first) {
2709 return strObjPtr;
2712 str = Jim_String(strObjPtr);
2714 /* Before part */
2715 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2717 /* Replacement */
2718 if (newStrObj) {
2719 Jim_AppendObj(interp, objPtr, newStrObj);
2722 /* After part */
2723 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2725 return objPtr;
2729 * Note: does not support embedded nulls.
2731 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2733 while (*str) {
2734 int c;
2735 str += utf8_tounicode(str, &c);
2736 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2738 *dest = 0;
2742 * Note: does not support embedded nulls.
2744 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2746 char *buf;
2747 int len;
2748 const char *str;
2750 str = Jim_GetString(strObjPtr, &len);
2752 #ifdef JIM_UTF8
2753 /* Case mapping can change the utf-8 length of the string.
2754 * But at worst it will be by one extra byte per char
2756 len *= 2;
2757 #endif
2758 buf = Jim_Alloc(len + 1);
2759 JimStrCopyUpperLower(buf, str, 0);
2760 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2764 * Note: does not support embedded nulls.
2766 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2768 char *buf;
2769 const char *str;
2770 int len;
2772 str = Jim_GetString(strObjPtr, &len);
2774 #ifdef JIM_UTF8
2775 /* Case mapping can change the utf-8 length of the string.
2776 * But at worst it will be by one extra byte per char
2778 len *= 2;
2779 #endif
2780 buf = Jim_Alloc(len + 1);
2781 JimStrCopyUpperLower(buf, str, 1);
2782 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2786 * Note: does not support embedded nulls.
2788 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2790 char *buf, *p;
2791 int len;
2792 int c;
2793 const char *str;
2795 str = Jim_GetString(strObjPtr, &len);
2797 #ifdef JIM_UTF8
2798 /* Case mapping can change the utf-8 length of the string.
2799 * But at worst it will be by one extra byte per char
2801 len *= 2;
2802 #endif
2803 buf = p = Jim_Alloc(len + 1);
2805 str += utf8_tounicode(str, &c);
2806 p += utf8_getchars(p, utf8_title(c));
2808 JimStrCopyUpperLower(p, str, 0);
2810 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2813 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2814 * for unicode character 'c'.
2815 * Returns the position if found or NULL if not
2817 static const char *utf8_memchr(const char *str, int len, int c)
2819 #ifdef JIM_UTF8
2820 while (len) {
2821 int sc;
2822 int n = utf8_tounicode(str, &sc);
2823 if (sc == c) {
2824 return str;
2826 str += n;
2827 len -= n;
2829 return NULL;
2830 #else
2831 return memchr(str, c, len);
2832 #endif
2836 * Searches for the first non-trim char in string (str, len)
2838 * If none is found, returns just past the last char.
2840 * Lengths are in bytes.
2842 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2844 while (len) {
2845 int c;
2846 int n = utf8_tounicode(str, &c);
2848 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2849 /* Not a trim char, so stop */
2850 break;
2852 str += n;
2853 len -= n;
2855 return str;
2859 * Searches backwards for a non-trim char in string (str, len).
2861 * Returns a pointer to just after the non-trim char, or NULL if not found.
2863 * Lengths are in bytes.
2865 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2867 str += len;
2869 while (len) {
2870 int c;
2871 int n = utf8_prev_len(str, len);
2873 len -= n;
2874 str -= n;
2876 n = utf8_tounicode(str, &c);
2878 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2879 return str + n;
2883 return NULL;
2886 static const char default_trim_chars[] = " \t\n\r";
2887 /* sizeof() here includes the null byte */
2888 static int default_trim_chars_len = sizeof(default_trim_chars);
2890 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2892 int len;
2893 const char *str = Jim_GetString(strObjPtr, &len);
2894 const char *trimchars = default_trim_chars;
2895 int trimcharslen = default_trim_chars_len;
2896 const char *newstr;
2898 if (trimcharsObjPtr) {
2899 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2902 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2903 if (newstr == str) {
2904 return strObjPtr;
2907 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2910 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2912 int len;
2913 const char *trimchars = default_trim_chars;
2914 int trimcharslen = default_trim_chars_len;
2915 const char *nontrim;
2917 if (trimcharsObjPtr) {
2918 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2921 SetStringFromAny(interp, strObjPtr);
2923 len = Jim_Length(strObjPtr);
2924 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2926 if (nontrim == NULL) {
2927 /* All trim, so return a zero-length string */
2928 return Jim_NewEmptyStringObj(interp);
2930 if (nontrim == strObjPtr->bytes + len) {
2931 /* All non-trim, so return the original object */
2932 return strObjPtr;
2935 if (Jim_IsShared(strObjPtr)) {
2936 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2938 else {
2939 /* Can modify this string in place */
2940 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2941 strObjPtr->length = (nontrim - strObjPtr->bytes);
2944 return strObjPtr;
2947 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2949 /* First trim left. */
2950 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2952 /* Now trim right */
2953 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2955 /* Note: refCount check is needed since objPtr may be emptyObj */
2956 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2957 /* We don't want this object to be leaked */
2958 Jim_FreeNewObj(interp, objPtr);
2961 return strObjPtr;
2964 /* Some platforms don't have isascii - need a non-macro version */
2965 #ifdef HAVE_ISASCII
2966 #define jim_isascii isascii
2967 #else
2968 static int jim_isascii(int c)
2970 return !(c & ~0x7f);
2972 #endif
2974 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2976 static const char * const strclassnames[] = {
2977 "integer", "alpha", "alnum", "ascii", "digit",
2978 "double", "lower", "upper", "space", "xdigit",
2979 "control", "print", "graph", "punct", "boolean",
2980 NULL
2982 enum {
2983 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2984 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2985 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2987 int strclass;
2988 int len;
2989 int i;
2990 const char *str;
2991 int (*isclassfunc)(int c) = NULL;
2993 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2994 return JIM_ERR;
2997 str = Jim_GetString(strObjPtr, &len);
2998 if (len == 0) {
2999 Jim_SetResultBool(interp, !strict);
3000 return JIM_OK;
3003 switch (strclass) {
3004 case STR_IS_INTEGER:
3006 jim_wide w;
3007 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3008 return JIM_OK;
3011 case STR_IS_DOUBLE:
3013 double d;
3014 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3015 return JIM_OK;
3018 case STR_IS_BOOLEAN:
3020 int b;
3021 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3022 return JIM_OK;
3025 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3026 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3027 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3028 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3029 case STR_IS_LOWER: isclassfunc = islower; break;
3030 case STR_IS_UPPER: isclassfunc = isupper; break;
3031 case STR_IS_SPACE: isclassfunc = isspace; break;
3032 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3033 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3034 case STR_IS_PRINT: isclassfunc = isprint; break;
3035 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3036 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3037 default:
3038 return JIM_ERR;
3041 for (i = 0; i < len; i++) {
3042 if (!isclassfunc(UCHAR(str[i]))) {
3043 Jim_SetResultBool(interp, 0);
3044 return JIM_OK;
3047 Jim_SetResultBool(interp, 1);
3048 return JIM_OK;
3051 /* -----------------------------------------------------------------------------
3052 * Compared String Object
3053 * ---------------------------------------------------------------------------*/
3055 /* This is strange object that allows comparison of a C literal string
3056 * with a Jim object in a very short time if the same comparison is done
3057 * multiple times. For example every time the [if] command is executed,
3058 * Jim has to check if a given argument is "else".
3059 * If the code has no errors, this comparison is true most of the time,
3060 * so we can cache the pointer of the string of the last matching
3061 * comparison inside the object. Because most C compilers perform literal sharing,
3062 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3063 * this works pretty well even if comparisons are at different places
3064 * inside the C code. */
3066 static const Jim_ObjType comparedStringObjType = {
3067 "compared-string",
3068 NULL,
3069 NULL,
3070 NULL,
3071 JIM_TYPE_REFERENCES,
3074 /* The only way this object is exposed to the API is via the following
3075 * function. Returns true if the string and the object string repr.
3076 * are the same, otherwise zero is returned.
3078 * Note: this isn't binary safe, but it hardly needs to be.*/
3079 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3081 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3082 return 1;
3084 else {
3085 if (strcmp(str, Jim_String(objPtr)) != 0)
3086 return 0;
3088 if (objPtr->typePtr != &comparedStringObjType) {
3089 Jim_FreeIntRep(interp, objPtr);
3090 objPtr->typePtr = &comparedStringObjType;
3092 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3093 return 1;
3097 static int qsortCompareStringPointers(const void *a, const void *b)
3099 char *const *sa = (char *const *)a;
3100 char *const *sb = (char *const *)b;
3102 return strcmp(*sa, *sb);
3106 /* -----------------------------------------------------------------------------
3107 * Source Object
3109 * This object is just a string from the language point of view, but
3110 * the internal representation contains the filename and line number
3111 * where this token was read. This information is used by
3112 * Jim_EvalObj() if the object passed happens to be of type "source".
3114 * This allows propagation of the information about line numbers and file
3115 * names and gives error messages with absolute line numbers.
3117 * Note that this object uses the internal representation of the Jim_Object,
3118 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3120 * Also the object will be converted to something else if the given
3121 * token it represents in the source file is not something to be
3122 * evaluated (not a script), and will be specialized in some other way,
3123 * so the time overhead is also almost zero.
3124 * ---------------------------------------------------------------------------*/
3126 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3127 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3129 static const Jim_ObjType sourceObjType = {
3130 "source",
3131 FreeSourceInternalRep,
3132 DupSourceInternalRep,
3133 NULL,
3134 JIM_TYPE_REFERENCES,
3137 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3139 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3142 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3144 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3145 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3148 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3149 Jim_Obj *fileNameObj, int lineNumber)
3151 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3152 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3153 Jim_IncrRefCount(fileNameObj);
3154 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3155 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3156 objPtr->typePtr = &sourceObjType;
3159 /* -----------------------------------------------------------------------------
3160 * ScriptLine Object
3162 * This object is used only in the Script internal represenation.
3163 * For each line of the script, it holds the number of tokens on the line
3164 * and the source line number.
3166 static const Jim_ObjType scriptLineObjType = {
3167 "scriptline",
3168 NULL,
3169 NULL,
3170 NULL,
3171 JIM_NONE,
3174 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3176 Jim_Obj *objPtr;
3178 #ifdef DEBUG_SHOW_SCRIPT
3179 char buf[100];
3180 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3181 objPtr = Jim_NewStringObj(interp, buf, -1);
3182 #else
3183 objPtr = Jim_NewEmptyStringObj(interp);
3184 #endif
3185 objPtr->typePtr = &scriptLineObjType;
3186 objPtr->internalRep.scriptLineValue.argc = argc;
3187 objPtr->internalRep.scriptLineValue.line = line;
3189 return objPtr;
3192 /* -----------------------------------------------------------------------------
3193 * Script Object
3195 * This object holds the parsed internal representation of a script.
3196 * This representation is help within an allocated ScriptObj (see below)
3198 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3199 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3201 static const Jim_ObjType scriptObjType = {
3202 "script",
3203 FreeScriptInternalRep,
3204 DupScriptInternalRep,
3205 NULL,
3206 JIM_TYPE_REFERENCES,
3209 /* Each token of a script is represented by a ScriptToken.
3210 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3211 * can be specialized by commands operating on it.
3213 typedef struct ScriptToken
3215 Jim_Obj *objPtr;
3216 int type;
3217 } ScriptToken;
3219 /* This is the script object internal representation. An array of
3220 * ScriptToken structures, including a pre-computed representation of the
3221 * command length and arguments.
3223 * For example the script:
3225 * puts hello
3226 * set $i $x$y [foo]BAR
3228 * will produce a ScriptObj with the following ScriptToken's:
3230 * LIN 2
3231 * ESC puts
3232 * ESC hello
3233 * LIN 4
3234 * ESC set
3235 * VAR i
3236 * WRD 2
3237 * VAR x
3238 * VAR y
3239 * WRD 2
3240 * CMD foo
3241 * ESC BAR
3243 * "puts hello" has two args (LIN 2), composed of single tokens.
3244 * (Note that the WRD token is omitted for the common case of a single token.)
3246 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3247 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3249 * The precomputation of the command structure makes Jim_Eval() faster,
3250 * and simpler because there aren't dynamic lengths / allocations.
3252 * -- {expand}/{*} handling --
3254 * Expand is handled in a special way.
3256 * If a "word" begins with {*}, the word token count is -ve.
3258 * For example the command:
3260 * list {*}{a b}
3262 * Will produce the following cmdstruct array:
3264 * LIN 2
3265 * ESC list
3266 * WRD -1
3267 * STR a b
3269 * Note that the 'LIN' token also contains the source information for the
3270 * first word of the line for error reporting purposes
3272 * -- the substFlags field of the structure --
3274 * The scriptObj structure is used to represent both "script" objects
3275 * and "subst" objects. In the second case, there are no LIN and WRD
3276 * tokens. Instead SEP and EOL tokens are added as-is.
3277 * In addition, the field 'substFlags' is used to represent the flags used to turn
3278 * the string into the internal representation.
3279 * If these flags do not match what the application requires,
3280 * the scriptObj is created again. For example the script:
3282 * subst -nocommands $string
3283 * subst -novariables $string
3285 * Will (re)create the internal representation of the $string object
3286 * two times.
3288 typedef struct ScriptObj
3290 ScriptToken *token; /* Tokens array. */
3291 Jim_Obj *fileNameObj; /* Filename */
3292 int len; /* Length of token[] */
3293 int substFlags; /* flags used for the compilation of "subst" objects */
3294 int inUse; /* Used to share a ScriptObj. Currently
3295 only used by Jim_EvalObj() as protection against
3296 shimmering of the currently evaluated object. */
3297 int firstline; /* Line number of the first line */
3298 int linenr; /* Error line number, if any */
3299 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3300 } ScriptObj;
3302 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3303 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3304 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3306 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3308 int i;
3309 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3311 if (--script->inUse != 0)
3312 return;
3313 for (i = 0; i < script->len; i++) {
3314 Jim_DecrRefCount(interp, script->token[i].objPtr);
3316 Jim_Free(script->token);
3317 Jim_DecrRefCount(interp, script->fileNameObj);
3318 Jim_Free(script);
3321 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3323 JIM_NOTUSED(interp);
3324 JIM_NOTUSED(srcPtr);
3326 /* Just return a simple string. We don't try to preserve the source info
3327 * since in practice scripts are never duplicated
3329 dupPtr->typePtr = NULL;
3332 /* A simple parse token.
3333 * As the script is parsed, the created tokens point into the script string rep.
3335 typedef struct
3337 const char *token; /* Pointer to the start of the token */
3338 int len; /* Length of this token */
3339 int type; /* Token type */
3340 int line; /* Line number */
3341 } ParseToken;
3343 /* A list of parsed tokens representing a script.
3344 * Tokens are added to this list as the script is parsed.
3345 * It grows as needed.
3347 typedef struct
3349 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3350 ParseToken *list; /* Array of tokens */
3351 int size; /* Current size of the list */
3352 int count; /* Number of entries used */
3353 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3354 } ParseTokenList;
3356 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3358 tokenlist->list = tokenlist->static_list;
3359 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3360 tokenlist->count = 0;
3363 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3365 if (tokenlist->list != tokenlist->static_list) {
3366 Jim_Free(tokenlist->list);
3371 * Adds the new token to the tokenlist.
3372 * The token has the given length, type and line number.
3373 * The token list is resized as necessary.
3375 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3376 int line)
3378 ParseToken *t;
3380 if (tokenlist->count == tokenlist->size) {
3381 /* Resize the list */
3382 tokenlist->size *= 2;
3383 if (tokenlist->list != tokenlist->static_list) {
3384 tokenlist->list =
3385 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3387 else {
3388 /* The list needs to become allocated */
3389 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3390 memcpy(tokenlist->list, tokenlist->static_list,
3391 tokenlist->count * sizeof(*tokenlist->list));
3394 t = &tokenlist->list[tokenlist->count++];
3395 t->token = token;
3396 t->len = len;
3397 t->type = type;
3398 t->line = line;
3401 /* Counts the number of adjoining non-separator tokens.
3403 * Returns -ve if the first token is the expansion
3404 * operator (in which case the count doesn't include
3405 * that token).
3407 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3409 int expand = 1;
3410 int count = 0;
3412 /* Is the first word {*} or {expand}? */
3413 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3414 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3415 /* Create an expand token */
3416 expand = -1;
3417 t++;
3419 else {
3420 if (script->missing == ' ') {
3421 /* This is a "extra characters after close-brace" error. Report the first error */
3422 script->missing = '}';
3423 script->linenr = t[1].line;
3428 /* Now count non-separator words */
3429 while (!TOKEN_IS_SEP(t->type)) {
3430 t++;
3431 count++;
3434 return count * expand;
3438 * Create a script/subst object from the given token.
3440 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3442 Jim_Obj *objPtr;
3444 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3445 /* Convert backlash escapes. The result will never be longer than the original */
3446 int len = t->len;
3447 char *str = Jim_Alloc(len + 1);
3448 len = JimEscape(str, t->token, len);
3449 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3451 else {
3452 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3453 * with a single space.
3455 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3457 return objPtr;
3461 * Takes a tokenlist and creates the allocated list of script tokens
3462 * in script->token, of length script->len.
3464 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3465 * as required.
3467 * Also sets script->line to the line number of the first token
3469 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3470 ParseTokenList *tokenlist)
3472 int i;
3473 struct ScriptToken *token;
3474 /* Number of tokens so far for the current command */
3475 int lineargs = 0;
3476 /* This is the first token for the current command */
3477 ScriptToken *linefirst;
3478 int count;
3479 int linenr;
3481 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3482 printf("==== Tokens ====\n");
3483 for (i = 0; i < tokenlist->count; i++) {
3484 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3485 tokenlist->list[i].len, tokenlist->list[i].token);
3487 #endif
3489 /* May need up to one extra script token for each EOL in the worst case */
3490 count = tokenlist->count;
3491 for (i = 0; i < tokenlist->count; i++) {
3492 if (tokenlist->list[i].type == JIM_TT_EOL) {
3493 count++;
3496 linenr = script->firstline = tokenlist->list[0].line;
3498 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3500 /* This is the first token for the current command */
3501 linefirst = token++;
3503 for (i = 0; i < tokenlist->count; ) {
3504 /* Look ahead to find out how many tokens make up the next word */
3505 int wordtokens;
3507 /* Skip any leading separators */
3508 while (tokenlist->list[i].type == JIM_TT_SEP) {
3509 i++;
3512 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3514 if (wordtokens == 0) {
3515 /* None, so at end of line */
3516 if (lineargs) {
3517 linefirst->type = JIM_TT_LINE;
3518 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3519 Jim_IncrRefCount(linefirst->objPtr);
3521 /* Reset for new line */
3522 lineargs = 0;
3523 linefirst = token++;
3525 i++;
3526 continue;
3528 else if (wordtokens != 1) {
3529 /* More than 1, or {*}, so insert a WORD token */
3530 token->type = JIM_TT_WORD;
3531 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3532 Jim_IncrRefCount(token->objPtr);
3533 token++;
3534 if (wordtokens < 0) {
3535 /* Skip the expand token */
3536 i++;
3537 wordtokens = -wordtokens - 1;
3538 lineargs--;
3542 if (lineargs == 0) {
3543 /* First real token on the line, so record the line number */
3544 linenr = tokenlist->list[i].line;
3546 lineargs++;
3548 /* Add each non-separator word token to the line */
3549 while (wordtokens--) {
3550 const ParseToken *t = &tokenlist->list[i++];
3552 token->type = t->type;
3553 token->objPtr = JimMakeScriptObj(interp, t);
3554 Jim_IncrRefCount(token->objPtr);
3556 /* Every object is initially a string of type 'source', but the
3557 * internal type may be specialized during execution of the
3558 * script. */
3559 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3560 token++;
3564 if (lineargs == 0) {
3565 token--;
3568 script->len = token - script->token;
3570 JimPanic((script->len >= count, "allocated script array is too short"));
3572 #ifdef DEBUG_SHOW_SCRIPT
3573 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3574 for (i = 0; i < script->len; i++) {
3575 const ScriptToken *t = &script->token[i];
3576 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3578 #endif
3582 /* Parses the given string object to determine if it represents a complete script.
3584 * This is useful for interactive shells implementation, for [info complete].
3586 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3587 * '{' on scripts incomplete missing one or more '}' to be balanced.
3588 * '[' on scripts incomplete missing one or more ']' to be balanced.
3589 * '"' on scripts incomplete missing a '"' char.
3590 * '\\' on scripts with a trailing backslash.
3592 * If the script is complete, 1 is returned, otherwise 0.
3594 * If the script has extra characters after a close brace, this still returns 1,
3595 * but sets *stateCharPtr to '}'
3596 * Evaluating the script will give the error "extra characters after close-brace".
3598 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3600 ScriptObj *script = JimGetScript(interp, scriptObj);
3601 if (stateCharPtr) {
3602 *stateCharPtr = script->missing;
3604 return script->missing == ' ' || script->missing == '}';
3608 * Sets an appropriate error message for a missing script/expression terminator.
3610 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3612 * Note that a trailing backslash is not considered to be an error.
3614 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3616 const char *msg;
3618 switch (ch) {
3619 case '\\':
3620 case ' ':
3621 return JIM_OK;
3623 case '[':
3624 msg = "unmatched \"[\"";
3625 break;
3626 case '{':
3627 msg = "missing close-brace";
3628 break;
3629 case '}':
3630 msg = "extra characters after close-brace";
3631 break;
3632 case '"':
3633 default:
3634 msg = "missing quote";
3635 break;
3638 Jim_SetResultString(interp, msg, -1);
3639 return JIM_ERR;
3643 * Similar to ScriptObjAddTokens(), but for subst objects.
3645 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3646 ParseTokenList *tokenlist)
3648 int i;
3649 struct ScriptToken *token;
3651 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3653 for (i = 0; i < tokenlist->count; i++) {
3654 const ParseToken *t = &tokenlist->list[i];
3656 /* Create a token for 't' */
3657 token->type = t->type;
3658 token->objPtr = JimMakeScriptObj(interp, t);
3659 Jim_IncrRefCount(token->objPtr);
3660 token++;
3663 script->len = i;
3666 /* This method takes the string representation of an object
3667 * as a Tcl script, and generates the pre-parsed internal representation
3668 * of the script.
3670 * On parse error, sets an error message and returns JIM_ERR
3671 * (Note: the object is still converted to a script, even if an error occurs)
3673 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3675 int scriptTextLen;
3676 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3677 struct JimParserCtx parser;
3678 struct ScriptObj *script;
3679 ParseTokenList tokenlist;
3680 int line = 1;
3682 /* Try to get information about filename / line number */
3683 if (objPtr->typePtr == &sourceObjType) {
3684 line = objPtr->internalRep.sourceValue.lineNumber;
3687 /* Initially parse the script into tokens (in tokenlist) */
3688 ScriptTokenListInit(&tokenlist);
3690 JimParserInit(&parser, scriptText, scriptTextLen, line);
3691 while (!parser.eof) {
3692 JimParseScript(&parser);
3693 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3694 parser.tline);
3697 /* Add a final EOF token */
3698 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3700 /* Create the "real" script tokens from the parsed tokens */
3701 script = Jim_Alloc(sizeof(*script));
3702 memset(script, 0, sizeof(*script));
3703 script->inUse = 1;
3704 if (objPtr->typePtr == &sourceObjType) {
3705 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3707 else {
3708 script->fileNameObj = interp->emptyObj;
3710 Jim_IncrRefCount(script->fileNameObj);
3711 script->missing = parser.missing.ch;
3712 script->linenr = parser.missing.line;
3714 ScriptObjAddTokens(interp, script, &tokenlist);
3716 /* No longer need the token list */
3717 ScriptTokenListFree(&tokenlist);
3719 /* Free the old internal rep and set the new one. */
3720 Jim_FreeIntRep(interp, objPtr);
3721 Jim_SetIntRepPtr(objPtr, script);
3722 objPtr->typePtr = &scriptObjType;
3725 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3728 * Returns the parsed script.
3729 * Note that if there is any possibility that the script is not valid,
3730 * call JimScriptValid() to check
3732 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3734 if (objPtr == interp->emptyObj) {
3735 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3736 objPtr = interp->nullScriptObj;
3739 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3740 JimSetScriptFromAny(interp, objPtr);
3743 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3747 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3748 * and leaves an error message in the interp result.
3751 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3753 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3754 JimAddErrorToStack(interp, script);
3755 return 0;
3757 return 1;
3761 /* -----------------------------------------------------------------------------
3762 * Commands
3763 * ---------------------------------------------------------------------------*/
3764 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3766 cmdPtr->inUse++;
3769 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3771 if (--cmdPtr->inUse == 0) {
3772 if (cmdPtr->isproc) {
3773 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3774 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3775 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3776 if (cmdPtr->u.proc.staticVars) {
3777 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3778 Jim_Free(cmdPtr->u.proc.staticVars);
3781 else {
3782 /* native (C) */
3783 if (cmdPtr->u.native.delProc) {
3784 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3787 if (cmdPtr->prevCmd) {
3788 /* Delete any pushed command too */
3789 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3791 Jim_Free(cmdPtr);
3795 /* Variables HashTable Type.
3797 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3799 static void JimVariablesHTValDestructor(void *interp, void *val)
3801 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3802 Jim_Free(val);
3805 static const Jim_HashTableType JimVariablesHashTableType = {
3806 JimStringCopyHTHashFunction, /* hash function */
3807 JimStringCopyHTDup, /* key dup */
3808 NULL, /* val dup */
3809 JimStringCopyHTKeyCompare, /* key compare */
3810 JimStringCopyHTKeyDestructor, /* key destructor */
3811 JimVariablesHTValDestructor /* val destructor */
3814 /* Commands HashTable Type.
3816 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3818 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3820 JimDecrCmdRefCount(interp, val);
3823 static const Jim_HashTableType JimCommandsHashTableType = {
3824 JimStringCopyHTHashFunction, /* hash function */
3825 JimStringCopyHTDup, /* key dup */
3826 NULL, /* val dup */
3827 JimStringCopyHTKeyCompare, /* key compare */
3828 JimStringCopyHTKeyDestructor, /* key destructor */
3829 JimCommandsHT_ValDestructor /* val destructor */
3832 /* ------------------------- Commands related functions --------------------- */
3834 #ifdef jim_ext_namespace
3836 * Returns the "unscoped" version of the given namespace.
3837 * That is, the fully qualified name without the leading ::
3838 * The returned value is either nsObj, or an object with a zero ref count.
3840 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3842 const char *name = Jim_String(nsObj);
3843 if (name[0] == ':' && name[1] == ':') {
3844 /* This command is being defined in the global namespace */
3845 while (*++name == ':') {
3847 nsObj = Jim_NewStringObj(interp, name, -1);
3849 else if (Jim_Length(interp->framePtr->nsObj)) {
3850 /* This command is being defined in a non-global namespace */
3851 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3852 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3854 return nsObj;
3858 * If nameObjPtr starts with "::", returns it.
3859 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3860 * In this case, decrements the ref count of nameObjPtr.
3862 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3864 Jim_Obj *resultObj;
3866 const char *name = Jim_String(nameObjPtr);
3867 if (name[0] == ':' && name[1] == ':') {
3868 return nameObjPtr;
3870 Jim_IncrRefCount(nameObjPtr);
3871 resultObj = Jim_NewStringObj(interp, "::", -1);
3872 Jim_AppendObj(interp, resultObj, nameObjPtr);
3873 Jim_DecrRefCount(interp, nameObjPtr);
3875 return resultObj;
3879 * An efficient version of JimQualifyNameObj() where the name is
3880 * available (and needed) as a 'const char *'.
3881 * Avoids creating an object if not necessary.
3882 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3884 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3886 Jim_Obj *objPtr = interp->emptyObj;
3888 if (name[0] == ':' && name[1] == ':') {
3889 /* This command is being defined in the global namespace */
3890 while (*++name == ':') {
3893 else if (Jim_Length(interp->framePtr->nsObj)) {
3894 /* This command is being defined in a non-global namespace */
3895 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3896 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3897 name = Jim_String(objPtr);
3899 Jim_IncrRefCount(objPtr);
3900 *objPtrPtr = objPtr;
3901 return name;
3904 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3906 #else
3907 /* We can be more efficient in the no-namespace case */
3908 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3909 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3911 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3913 return nameObjPtr;
3915 #endif
3917 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3919 /* It may already exist, so we try to delete the old one.
3920 * Note that reference count means that it won't be deleted yet if
3921 * it exists in the call stack.
3923 * BUT, if 'local' is in force, instead of deleting the existing
3924 * proc, we stash a reference to the old proc here.
3926 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3927 if (he) {
3928 /* There was an old cmd with the same name,
3929 * so this requires a 'proc epoch' update. */
3931 /* If a procedure with the same name didn't exist there is no need
3932 * to increment the 'proc epoch' because creation of a new procedure
3933 * can never affect existing cached commands. We don't do
3934 * negative caching. */
3935 Jim_InterpIncrProcEpoch(interp);
3938 if (he && interp->local) {
3939 /* Push this command over the top of the previous one */
3940 cmd->prevCmd = Jim_GetHashEntryVal(he);
3941 Jim_SetHashVal(&interp->commands, he, cmd);
3943 else {
3944 if (he) {
3945 /* Replace the existing command */
3946 Jim_DeleteHashEntry(&interp->commands, name);
3949 Jim_AddHashEntry(&interp->commands, name, cmd);
3951 return JIM_OK;
3955 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3956 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3958 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3960 /* Store the new details for this command */
3961 memset(cmdPtr, 0, sizeof(*cmdPtr));
3962 cmdPtr->inUse = 1;
3963 cmdPtr->u.native.delProc = delProc;
3964 cmdPtr->u.native.cmdProc = cmdProc;
3965 cmdPtr->u.native.privData = privData;
3967 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3969 return JIM_OK;
3972 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3974 int len, i;
3976 len = Jim_ListLength(interp, staticsListObjPtr);
3977 if (len == 0) {
3978 return JIM_OK;
3981 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3982 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3983 for (i = 0; i < len; i++) {
3984 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3985 Jim_Var *varPtr;
3986 int subLen;
3988 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3989 /* Check if it's composed of two elements. */
3990 subLen = Jim_ListLength(interp, objPtr);
3991 if (subLen == 1 || subLen == 2) {
3992 /* Try to get the variable value from the current
3993 * environment. */
3994 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3995 if (subLen == 1) {
3996 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3997 if (initObjPtr == NULL) {
3998 Jim_SetResultFormatted(interp,
3999 "variable for initialization of static \"%#s\" not found in the local context",
4000 nameObjPtr);
4001 return JIM_ERR;
4004 else {
4005 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
4007 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
4008 return JIM_ERR;
4011 varPtr = Jim_Alloc(sizeof(*varPtr));
4012 varPtr->objPtr = initObjPtr;
4013 Jim_IncrRefCount(initObjPtr);
4014 varPtr->linkFramePtr = NULL;
4015 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
4016 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
4017 Jim_SetResultFormatted(interp,
4018 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4019 Jim_DecrRefCount(interp, initObjPtr);
4020 Jim_Free(varPtr);
4021 return JIM_ERR;
4024 else {
4025 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4026 objPtr);
4027 return JIM_ERR;
4030 return JIM_OK;
4034 * If the command is a proc, sets/updates the cached namespace (nsObj)
4035 * based on the command name.
4037 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4039 #ifdef jim_ext_namespace
4040 if (cmdPtr->isproc) {
4041 /* XXX: Really need JimNamespaceSplit() */
4042 const char *pt = strrchr(cmdname, ':');
4043 if (pt && pt != cmdname && pt[-1] == ':') {
4044 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4045 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4046 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4048 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4049 /* This command shadows a global command, so a proc epoch update is required */
4050 Jim_InterpIncrProcEpoch(interp);
4054 #endif
4057 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4058 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4060 Jim_Cmd *cmdPtr;
4061 int argListLen;
4062 int i;
4064 argListLen = Jim_ListLength(interp, argListObjPtr);
4066 /* Allocate space for both the command pointer and the arg list */
4067 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4068 memset(cmdPtr, 0, sizeof(*cmdPtr));
4069 cmdPtr->inUse = 1;
4070 cmdPtr->isproc = 1;
4071 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4072 cmdPtr->u.proc.argListLen = argListLen;
4073 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4074 cmdPtr->u.proc.argsPos = -1;
4075 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4076 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4077 Jim_IncrRefCount(argListObjPtr);
4078 Jim_IncrRefCount(bodyObjPtr);
4079 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4081 /* Create the statics hash table. */
4082 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4083 goto err;
4086 /* Parse the args out into arglist, validating as we go */
4087 /* Examine the argument list for default parameters and 'args' */
4088 for (i = 0; i < argListLen; i++) {
4089 Jim_Obj *argPtr;
4090 Jim_Obj *nameObjPtr;
4091 Jim_Obj *defaultObjPtr;
4092 int len;
4094 /* Examine a parameter */
4095 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4096 len = Jim_ListLength(interp, argPtr);
4097 if (len == 0) {
4098 Jim_SetResultString(interp, "argument with no name", -1);
4099 err:
4100 JimDecrCmdRefCount(interp, cmdPtr);
4101 return NULL;
4103 if (len > 2) {
4104 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4105 goto err;
4108 if (len == 2) {
4109 /* Optional parameter */
4110 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4111 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4113 else {
4114 /* Required parameter */
4115 nameObjPtr = argPtr;
4116 defaultObjPtr = NULL;
4120 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4121 if (cmdPtr->u.proc.argsPos >= 0) {
4122 Jim_SetResultString(interp, "'args' specified more than once", -1);
4123 goto err;
4125 cmdPtr->u.proc.argsPos = i;
4127 else {
4128 if (len == 2) {
4129 cmdPtr->u.proc.optArity++;
4131 else {
4132 cmdPtr->u.proc.reqArity++;
4136 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4137 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4140 return cmdPtr;
4143 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4145 int ret = JIM_OK;
4146 Jim_Obj *qualifiedNameObj;
4147 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4149 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4150 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4151 ret = JIM_ERR;
4153 else {
4154 Jim_InterpIncrProcEpoch(interp);
4157 JimFreeQualifiedName(interp, qualifiedNameObj);
4159 return ret;
4162 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4164 int ret = JIM_ERR;
4165 Jim_HashEntry *he;
4166 Jim_Cmd *cmdPtr;
4167 Jim_Obj *qualifiedOldNameObj;
4168 Jim_Obj *qualifiedNewNameObj;
4169 const char *fqold;
4170 const char *fqnew;
4172 if (newName[0] == 0) {
4173 return Jim_DeleteCommand(interp, oldName);
4176 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4177 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4179 /* Does it exist? */
4180 he = Jim_FindHashEntry(&interp->commands, fqold);
4181 if (he == NULL) {
4182 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4184 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4185 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4187 else {
4188 /* Add the new name first */
4189 cmdPtr = Jim_GetHashEntryVal(he);
4190 JimIncrCmdRefCount(cmdPtr);
4191 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4192 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4194 /* Now remove the old name */
4195 Jim_DeleteHashEntry(&interp->commands, fqold);
4197 /* Increment the epoch */
4198 Jim_InterpIncrProcEpoch(interp);
4200 ret = JIM_OK;
4203 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4204 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4206 return ret;
4209 /* -----------------------------------------------------------------------------
4210 * Command object
4211 * ---------------------------------------------------------------------------*/
4213 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4215 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4218 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4220 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4221 dupPtr->typePtr = srcPtr->typePtr;
4222 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4225 static const Jim_ObjType commandObjType = {
4226 "command",
4227 FreeCommandInternalRep,
4228 DupCommandInternalRep,
4229 NULL,
4230 JIM_TYPE_REFERENCES,
4233 /* This function returns the command structure for the command name
4234 * stored in objPtr. It specializes the objPtr to contain
4235 * cached info instead of performing the lookup into the hash table
4236 * every time. The information cached may not be up-to-date, in this
4237 * case the lookup is performed and the cache updated.
4239 * Respects the 'upcall' setting.
4241 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4243 Jim_Cmd *cmd;
4245 /* In order to be valid, the proc epoch must match and
4246 * the lookup must have occurred in the same namespace
4248 if (objPtr->typePtr != &commandObjType ||
4249 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4250 #ifdef jim_ext_namespace
4251 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4252 #endif
4254 /* Not cached or out of date, so lookup */
4256 /* Do we need to try the local namespace? */
4257 const char *name = Jim_String(objPtr);
4258 Jim_HashEntry *he;
4260 if (name[0] == ':' && name[1] == ':') {
4261 while (*++name == ':') {
4264 #ifdef jim_ext_namespace
4265 else if (Jim_Length(interp->framePtr->nsObj)) {
4266 /* This command is being defined in a non-global namespace */
4267 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4268 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4269 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4270 Jim_FreeNewObj(interp, nameObj);
4271 if (he) {
4272 goto found;
4275 #endif
4277 /* Lookup in the global namespace */
4278 he = Jim_FindHashEntry(&interp->commands, name);
4279 if (he == NULL) {
4280 if (flags & JIM_ERRMSG) {
4281 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4283 return NULL;
4285 #ifdef jim_ext_namespace
4286 found:
4287 #endif
4288 cmd = Jim_GetHashEntryVal(he);
4290 /* Free the old internal rep and set the new one. */
4291 Jim_FreeIntRep(interp, objPtr);
4292 objPtr->typePtr = &commandObjType;
4293 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4294 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4295 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4296 Jim_IncrRefCount(interp->framePtr->nsObj);
4298 else {
4299 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4301 while (cmd->u.proc.upcall) {
4302 cmd = cmd->prevCmd;
4304 return cmd;
4307 /* -----------------------------------------------------------------------------
4308 * Variables
4309 * ---------------------------------------------------------------------------*/
4311 /* -----------------------------------------------------------------------------
4312 * Variable object
4313 * ---------------------------------------------------------------------------*/
4315 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4317 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4319 static const Jim_ObjType variableObjType = {
4320 "variable",
4321 NULL,
4322 NULL,
4323 NULL,
4324 JIM_TYPE_REFERENCES,
4328 * Check that the name does not contain embedded nulls.
4330 * Variable and procedure names are manipulated as null terminated strings, so
4331 * don't allow names with embedded nulls.
4333 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4335 /* Variable names and proc names can't contain embedded nulls */
4336 if (nameObjPtr->typePtr != &variableObjType) {
4337 int len;
4338 const char *str = Jim_GetString(nameObjPtr, &len);
4339 if (memchr(str, '\0', len)) {
4340 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4341 return JIM_ERR;
4344 return JIM_OK;
4347 /* This method should be called only by the variable API.
4348 * It returns JIM_OK on success (variable already exists),
4349 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4350 * a variable name, but syntax glue for [dict] i.e. the last
4351 * character is ')' */
4352 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4354 const char *varName;
4355 Jim_CallFrame *framePtr;
4356 Jim_HashEntry *he;
4357 int global;
4358 int len;
4360 /* Check if the object is already an uptodate variable */
4361 if (objPtr->typePtr == &variableObjType) {
4362 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4363 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4364 /* nothing to do */
4365 return JIM_OK;
4367 /* Need to re-resolve the variable in the updated callframe */
4369 else if (objPtr->typePtr == &dictSubstObjType) {
4370 return JIM_DICT_SUGAR;
4372 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4373 return JIM_ERR;
4377 varName = Jim_GetString(objPtr, &len);
4379 /* Make sure it's not syntax glue to get/set dict. */
4380 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4381 return JIM_DICT_SUGAR;
4384 if (varName[0] == ':' && varName[1] == ':') {
4385 while (*++varName == ':') {
4387 global = 1;
4388 framePtr = interp->topFramePtr;
4390 else {
4391 global = 0;
4392 framePtr = interp->framePtr;
4395 /* Resolve this name in the variables hash table */
4396 he = Jim_FindHashEntry(&framePtr->vars, varName);
4397 if (he == NULL) {
4398 if (!global && framePtr->staticVars) {
4399 /* Try with static vars. */
4400 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4402 if (he == NULL) {
4403 return JIM_ERR;
4407 /* Free the old internal repr and set the new one. */
4408 Jim_FreeIntRep(interp, objPtr);
4409 objPtr->typePtr = &variableObjType;
4410 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4411 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4412 objPtr->internalRep.varValue.global = global;
4413 return JIM_OK;
4416 /* -------------------- Variables related functions ------------------------- */
4417 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4418 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4420 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4422 const char *name;
4423 Jim_CallFrame *framePtr;
4424 int global;
4426 /* New variable to create */
4427 Jim_Var *var = Jim_Alloc(sizeof(*var));
4429 var->objPtr = valObjPtr;
4430 Jim_IncrRefCount(valObjPtr);
4431 var->linkFramePtr = NULL;
4433 name = Jim_String(nameObjPtr);
4434 if (name[0] == ':' && name[1] == ':') {
4435 while (*++name == ':') {
4437 framePtr = interp->topFramePtr;
4438 global = 1;
4440 else {
4441 framePtr = interp->framePtr;
4442 global = 0;
4445 /* Insert the new variable */
4446 Jim_AddHashEntry(&framePtr->vars, name, var);
4448 /* Make the object int rep a variable */
4449 Jim_FreeIntRep(interp, nameObjPtr);
4450 nameObjPtr->typePtr = &variableObjType;
4451 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4452 nameObjPtr->internalRep.varValue.varPtr = var;
4453 nameObjPtr->internalRep.varValue.global = global;
4455 return var;
4458 /* For now that's dummy. Variables lookup should be optimized
4459 * in many ways, with caching of lookups, and possibly with
4460 * a table of pre-allocated vars in every CallFrame for local vars.
4461 * All the caching should also have an 'epoch' mechanism similar
4462 * to the one used by Tcl for procedures lookup caching. */
4465 * Set the variable nameObjPtr to value valObjptr.
4467 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4469 int err;
4470 Jim_Var *var;
4472 switch (SetVariableFromAny(interp, nameObjPtr)) {
4473 case JIM_DICT_SUGAR:
4474 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4476 case JIM_ERR:
4477 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4478 return JIM_ERR;
4480 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4481 break;
4483 case JIM_OK:
4484 var = nameObjPtr->internalRep.varValue.varPtr;
4485 if (var->linkFramePtr == NULL) {
4486 Jim_IncrRefCount(valObjPtr);
4487 Jim_DecrRefCount(interp, var->objPtr);
4488 var->objPtr = valObjPtr;
4490 else { /* Else handle the link */
4491 Jim_CallFrame *savedCallFrame;
4493 savedCallFrame = interp->framePtr;
4494 interp->framePtr = var->linkFramePtr;
4495 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4496 interp->framePtr = savedCallFrame;
4497 if (err != JIM_OK)
4498 return err;
4501 return JIM_OK;
4504 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4506 Jim_Obj *nameObjPtr;
4507 int result;
4509 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4510 Jim_IncrRefCount(nameObjPtr);
4511 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4512 Jim_DecrRefCount(interp, nameObjPtr);
4513 return result;
4516 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4518 Jim_CallFrame *savedFramePtr;
4519 int result;
4521 savedFramePtr = interp->framePtr;
4522 interp->framePtr = interp->topFramePtr;
4523 result = Jim_SetVariableStr(interp, name, objPtr);
4524 interp->framePtr = savedFramePtr;
4525 return result;
4528 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4530 Jim_Obj *valObjPtr;
4531 int result;
4533 valObjPtr = Jim_NewStringObj(interp, val, -1);
4534 Jim_IncrRefCount(valObjPtr);
4535 result = Jim_SetVariableStr(interp, name, valObjPtr);
4536 Jim_DecrRefCount(interp, valObjPtr);
4537 return result;
4540 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4541 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4543 const char *varName;
4544 const char *targetName;
4545 Jim_CallFrame *framePtr;
4546 Jim_Var *varPtr;
4548 /* Check for an existing variable or link */
4549 switch (SetVariableFromAny(interp, nameObjPtr)) {
4550 case JIM_DICT_SUGAR:
4551 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4552 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4553 return JIM_ERR;
4555 case JIM_OK:
4556 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4558 if (varPtr->linkFramePtr == NULL) {
4559 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4560 return JIM_ERR;
4563 /* It exists, but is a link, so first delete the link */
4564 varPtr->linkFramePtr = NULL;
4565 break;
4568 /* Resolve the call frames for both variables */
4569 /* XXX: SetVariableFromAny() already did this! */
4570 varName = Jim_String(nameObjPtr);
4572 if (varName[0] == ':' && varName[1] == ':') {
4573 while (*++varName == ':') {
4575 /* Linking a global var does nothing */
4576 framePtr = interp->topFramePtr;
4578 else {
4579 framePtr = interp->framePtr;
4582 targetName = Jim_String(targetNameObjPtr);
4583 if (targetName[0] == ':' && targetName[1] == ':') {
4584 while (*++targetName == ':') {
4586 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4587 targetCallFrame = interp->topFramePtr;
4589 Jim_IncrRefCount(targetNameObjPtr);
4591 if (framePtr->level < targetCallFrame->level) {
4592 Jim_SetResultFormatted(interp,
4593 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4594 nameObjPtr);
4595 Jim_DecrRefCount(interp, targetNameObjPtr);
4596 return JIM_ERR;
4599 /* Check for cycles. */
4600 if (framePtr == targetCallFrame) {
4601 Jim_Obj *objPtr = targetNameObjPtr;
4603 /* Cycles are only possible with 'uplevel 0' */
4604 while (1) {
4605 if (strcmp(Jim_String(objPtr), varName) == 0) {
4606 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4607 Jim_DecrRefCount(interp, targetNameObjPtr);
4608 return JIM_ERR;
4610 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4611 break;
4612 varPtr = objPtr->internalRep.varValue.varPtr;
4613 if (varPtr->linkFramePtr != targetCallFrame)
4614 break;
4615 objPtr = varPtr->objPtr;
4619 /* Perform the binding */
4620 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4621 /* We are now sure 'nameObjPtr' type is variableObjType */
4622 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4623 Jim_DecrRefCount(interp, targetNameObjPtr);
4624 return JIM_OK;
4627 /* Return the Jim_Obj pointer associated with a variable name,
4628 * or NULL if the variable was not found in the current context.
4629 * The same optimization discussed in the comment to the
4630 * 'SetVariable' function should apply here.
4632 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4633 * in a dictionary which is shared, the array variable value is duplicated first.
4634 * This allows the array element to be updated (e.g. append, lappend) without
4635 * affecting other references to the dictionary.
4637 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4639 switch (SetVariableFromAny(interp, nameObjPtr)) {
4640 case JIM_OK:{
4641 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4643 if (varPtr->linkFramePtr == NULL) {
4644 return varPtr->objPtr;
4646 else {
4647 Jim_Obj *objPtr;
4649 /* The variable is a link? Resolve it. */
4650 Jim_CallFrame *savedCallFrame = interp->framePtr;
4652 interp->framePtr = varPtr->linkFramePtr;
4653 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4654 interp->framePtr = savedCallFrame;
4655 if (objPtr) {
4656 return objPtr;
4658 /* Error, so fall through to the error message */
4661 break;
4663 case JIM_DICT_SUGAR:
4664 /* [dict] syntax sugar. */
4665 return JimDictSugarGet(interp, nameObjPtr, flags);
4667 if (flags & JIM_ERRMSG) {
4668 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4670 return NULL;
4673 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4675 Jim_CallFrame *savedFramePtr;
4676 Jim_Obj *objPtr;
4678 savedFramePtr = interp->framePtr;
4679 interp->framePtr = interp->topFramePtr;
4680 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4681 interp->framePtr = savedFramePtr;
4683 return objPtr;
4686 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4688 Jim_Obj *nameObjPtr, *varObjPtr;
4690 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4691 Jim_IncrRefCount(nameObjPtr);
4692 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4693 Jim_DecrRefCount(interp, nameObjPtr);
4694 return varObjPtr;
4697 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4699 Jim_CallFrame *savedFramePtr;
4700 Jim_Obj *objPtr;
4702 savedFramePtr = interp->framePtr;
4703 interp->framePtr = interp->topFramePtr;
4704 objPtr = Jim_GetVariableStr(interp, name, flags);
4705 interp->framePtr = savedFramePtr;
4707 return objPtr;
4710 /* Unset a variable.
4711 * Note: On success unset invalidates all the (cached) variable objects
4712 * by incrementing callFrameEpoch
4714 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4716 Jim_Var *varPtr;
4717 int retval;
4718 Jim_CallFrame *framePtr;
4720 retval = SetVariableFromAny(interp, nameObjPtr);
4721 if (retval == JIM_DICT_SUGAR) {
4722 /* [dict] syntax sugar. */
4723 return JimDictSugarSet(interp, nameObjPtr, NULL);
4725 else if (retval == JIM_OK) {
4726 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4728 /* If it's a link call UnsetVariable recursively */
4729 if (varPtr->linkFramePtr) {
4730 framePtr = interp->framePtr;
4731 interp->framePtr = varPtr->linkFramePtr;
4732 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4733 interp->framePtr = framePtr;
4735 else {
4736 const char *name = Jim_String(nameObjPtr);
4737 if (nameObjPtr->internalRep.varValue.global) {
4738 name += 2;
4739 framePtr = interp->topFramePtr;
4741 else {
4742 framePtr = interp->framePtr;
4745 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4746 if (retval == JIM_OK) {
4747 /* Change the callframe id, invalidating var lookup caching */
4748 framePtr->id = interp->callFrameEpoch++;
4752 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4753 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4755 return retval;
4758 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4760 /* Given a variable name for [dict] operation syntax sugar,
4761 * this function returns two objects, the first with the name
4762 * of the variable to set, and the second with the respective key.
4763 * For example "foo(bar)" will return objects with string repr. of
4764 * "foo" and "bar".
4766 * The returned objects have refcount = 1. The function can't fail. */
4767 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4768 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4770 const char *str, *p;
4771 int len, keyLen;
4772 Jim_Obj *varObjPtr, *keyObjPtr;
4774 str = Jim_GetString(objPtr, &len);
4776 p = strchr(str, '(');
4777 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4779 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4781 p++;
4782 keyLen = (str + len) - p;
4783 if (str[len - 1] == ')') {
4784 keyLen--;
4787 /* Create the objects with the variable name and key. */
4788 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4790 Jim_IncrRefCount(varObjPtr);
4791 Jim_IncrRefCount(keyObjPtr);
4792 *varPtrPtr = varObjPtr;
4793 *keyPtrPtr = keyObjPtr;
4796 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4797 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4798 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4800 int err;
4802 SetDictSubstFromAny(interp, objPtr);
4804 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4805 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4807 if (err == JIM_OK) {
4808 /* Don't keep an extra ref to the result */
4809 Jim_SetEmptyResult(interp);
4811 else {
4812 if (!valObjPtr) {
4813 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4814 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4815 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4816 objPtr);
4817 return err;
4820 /* Make the error more informative and Tcl-compatible */
4821 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4822 (valObjPtr ? "set" : "unset"), objPtr);
4824 return err;
4828 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4830 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4831 * and stored back to the variable before expansion.
4833 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4834 Jim_Obj *keyObjPtr, int flags)
4836 Jim_Obj *dictObjPtr;
4837 Jim_Obj *resObjPtr = NULL;
4838 int ret;
4840 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4841 if (!dictObjPtr) {
4842 return NULL;
4845 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4846 if (ret != JIM_OK) {
4847 Jim_SetResultFormatted(interp,
4848 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4849 ret < 0 ? "variable isn't" : "no such element in");
4851 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4852 /* Update the variable to have an unshared copy */
4853 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4856 return resObjPtr;
4859 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4860 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4862 SetDictSubstFromAny(interp, objPtr);
4864 return JimDictExpandArrayVariable(interp,
4865 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4866 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4869 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4871 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4873 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4874 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4877 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4879 /* Copy the internal rep */
4880 dupPtr->internalRep = srcPtr->internalRep;
4881 /* Need to increment the ref counts */
4882 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4883 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4886 /* Note: The object *must* be in dict-sugar format */
4887 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4889 if (objPtr->typePtr != &dictSubstObjType) {
4890 Jim_Obj *varObjPtr, *keyObjPtr;
4892 if (objPtr->typePtr == &interpolatedObjType) {
4893 /* An interpolated object in dict-sugar form */
4895 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4896 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4898 Jim_IncrRefCount(varObjPtr);
4899 Jim_IncrRefCount(keyObjPtr);
4901 else {
4902 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4905 Jim_FreeIntRep(interp, objPtr);
4906 objPtr->typePtr = &dictSubstObjType;
4907 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4908 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4912 /* This function is used to expand [dict get] sugar in the form
4913 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4914 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4915 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4916 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4917 * the [dict]ionary contained in variable VARNAME. */
4918 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4920 Jim_Obj *resObjPtr = NULL;
4921 Jim_Obj *substKeyObjPtr = NULL;
4923 SetDictSubstFromAny(interp, objPtr);
4925 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4926 &substKeyObjPtr, JIM_NONE)
4927 != JIM_OK) {
4928 return NULL;
4930 Jim_IncrRefCount(substKeyObjPtr);
4931 resObjPtr =
4932 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4933 substKeyObjPtr, 0);
4934 Jim_DecrRefCount(interp, substKeyObjPtr);
4936 return resObjPtr;
4939 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4941 if (Jim_EvalExpression(interp, objPtr) == JIM_OK) {
4942 return Jim_GetResult(interp);
4944 return NULL;
4947 /* -----------------------------------------------------------------------------
4948 * CallFrame
4949 * ---------------------------------------------------------------------------*/
4951 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4953 Jim_CallFrame *cf;
4955 if (interp->freeFramesList) {
4956 cf = interp->freeFramesList;
4957 interp->freeFramesList = cf->next;
4959 cf->argv = NULL;
4960 cf->argc = 0;
4961 cf->procArgsObjPtr = NULL;
4962 cf->procBodyObjPtr = NULL;
4963 cf->next = NULL;
4964 cf->staticVars = NULL;
4965 cf->localCommands = NULL;
4966 cf->tailcallObj = NULL;
4967 cf->tailcallCmd = NULL;
4969 else {
4970 cf = Jim_Alloc(sizeof(*cf));
4971 memset(cf, 0, sizeof(*cf));
4973 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4976 cf->id = interp->callFrameEpoch++;
4977 cf->parent = parent;
4978 cf->level = parent ? parent->level + 1 : 0;
4979 cf->nsObj = nsObj;
4980 Jim_IncrRefCount(nsObj);
4982 return cf;
4985 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4987 /* Delete any local procs */
4988 if (localCommands) {
4989 Jim_Obj *cmdNameObj;
4991 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4992 Jim_HashEntry *he;
4993 Jim_Obj *fqObjName;
4994 Jim_HashTable *ht = &interp->commands;
4996 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4998 he = Jim_FindHashEntry(ht, fqname);
5000 if (he) {
5001 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
5002 if (cmd->prevCmd) {
5003 Jim_Cmd *prevCmd = cmd->prevCmd;
5004 cmd->prevCmd = NULL;
5006 /* Delete the old command */
5007 JimDecrCmdRefCount(interp, cmd);
5009 /* And restore the original */
5010 Jim_SetHashVal(ht, he, prevCmd);
5012 else {
5013 Jim_DeleteHashEntry(ht, fqname);
5015 Jim_InterpIncrProcEpoch(interp);
5017 Jim_DecrRefCount(interp, cmdNameObj);
5018 JimFreeQualifiedName(interp, fqObjName);
5020 Jim_FreeStack(localCommands);
5021 Jim_Free(localCommands);
5023 return JIM_OK;
5027 * Run any $jim::defer scripts for the current call frame.
5029 * retcode is the return code from the current proc.
5031 * Returns the new return code.
5033 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
5035 Jim_Obj *objPtr;
5037 /* Fast check for the likely case that the variable doesn't exist */
5038 if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
5039 return retcode;
5042 objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
5044 if (objPtr) {
5045 int ret = JIM_OK;
5046 int i;
5047 int listLen = Jim_ListLength(interp, objPtr);
5048 Jim_Obj *resultObjPtr;
5050 Jim_IncrRefCount(objPtr);
5052 /* Need to save away the current interp result and
5053 * restore it if appropriate
5055 resultObjPtr = Jim_GetResult(interp);
5056 Jim_IncrRefCount(resultObjPtr);
5057 Jim_SetEmptyResult(interp);
5059 /* Invoke in reverse order */
5060 for (i = listLen; i > 0; i--) {
5061 /* If a defer script returns an error, don't evaluate remaining scripts */
5062 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5063 ret = Jim_EvalObj(interp, scriptObjPtr);
5064 if (ret != JIM_OK) {
5065 break;
5069 if (ret == JIM_OK || retcode == JIM_ERR) {
5070 /* defer script had no error, or proc had an error so restore proc result */
5071 Jim_SetResult(interp, resultObjPtr);
5073 else {
5074 retcode = ret;
5077 Jim_DecrRefCount(interp, resultObjPtr);
5078 Jim_DecrRefCount(interp, objPtr);
5080 return retcode;
5083 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5084 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5085 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5087 JimDeleteLocalProcs(interp, cf->localCommands);
5089 if (cf->procArgsObjPtr)
5090 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5091 if (cf->procBodyObjPtr)
5092 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5093 Jim_DecrRefCount(interp, cf->nsObj);
5094 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5095 Jim_FreeHashTable(&cf->vars);
5096 else {
5097 int i;
5098 Jim_HashEntry **table = cf->vars.table, *he;
5100 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5101 he = table[i];
5102 while (he != NULL) {
5103 Jim_HashEntry *nextEntry = he->next;
5104 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5106 Jim_DecrRefCount(interp, varPtr->objPtr);
5107 Jim_Free(Jim_GetHashEntryKey(he));
5108 Jim_Free(varPtr);
5109 Jim_Free(he);
5110 table[i] = NULL;
5111 he = nextEntry;
5114 cf->vars.used = 0;
5116 cf->next = interp->freeFramesList;
5117 interp->freeFramesList = cf;
5121 /* -----------------------------------------------------------------------------
5122 * References
5123 * ---------------------------------------------------------------------------*/
5124 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5126 /* References HashTable Type.
5128 * Keys are unsigned long integers, dynamically allocated for now but in the
5129 * future it's worth to cache this 4 bytes objects. Values are pointers
5130 * to Jim_References. */
5131 static void JimReferencesHTValDestructor(void *interp, void *val)
5133 Jim_Reference *refPtr = (void *)val;
5135 Jim_DecrRefCount(interp, refPtr->objPtr);
5136 if (refPtr->finalizerCmdNamePtr != NULL) {
5137 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5139 Jim_Free(val);
5142 static unsigned int JimReferencesHTHashFunction(const void *key)
5144 /* Only the least significant bits are used. */
5145 const unsigned long *widePtr = key;
5146 unsigned int intValue = (unsigned int)*widePtr;
5148 return Jim_IntHashFunction(intValue);
5151 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5153 void *copy = Jim_Alloc(sizeof(unsigned long));
5155 JIM_NOTUSED(privdata);
5157 memcpy(copy, key, sizeof(unsigned long));
5158 return copy;
5161 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5163 JIM_NOTUSED(privdata);
5165 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5168 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5170 JIM_NOTUSED(privdata);
5172 Jim_Free(key);
5175 static const Jim_HashTableType JimReferencesHashTableType = {
5176 JimReferencesHTHashFunction, /* hash function */
5177 JimReferencesHTKeyDup, /* key dup */
5178 NULL, /* val dup */
5179 JimReferencesHTKeyCompare, /* key compare */
5180 JimReferencesHTKeyDestructor, /* key destructor */
5181 JimReferencesHTValDestructor /* val destructor */
5184 /* -----------------------------------------------------------------------------
5185 * Reference object type and References API
5186 * ---------------------------------------------------------------------------*/
5188 /* The string representation of references has two features in order
5189 * to make the GC faster. The first is that every reference starts
5190 * with a non common character '<', in order to make the string matching
5191 * faster. The second is that the reference string rep is 42 characters
5192 * in length, this means that it is not necessary to check any object with a string
5193 * repr < 42, and usually there aren't many of these objects. */
5195 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5197 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5199 const char *fmt = "<reference.<%s>.%020lu>";
5201 sprintf(buf, fmt, refPtr->tag, id);
5202 return JIM_REFERENCE_SPACE;
5205 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5207 static const Jim_ObjType referenceObjType = {
5208 "reference",
5209 NULL,
5210 NULL,
5211 UpdateStringOfReference,
5212 JIM_TYPE_REFERENCES,
5215 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5217 char buf[JIM_REFERENCE_SPACE + 1];
5219 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5220 JimSetStringBytes(objPtr, buf);
5223 /* returns true if 'c' is a valid reference tag character.
5224 * i.e. inside the range [_a-zA-Z0-9] */
5225 static int isrefchar(int c)
5227 return (c == '_' || isalnum(c));
5230 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5232 unsigned long value;
5233 int i, len;
5234 const char *str, *start, *end;
5235 char refId[21];
5236 Jim_Reference *refPtr;
5237 Jim_HashEntry *he;
5238 char *endptr;
5240 /* Get the string representation */
5241 str = Jim_GetString(objPtr, &len);
5242 /* Check if it looks like a reference */
5243 if (len < JIM_REFERENCE_SPACE)
5244 goto badformat;
5245 /* Trim spaces */
5246 start = str;
5247 end = str + len - 1;
5248 while (*start == ' ')
5249 start++;
5250 while (*end == ' ' && end > start)
5251 end--;
5252 if (end - start + 1 != JIM_REFERENCE_SPACE)
5253 goto badformat;
5254 /* <reference.<1234567>.%020> */
5255 if (memcmp(start, "<reference.<", 12) != 0)
5256 goto badformat;
5257 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5258 goto badformat;
5259 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5260 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5261 if (!isrefchar(start[12 + i]))
5262 goto badformat;
5264 /* Extract info from the reference. */
5265 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5266 refId[20] = '\0';
5267 /* Try to convert the ID into an unsigned long */
5268 value = strtoul(refId, &endptr, 10);
5269 if (JimCheckConversion(refId, endptr) != JIM_OK)
5270 goto badformat;
5271 /* Check if the reference really exists! */
5272 he = Jim_FindHashEntry(&interp->references, &value);
5273 if (he == NULL) {
5274 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5275 return JIM_ERR;
5277 refPtr = Jim_GetHashEntryVal(he);
5278 /* Free the old internal repr and set the new one. */
5279 Jim_FreeIntRep(interp, objPtr);
5280 objPtr->typePtr = &referenceObjType;
5281 objPtr->internalRep.refValue.id = value;
5282 objPtr->internalRep.refValue.refPtr = refPtr;
5283 return JIM_OK;
5285 badformat:
5286 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5287 return JIM_ERR;
5290 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5291 * as finalizer command (or NULL if there is no finalizer).
5292 * The returned reference object has refcount = 0. */
5293 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5295 struct Jim_Reference *refPtr;
5296 unsigned long id;
5297 Jim_Obj *refObjPtr;
5298 const char *tag;
5299 int tagLen, i;
5301 /* Perform the Garbage Collection if needed. */
5302 Jim_CollectIfNeeded(interp);
5304 refPtr = Jim_Alloc(sizeof(*refPtr));
5305 refPtr->objPtr = objPtr;
5306 Jim_IncrRefCount(objPtr);
5307 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5308 if (cmdNamePtr)
5309 Jim_IncrRefCount(cmdNamePtr);
5310 id = interp->referenceNextId++;
5311 Jim_AddHashEntry(&interp->references, &id, refPtr);
5312 refObjPtr = Jim_NewObj(interp);
5313 refObjPtr->typePtr = &referenceObjType;
5314 refObjPtr->bytes = NULL;
5315 refObjPtr->internalRep.refValue.id = id;
5316 refObjPtr->internalRep.refValue.refPtr = refPtr;
5317 interp->referenceNextId++;
5318 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5319 * that does not pass the 'isrefchar' test is replaced with '_' */
5320 tag = Jim_GetString(tagPtr, &tagLen);
5321 if (tagLen > JIM_REFERENCE_TAGLEN)
5322 tagLen = JIM_REFERENCE_TAGLEN;
5323 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5324 if (i < tagLen && isrefchar(tag[i]))
5325 refPtr->tag[i] = tag[i];
5326 else
5327 refPtr->tag[i] = '_';
5329 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5330 return refObjPtr;
5333 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5335 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5336 return NULL;
5337 return objPtr->internalRep.refValue.refPtr;
5340 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5342 Jim_Reference *refPtr;
5344 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5345 return JIM_ERR;
5346 Jim_IncrRefCount(cmdNamePtr);
5347 if (refPtr->finalizerCmdNamePtr)
5348 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5349 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5350 return JIM_OK;
5353 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5355 Jim_Reference *refPtr;
5357 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5358 return JIM_ERR;
5359 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5360 return JIM_OK;
5363 /* -----------------------------------------------------------------------------
5364 * References Garbage Collection
5365 * ---------------------------------------------------------------------------*/
5367 /* This the hash table type for the "MARK" phase of the GC */
5368 static const Jim_HashTableType JimRefMarkHashTableType = {
5369 JimReferencesHTHashFunction, /* hash function */
5370 JimReferencesHTKeyDup, /* key dup */
5371 NULL, /* val dup */
5372 JimReferencesHTKeyCompare, /* key compare */
5373 JimReferencesHTKeyDestructor, /* key destructor */
5374 NULL /* val destructor */
5377 /* Performs the garbage collection. */
5378 int Jim_Collect(Jim_Interp *interp)
5380 int collected = 0;
5381 Jim_HashTable marks;
5382 Jim_HashTableIterator htiter;
5383 Jim_HashEntry *he;
5384 Jim_Obj *objPtr;
5386 /* Avoid recursive calls */
5387 if (interp->lastCollectId == -1) {
5388 /* Jim_Collect() already running. Return just now. */
5389 return 0;
5391 interp->lastCollectId = -1;
5393 /* Mark all the references found into the 'mark' hash table.
5394 * The references are searched in every live object that
5395 * is of a type that can contain references. */
5396 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5397 objPtr = interp->liveList;
5398 while (objPtr) {
5399 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5400 const char *str, *p;
5401 int len;
5403 /* If the object is of type reference, to get the
5404 * Id is simple... */
5405 if (objPtr->typePtr == &referenceObjType) {
5406 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5407 #ifdef JIM_DEBUG_GC
5408 printf("MARK (reference): %d refcount: %d\n",
5409 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5410 #endif
5411 objPtr = objPtr->nextObjPtr;
5412 continue;
5414 /* Get the string repr of the object we want
5415 * to scan for references. */
5416 p = str = Jim_GetString(objPtr, &len);
5417 /* Skip objects too little to contain references. */
5418 if (len < JIM_REFERENCE_SPACE) {
5419 objPtr = objPtr->nextObjPtr;
5420 continue;
5422 /* Extract references from the object string repr. */
5423 while (1) {
5424 int i;
5425 unsigned long id;
5427 if ((p = strstr(p, "<reference.<")) == NULL)
5428 break;
5429 /* Check if it's a valid reference. */
5430 if (len - (p - str) < JIM_REFERENCE_SPACE)
5431 break;
5432 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5433 break;
5434 for (i = 21; i <= 40; i++)
5435 if (!isdigit(UCHAR(p[i])))
5436 break;
5437 /* Get the ID */
5438 id = strtoul(p + 21, NULL, 10);
5440 /* Ok, a reference for the given ID
5441 * was found. Mark it. */
5442 Jim_AddHashEntry(&marks, &id, NULL);
5443 #ifdef JIM_DEBUG_GC
5444 printf("MARK: %d\n", (int)id);
5445 #endif
5446 p += JIM_REFERENCE_SPACE;
5449 objPtr = objPtr->nextObjPtr;
5452 /* Run the references hash table to destroy every reference that
5453 * is not referenced outside (not present in the mark HT). */
5454 JimInitHashTableIterator(&interp->references, &htiter);
5455 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5456 const unsigned long *refId;
5457 Jim_Reference *refPtr;
5459 refId = he->key;
5460 /* Check if in the mark phase we encountered
5461 * this reference. */
5462 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5463 #ifdef JIM_DEBUG_GC
5464 printf("COLLECTING %d\n", (int)*refId);
5465 #endif
5466 collected++;
5467 /* Drop the reference, but call the
5468 * finalizer first if registered. */
5469 refPtr = Jim_GetHashEntryVal(he);
5470 if (refPtr->finalizerCmdNamePtr) {
5471 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5472 Jim_Obj *objv[3], *oldResult;
5474 JimFormatReference(refstr, refPtr, *refId);
5476 objv[0] = refPtr->finalizerCmdNamePtr;
5477 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5478 objv[2] = refPtr->objPtr;
5480 /* Drop the reference itself */
5481 /* Avoid the finaliser being freed here */
5482 Jim_IncrRefCount(objv[0]);
5483 /* Don't remove the reference from the hash table just yet
5484 * since that will free refPtr, and hence refPtr->objPtr
5487 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5488 oldResult = interp->result;
5489 Jim_IncrRefCount(oldResult);
5490 Jim_EvalObjVector(interp, 3, objv);
5491 Jim_SetResult(interp, oldResult);
5492 Jim_DecrRefCount(interp, oldResult);
5494 Jim_DecrRefCount(interp, objv[0]);
5496 Jim_DeleteHashEntry(&interp->references, refId);
5499 Jim_FreeHashTable(&marks);
5500 interp->lastCollectId = interp->referenceNextId;
5501 interp->lastCollectTime = time(NULL);
5502 return collected;
5505 #define JIM_COLLECT_ID_PERIOD 5000
5506 #define JIM_COLLECT_TIME_PERIOD 300
5508 void Jim_CollectIfNeeded(Jim_Interp *interp)
5510 unsigned long elapsedId;
5511 int elapsedTime;
5513 elapsedId = interp->referenceNextId - interp->lastCollectId;
5514 elapsedTime = time(NULL) - interp->lastCollectTime;
5517 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5518 Jim_Collect(interp);
5521 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5523 int Jim_IsBigEndian(void)
5525 union {
5526 unsigned short s;
5527 unsigned char c[2];
5528 } uval = {0x0102};
5530 return uval.c[0] == 1;
5533 /* -----------------------------------------------------------------------------
5534 * Interpreter related functions
5535 * ---------------------------------------------------------------------------*/
5537 Jim_Interp *Jim_CreateInterp(void)
5539 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5541 memset(i, 0, sizeof(*i));
5543 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5544 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5545 i->lastCollectTime = time(NULL);
5547 /* Note that we can create objects only after the
5548 * interpreter liveList and freeList pointers are
5549 * initialized to NULL. */
5550 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5551 #ifdef JIM_REFERENCES
5552 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5553 #endif
5554 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5555 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5556 i->emptyObj = Jim_NewEmptyStringObj(i);
5557 i->trueObj = Jim_NewIntObj(i, 1);
5558 i->falseObj = Jim_NewIntObj(i, 0);
5559 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5560 i->errorFileNameObj = i->emptyObj;
5561 i->result = i->emptyObj;
5562 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5563 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5564 i->errorProc = i->emptyObj;
5565 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5566 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5567 Jim_IncrRefCount(i->emptyObj);
5568 Jim_IncrRefCount(i->errorFileNameObj);
5569 Jim_IncrRefCount(i->result);
5570 Jim_IncrRefCount(i->stackTrace);
5571 Jim_IncrRefCount(i->unknown);
5572 Jim_IncrRefCount(i->currentScriptObj);
5573 Jim_IncrRefCount(i->nullScriptObj);
5574 Jim_IncrRefCount(i->errorProc);
5575 Jim_IncrRefCount(i->trueObj);
5576 Jim_IncrRefCount(i->falseObj);
5578 /* Initialize key variables every interpreter should contain */
5579 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5580 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5582 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5583 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5584 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5585 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5586 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5587 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5588 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5589 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5591 return i;
5594 void Jim_FreeInterp(Jim_Interp *i)
5596 Jim_CallFrame *cf, *cfx;
5598 Jim_Obj *objPtr, *nextObjPtr;
5600 /* Free the active call frames list - must be done before i->commands is destroyed */
5601 for (cf = i->framePtr; cf; cf = cfx) {
5602 /* Note that we ignore any errors */
5603 JimInvokeDefer(i, JIM_OK);
5604 cfx = cf->parent;
5605 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5608 Jim_DecrRefCount(i, i->emptyObj);
5609 Jim_DecrRefCount(i, i->trueObj);
5610 Jim_DecrRefCount(i, i->falseObj);
5611 Jim_DecrRefCount(i, i->result);
5612 Jim_DecrRefCount(i, i->stackTrace);
5613 Jim_DecrRefCount(i, i->errorProc);
5614 Jim_DecrRefCount(i, i->unknown);
5615 Jim_DecrRefCount(i, i->errorFileNameObj);
5616 Jim_DecrRefCount(i, i->currentScriptObj);
5617 Jim_DecrRefCount(i, i->nullScriptObj);
5618 Jim_FreeHashTable(&i->commands);
5619 #ifdef JIM_REFERENCES
5620 Jim_FreeHashTable(&i->references);
5621 #endif
5622 Jim_FreeHashTable(&i->packages);
5623 Jim_Free(i->prngState);
5624 Jim_FreeHashTable(&i->assocData);
5626 /* Check that the live object list is empty, otherwise
5627 * there is a memory leak. */
5628 #ifdef JIM_MAINTAINER
5629 if (i->liveList != NULL) {
5630 objPtr = i->liveList;
5632 printf("\n-------------------------------------\n");
5633 printf("Objects still in the free list:\n");
5634 while (objPtr) {
5635 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5636 Jim_String(objPtr);
5638 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5639 printf("%p (%d) %-10s: '%.20s...'\n",
5640 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5642 else {
5643 printf("%p (%d) %-10s: '%s'\n",
5644 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5646 if (objPtr->typePtr == &sourceObjType) {
5647 printf("FILE %s LINE %d\n",
5648 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5649 objPtr->internalRep.sourceValue.lineNumber);
5651 objPtr = objPtr->nextObjPtr;
5653 printf("-------------------------------------\n\n");
5654 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5656 #endif
5658 /* Free all the freed objects. */
5659 objPtr = i->freeList;
5660 while (objPtr) {
5661 nextObjPtr = objPtr->nextObjPtr;
5662 Jim_Free(objPtr);
5663 objPtr = nextObjPtr;
5666 /* Free the free call frames list */
5667 for (cf = i->freeFramesList; cf; cf = cfx) {
5668 cfx = cf->next;
5669 if (cf->vars.table)
5670 Jim_FreeHashTable(&cf->vars);
5671 Jim_Free(cf);
5674 /* Free the interpreter structure. */
5675 Jim_Free(i);
5678 /* Returns the call frame relative to the level represented by
5679 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5681 * This function accepts the 'level' argument in the form
5682 * of the commands [uplevel] and [upvar].
5684 * Returns NULL on error.
5686 * Note: for a function accepting a relative integer as level suitable
5687 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5689 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5691 long level;
5692 const char *str;
5693 Jim_CallFrame *framePtr;
5695 if (levelObjPtr) {
5696 str = Jim_String(levelObjPtr);
5697 if (str[0] == '#') {
5698 char *endptr;
5700 level = jim_strtol(str + 1, &endptr);
5701 if (str[1] == '\0' || endptr[0] != '\0') {
5702 level = -1;
5705 else {
5706 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5707 level = -1;
5709 else {
5710 /* Convert from a relative to an absolute level */
5711 level = interp->framePtr->level - level;
5715 else {
5716 str = "1"; /* Needed to format the error message. */
5717 level = interp->framePtr->level - 1;
5720 if (level == 0) {
5721 return interp->topFramePtr;
5723 if (level > 0) {
5724 /* Lookup */
5725 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5726 if (framePtr->level == level) {
5727 return framePtr;
5732 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5733 return NULL;
5736 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5737 * as a relative integer like in the [info level ?level?] command.
5739 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5741 long level;
5742 Jim_CallFrame *framePtr;
5744 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5745 if (level <= 0) {
5746 /* Convert from a relative to an absolute level */
5747 level = interp->framePtr->level + level;
5750 if (level == 0) {
5751 return interp->topFramePtr;
5754 /* Lookup */
5755 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5756 if (framePtr->level == level) {
5757 return framePtr;
5762 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5763 return NULL;
5766 static void JimResetStackTrace(Jim_Interp *interp)
5768 Jim_DecrRefCount(interp, interp->stackTrace);
5769 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5770 Jim_IncrRefCount(interp->stackTrace);
5773 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5775 int len;
5777 /* Increment reference first in case these are the same object */
5778 Jim_IncrRefCount(stackTraceObj);
5779 Jim_DecrRefCount(interp, interp->stackTrace);
5780 interp->stackTrace = stackTraceObj;
5781 interp->errorFlag = 1;
5783 /* This is a bit ugly.
5784 * If the filename of the last entry of the stack trace is empty,
5785 * the next stack level should be added.
5787 len = Jim_ListLength(interp, interp->stackTrace);
5788 if (len >= 3) {
5789 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5790 interp->addStackTrace = 1;
5795 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5796 Jim_Obj *fileNameObj, int linenr)
5798 if (strcmp(procname, "unknown") == 0) {
5799 procname = "";
5801 if (!*procname && !Jim_Length(fileNameObj)) {
5802 /* No useful info here */
5803 return;
5806 if (Jim_IsShared(interp->stackTrace)) {
5807 Jim_DecrRefCount(interp, interp->stackTrace);
5808 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5809 Jim_IncrRefCount(interp->stackTrace);
5812 /* If we have no procname but the previous element did, merge with that frame */
5813 if (!*procname && Jim_Length(fileNameObj)) {
5814 /* Just a filename. Check the previous entry */
5815 int len = Jim_ListLength(interp, interp->stackTrace);
5817 if (len >= 3) {
5818 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5819 if (Jim_Length(objPtr)) {
5820 /* Yes, the previous level had procname */
5821 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5822 if (Jim_Length(objPtr) == 0) {
5823 /* But no filename, so merge the new info with that frame */
5824 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5825 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5826 return;
5832 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5833 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5834 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5837 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5838 void *data)
5840 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5842 assocEntryPtr->delProc = delProc;
5843 assocEntryPtr->data = data;
5844 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5847 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5849 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5851 if (entryPtr != NULL) {
5852 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5853 return assocEntryPtr->data;
5855 return NULL;
5858 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5860 return Jim_DeleteHashEntry(&interp->assocData, key);
5863 int Jim_GetExitCode(Jim_Interp *interp)
5865 return interp->exitCode;
5868 /* -----------------------------------------------------------------------------
5869 * Integer object
5870 * ---------------------------------------------------------------------------*/
5871 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5872 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5874 static const Jim_ObjType intObjType = {
5875 "int",
5876 NULL,
5877 NULL,
5878 UpdateStringOfInt,
5879 JIM_TYPE_NONE,
5882 /* A coerced double is closer to an int than a double.
5883 * It is an int value temporarily masquerading as a double value.
5884 * i.e. it has the same string value as an int and Jim_GetWide()
5885 * succeeds, but also Jim_GetDouble() returns the value directly.
5887 static const Jim_ObjType coercedDoubleObjType = {
5888 "coerced-double",
5889 NULL,
5890 NULL,
5891 UpdateStringOfInt,
5892 JIM_TYPE_NONE,
5896 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5898 char buf[JIM_INTEGER_SPACE + 1];
5899 jim_wide wideValue = JimWideValue(objPtr);
5900 int pos = 0;
5902 if (wideValue == 0) {
5903 buf[pos++] = '0';
5905 else {
5906 char tmp[JIM_INTEGER_SPACE];
5907 int num = 0;
5908 int i;
5910 if (wideValue < 0) {
5911 buf[pos++] = '-';
5912 i = wideValue % 10;
5913 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5914 * whereas C99 is always -6
5915 * coverity[dead_error_line]
5917 tmp[num++] = (i > 0) ? (10 - i) : -i;
5918 wideValue /= -10;
5921 while (wideValue) {
5922 tmp[num++] = wideValue % 10;
5923 wideValue /= 10;
5926 for (i = 0; i < num; i++) {
5927 buf[pos++] = '0' + tmp[num - i - 1];
5930 buf[pos] = 0;
5932 JimSetStringBytes(objPtr, buf);
5935 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5937 jim_wide wideValue;
5938 const char *str;
5940 if (objPtr->typePtr == &coercedDoubleObjType) {
5941 /* Simple switch */
5942 objPtr->typePtr = &intObjType;
5943 return JIM_OK;
5946 /* Get the string representation */
5947 str = Jim_String(objPtr);
5948 /* Try to convert into a jim_wide */
5949 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5950 if (flags & JIM_ERRMSG) {
5951 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5953 return JIM_ERR;
5955 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5956 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5957 return JIM_ERR;
5959 /* Free the old internal repr and set the new one. */
5960 Jim_FreeIntRep(interp, objPtr);
5961 objPtr->typePtr = &intObjType;
5962 objPtr->internalRep.wideValue = wideValue;
5963 return JIM_OK;
5966 #ifdef JIM_OPTIMIZATION
5967 static int JimIsWide(Jim_Obj *objPtr)
5969 return objPtr->typePtr == &intObjType;
5971 #endif
5973 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5975 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5976 return JIM_ERR;
5977 *widePtr = JimWideValue(objPtr);
5978 return JIM_OK;
5981 /* Get a wide but does not set an error if the format is bad. */
5982 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5984 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5985 return JIM_ERR;
5986 *widePtr = JimWideValue(objPtr);
5987 return JIM_OK;
5990 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5992 jim_wide wideValue;
5993 int retval;
5995 retval = Jim_GetWide(interp, objPtr, &wideValue);
5996 if (retval == JIM_OK) {
5997 *longPtr = (long)wideValue;
5998 return JIM_OK;
6000 return JIM_ERR;
6003 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
6005 Jim_Obj *objPtr;
6007 objPtr = Jim_NewObj(interp);
6008 objPtr->typePtr = &intObjType;
6009 objPtr->bytes = NULL;
6010 objPtr->internalRep.wideValue = wideValue;
6011 return objPtr;
6014 /* -----------------------------------------------------------------------------
6015 * Double object
6016 * ---------------------------------------------------------------------------*/
6017 #define JIM_DOUBLE_SPACE 30
6019 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
6020 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6022 static const Jim_ObjType doubleObjType = {
6023 "double",
6024 NULL,
6025 NULL,
6026 UpdateStringOfDouble,
6027 JIM_TYPE_NONE,
6030 #ifndef HAVE_ISNAN
6031 #undef isnan
6032 #define isnan(X) ((X) != (X))
6033 #endif
6034 #ifndef HAVE_ISINF
6035 #undef isinf
6036 #define isinf(X) (1.0 / (X) == 0.0)
6037 #endif
6039 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
6041 double value = objPtr->internalRep.doubleValue;
6043 if (isnan(value)) {
6044 JimSetStringBytes(objPtr, "NaN");
6045 return;
6047 if (isinf(value)) {
6048 if (value < 0) {
6049 JimSetStringBytes(objPtr, "-Inf");
6051 else {
6052 JimSetStringBytes(objPtr, "Inf");
6054 return;
6057 char buf[JIM_DOUBLE_SPACE + 1];
6058 int i;
6059 int len = sprintf(buf, "%.12g", value);
6061 /* Add a final ".0" if necessary */
6062 for (i = 0; i < len; i++) {
6063 if (buf[i] == '.' || buf[i] == 'e') {
6064 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6065 /* If 'buf' ends in e-0nn or e+0nn, remove
6066 * the 0 after the + or - and reduce the length by 1
6068 char *e = strchr(buf, 'e');
6069 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6070 /* Move it up */
6071 e += 2;
6072 memmove(e, e + 1, len - (e - buf));
6074 #endif
6075 break;
6078 if (buf[i] == '\0') {
6079 buf[i++] = '.';
6080 buf[i++] = '0';
6081 buf[i] = '\0';
6083 JimSetStringBytes(objPtr, buf);
6087 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6089 double doubleValue;
6090 jim_wide wideValue;
6091 const char *str;
6093 #ifdef HAVE_LONG_LONG
6094 /* Assume a 53 bit mantissa */
6095 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6096 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6098 if (objPtr->typePtr == &intObjType
6099 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6100 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6102 /* Direct conversion to coerced double */
6103 objPtr->typePtr = &coercedDoubleObjType;
6104 return JIM_OK;
6106 #endif
6107 /* Preserve the string representation.
6108 * Needed so we can convert back to int without loss
6110 str = Jim_String(objPtr);
6112 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6113 /* Managed to convert to an int, so we can use this as a cooerced double */
6114 Jim_FreeIntRep(interp, objPtr);
6115 objPtr->typePtr = &coercedDoubleObjType;
6116 objPtr->internalRep.wideValue = wideValue;
6117 return JIM_OK;
6119 else {
6120 /* Try to convert into a double */
6121 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6122 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6123 return JIM_ERR;
6125 /* Free the old internal repr and set the new one. */
6126 Jim_FreeIntRep(interp, objPtr);
6128 objPtr->typePtr = &doubleObjType;
6129 objPtr->internalRep.doubleValue = doubleValue;
6130 return JIM_OK;
6133 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6135 if (objPtr->typePtr == &coercedDoubleObjType) {
6136 *doublePtr = JimWideValue(objPtr);
6137 return JIM_OK;
6139 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6140 return JIM_ERR;
6142 if (objPtr->typePtr == &coercedDoubleObjType) {
6143 *doublePtr = JimWideValue(objPtr);
6145 else {
6146 *doublePtr = objPtr->internalRep.doubleValue;
6148 return JIM_OK;
6151 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6153 Jim_Obj *objPtr;
6155 objPtr = Jim_NewObj(interp);
6156 objPtr->typePtr = &doubleObjType;
6157 objPtr->bytes = NULL;
6158 objPtr->internalRep.doubleValue = doubleValue;
6159 return objPtr;
6162 /* -----------------------------------------------------------------------------
6163 * Boolean conversion
6164 * ---------------------------------------------------------------------------*/
6165 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6167 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6169 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6170 return JIM_ERR;
6171 *booleanPtr = (int) JimWideValue(objPtr);
6172 return JIM_OK;
6175 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6177 static const char * const falses[] = {
6178 "0", "false", "no", "off", NULL
6180 static const char * const trues[] = {
6181 "1", "true", "yes", "on", NULL
6184 int boolean;
6186 int index;
6187 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6188 boolean = 0;
6189 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6190 boolean = 1;
6191 } else {
6192 if (flags & JIM_ERRMSG) {
6193 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6195 return JIM_ERR;
6198 /* Free the old internal repr and set the new one. */
6199 Jim_FreeIntRep(interp, objPtr);
6200 objPtr->typePtr = &intObjType;
6201 objPtr->internalRep.wideValue = boolean;
6202 return JIM_OK;
6205 /* -----------------------------------------------------------------------------
6206 * List object
6207 * ---------------------------------------------------------------------------*/
6208 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6209 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6210 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6211 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6212 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6213 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6215 /* Note that while the elements of the list may contain references,
6216 * the list object itself can't. This basically means that the
6217 * list object string representation as a whole can't contain references
6218 * that are not presents in the single elements. */
6219 static const Jim_ObjType listObjType = {
6220 "list",
6221 FreeListInternalRep,
6222 DupListInternalRep,
6223 UpdateStringOfList,
6224 JIM_TYPE_NONE,
6227 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6229 int i;
6231 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6232 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6234 Jim_Free(objPtr->internalRep.listValue.ele);
6237 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6239 int i;
6241 JIM_NOTUSED(interp);
6243 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6244 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6245 dupPtr->internalRep.listValue.ele =
6246 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6247 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6248 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6249 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6250 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6252 dupPtr->typePtr = &listObjType;
6255 /* The following function checks if a given string can be encoded
6256 * into a list element without any kind of quoting, surrounded by braces,
6257 * or using escapes to quote. */
6258 #define JIM_ELESTR_SIMPLE 0
6259 #define JIM_ELESTR_BRACE 1
6260 #define JIM_ELESTR_QUOTE 2
6261 static unsigned char ListElementQuotingType(const char *s, int len)
6263 int i, level, blevel, trySimple = 1;
6265 /* Try with the SIMPLE case */
6266 if (len == 0)
6267 return JIM_ELESTR_BRACE;
6268 if (s[0] == '"' || s[0] == '{') {
6269 trySimple = 0;
6270 goto testbrace;
6272 for (i = 0; i < len; i++) {
6273 switch (s[i]) {
6274 case ' ':
6275 case '$':
6276 case '"':
6277 case '[':
6278 case ']':
6279 case ';':
6280 case '\\':
6281 case '\r':
6282 case '\n':
6283 case '\t':
6284 case '\f':
6285 case '\v':
6286 trySimple = 0;
6287 /* fall through */
6288 case '{':
6289 case '}':
6290 goto testbrace;
6293 return JIM_ELESTR_SIMPLE;
6295 testbrace:
6296 /* Test if it's possible to do with braces */
6297 if (s[len - 1] == '\\')
6298 return JIM_ELESTR_QUOTE;
6299 level = 0;
6300 blevel = 0;
6301 for (i = 0; i < len; i++) {
6302 switch (s[i]) {
6303 case '{':
6304 level++;
6305 break;
6306 case '}':
6307 level--;
6308 if (level < 0)
6309 return JIM_ELESTR_QUOTE;
6310 break;
6311 case '[':
6312 blevel++;
6313 break;
6314 case ']':
6315 blevel--;
6316 break;
6317 case '\\':
6318 if (s[i + 1] == '\n')
6319 return JIM_ELESTR_QUOTE;
6320 else if (s[i + 1] != '\0')
6321 i++;
6322 break;
6325 if (blevel < 0) {
6326 return JIM_ELESTR_QUOTE;
6329 if (level == 0) {
6330 if (!trySimple)
6331 return JIM_ELESTR_BRACE;
6332 for (i = 0; i < len; i++) {
6333 switch (s[i]) {
6334 case ' ':
6335 case '$':
6336 case '"':
6337 case '[':
6338 case ']':
6339 case ';':
6340 case '\\':
6341 case '\r':
6342 case '\n':
6343 case '\t':
6344 case '\f':
6345 case '\v':
6346 return JIM_ELESTR_BRACE;
6347 break;
6350 return JIM_ELESTR_SIMPLE;
6352 return JIM_ELESTR_QUOTE;
6355 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6356 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6357 * scenario.
6358 * Returns the length of the result.
6360 static int BackslashQuoteString(const char *s, int len, char *q)
6362 char *p = q;
6364 while (len--) {
6365 switch (*s) {
6366 case ' ':
6367 case '$':
6368 case '"':
6369 case '[':
6370 case ']':
6371 case '{':
6372 case '}':
6373 case ';':
6374 case '\\':
6375 *p++ = '\\';
6376 *p++ = *s++;
6377 break;
6378 case '\n':
6379 *p++ = '\\';
6380 *p++ = 'n';
6381 s++;
6382 break;
6383 case '\r':
6384 *p++ = '\\';
6385 *p++ = 'r';
6386 s++;
6387 break;
6388 case '\t':
6389 *p++ = '\\';
6390 *p++ = 't';
6391 s++;
6392 break;
6393 case '\f':
6394 *p++ = '\\';
6395 *p++ = 'f';
6396 s++;
6397 break;
6398 case '\v':
6399 *p++ = '\\';
6400 *p++ = 'v';
6401 s++;
6402 break;
6403 default:
6404 *p++ = *s++;
6405 break;
6408 *p = '\0';
6410 return p - q;
6413 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6415 #define STATIC_QUOTING_LEN 32
6416 int i, bufLen, realLength;
6417 const char *strRep;
6418 char *p;
6419 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6421 /* Estimate the space needed. */
6422 if (objc > STATIC_QUOTING_LEN) {
6423 quotingType = Jim_Alloc(objc);
6425 else {
6426 quotingType = staticQuoting;
6428 bufLen = 0;
6429 for (i = 0; i < objc; i++) {
6430 int len;
6432 strRep = Jim_GetString(objv[i], &len);
6433 quotingType[i] = ListElementQuotingType(strRep, len);
6434 switch (quotingType[i]) {
6435 case JIM_ELESTR_SIMPLE:
6436 if (i != 0 || strRep[0] != '#') {
6437 bufLen += len;
6438 break;
6440 /* Special case '#' on first element needs braces */
6441 quotingType[i] = JIM_ELESTR_BRACE;
6442 /* fall through */
6443 case JIM_ELESTR_BRACE:
6444 bufLen += len + 2;
6445 break;
6446 case JIM_ELESTR_QUOTE:
6447 bufLen += len * 2;
6448 break;
6450 bufLen++; /* elements separator. */
6452 bufLen++;
6454 /* Generate the string rep. */
6455 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6456 realLength = 0;
6457 for (i = 0; i < objc; i++) {
6458 int len, qlen;
6460 strRep = Jim_GetString(objv[i], &len);
6462 switch (quotingType[i]) {
6463 case JIM_ELESTR_SIMPLE:
6464 memcpy(p, strRep, len);
6465 p += len;
6466 realLength += len;
6467 break;
6468 case JIM_ELESTR_BRACE:
6469 *p++ = '{';
6470 memcpy(p, strRep, len);
6471 p += len;
6472 *p++ = '}';
6473 realLength += len + 2;
6474 break;
6475 case JIM_ELESTR_QUOTE:
6476 if (i == 0 && strRep[0] == '#') {
6477 *p++ = '\\';
6478 realLength++;
6480 qlen = BackslashQuoteString(strRep, len, p);
6481 p += qlen;
6482 realLength += qlen;
6483 break;
6485 /* Add a separating space */
6486 if (i + 1 != objc) {
6487 *p++ = ' ';
6488 realLength++;
6491 *p = '\0'; /* nul term. */
6492 objPtr->length = realLength;
6494 if (quotingType != staticQuoting) {
6495 Jim_Free(quotingType);
6499 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6501 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6504 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6506 struct JimParserCtx parser;
6507 const char *str;
6508 int strLen;
6509 Jim_Obj *fileNameObj;
6510 int linenr;
6512 if (objPtr->typePtr == &listObjType) {
6513 return JIM_OK;
6516 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6517 * it also preserves any source location of the dict elements
6518 * which can be very useful
6520 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6521 Jim_Obj **listObjPtrPtr;
6522 int len;
6523 int i;
6525 listObjPtrPtr = JimDictPairs(objPtr, &len);
6526 for (i = 0; i < len; i++) {
6527 Jim_IncrRefCount(listObjPtrPtr[i]);
6530 /* Now just switch the internal rep */
6531 Jim_FreeIntRep(interp, objPtr);
6532 objPtr->typePtr = &listObjType;
6533 objPtr->internalRep.listValue.len = len;
6534 objPtr->internalRep.listValue.maxLen = len;
6535 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6537 return JIM_OK;
6540 /* Try to preserve information about filename / line number */
6541 if (objPtr->typePtr == &sourceObjType) {
6542 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6543 linenr = objPtr->internalRep.sourceValue.lineNumber;
6545 else {
6546 fileNameObj = interp->emptyObj;
6547 linenr = 1;
6549 Jim_IncrRefCount(fileNameObj);
6551 /* Get the string representation */
6552 str = Jim_GetString(objPtr, &strLen);
6554 /* Free the old internal repr just now and initialize the
6555 * new one just now. The string->list conversion can't fail. */
6556 Jim_FreeIntRep(interp, objPtr);
6557 objPtr->typePtr = &listObjType;
6558 objPtr->internalRep.listValue.len = 0;
6559 objPtr->internalRep.listValue.maxLen = 0;
6560 objPtr->internalRep.listValue.ele = NULL;
6562 /* Convert into a list */
6563 if (strLen) {
6564 JimParserInit(&parser, str, strLen, linenr);
6565 while (!parser.eof) {
6566 Jim_Obj *elementPtr;
6568 JimParseList(&parser);
6569 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6570 continue;
6571 elementPtr = JimParserGetTokenObj(interp, &parser);
6572 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6573 ListAppendElement(objPtr, elementPtr);
6576 Jim_DecrRefCount(interp, fileNameObj);
6577 return JIM_OK;
6580 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6582 Jim_Obj *objPtr;
6584 objPtr = Jim_NewObj(interp);
6585 objPtr->typePtr = &listObjType;
6586 objPtr->bytes = NULL;
6587 objPtr->internalRep.listValue.ele = NULL;
6588 objPtr->internalRep.listValue.len = 0;
6589 objPtr->internalRep.listValue.maxLen = 0;
6591 if (len) {
6592 ListInsertElements(objPtr, 0, len, elements);
6595 return objPtr;
6598 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6599 * length of the vector. Note that the user of this function should make
6600 * sure that the list object can't shimmer while the vector returned
6601 * is in use, this vector is the one stored inside the internal representation
6602 * of the list object. This function is not exported, extensions should
6603 * always access to the List object elements using Jim_ListIndex(). */
6604 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6605 Jim_Obj ***listVec)
6607 *listLen = Jim_ListLength(interp, listObj);
6608 *listVec = listObj->internalRep.listValue.ele;
6611 /* Sorting uses ints, but commands may return wide */
6612 static int JimSign(jim_wide w)
6614 if (w == 0) {
6615 return 0;
6617 else if (w < 0) {
6618 return -1;
6620 return 1;
6623 /* ListSortElements type values */
6624 struct lsort_info {
6625 jmp_buf jmpbuf;
6626 Jim_Obj *command;
6627 Jim_Interp *interp;
6628 enum {
6629 JIM_LSORT_ASCII,
6630 JIM_LSORT_NOCASE,
6631 JIM_LSORT_INTEGER,
6632 JIM_LSORT_REAL,
6633 JIM_LSORT_COMMAND
6634 } type;
6635 int order;
6636 int index;
6637 int indexed;
6638 int unique;
6639 int (*subfn)(Jim_Obj **, Jim_Obj **);
6642 static struct lsort_info *sort_info;
6644 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6646 Jim_Obj *lObj, *rObj;
6648 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6649 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6650 longjmp(sort_info->jmpbuf, JIM_ERR);
6652 return sort_info->subfn(&lObj, &rObj);
6655 /* Sort the internal rep of a list. */
6656 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6658 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6661 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6663 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6666 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6668 jim_wide lhs = 0, rhs = 0;
6670 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6671 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6672 longjmp(sort_info->jmpbuf, JIM_ERR);
6675 return JimSign(lhs - rhs) * sort_info->order;
6678 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6680 double lhs = 0, rhs = 0;
6682 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6683 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6684 longjmp(sort_info->jmpbuf, JIM_ERR);
6686 if (lhs == rhs) {
6687 return 0;
6689 if (lhs > rhs) {
6690 return sort_info->order;
6692 return -sort_info->order;
6695 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6697 Jim_Obj *compare_script;
6698 int rc;
6700 jim_wide ret = 0;
6702 /* This must be a valid list */
6703 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6704 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6705 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6707 rc = Jim_EvalObj(sort_info->interp, compare_script);
6709 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6710 longjmp(sort_info->jmpbuf, rc);
6713 return JimSign(ret) * sort_info->order;
6716 /* Remove duplicate elements from the (sorted) list in-place, according to the
6717 * comparison function, comp.
6719 * Note that the last unique value is kept, not the first
6721 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6723 int src;
6724 int dst = 0;
6725 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6727 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6728 if (comp(&ele[dst], &ele[src]) == 0) {
6729 /* Match, so replace the dest with the current source */
6730 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6732 else {
6733 /* No match, so keep the current source and move to the next destination */
6734 dst++;
6736 ele[dst] = ele[src];
6739 /* At end of list, keep the final element unless all elements were kept */
6740 dst++;
6741 if (dst < listObjPtr->internalRep.listValue.len) {
6742 ele[dst] = ele[src];
6745 /* Set the new length */
6746 listObjPtr->internalRep.listValue.len = dst;
6749 /* Sort a list *in place*. MUST be called with a non-shared list. */
6750 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6752 struct lsort_info *prev_info;
6754 typedef int (qsort_comparator) (const void *, const void *);
6755 int (*fn) (Jim_Obj **, Jim_Obj **);
6756 Jim_Obj **vector;
6757 int len;
6758 int rc;
6760 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6761 SetListFromAny(interp, listObjPtr);
6763 /* Allow lsort to be called reentrantly */
6764 prev_info = sort_info;
6765 sort_info = info;
6767 vector = listObjPtr->internalRep.listValue.ele;
6768 len = listObjPtr->internalRep.listValue.len;
6769 switch (info->type) {
6770 case JIM_LSORT_ASCII:
6771 fn = ListSortString;
6772 break;
6773 case JIM_LSORT_NOCASE:
6774 fn = ListSortStringNoCase;
6775 break;
6776 case JIM_LSORT_INTEGER:
6777 fn = ListSortInteger;
6778 break;
6779 case JIM_LSORT_REAL:
6780 fn = ListSortReal;
6781 break;
6782 case JIM_LSORT_COMMAND:
6783 fn = ListSortCommand;
6784 break;
6785 default:
6786 fn = NULL; /* avoid warning */
6787 JimPanic((1, "ListSort called with invalid sort type"));
6788 return -1; /* Should not be run but keeps static analysers happy */
6791 if (info->indexed) {
6792 /* Need to interpose a "list index" function */
6793 info->subfn = fn;
6794 fn = ListSortIndexHelper;
6797 if ((rc = setjmp(info->jmpbuf)) == 0) {
6798 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6800 if (info->unique && len > 1) {
6801 ListRemoveDuplicates(listObjPtr, fn);
6804 Jim_InvalidateStringRep(listObjPtr);
6806 sort_info = prev_info;
6808 return rc;
6811 /* This is the low-level function to insert elements into a list.
6812 * The higher-level Jim_ListInsertElements() performs shared object
6813 * check and invalidates the string repr. This version is used
6814 * in the internals of the List Object and is not exported.
6816 * NOTE: this function can be called only against objects
6817 * with internal type of List.
6819 * An insertion point (idx) of -1 means end-of-list.
6821 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6823 int currentLen = listPtr->internalRep.listValue.len;
6824 int requiredLen = currentLen + elemc;
6825 int i;
6826 Jim_Obj **point;
6828 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6829 if (requiredLen < 2) {
6830 /* Don't do allocations of under 4 pointers. */
6831 requiredLen = 4;
6833 else {
6834 requiredLen *= 2;
6837 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6838 sizeof(Jim_Obj *) * requiredLen);
6840 listPtr->internalRep.listValue.maxLen = requiredLen;
6842 if (idx < 0) {
6843 idx = currentLen;
6845 point = listPtr->internalRep.listValue.ele + idx;
6846 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6847 for (i = 0; i < elemc; ++i) {
6848 point[i] = elemVec[i];
6849 Jim_IncrRefCount(point[i]);
6851 listPtr->internalRep.listValue.len += elemc;
6854 /* Convenience call to ListInsertElements() to append a single element.
6856 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6858 ListInsertElements(listPtr, -1, 1, &objPtr);
6861 /* Appends every element of appendListPtr into listPtr.
6862 * Both have to be of the list type.
6863 * Convenience call to ListInsertElements()
6865 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6867 ListInsertElements(listPtr, -1,
6868 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6871 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6873 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6874 SetListFromAny(interp, listPtr);
6875 Jim_InvalidateStringRep(listPtr);
6876 ListAppendElement(listPtr, objPtr);
6879 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6881 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6882 SetListFromAny(interp, listPtr);
6883 SetListFromAny(interp, appendListPtr);
6884 Jim_InvalidateStringRep(listPtr);
6885 ListAppendList(listPtr, appendListPtr);
6888 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6890 SetListFromAny(interp, objPtr);
6891 return objPtr->internalRep.listValue.len;
6894 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6895 int objc, Jim_Obj *const *objVec)
6897 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6898 SetListFromAny(interp, listPtr);
6899 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6900 idx = listPtr->internalRep.listValue.len;
6901 else if (idx < 0)
6902 idx = 0;
6903 Jim_InvalidateStringRep(listPtr);
6904 ListInsertElements(listPtr, idx, objc, objVec);
6907 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6909 SetListFromAny(interp, listPtr);
6910 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6911 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6912 return NULL;
6914 if (idx < 0)
6915 idx = listPtr->internalRep.listValue.len + idx;
6916 return listPtr->internalRep.listValue.ele[idx];
6919 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6921 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6922 if (*objPtrPtr == NULL) {
6923 if (flags & JIM_ERRMSG) {
6924 Jim_SetResultString(interp, "list index out of range", -1);
6926 return JIM_ERR;
6928 return JIM_OK;
6931 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6932 Jim_Obj *newObjPtr, int flags)
6934 SetListFromAny(interp, listPtr);
6935 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6936 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6937 if (flags & JIM_ERRMSG) {
6938 Jim_SetResultString(interp, "list index out of range", -1);
6940 return JIM_ERR;
6942 if (idx < 0)
6943 idx = listPtr->internalRep.listValue.len + idx;
6944 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6945 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6946 Jim_IncrRefCount(newObjPtr);
6947 return JIM_OK;
6950 /* Modify the list stored in the variable named 'varNamePtr'
6951 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6952 * with the new element 'newObjptr'. (implements the [lset] command) */
6953 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6954 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6956 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6957 int shared, i, idx;
6959 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6960 if (objPtr == NULL)
6961 return JIM_ERR;
6962 if ((shared = Jim_IsShared(objPtr)))
6963 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6964 for (i = 0; i < indexc - 1; i++) {
6965 listObjPtr = objPtr;
6966 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6967 goto err;
6968 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6969 goto err;
6971 if (Jim_IsShared(objPtr)) {
6972 objPtr = Jim_DuplicateObj(interp, objPtr);
6973 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6975 Jim_InvalidateStringRep(listObjPtr);
6977 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6978 goto err;
6979 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6980 goto err;
6981 Jim_InvalidateStringRep(objPtr);
6982 Jim_InvalidateStringRep(varObjPtr);
6983 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6984 goto err;
6985 Jim_SetResult(interp, varObjPtr);
6986 return JIM_OK;
6987 err:
6988 if (shared) {
6989 Jim_FreeNewObj(interp, varObjPtr);
6991 return JIM_ERR;
6994 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6996 int i;
6997 int listLen = Jim_ListLength(interp, listObjPtr);
6998 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
7000 for (i = 0; i < listLen; ) {
7001 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
7002 if (++i != listLen) {
7003 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
7006 return resObjPtr;
7009 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
7011 int i;
7013 /* If all the objects in objv are lists,
7014 * it's possible to return a list as result, that's the
7015 * concatenation of all the lists. */
7016 for (i = 0; i < objc; i++) {
7017 if (!Jim_IsList(objv[i]))
7018 break;
7020 if (i == objc) {
7021 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
7023 for (i = 0; i < objc; i++)
7024 ListAppendList(objPtr, objv[i]);
7025 return objPtr;
7027 else {
7028 /* Else... we have to glue strings together */
7029 int len = 0, objLen;
7030 char *bytes, *p;
7032 /* Compute the length */
7033 for (i = 0; i < objc; i++) {
7034 len += Jim_Length(objv[i]);
7036 if (objc)
7037 len += objc - 1;
7038 /* Create the string rep, and a string object holding it. */
7039 p = bytes = Jim_Alloc(len + 1);
7040 for (i = 0; i < objc; i++) {
7041 const char *s = Jim_GetString(objv[i], &objLen);
7043 /* Remove leading space */
7044 while (objLen && isspace(UCHAR(*s))) {
7045 s++;
7046 objLen--;
7047 len--;
7049 /* And trailing space */
7050 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
7051 /* Handle trailing backslash-space case */
7052 if (objLen > 1 && s[objLen - 2] == '\\') {
7053 break;
7055 objLen--;
7056 len--;
7058 memcpy(p, s, objLen);
7059 p += objLen;
7060 if (i + 1 != objc) {
7061 if (objLen)
7062 *p++ = ' ';
7063 else {
7064 /* Drop the space calculated for this
7065 * element that is instead null. */
7066 len--;
7070 *p = '\0';
7071 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7075 /* Returns a list composed of the elements in the specified range.
7076 * first and start are directly accepted as Jim_Objects and
7077 * processed for the end?-index? case. */
7078 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7079 Jim_Obj *lastObjPtr)
7081 int first, last;
7082 int len, rangeLen;
7084 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7085 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7086 return NULL;
7087 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7088 first = JimRelToAbsIndex(len, first);
7089 last = JimRelToAbsIndex(len, last);
7090 JimRelToAbsRange(len, &first, &last, &rangeLen);
7091 if (first == 0 && last == len) {
7092 return listObjPtr;
7094 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7097 /* -----------------------------------------------------------------------------
7098 * Dict object
7099 * ---------------------------------------------------------------------------*/
7100 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7101 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7102 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7103 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7105 /* Dict HashTable Type.
7107 * Keys and Values are Jim objects. */
7109 static unsigned int JimObjectHTHashFunction(const void *key)
7111 int len;
7112 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7113 return Jim_GenHashFunction((const unsigned char *)str, len);
7116 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7118 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7121 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7123 Jim_IncrRefCount((Jim_Obj *)val);
7124 return (void *)val;
7127 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7129 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7132 static const Jim_HashTableType JimDictHashTableType = {
7133 JimObjectHTHashFunction, /* hash function */
7134 JimObjectHTKeyValDup, /* key dup */
7135 JimObjectHTKeyValDup, /* val dup */
7136 JimObjectHTKeyCompare, /* key compare */
7137 JimObjectHTKeyValDestructor, /* key destructor */
7138 JimObjectHTKeyValDestructor /* val destructor */
7141 /* Note that while the elements of the dict may contain references,
7142 * the list object itself can't. This basically means that the
7143 * dict object string representation as a whole can't contain references
7144 * that are not presents in the single elements. */
7145 static const Jim_ObjType dictObjType = {
7146 "dict",
7147 FreeDictInternalRep,
7148 DupDictInternalRep,
7149 UpdateStringOfDict,
7150 JIM_TYPE_NONE,
7153 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7155 JIM_NOTUSED(interp);
7157 Jim_FreeHashTable(objPtr->internalRep.ptr);
7158 Jim_Free(objPtr->internalRep.ptr);
7161 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7163 Jim_HashTable *ht, *dupHt;
7164 Jim_HashTableIterator htiter;
7165 Jim_HashEntry *he;
7167 /* Create a new hash table */
7168 ht = srcPtr->internalRep.ptr;
7169 dupHt = Jim_Alloc(sizeof(*dupHt));
7170 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7171 if (ht->size != 0)
7172 Jim_ExpandHashTable(dupHt, ht->size);
7173 /* Copy every element from the source to the dup hash table */
7174 JimInitHashTableIterator(ht, &htiter);
7175 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7176 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7179 dupPtr->internalRep.ptr = dupHt;
7180 dupPtr->typePtr = &dictObjType;
7183 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7185 Jim_HashTable *ht;
7186 Jim_HashTableIterator htiter;
7187 Jim_HashEntry *he;
7188 Jim_Obj **objv;
7189 int i;
7191 ht = dictPtr->internalRep.ptr;
7193 /* Turn the hash table into a flat vector of Jim_Objects. */
7194 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7195 JimInitHashTableIterator(ht, &htiter);
7196 i = 0;
7197 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7198 objv[i++] = Jim_GetHashEntryKey(he);
7199 objv[i++] = Jim_GetHashEntryVal(he);
7201 *len = i;
7202 return objv;
7205 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7207 /* Turn the hash table into a flat vector of Jim_Objects. */
7208 int len;
7209 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7211 /* And now generate the string rep as a list */
7212 JimMakeListStringRep(objPtr, objv, len);
7214 Jim_Free(objv);
7217 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7219 int listlen;
7221 if (objPtr->typePtr == &dictObjType) {
7222 return JIM_OK;
7225 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7226 /* A shared list, so get the string representation now to avoid
7227 * changing the order in case of fast conversion to dict.
7229 Jim_String(objPtr);
7232 /* For simplicity, convert a non-list object to a list and then to a dict */
7233 listlen = Jim_ListLength(interp, objPtr);
7234 if (listlen % 2) {
7235 Jim_SetResultString(interp, "missing value to go with key", -1);
7236 return JIM_ERR;
7238 else {
7239 /* Converting from a list to a dict can't fail */
7240 Jim_HashTable *ht;
7241 int i;
7243 ht = Jim_Alloc(sizeof(*ht));
7244 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7246 for (i = 0; i < listlen; i += 2) {
7247 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7248 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7250 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7253 Jim_FreeIntRep(interp, objPtr);
7254 objPtr->typePtr = &dictObjType;
7255 objPtr->internalRep.ptr = ht;
7257 return JIM_OK;
7261 /* Dict object API */
7263 /* Add an element to a dict. objPtr must be of the "dict" type.
7264 * The higher-level exported function is Jim_DictAddElement().
7265 * If an element with the specified key already exists, the value
7266 * associated is replaced with the new one.
7268 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7269 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7270 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7272 Jim_HashTable *ht = objPtr->internalRep.ptr;
7274 if (valueObjPtr == NULL) { /* unset */
7275 return Jim_DeleteHashEntry(ht, keyObjPtr);
7277 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7278 return JIM_OK;
7281 /* Add an element, higher-level interface for DictAddElement().
7282 * If valueObjPtr == NULL, the key is removed if it exists. */
7283 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7284 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7286 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7287 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7288 return JIM_ERR;
7290 Jim_InvalidateStringRep(objPtr);
7291 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7294 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7296 Jim_Obj *objPtr;
7297 int i;
7299 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7301 objPtr = Jim_NewObj(interp);
7302 objPtr->typePtr = &dictObjType;
7303 objPtr->bytes = NULL;
7304 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7305 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7306 for (i = 0; i < len; i += 2)
7307 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7308 return objPtr;
7311 /* Return the value associated to the specified dict key
7312 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7314 * Sets *objPtrPtr to non-NULL only upon success.
7316 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7317 Jim_Obj **objPtrPtr, int flags)
7319 Jim_HashEntry *he;
7320 Jim_HashTable *ht;
7322 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7323 return -1;
7325 ht = dictPtr->internalRep.ptr;
7326 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7327 if (flags & JIM_ERRMSG) {
7328 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7330 return JIM_ERR;
7332 else {
7333 *objPtrPtr = Jim_GetHashEntryVal(he);
7334 return JIM_OK;
7338 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7339 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7341 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7342 return JIM_ERR;
7344 *objPtrPtr = JimDictPairs(dictPtr, len);
7346 return JIM_OK;
7350 /* Return the value associated to the specified dict keys */
7351 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7352 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7354 int i;
7356 if (keyc == 0) {
7357 *objPtrPtr = dictPtr;
7358 return JIM_OK;
7361 for (i = 0; i < keyc; i++) {
7362 Jim_Obj *objPtr;
7364 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7365 if (rc != JIM_OK) {
7366 return rc;
7368 dictPtr = objPtr;
7370 *objPtrPtr = dictPtr;
7371 return JIM_OK;
7374 /* Modify the dict stored into the variable named 'varNamePtr'
7375 * setting the element specified by the 'keyc' keys objects in 'keyv',
7376 * with the new value of the element 'newObjPtr'.
7378 * If newObjPtr == NULL the operation is to remove the given key
7379 * from the dictionary.
7381 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7382 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7384 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7385 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7387 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7388 int shared, i;
7390 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7391 if (objPtr == NULL) {
7392 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7393 /* Cannot remove a key from non existing var */
7394 return JIM_ERR;
7396 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7397 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7398 Jim_FreeNewObj(interp, varObjPtr);
7399 return JIM_ERR;
7402 if ((shared = Jim_IsShared(objPtr)))
7403 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7404 for (i = 0; i < keyc; i++) {
7405 dictObjPtr = objPtr;
7407 /* Check if it's a valid dictionary */
7408 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7409 goto err;
7412 if (i == keyc - 1) {
7413 /* Last key: Note that error on unset with missing last key is OK */
7414 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7415 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7416 goto err;
7419 break;
7422 /* Check if the given key exists. */
7423 Jim_InvalidateStringRep(dictObjPtr);
7424 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7425 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7426 /* This key exists at the current level.
7427 * Make sure it's not shared!. */
7428 if (Jim_IsShared(objPtr)) {
7429 objPtr = Jim_DuplicateObj(interp, objPtr);
7430 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7433 else {
7434 /* Key not found. If it's an [unset] operation
7435 * this is an error. Only the last key may not
7436 * exist. */
7437 if (newObjPtr == NULL) {
7438 goto err;
7440 /* Otherwise set an empty dictionary
7441 * as key's value. */
7442 objPtr = Jim_NewDictObj(interp, NULL, 0);
7443 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7446 /* XXX: Is this necessary? */
7447 Jim_InvalidateStringRep(objPtr);
7448 Jim_InvalidateStringRep(varObjPtr);
7449 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7450 goto err;
7452 Jim_SetResult(interp, varObjPtr);
7453 return JIM_OK;
7454 err:
7455 if (shared) {
7456 Jim_FreeNewObj(interp, varObjPtr);
7458 return JIM_ERR;
7461 /* -----------------------------------------------------------------------------
7462 * Index object
7463 * ---------------------------------------------------------------------------*/
7464 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7465 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7467 static const Jim_ObjType indexObjType = {
7468 "index",
7469 NULL,
7470 NULL,
7471 UpdateStringOfIndex,
7472 JIM_TYPE_NONE,
7475 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7477 if (objPtr->internalRep.intValue == -1) {
7478 JimSetStringBytes(objPtr, "end");
7480 else {
7481 char buf[JIM_INTEGER_SPACE + 1];
7482 if (objPtr->internalRep.intValue >= 0) {
7483 sprintf(buf, "%d", objPtr->internalRep.intValue);
7485 else {
7486 /* Must be <= -2 */
7487 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7489 JimSetStringBytes(objPtr, buf);
7493 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7495 int idx, end = 0;
7496 const char *str;
7497 char *endptr;
7499 /* Get the string representation */
7500 str = Jim_String(objPtr);
7502 /* Try to convert into an index */
7503 if (strncmp(str, "end", 3) == 0) {
7504 end = 1;
7505 str += 3;
7506 idx = 0;
7508 else {
7509 idx = jim_strtol(str, &endptr);
7511 if (endptr == str) {
7512 goto badindex;
7514 str = endptr;
7517 /* Now str may include or +<num> or -<num> */
7518 if (*str == '+' || *str == '-') {
7519 int sign = (*str == '+' ? 1 : -1);
7521 idx += sign * jim_strtol(++str, &endptr);
7522 if (str == endptr || *endptr) {
7523 goto badindex;
7525 str = endptr;
7527 /* The only thing left should be spaces */
7528 while (isspace(UCHAR(*str))) {
7529 str++;
7531 if (*str) {
7532 goto badindex;
7534 if (end) {
7535 if (idx > 0) {
7536 idx = INT_MAX;
7538 else {
7539 /* end-1 is repesented as -2 */
7540 idx--;
7543 else if (idx < 0) {
7544 idx = -INT_MAX;
7547 /* Free the old internal repr and set the new one. */
7548 Jim_FreeIntRep(interp, objPtr);
7549 objPtr->typePtr = &indexObjType;
7550 objPtr->internalRep.intValue = idx;
7551 return JIM_OK;
7553 badindex:
7554 Jim_SetResultFormatted(interp,
7555 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7556 return JIM_ERR;
7559 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7561 /* Avoid shimmering if the object is an integer. */
7562 if (objPtr->typePtr == &intObjType) {
7563 jim_wide val = JimWideValue(objPtr);
7565 if (val < 0)
7566 *indexPtr = -INT_MAX;
7567 else if (val > INT_MAX)
7568 *indexPtr = INT_MAX;
7569 else
7570 *indexPtr = (int)val;
7571 return JIM_OK;
7573 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7574 return JIM_ERR;
7575 *indexPtr = objPtr->internalRep.intValue;
7576 return JIM_OK;
7579 /* -----------------------------------------------------------------------------
7580 * Return Code Object.
7581 * ---------------------------------------------------------------------------*/
7583 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7584 static const char * const jimReturnCodes[] = {
7585 "ok",
7586 "error",
7587 "return",
7588 "break",
7589 "continue",
7590 "signal",
7591 "exit",
7592 "eval",
7593 NULL
7596 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7598 static const Jim_ObjType returnCodeObjType = {
7599 "return-code",
7600 NULL,
7601 NULL,
7602 NULL,
7603 JIM_TYPE_NONE,
7606 /* Converts a (standard) return code to a string. Returns "?" for
7607 * non-standard return codes.
7609 const char *Jim_ReturnCode(int code)
7611 if (code < 0 || code >= (int)jimReturnCodesSize) {
7612 return "?";
7614 else {
7615 return jimReturnCodes[code];
7619 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7621 int returnCode;
7622 jim_wide wideValue;
7624 /* Try to convert into an integer */
7625 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7626 returnCode = (int)wideValue;
7627 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7628 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7629 return JIM_ERR;
7631 /* Free the old internal repr and set the new one. */
7632 Jim_FreeIntRep(interp, objPtr);
7633 objPtr->typePtr = &returnCodeObjType;
7634 objPtr->internalRep.intValue = returnCode;
7635 return JIM_OK;
7638 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7640 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7641 return JIM_ERR;
7642 *intPtr = objPtr->internalRep.intValue;
7643 return JIM_OK;
7646 /* -----------------------------------------------------------------------------
7647 * Expression Parsing
7648 * ---------------------------------------------------------------------------*/
7649 static int JimParseExprOperator(struct JimParserCtx *pc);
7650 static int JimParseExprNumber(struct JimParserCtx *pc);
7651 static int JimParseExprIrrational(struct JimParserCtx *pc);
7652 static int JimParseExprBoolean(struct JimParserCtx *pc);
7654 /* expr operator opcodes. */
7655 enum
7657 /* Continues on from the JIM_TT_ space */
7659 /* Binary operators (numbers) */
7660 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7661 JIM_EXPROP_DIV,
7662 JIM_EXPROP_MOD,
7663 JIM_EXPROP_SUB,
7664 JIM_EXPROP_ADD,
7665 JIM_EXPROP_LSHIFT,
7666 JIM_EXPROP_RSHIFT,
7667 JIM_EXPROP_ROTL,
7668 JIM_EXPROP_ROTR,
7669 JIM_EXPROP_LT,
7670 JIM_EXPROP_GT,
7671 JIM_EXPROP_LTE,
7672 JIM_EXPROP_GTE,
7673 JIM_EXPROP_NUMEQ,
7674 JIM_EXPROP_NUMNE,
7675 JIM_EXPROP_BITAND, /* 35 */
7676 JIM_EXPROP_BITXOR,
7677 JIM_EXPROP_BITOR,
7678 JIM_EXPROP_LOGICAND, /* 38 */
7679 JIM_EXPROP_LOGICOR, /* 39 */
7680 JIM_EXPROP_TERNARY, /* 40 */
7681 JIM_EXPROP_COLON, /* 41 */
7682 JIM_EXPROP_POW, /* 42 */
7684 /* Binary operators (strings) */
7685 JIM_EXPROP_STREQ, /* 43 */
7686 JIM_EXPROP_STRNE,
7687 JIM_EXPROP_STRIN,
7688 JIM_EXPROP_STRNI,
7690 /* Unary operators (numbers) */
7691 JIM_EXPROP_NOT, /* 47 */
7692 JIM_EXPROP_BITNOT,
7693 JIM_EXPROP_UNARYMINUS,
7694 JIM_EXPROP_UNARYPLUS,
7696 /* Functions */
7697 JIM_EXPROP_FUNC_INT, /* 51 */
7698 JIM_EXPROP_FUNC_WIDE,
7699 JIM_EXPROP_FUNC_ABS,
7700 JIM_EXPROP_FUNC_DOUBLE,
7701 JIM_EXPROP_FUNC_ROUND,
7702 JIM_EXPROP_FUNC_RAND,
7703 JIM_EXPROP_FUNC_SRAND,
7705 /* math functions from libm */
7706 JIM_EXPROP_FUNC_SIN, /* 65 */
7707 JIM_EXPROP_FUNC_COS,
7708 JIM_EXPROP_FUNC_TAN,
7709 JIM_EXPROP_FUNC_ASIN,
7710 JIM_EXPROP_FUNC_ACOS,
7711 JIM_EXPROP_FUNC_ATAN,
7712 JIM_EXPROP_FUNC_ATAN2,
7713 JIM_EXPROP_FUNC_SINH,
7714 JIM_EXPROP_FUNC_COSH,
7715 JIM_EXPROP_FUNC_TANH,
7716 JIM_EXPROP_FUNC_CEIL,
7717 JIM_EXPROP_FUNC_FLOOR,
7718 JIM_EXPROP_FUNC_EXP,
7719 JIM_EXPROP_FUNC_LOG,
7720 JIM_EXPROP_FUNC_LOG10,
7721 JIM_EXPROP_FUNC_SQRT,
7722 JIM_EXPROP_FUNC_POW,
7723 JIM_EXPROP_FUNC_HYPOT,
7724 JIM_EXPROP_FUNC_FMOD,
7727 /* A expression node is either a term or an operator
7728 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7730 struct JimExprNode {
7731 int type; /* JIM_TT_xxx */
7732 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7734 struct JimExprNode *left; /* For all operators */
7735 struct JimExprNode *right; /* For binary operators */
7736 struct JimExprNode *ternary; /* For ternary operator only */
7739 /* Operators table */
7740 typedef struct Jim_ExprOperator
7742 const char *name;
7743 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7744 unsigned char precedence;
7745 unsigned char arity;
7746 unsigned char attr;
7747 unsigned char namelen;
7748 } Jim_ExprOperator;
7750 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7751 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7752 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7754 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7756 int intresult = 1;
7757 int rc;
7758 double dA, dC = 0;
7759 jim_wide wA, wC = 0;
7760 Jim_Obj *A;
7762 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7763 return rc;
7766 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7767 switch (node->type) {
7768 case JIM_EXPROP_FUNC_INT:
7769 case JIM_EXPROP_FUNC_WIDE:
7770 case JIM_EXPROP_FUNC_ROUND:
7771 case JIM_EXPROP_UNARYPLUS:
7772 wC = wA;
7773 break;
7774 case JIM_EXPROP_FUNC_DOUBLE:
7775 dC = wA;
7776 intresult = 0;
7777 break;
7778 case JIM_EXPROP_FUNC_ABS:
7779 wC = wA >= 0 ? wA : -wA;
7780 break;
7781 case JIM_EXPROP_UNARYMINUS:
7782 wC = -wA;
7783 break;
7784 case JIM_EXPROP_NOT:
7785 wC = !wA;
7786 break;
7787 default:
7788 abort();
7791 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7792 switch (node->type) {
7793 case JIM_EXPROP_FUNC_INT:
7794 case JIM_EXPROP_FUNC_WIDE:
7795 wC = dA;
7796 break;
7797 case JIM_EXPROP_FUNC_ROUND:
7798 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7799 break;
7800 case JIM_EXPROP_FUNC_DOUBLE:
7801 case JIM_EXPROP_UNARYPLUS:
7802 dC = dA;
7803 intresult = 0;
7804 break;
7805 case JIM_EXPROP_FUNC_ABS:
7806 #ifdef JIM_MATH_FUNCTIONS
7807 dC = fabs(dA);
7808 #else
7809 dC = dA >= 0 ? dA : -dA;
7810 #endif
7811 intresult = 0;
7812 break;
7813 case JIM_EXPROP_UNARYMINUS:
7814 dC = -dA;
7815 intresult = 0;
7816 break;
7817 case JIM_EXPROP_NOT:
7818 wC = !dA;
7819 break;
7820 default:
7821 abort();
7825 if (rc == JIM_OK) {
7826 if (intresult) {
7827 Jim_SetResultInt(interp, wC);
7829 else {
7830 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7834 Jim_DecrRefCount(interp, A);
7836 return rc;
7839 static double JimRandDouble(Jim_Interp *interp)
7841 unsigned long x;
7842 JimRandomBytes(interp, &x, sizeof(x));
7844 return (double)x / (unsigned long)~0;
7847 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7849 jim_wide wA;
7850 Jim_Obj *A;
7851 int rc;
7853 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7854 return rc;
7857 rc = Jim_GetWide(interp, A, &wA);
7858 if (rc == JIM_OK) {
7859 switch (node->type) {
7860 case JIM_EXPROP_BITNOT:
7861 Jim_SetResultInt(interp, ~wA);
7862 break;
7863 case JIM_EXPROP_FUNC_SRAND:
7864 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7865 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7866 break;
7867 default:
7868 abort();
7872 Jim_DecrRefCount(interp, A);
7874 return rc;
7877 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7879 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7881 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7883 return JIM_OK;
7886 #ifdef JIM_MATH_FUNCTIONS
7887 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7889 int rc;
7890 double dA, dC;
7891 Jim_Obj *A;
7893 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7894 return rc;
7897 rc = Jim_GetDouble(interp, A, &dA);
7898 if (rc == JIM_OK) {
7899 switch (node->type) {
7900 case JIM_EXPROP_FUNC_SIN:
7901 dC = sin(dA);
7902 break;
7903 case JIM_EXPROP_FUNC_COS:
7904 dC = cos(dA);
7905 break;
7906 case JIM_EXPROP_FUNC_TAN:
7907 dC = tan(dA);
7908 break;
7909 case JIM_EXPROP_FUNC_ASIN:
7910 dC = asin(dA);
7911 break;
7912 case JIM_EXPROP_FUNC_ACOS:
7913 dC = acos(dA);
7914 break;
7915 case JIM_EXPROP_FUNC_ATAN:
7916 dC = atan(dA);
7917 break;
7918 case JIM_EXPROP_FUNC_SINH:
7919 dC = sinh(dA);
7920 break;
7921 case JIM_EXPROP_FUNC_COSH:
7922 dC = cosh(dA);
7923 break;
7924 case JIM_EXPROP_FUNC_TANH:
7925 dC = tanh(dA);
7926 break;
7927 case JIM_EXPROP_FUNC_CEIL:
7928 dC = ceil(dA);
7929 break;
7930 case JIM_EXPROP_FUNC_FLOOR:
7931 dC = floor(dA);
7932 break;
7933 case JIM_EXPROP_FUNC_EXP:
7934 dC = exp(dA);
7935 break;
7936 case JIM_EXPROP_FUNC_LOG:
7937 dC = log(dA);
7938 break;
7939 case JIM_EXPROP_FUNC_LOG10:
7940 dC = log10(dA);
7941 break;
7942 case JIM_EXPROP_FUNC_SQRT:
7943 dC = sqrt(dA);
7944 break;
7945 default:
7946 abort();
7948 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7951 Jim_DecrRefCount(interp, A);
7953 return rc;
7955 #endif
7957 /* A binary operation on two ints */
7958 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7960 jim_wide wA, wB;
7961 int rc;
7962 Jim_Obj *A, *B;
7964 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7965 return rc;
7967 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7968 Jim_DecrRefCount(interp, A);
7969 return rc;
7972 rc = JIM_ERR;
7974 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7975 jim_wide wC;
7977 rc = JIM_OK;
7979 switch (node->type) {
7980 case JIM_EXPROP_LSHIFT:
7981 wC = wA << wB;
7982 break;
7983 case JIM_EXPROP_RSHIFT:
7984 wC = wA >> wB;
7985 break;
7986 case JIM_EXPROP_BITAND:
7987 wC = wA & wB;
7988 break;
7989 case JIM_EXPROP_BITXOR:
7990 wC = wA ^ wB;
7991 break;
7992 case JIM_EXPROP_BITOR:
7993 wC = wA | wB;
7994 break;
7995 case JIM_EXPROP_MOD:
7996 if (wB == 0) {
7997 wC = 0;
7998 Jim_SetResultString(interp, "Division by zero", -1);
7999 rc = JIM_ERR;
8001 else {
8003 * From Tcl 8.x
8005 * This code is tricky: C doesn't guarantee much
8006 * about the quotient or remainder, but Tcl does.
8007 * The remainder always has the same sign as the
8008 * divisor and a smaller absolute value.
8010 int negative = 0;
8012 if (wB < 0) {
8013 wB = -wB;
8014 wA = -wA;
8015 negative = 1;
8017 wC = wA % wB;
8018 if (wC < 0) {
8019 wC += wB;
8021 if (negative) {
8022 wC = -wC;
8025 break;
8026 case JIM_EXPROP_ROTL:
8027 case JIM_EXPROP_ROTR:{
8028 /* uint32_t would be better. But not everyone has inttypes.h? */
8029 unsigned long uA = (unsigned long)wA;
8030 unsigned long uB = (unsigned long)wB;
8031 const unsigned int S = sizeof(unsigned long) * 8;
8033 /* Shift left by the word size or more is undefined. */
8034 uB %= S;
8036 if (node->type == JIM_EXPROP_ROTR) {
8037 uB = S - uB;
8039 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
8040 break;
8042 default:
8043 abort();
8045 Jim_SetResultInt(interp, wC);
8048 Jim_DecrRefCount(interp, A);
8049 Jim_DecrRefCount(interp, B);
8051 return rc;
8055 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8056 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8058 int rc = JIM_OK;
8059 double dA, dB, dC = 0;
8060 jim_wide wA, wB, wC = 0;
8061 Jim_Obj *A, *B;
8063 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8064 return rc;
8066 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8067 Jim_DecrRefCount(interp, A);
8068 return rc;
8071 if ((A->typePtr != &doubleObjType || A->bytes) &&
8072 (B->typePtr != &doubleObjType || B->bytes) &&
8073 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8075 /* Both are ints */
8077 switch (node->type) {
8078 case JIM_EXPROP_POW:
8079 case JIM_EXPROP_FUNC_POW:
8080 if (wA == 0 && wB < 0) {
8081 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8082 rc = JIM_ERR;
8083 goto done;
8085 wC = JimPowWide(wA, wB);
8086 goto intresult;
8087 case JIM_EXPROP_ADD:
8088 wC = wA + wB;
8089 goto intresult;
8090 case JIM_EXPROP_SUB:
8091 wC = wA - wB;
8092 goto intresult;
8093 case JIM_EXPROP_MUL:
8094 wC = wA * wB;
8095 goto intresult;
8096 case JIM_EXPROP_DIV:
8097 if (wB == 0) {
8098 Jim_SetResultString(interp, "Division by zero", -1);
8099 rc = JIM_ERR;
8100 goto done;
8102 else {
8104 * From Tcl 8.x
8106 * This code is tricky: C doesn't guarantee much
8107 * about the quotient or remainder, but Tcl does.
8108 * The remainder always has the same sign as the
8109 * divisor and a smaller absolute value.
8111 if (wB < 0) {
8112 wB = -wB;
8113 wA = -wA;
8115 wC = wA / wB;
8116 if (wA % wB < 0) {
8117 wC--;
8119 goto intresult;
8121 case JIM_EXPROP_LT:
8122 wC = wA < wB;
8123 goto intresult;
8124 case JIM_EXPROP_GT:
8125 wC = wA > wB;
8126 goto intresult;
8127 case JIM_EXPROP_LTE:
8128 wC = wA <= wB;
8129 goto intresult;
8130 case JIM_EXPROP_GTE:
8131 wC = wA >= wB;
8132 goto intresult;
8133 case JIM_EXPROP_NUMEQ:
8134 wC = wA == wB;
8135 goto intresult;
8136 case JIM_EXPROP_NUMNE:
8137 wC = wA != wB;
8138 goto intresult;
8141 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8142 switch (node->type) {
8143 #ifndef JIM_MATH_FUNCTIONS
8144 case JIM_EXPROP_POW:
8145 case JIM_EXPROP_FUNC_POW:
8146 case JIM_EXPROP_FUNC_ATAN2:
8147 case JIM_EXPROP_FUNC_HYPOT:
8148 case JIM_EXPROP_FUNC_FMOD:
8149 Jim_SetResultString(interp, "unsupported", -1);
8150 rc = JIM_ERR;
8151 goto done;
8152 #else
8153 case JIM_EXPROP_POW:
8154 case JIM_EXPROP_FUNC_POW:
8155 dC = pow(dA, dB);
8156 goto doubleresult;
8157 case JIM_EXPROP_FUNC_ATAN2:
8158 dC = atan2(dA, dB);
8159 goto doubleresult;
8160 case JIM_EXPROP_FUNC_HYPOT:
8161 dC = hypot(dA, dB);
8162 goto doubleresult;
8163 case JIM_EXPROP_FUNC_FMOD:
8164 dC = fmod(dA, dB);
8165 goto doubleresult;
8166 #endif
8167 case JIM_EXPROP_ADD:
8168 dC = dA + dB;
8169 goto doubleresult;
8170 case JIM_EXPROP_SUB:
8171 dC = dA - dB;
8172 goto doubleresult;
8173 case JIM_EXPROP_MUL:
8174 dC = dA * dB;
8175 goto doubleresult;
8176 case JIM_EXPROP_DIV:
8177 if (dB == 0) {
8178 #ifdef INFINITY
8179 dC = dA < 0 ? -INFINITY : INFINITY;
8180 #else
8181 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8182 #endif
8184 else {
8185 dC = dA / dB;
8187 goto doubleresult;
8188 case JIM_EXPROP_LT:
8189 wC = dA < dB;
8190 goto intresult;
8191 case JIM_EXPROP_GT:
8192 wC = dA > dB;
8193 goto intresult;
8194 case JIM_EXPROP_LTE:
8195 wC = dA <= dB;
8196 goto intresult;
8197 case JIM_EXPROP_GTE:
8198 wC = dA >= dB;
8199 goto intresult;
8200 case JIM_EXPROP_NUMEQ:
8201 wC = dA == dB;
8202 goto intresult;
8203 case JIM_EXPROP_NUMNE:
8204 wC = dA != dB;
8205 goto intresult;
8208 else {
8209 /* Handle the string case */
8211 /* XXX: Could optimise the eq/ne case by checking lengths */
8212 int i = Jim_StringCompareObj(interp, A, B, 0);
8214 switch (node->type) {
8215 case JIM_EXPROP_LT:
8216 wC = i < 0;
8217 goto intresult;
8218 case JIM_EXPROP_GT:
8219 wC = i > 0;
8220 goto intresult;
8221 case JIM_EXPROP_LTE:
8222 wC = i <= 0;
8223 goto intresult;
8224 case JIM_EXPROP_GTE:
8225 wC = i >= 0;
8226 goto intresult;
8227 case JIM_EXPROP_NUMEQ:
8228 wC = i == 0;
8229 goto intresult;
8230 case JIM_EXPROP_NUMNE:
8231 wC = i != 0;
8232 goto intresult;
8235 /* If we get here, it is an error */
8236 rc = JIM_ERR;
8237 done:
8238 Jim_DecrRefCount(interp, A);
8239 Jim_DecrRefCount(interp, B);
8240 return rc;
8241 intresult:
8242 Jim_SetResultInt(interp, wC);
8243 goto done;
8244 doubleresult:
8245 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8246 goto done;
8249 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8251 int listlen;
8252 int i;
8254 listlen = Jim_ListLength(interp, listObjPtr);
8255 for (i = 0; i < listlen; i++) {
8256 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8257 return 1;
8260 return 0;
8265 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8267 Jim_Obj *A, *B;
8268 jim_wide wC;
8269 int rc;
8271 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8272 return rc;
8274 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8275 Jim_DecrRefCount(interp, A);
8276 return rc;
8279 switch (node->type) {
8280 case JIM_EXPROP_STREQ:
8281 case JIM_EXPROP_STRNE:
8282 wC = Jim_StringEqObj(A, B);
8283 if (node->type == JIM_EXPROP_STRNE) {
8284 wC = !wC;
8286 break;
8287 case JIM_EXPROP_STRIN:
8288 wC = JimSearchList(interp, B, A);
8289 break;
8290 case JIM_EXPROP_STRNI:
8291 wC = !JimSearchList(interp, B, A);
8292 break;
8293 default:
8294 abort();
8296 Jim_SetResultInt(interp, wC);
8298 Jim_DecrRefCount(interp, A);
8299 Jim_DecrRefCount(interp, B);
8301 return rc;
8304 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8306 long l;
8307 double d;
8308 int b;
8309 int ret = -1;
8311 /* In case the object is interp->result with refcount 1*/
8312 Jim_IncrRefCount(obj);
8314 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8315 ret = (l != 0);
8317 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8318 ret = (d != 0);
8320 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8321 ret = (b != 0);
8324 Jim_DecrRefCount(interp, obj);
8325 return ret;
8328 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8330 /* evaluate left */
8331 int result = JimExprGetTermBoolean(interp, node->left);
8333 if (result == 1) {
8334 /* true so evaluate right */
8335 result = JimExprGetTermBoolean(interp, node->right);
8337 if (result == -1) {
8338 return JIM_ERR;
8340 Jim_SetResultInt(interp, result);
8341 return JIM_OK;
8344 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8346 /* evaluate left */
8347 int result = JimExprGetTermBoolean(interp, node->left);
8349 if (result == 0) {
8350 /* false so evaluate right */
8351 result = JimExprGetTermBoolean(interp, node->right);
8353 if (result == -1) {
8354 return JIM_ERR;
8356 Jim_SetResultInt(interp, result);
8357 return JIM_OK;
8360 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8362 /* evaluate left */
8363 int result = JimExprGetTermBoolean(interp, node->left);
8365 if (result == 1) {
8366 /* true so select right */
8367 return JimExprEvalTermNode(interp, node->right);
8369 else if (result == 0) {
8370 /* false so select ternary */
8371 return JimExprEvalTermNode(interp, node->ternary);
8373 /* error */
8374 return JIM_ERR;
8377 enum
8379 OP_FUNC = 0x0001, /* function syntax */
8380 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8383 /* name - precedence - arity - opcode
8385 * This array *must* be kept in sync with the JIM_EXPROP enum.
8387 * The following macros pre-compute the string length at compile time.
8389 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8390 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8392 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8393 OPRINIT("*", 110, 2, JimExprOpBin),
8394 OPRINIT("/", 110, 2, JimExprOpBin),
8395 OPRINIT("%", 110, 2, JimExprOpIntBin),
8397 OPRINIT("-", 100, 2, JimExprOpBin),
8398 OPRINIT("+", 100, 2, JimExprOpBin),
8400 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8401 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8403 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8404 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8406 OPRINIT("<", 80, 2, JimExprOpBin),
8407 OPRINIT(">", 80, 2, JimExprOpBin),
8408 OPRINIT("<=", 80, 2, JimExprOpBin),
8409 OPRINIT(">=", 80, 2, JimExprOpBin),
8411 OPRINIT("==", 70, 2, JimExprOpBin),
8412 OPRINIT("!=", 70, 2, JimExprOpBin),
8414 OPRINIT("&", 50, 2, JimExprOpIntBin),
8415 OPRINIT("^", 49, 2, JimExprOpIntBin),
8416 OPRINIT("|", 48, 2, JimExprOpIntBin),
8418 OPRINIT("&&", 10, 2, JimExprOpAnd),
8419 OPRINIT("||", 9, 2, JimExprOpOr),
8420 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8421 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8423 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8424 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8426 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8427 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8429 OPRINIT("in", 55, 2, JimExprOpStrBin),
8430 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8432 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8433 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8434 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8435 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8439 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8440 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8441 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8442 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8443 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8444 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8445 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8447 #ifdef JIM_MATH_FUNCTIONS
8448 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8449 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8450 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8451 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8452 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8453 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8454 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8455 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8456 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8457 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8458 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8459 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8460 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8461 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8462 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8463 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8464 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8465 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8466 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8467 #endif
8469 #undef OPRINIT
8470 #undef OPRINIT_ATTR
8472 #define JIM_EXPR_OPERATORS_NUM \
8473 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8475 static int JimParseExpression(struct JimParserCtx *pc)
8477 /* Discard spaces and quoted newline */
8478 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8479 if (*pc->p == '\n') {
8480 pc->linenr++;
8482 pc->p++;
8483 pc->len--;
8486 /* Common case */
8487 pc->tline = pc->linenr;
8488 pc->tstart = pc->p;
8490 if (pc->len == 0) {
8491 pc->tend = pc->p;
8492 pc->tt = JIM_TT_EOL;
8493 pc->eof = 1;
8494 return JIM_OK;
8496 switch (*(pc->p)) {
8497 case '(':
8498 pc->tt = JIM_TT_SUBEXPR_START;
8499 goto singlechar;
8500 case ')':
8501 pc->tt = JIM_TT_SUBEXPR_END;
8502 goto singlechar;
8503 case ',':
8504 pc->tt = JIM_TT_SUBEXPR_COMMA;
8505 singlechar:
8506 pc->tend = pc->p;
8507 pc->p++;
8508 pc->len--;
8509 break;
8510 case '[':
8511 return JimParseCmd(pc);
8512 case '$':
8513 if (JimParseVar(pc) == JIM_ERR)
8514 return JimParseExprOperator(pc);
8515 else {
8516 /* Don't allow expr sugar in expressions */
8517 if (pc->tt == JIM_TT_EXPRSUGAR) {
8518 return JIM_ERR;
8520 return JIM_OK;
8522 break;
8523 case '0':
8524 case '1':
8525 case '2':
8526 case '3':
8527 case '4':
8528 case '5':
8529 case '6':
8530 case '7':
8531 case '8':
8532 case '9':
8533 case '.':
8534 return JimParseExprNumber(pc);
8535 case '"':
8536 return JimParseQuote(pc);
8537 case '{':
8538 return JimParseBrace(pc);
8540 case 'N':
8541 case 'I':
8542 case 'n':
8543 case 'i':
8544 if (JimParseExprIrrational(pc) == JIM_ERR)
8545 if (JimParseExprBoolean(pc) == JIM_ERR)
8546 return JimParseExprOperator(pc);
8547 break;
8548 case 't':
8549 case 'f':
8550 case 'o':
8551 case 'y':
8552 if (JimParseExprBoolean(pc) == JIM_ERR)
8553 return JimParseExprOperator(pc);
8554 break;
8555 default:
8556 return JimParseExprOperator(pc);
8557 break;
8559 return JIM_OK;
8562 static int JimParseExprNumber(struct JimParserCtx *pc)
8564 char *end;
8566 /* Assume an integer for now */
8567 pc->tt = JIM_TT_EXPR_INT;
8569 jim_strtoull(pc->p, (char **)&pc->p);
8570 /* Tried as an integer, but perhaps it parses as a double */
8571 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8572 /* Some stupid compilers insist they are cleverer that
8573 * we are. Even a (void) cast doesn't prevent this warning!
8575 if (strtod(pc->tstart, &end)) { /* nothing */ }
8576 if (end == pc->tstart)
8577 return JIM_ERR;
8578 if (end > pc->p) {
8579 /* Yes, double captured more chars */
8580 pc->tt = JIM_TT_EXPR_DOUBLE;
8581 pc->p = end;
8584 pc->tend = pc->p - 1;
8585 pc->len -= (pc->p - pc->tstart);
8586 return JIM_OK;
8589 static int JimParseExprIrrational(struct JimParserCtx *pc)
8591 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8592 int i;
8594 for (i = 0; irrationals[i]; i++) {
8595 const char *irr = irrationals[i];
8597 if (strncmp(irr, pc->p, 3) == 0) {
8598 pc->p += 3;
8599 pc->len -= 3;
8600 pc->tend = pc->p - 1;
8601 pc->tt = JIM_TT_EXPR_DOUBLE;
8602 return JIM_OK;
8605 return JIM_ERR;
8608 static int JimParseExprBoolean(struct JimParserCtx *pc)
8610 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8611 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8612 int i;
8614 for (i = 0; booleans[i]; i++) {
8615 const char *boolean = booleans[i];
8616 int length = lengths[i];
8618 if (strncmp(boolean, pc->p, length) == 0) {
8619 pc->p += length;
8620 pc->len -= length;
8621 pc->tend = pc->p - 1;
8622 pc->tt = JIM_TT_EXPR_BOOLEAN;
8623 return JIM_OK;
8626 return JIM_ERR;
8629 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8631 static Jim_ExprOperator dummy_op;
8632 if (opcode < JIM_TT_EXPR_OP) {
8633 return &dummy_op;
8635 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8638 static int JimParseExprOperator(struct JimParserCtx *pc)
8640 int i;
8641 const struct Jim_ExprOperator *bestOp = NULL;
8642 int bestLen = 0;
8644 /* Try to get the longest match. */
8645 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8646 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8648 if (op->name[0] != pc->p[0]) {
8649 continue;
8652 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8653 bestOp = op;
8654 bestLen = op->namelen;
8657 if (bestOp == NULL) {
8658 return JIM_ERR;
8661 /* Validate paretheses around function arguments */
8662 if (bestOp->attr & OP_FUNC) {
8663 const char *p = pc->p + bestLen;
8664 int len = pc->len - bestLen;
8666 while (len && isspace(UCHAR(*p))) {
8667 len--;
8668 p++;
8670 if (*p != '(') {
8671 return JIM_ERR;
8674 pc->tend = pc->p + bestLen - 1;
8675 pc->p += bestLen;
8676 pc->len -= bestLen;
8678 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8679 return JIM_OK;
8682 const char *jim_tt_name(int type)
8684 static const char * const tt_names[JIM_TT_EXPR_OP] =
8685 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8686 "DBL", "BOO", "$()" };
8687 if (type < JIM_TT_EXPR_OP) {
8688 return tt_names[type];
8690 else if (type == JIM_EXPROP_UNARYMINUS) {
8691 return "-VE";
8693 else if (type == JIM_EXPROP_UNARYPLUS) {
8694 return "+VE";
8696 else {
8697 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8698 static char buf[20];
8700 if (op->name) {
8701 return op->name;
8703 sprintf(buf, "(%d)", type);
8704 return buf;
8708 /* -----------------------------------------------------------------------------
8709 * Expression Object
8710 * ---------------------------------------------------------------------------*/
8711 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8712 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8713 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8715 static const Jim_ObjType exprObjType = {
8716 "expression",
8717 FreeExprInternalRep,
8718 DupExprInternalRep,
8719 NULL,
8720 JIM_TYPE_REFERENCES,
8723 /* expr tree structure */
8724 struct ExprTree
8726 struct JimExprNode *expr; /* The first operator or term */
8727 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8728 int len; /* Number of nodes in use */
8729 int inUse; /* Used for sharing. */
8732 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8734 int i;
8735 for (i = 0; i < num; i++) {
8736 if (nodes[i].objPtr) {
8737 Jim_DecrRefCount(interp, nodes[i].objPtr);
8740 Jim_Free(nodes);
8743 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8745 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8746 Jim_Free(expr);
8749 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8751 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8753 if (expr) {
8754 if (--expr->inUse != 0) {
8755 return;
8758 ExprTreeFree(interp, expr);
8762 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8764 JIM_NOTUSED(interp);
8765 JIM_NOTUSED(srcPtr);
8767 /* Just returns an simple string. */
8768 dupPtr->typePtr = NULL;
8771 struct ExprBuilder {
8772 int parencount; /* count of outstanding parentheses */
8773 int level; /* recursion depth */
8774 ParseToken *token; /* The current token */
8775 ParseToken *first_token; /* The first token */
8776 Jim_Stack stack; /* stack of pending terms */
8777 Jim_Obj *exprObjPtr; /* the original expression */
8778 Jim_Obj *fileNameObj; /* filename of the original expression */
8779 struct JimExprNode *nodes; /* storage for all nodes */
8780 struct JimExprNode *next; /* storage for the next node */
8783 #ifdef DEBUG_SHOW_EXPR
8784 static void JimShowExprNode(struct JimExprNode *node, int level)
8786 int i;
8787 for (i = 0; i < level; i++) {
8788 printf(" ");
8790 if (TOKEN_IS_EXPR_OP(node->type)) {
8791 printf("%s\n", jim_tt_name(node->type));
8792 if (node->left) {
8793 JimShowExprNode(node->left, level + 1);
8795 if (node->right) {
8796 JimShowExprNode(node->right, level + 1);
8798 if (node->ternary) {
8799 JimShowExprNode(node->ternary, level + 1);
8802 else {
8803 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8806 #endif
8808 #define EXPR_UNTIL_CLOSE 0x0001
8809 #define EXPR_FUNC_ARGS 0x0002
8810 #define EXPR_TERNARY 0x0004
8813 * Parse the subexpression at builder->token and return with the node on the stack.
8814 * builder->token is advanced to the next unconsumed token.
8815 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8817 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8818 * with an equal or lower precedence is reached (or strictly lower if right associative).
8820 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8821 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8822 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8824 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8826 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8828 int rc;
8829 struct JimExprNode *node;
8830 /* Calculate the stack length expected after pushing the number of expected terms */
8831 int exp_stacklen = builder->stack.len + exp_numterms;
8833 builder->level++;
8835 while (builder->token->type != JIM_TT_EOL) {
8836 ParseToken *t = builder->token++;
8837 int prevtt;
8839 if (t == builder->first_token) {
8840 prevtt = JIM_TT_NONE;
8842 else {
8843 prevtt = t[-1].type;
8846 if (t->type == JIM_TT_SUBEXPR_START) {
8847 if (builder->stack.len == exp_stacklen) {
8848 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8849 return JIM_ERR;
8851 builder->parencount++;
8852 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8853 if (rc != JIM_OK) {
8854 return rc;
8856 /* A complete subexpression is on the stack */
8858 else if (t->type == JIM_TT_SUBEXPR_END) {
8859 if (!(flags & EXPR_UNTIL_CLOSE)) {
8860 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8861 builder->token--;
8862 builder->level--;
8863 return JIM_OK;
8865 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8866 return JIM_ERR;
8868 builder->parencount--;
8869 if (builder->stack.len == exp_stacklen) {
8870 /* Return with the expected number of subexpressions on the stack */
8871 break;
8874 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8875 if (!(flags & EXPR_FUNC_ARGS)) {
8876 if (builder->stack.len == exp_stacklen) {
8877 /* handle the comma back at the parent level */
8878 builder->token--;
8879 builder->level--;
8880 return JIM_OK;
8882 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8883 return JIM_ERR;
8885 else {
8886 /* If we see more terms than expected, it is an error */
8887 if (builder->stack.len > exp_stacklen) {
8888 Jim_SetResultFormatted(interp, "too many arguments to math function");
8889 return JIM_ERR;
8892 /* just go onto the next arg */
8894 else if (t->type == JIM_EXPROP_COLON) {
8895 if (!(flags & EXPR_TERNARY)) {
8896 if (builder->level != 1) {
8897 /* handle the comma back at the parent level */
8898 builder->token--;
8899 builder->level--;
8900 return JIM_OK;
8902 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8903 return JIM_ERR;
8905 if (builder->stack.len == exp_stacklen) {
8906 /* handle the comma back at the parent level */
8907 builder->token--;
8908 builder->level--;
8909 return JIM_OK;
8911 /* just go onto the next term */
8913 else if (TOKEN_IS_EXPR_OP(t->type)) {
8914 const struct Jim_ExprOperator *op;
8916 /* Convert -/+ to unary minus or unary plus if necessary */
8917 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8918 if (t->type == JIM_EXPROP_SUB) {
8919 t->type = JIM_EXPROP_UNARYMINUS;
8921 else if (t->type == JIM_EXPROP_ADD) {
8922 t->type = JIM_EXPROP_UNARYPLUS;
8926 op = JimExprOperatorInfoByOpcode(t->type);
8928 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8929 /* next op is lower precedence, or equal and left associative, so done here */
8930 builder->token--;
8931 break;
8934 if (op->attr & OP_FUNC) {
8935 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8936 Jim_SetResultString(interp, "missing arguments for math function", -1);
8937 return JIM_ERR;
8939 builder->token++;
8940 if (op->arity == 0) {
8941 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8942 Jim_SetResultString(interp, "too many arguments for math function", -1);
8943 return JIM_ERR;
8945 builder->token++;
8946 goto noargs;
8948 builder->parencount++;
8950 /* This will push left and return right */
8951 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8953 else if (t->type == JIM_EXPROP_TERNARY) {
8954 /* Collect the two arguments to the ternary operator */
8955 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8957 else {
8958 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8959 * and push that on the term stack
8961 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8964 if (rc != JIM_OK) {
8965 return rc;
8968 noargs:
8969 node = builder->next++;
8970 node->type = t->type;
8972 if (op->arity >= 3) {
8973 node->ternary = Jim_StackPop(&builder->stack);
8974 if (node->ternary == NULL) {
8975 goto missingoperand;
8978 if (op->arity >= 2) {
8979 node->right = Jim_StackPop(&builder->stack);
8980 if (node->right == NULL) {
8981 goto missingoperand;
8984 if (op->arity >= 1) {
8985 node->left = Jim_StackPop(&builder->stack);
8986 if (node->left == NULL) {
8987 missingoperand:
8988 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8989 builder->next--;
8990 return JIM_ERR;
8995 /* Now push the node */
8996 Jim_StackPush(&builder->stack, node);
8998 else {
8999 Jim_Obj *objPtr = NULL;
9001 /* This is a simple non-operator term, so create and push the appropriate object */
9003 /* Two consecutive terms without an operator is invalid */
9004 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9005 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
9006 return JIM_ERR;
9009 /* Immediately create a double or int object? */
9010 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9011 char *endptr;
9012 if (t->type == JIM_TT_EXPR_INT) {
9013 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9015 else {
9016 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9018 if (endptr != t->token + t->len) {
9019 /* Conversion failed, so just store it as a string */
9020 Jim_FreeNewObj(interp, objPtr);
9021 objPtr = NULL;
9025 if (!objPtr) {
9026 /* Everything else is stored a simple string term */
9027 objPtr = Jim_NewStringObj(interp, t->token, t->len);
9028 if (t->type == JIM_TT_CMD) {
9029 /* Only commands need source info */
9030 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
9034 /* Now push a term node */
9035 node = builder->next++;
9036 node->objPtr = objPtr;
9037 Jim_IncrRefCount(node->objPtr);
9038 node->type = t->type;
9039 Jim_StackPush(&builder->stack, node);
9043 if (builder->stack.len == exp_stacklen) {
9044 builder->level--;
9045 return JIM_OK;
9048 if ((flags & EXPR_FUNC_ARGS)) {
9049 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9051 else {
9052 if (builder->stack.len < exp_stacklen) {
9053 if (builder->level == 0) {
9054 Jim_SetResultFormatted(interp, "empty expression");
9056 else {
9057 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9060 else {
9061 Jim_SetResultFormatted(interp, "extra terms after expression");
9065 return JIM_ERR;
9068 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9070 struct ExprTree *expr;
9071 struct ExprBuilder builder;
9072 int rc;
9073 struct JimExprNode *top;
9075 builder.parencount = 0;
9076 builder.level = 0;
9077 builder.token = builder.first_token = tokenlist->list;
9078 builder.exprObjPtr = exprObjPtr;
9079 builder.fileNameObj = fileNameObj;
9080 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9081 builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9082 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9083 builder.next = builder.nodes;
9084 Jim_InitStack(&builder.stack);
9086 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9088 if (rc == JIM_OK) {
9089 top = Jim_StackPop(&builder.stack);
9091 if (builder.parencount) {
9092 Jim_SetResultString(interp, "missing close parenthesis", -1);
9093 rc = JIM_ERR;
9097 /* Free the stack used for the compilation. */
9098 Jim_FreeStack(&builder.stack);
9100 if (rc != JIM_OK) {
9101 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9102 return NULL;
9105 expr = Jim_Alloc(sizeof(*expr));
9106 expr->inUse = 1;
9107 expr->expr = top;
9108 expr->nodes = builder.nodes;
9109 expr->len = builder.next - builder.nodes;
9111 assert(expr->len <= tokenlist->count - 1);
9113 return expr;
9116 /* This method takes the string representation of an expression
9117 * and generates a program for the expr engine */
9118 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9120 int exprTextLen;
9121 const char *exprText;
9122 struct JimParserCtx parser;
9123 struct ExprTree *expr;
9124 ParseTokenList tokenlist;
9125 int line;
9126 Jim_Obj *fileNameObj;
9127 int rc = JIM_ERR;
9129 /* Try to get information about filename / line number */
9130 if (objPtr->typePtr == &sourceObjType) {
9131 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9132 line = objPtr->internalRep.sourceValue.lineNumber;
9134 else {
9135 fileNameObj = interp->emptyObj;
9136 line = 1;
9138 Jim_IncrRefCount(fileNameObj);
9140 exprText = Jim_GetString(objPtr, &exprTextLen);
9142 /* Initially tokenise the expression into tokenlist */
9143 ScriptTokenListInit(&tokenlist);
9145 JimParserInit(&parser, exprText, exprTextLen, line);
9146 while (!parser.eof) {
9147 if (JimParseExpression(&parser) != JIM_OK) {
9148 ScriptTokenListFree(&tokenlist);
9149 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9150 expr = NULL;
9151 goto err;
9154 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9155 parser.tline);
9158 #ifdef DEBUG_SHOW_EXPR_TOKENS
9160 int i;
9161 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9162 for (i = 0; i < tokenlist.count; i++) {
9163 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9164 tokenlist.list[i].len, tokenlist.list[i].token);
9167 #endif
9169 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9170 ScriptTokenListFree(&tokenlist);
9171 Jim_DecrRefCount(interp, fileNameObj);
9172 return JIM_ERR;
9175 /* Now create the expression bytecode from the tokenlist */
9176 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9178 /* No longer need the token list */
9179 ScriptTokenListFree(&tokenlist);
9181 if (!expr) {
9182 goto err;
9185 #ifdef DEBUG_SHOW_EXPR
9186 printf("==== Expr ====\n");
9187 JimShowExprNode(expr->expr, 0);
9188 #endif
9190 rc = JIM_OK;
9192 err:
9193 /* Free the old internal rep and set the new one. */
9194 Jim_DecrRefCount(interp, fileNameObj);
9195 Jim_FreeIntRep(interp, objPtr);
9196 Jim_SetIntRepPtr(objPtr, expr);
9197 objPtr->typePtr = &exprObjType;
9198 return rc;
9201 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9203 if (objPtr->typePtr != &exprObjType) {
9204 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9205 return NULL;
9208 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9211 #ifdef JIM_OPTIMIZATION
9212 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9214 if (node->type == JIM_TT_EXPR_INT)
9215 return node->objPtr;
9216 else if (node->type == JIM_TT_VAR)
9217 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9218 else if (node->type == JIM_TT_DICTSUGAR)
9219 return JimExpandDictSugar(interp, node->objPtr);
9220 else
9221 return NULL;
9223 #endif
9225 /* -----------------------------------------------------------------------------
9226 * Expressions evaluation.
9227 * Jim uses a recursive evaluation engine for expressions,
9228 * that takes advantage of the fact that expr's operators
9229 * can't be redefined.
9231 * Jim_EvalExpression() uses the expression tree compiled by
9232 * SetExprFromAny() method of the "expression" object.
9234 * On success a Tcl Object containing the result of the evaluation
9235 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9236 * returned.
9237 * On error the function returns a retcode != to JIM_OK and set a suitable
9238 * error on the interp.
9239 * ---------------------------------------------------------------------------*/
9241 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9243 if (TOKEN_IS_EXPR_OP(node->type)) {
9244 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9245 return op->funcop(interp, node);
9247 else {
9248 Jim_Obj *objPtr;
9250 /* A term */
9251 switch (node->type) {
9252 case JIM_TT_EXPR_INT:
9253 case JIM_TT_EXPR_DOUBLE:
9254 case JIM_TT_EXPR_BOOLEAN:
9255 case JIM_TT_STR:
9256 Jim_SetResult(interp, node->objPtr);
9257 return JIM_OK;
9259 case JIM_TT_VAR:
9260 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9261 if (objPtr) {
9262 Jim_SetResult(interp, objPtr);
9263 return JIM_OK;
9265 return JIM_ERR;
9267 case JIM_TT_DICTSUGAR:
9268 objPtr = JimExpandDictSugar(interp, node->objPtr);
9269 if (objPtr) {
9270 Jim_SetResult(interp, objPtr);
9271 return JIM_OK;
9273 return JIM_ERR;
9275 case JIM_TT_ESC:
9276 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9277 Jim_SetResult(interp, objPtr);
9278 return JIM_OK;
9280 return JIM_ERR;
9282 case JIM_TT_CMD:
9283 return Jim_EvalObj(interp, node->objPtr);
9285 default:
9286 /* Should never get here */
9287 return JIM_ERR;
9292 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9294 int rc = JimExprEvalTermNode(interp, node);
9295 if (rc == JIM_OK) {
9296 *objPtrPtr = Jim_GetResult(interp);
9297 Jim_IncrRefCount(*objPtrPtr);
9299 return rc;
9302 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9304 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9305 return ExprBool(interp, Jim_GetResult(interp));
9307 return -1;
9310 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9312 struct ExprTree *expr;
9313 int retcode = JIM_OK;
9315 expr = JimGetExpression(interp, exprObjPtr);
9316 if (!expr) {
9317 return JIM_ERR; /* error in expression. */
9320 #ifdef JIM_OPTIMIZATION
9321 /* Check for one of the following common expressions used by while/for
9323 * CONST
9324 * $a
9325 * !$a
9326 * $a < CONST, $a < $b
9327 * $a <= CONST, $a <= $b
9328 * $a > CONST, $a > $b
9329 * $a >= CONST, $a >= $b
9330 * $a != CONST, $a != $b
9331 * $a == CONST, $a == $b
9334 Jim_Obj *objPtr;
9336 /* STEP 1 -- Check if there are the conditions to run the specialized
9337 * version of while */
9339 switch (expr->len) {
9340 case 1:
9341 objPtr = JimExprIntValOrVar(interp, expr->expr);
9342 if (objPtr) {
9343 Jim_SetResult(interp, objPtr);
9344 return JIM_OK;
9346 break;
9348 case 2:
9349 if (expr->expr->type == JIM_EXPROP_NOT) {
9350 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9352 if (objPtr && JimIsWide(objPtr)) {
9353 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9354 return JIM_OK;
9357 break;
9359 case 3:
9360 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9361 if (objPtr && JimIsWide(objPtr)) {
9362 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9363 if (objPtr2 && JimIsWide(objPtr2)) {
9364 jim_wide wideValueA = JimWideValue(objPtr);
9365 jim_wide wideValueB = JimWideValue(objPtr2);
9366 int cmpRes;
9367 switch (expr->expr->type) {
9368 case JIM_EXPROP_LT:
9369 cmpRes = wideValueA < wideValueB;
9370 break;
9371 case JIM_EXPROP_LTE:
9372 cmpRes = wideValueA <= wideValueB;
9373 break;
9374 case JIM_EXPROP_GT:
9375 cmpRes = wideValueA > wideValueB;
9376 break;
9377 case JIM_EXPROP_GTE:
9378 cmpRes = wideValueA >= wideValueB;
9379 break;
9380 case JIM_EXPROP_NUMEQ:
9381 cmpRes = wideValueA == wideValueB;
9382 break;
9383 case JIM_EXPROP_NUMNE:
9384 cmpRes = wideValueA != wideValueB;
9385 break;
9386 default:
9387 goto noopt;
9389 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9390 return JIM_OK;
9393 break;
9396 noopt:
9397 #endif
9399 /* In order to avoid the internal repr being freed due to
9400 * shimmering of the exprObjPtr's object, we make the internal rep
9401 * shared. */
9402 expr->inUse++;
9404 /* Evaluate with the recursive expr engine */
9405 retcode = JimExprEvalTermNode(interp, expr->expr);
9407 expr->inUse--;
9409 return retcode;
9412 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9414 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9416 if (retcode == JIM_OK) {
9417 switch (ExprBool(interp, Jim_GetResult(interp))) {
9418 case 0:
9419 *boolPtr = 0;
9420 break;
9422 case 1:
9423 *boolPtr = 1;
9424 break;
9426 case -1:
9427 retcode = JIM_ERR;
9428 break;
9431 return retcode;
9434 /* -----------------------------------------------------------------------------
9435 * ScanFormat String Object
9436 * ---------------------------------------------------------------------------*/
9438 /* This Jim_Obj will held a parsed representation of a format string passed to
9439 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9440 * to be parsed in its entirely first and then, if correct, can be used for
9441 * scanning. To avoid endless re-parsing, the parsed representation will be
9442 * stored in an internal representation and re-used for performance reason. */
9444 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9445 * scanformat string. This part will later be used to extract information
9446 * out from the string to be parsed by Jim_ScanString */
9448 typedef struct ScanFmtPartDescr
9450 const char *arg; /* Specification of a CHARSET conversion */
9451 const char *prefix; /* Prefix to be scanned literally before conversion */
9452 size_t width; /* Maximal width of input to be converted */
9453 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9454 char type; /* Type of conversion (e.g. c, d, f) */
9455 char modifier; /* Modify type (e.g. l - long, h - short */
9456 } ScanFmtPartDescr;
9458 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9459 * string parsed and separated in part descriptions. Furthermore it contains
9460 * the original string representation of the scanformat string to allow for
9461 * fast update of the Jim_Obj's string representation part.
9463 * As an add-on the internal object representation adds some scratch pad area
9464 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9465 * memory for purpose of string scanning.
9467 * The error member points to a static allocated string in case of a mal-
9468 * formed scanformat string or it contains '0' (NULL) in case of a valid
9469 * parse representation.
9471 * The whole memory of the internal representation is allocated as a single
9472 * area of memory that will be internally separated. So freeing and duplicating
9473 * of such an object is cheap */
9475 typedef struct ScanFmtStringObj
9477 jim_wide size; /* Size of internal repr in bytes */
9478 char *stringRep; /* Original string representation */
9479 size_t count; /* Number of ScanFmtPartDescr contained */
9480 size_t convCount; /* Number of conversions that will assign */
9481 size_t maxPos; /* Max position index if XPG3 is used */
9482 const char *error; /* Ptr to error text (NULL if no error */
9483 char *scratch; /* Some scratch pad used by Jim_ScanString */
9484 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9485 } ScanFmtStringObj;
9488 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9489 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9490 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9492 static const Jim_ObjType scanFmtStringObjType = {
9493 "scanformatstring",
9494 FreeScanFmtInternalRep,
9495 DupScanFmtInternalRep,
9496 UpdateStringOfScanFmt,
9497 JIM_TYPE_NONE,
9500 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9502 JIM_NOTUSED(interp);
9503 Jim_Free((char *)objPtr->internalRep.ptr);
9504 objPtr->internalRep.ptr = 0;
9507 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9509 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9510 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9512 JIM_NOTUSED(interp);
9513 memcpy(newVec, srcPtr->internalRep.ptr, size);
9514 dupPtr->internalRep.ptr = newVec;
9515 dupPtr->typePtr = &scanFmtStringObjType;
9518 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9520 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9523 /* SetScanFmtFromAny will parse a given string and create the internal
9524 * representation of the format specification. In case of an error
9525 * the error data member of the internal representation will be set
9526 * to an descriptive error text and the function will be left with
9527 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9528 * specification */
9530 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9532 ScanFmtStringObj *fmtObj;
9533 char *buffer;
9534 int maxCount, i, approxSize, lastPos = -1;
9535 const char *fmt = Jim_String(objPtr);
9536 int maxFmtLen = Jim_Length(objPtr);
9537 const char *fmtEnd = fmt + maxFmtLen;
9538 int curr;
9540 Jim_FreeIntRep(interp, objPtr);
9541 /* Count how many conversions could take place maximally */
9542 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9543 if (fmt[i] == '%')
9544 ++maxCount;
9545 /* Calculate an approximation of the memory necessary */
9546 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9547 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9548 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9549 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9550 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9551 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9552 +1; /* safety byte */
9553 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9554 memset(fmtObj, 0, approxSize);
9555 fmtObj->size = approxSize;
9556 fmtObj->maxPos = 0;
9557 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9558 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9559 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9560 buffer = fmtObj->stringRep + maxFmtLen + 1;
9561 objPtr->internalRep.ptr = fmtObj;
9562 objPtr->typePtr = &scanFmtStringObjType;
9563 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9564 int width = 0, skip;
9565 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9567 fmtObj->count++;
9568 descr->width = 0; /* Assume width unspecified */
9569 /* Overread and store any "literal" prefix */
9570 if (*fmt != '%' || fmt[1] == '%') {
9571 descr->type = 0;
9572 descr->prefix = &buffer[i];
9573 for (; fmt < fmtEnd; ++fmt) {
9574 if (*fmt == '%') {
9575 if (fmt[1] != '%')
9576 break;
9577 ++fmt;
9579 buffer[i++] = *fmt;
9581 buffer[i++] = 0;
9583 /* Skip the conversion introducing '%' sign */
9584 ++fmt;
9585 /* End reached due to non-conversion literal only? */
9586 if (fmt >= fmtEnd)
9587 goto done;
9588 descr->pos = 0; /* Assume "natural" positioning */
9589 if (*fmt == '*') {
9590 descr->pos = -1; /* Okay, conversion will not be assigned */
9591 ++fmt;
9593 else
9594 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9595 /* Check if next token is a number (could be width or pos */
9596 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9597 fmt += skip;
9598 /* Was the number a XPG3 position specifier? */
9599 if (descr->pos != -1 && *fmt == '$') {
9600 int prev;
9602 ++fmt;
9603 descr->pos = width;
9604 width = 0;
9605 /* Look if "natural" postioning and XPG3 one was mixed */
9606 if ((lastPos == 0 && descr->pos > 0)
9607 || (lastPos > 0 && descr->pos == 0)) {
9608 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9609 return JIM_ERR;
9611 /* Look if this position was already used */
9612 for (prev = 0; prev < curr; ++prev) {
9613 if (fmtObj->descr[prev].pos == -1)
9614 continue;
9615 if (fmtObj->descr[prev].pos == descr->pos) {
9616 fmtObj->error =
9617 "variable is assigned by multiple \"%n$\" conversion specifiers";
9618 return JIM_ERR;
9621 if (descr->pos < 0) {
9622 fmtObj->error =
9623 "\"%n$\" conversion specifier is negative";
9624 return JIM_ERR;
9626 /* Try to find a width after the XPG3 specifier */
9627 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9628 descr->width = width;
9629 fmt += skip;
9631 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9632 fmtObj->maxPos = descr->pos;
9634 else {
9635 /* Number was not a XPG3, so it has to be a width */
9636 descr->width = width;
9639 /* If positioning mode was undetermined yet, fix this */
9640 if (lastPos == -1)
9641 lastPos = descr->pos;
9642 /* Handle CHARSET conversion type ... */
9643 if (*fmt == '[') {
9644 int swapped = 1, beg = i, end, j;
9646 descr->type = '[';
9647 descr->arg = &buffer[i];
9648 ++fmt;
9649 if (*fmt == '^')
9650 buffer[i++] = *fmt++;
9651 if (*fmt == ']')
9652 buffer[i++] = *fmt++;
9653 while (*fmt && *fmt != ']')
9654 buffer[i++] = *fmt++;
9655 if (*fmt != ']') {
9656 fmtObj->error = "unmatched [ in format string";
9657 return JIM_ERR;
9659 end = i;
9660 buffer[i++] = 0;
9661 /* In case a range fence was given "backwards", swap it */
9662 while (swapped) {
9663 swapped = 0;
9664 for (j = beg + 1; j < end - 1; ++j) {
9665 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9666 char tmp = buffer[j - 1];
9668 buffer[j - 1] = buffer[j + 1];
9669 buffer[j + 1] = tmp;
9670 swapped = 1;
9675 else {
9676 /* Remember any valid modifier if given */
9677 if (fmt < fmtEnd && strchr("hlL", *fmt))
9678 descr->modifier = tolower((int)*fmt++);
9680 if (fmt >= fmtEnd) {
9681 fmtObj->error = "missing scan conversion character";
9682 return JIM_ERR;
9685 descr->type = *fmt;
9686 if (strchr("efgcsndoxui", *fmt) == 0) {
9687 fmtObj->error = "bad scan conversion character";
9688 return JIM_ERR;
9690 else if (*fmt == 'c' && descr->width != 0) {
9691 fmtObj->error = "field width may not be specified in %c " "conversion";
9692 return JIM_ERR;
9694 else if (*fmt == 'u' && descr->modifier == 'l') {
9695 fmtObj->error = "unsigned wide not supported";
9696 return JIM_ERR;
9699 curr++;
9701 done:
9702 return JIM_OK;
9705 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9707 #define FormatGetCnvCount(_fo_) \
9708 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9709 #define FormatGetMaxPos(_fo_) \
9710 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9711 #define FormatGetError(_fo_) \
9712 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9714 /* JimScanAString is used to scan an unspecified string that ends with
9715 * next WS, or a string that is specified via a charset.
9718 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9720 char *buffer = Jim_StrDup(str);
9721 char *p = buffer;
9723 while (*str) {
9724 int c;
9725 int n;
9727 if (!sdescr && isspace(UCHAR(*str)))
9728 break; /* EOS via WS if unspecified */
9730 n = utf8_tounicode(str, &c);
9731 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9732 break;
9733 while (n--)
9734 *p++ = *str++;
9736 *p = 0;
9737 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9740 /* ScanOneEntry will scan one entry out of the string passed as argument.
9741 * It use the sscanf() function for this task. After extracting and
9742 * converting of the value, the count of scanned characters will be
9743 * returned of -1 in case of no conversion tool place and string was
9744 * already scanned thru */
9746 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9747 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9749 const char *tok;
9750 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9751 size_t scanned = 0;
9752 size_t anchor = pos;
9753 int i;
9754 Jim_Obj *tmpObj = NULL;
9756 /* First pessimistically assume, we will not scan anything :-) */
9757 *valObjPtr = 0;
9758 if (descr->prefix) {
9759 /* There was a prefix given before the conversion, skip it and adjust
9760 * the string-to-be-parsed accordingly */
9761 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9762 /* If prefix require, skip WS */
9763 if (isspace(UCHAR(descr->prefix[i])))
9764 while (pos < strLen && isspace(UCHAR(str[pos])))
9765 ++pos;
9766 else if (descr->prefix[i] != str[pos])
9767 break; /* Prefix do not match here, leave the loop */
9768 else
9769 ++pos; /* Prefix matched so far, next round */
9771 if (pos >= strLen) {
9772 return -1; /* All of str consumed: EOF condition */
9774 else if (descr->prefix[i] != 0)
9775 return 0; /* Not whole prefix consumed, no conversion possible */
9777 /* For all but following conversion, skip leading WS */
9778 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9779 while (isspace(UCHAR(str[pos])))
9780 ++pos;
9781 /* Determine how much skipped/scanned so far */
9782 scanned = pos - anchor;
9784 /* %c is a special, simple case. no width */
9785 if (descr->type == 'n') {
9786 /* Return pseudo conversion means: how much scanned so far? */
9787 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9789 else if (pos >= strLen) {
9790 /* Cannot scan anything, as str is totally consumed */
9791 return -1;
9793 else if (descr->type == 'c') {
9794 int c;
9795 scanned += utf8_tounicode(&str[pos], &c);
9796 *valObjPtr = Jim_NewIntObj(interp, c);
9797 return scanned;
9799 else {
9800 /* Processing of conversions follows ... */
9801 if (descr->width > 0) {
9802 /* Do not try to scan as fas as possible but only the given width.
9803 * To ensure this, we copy the part that should be scanned. */
9804 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9805 size_t tLen = descr->width > sLen ? sLen : descr->width;
9807 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9808 tok = tmpObj->bytes;
9810 else {
9811 /* As no width was given, simply refer to the original string */
9812 tok = &str[pos];
9814 switch (descr->type) {
9815 case 'd':
9816 case 'o':
9817 case 'x':
9818 case 'u':
9819 case 'i':{
9820 char *endp; /* Position where the number finished */
9821 jim_wide w;
9823 int base = descr->type == 'o' ? 8
9824 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9826 /* Try to scan a number with the given base */
9827 if (base == 0) {
9828 w = jim_strtoull(tok, &endp);
9830 else {
9831 w = strtoull(tok, &endp, base);
9834 if (endp != tok) {
9835 /* There was some number sucessfully scanned! */
9836 *valObjPtr = Jim_NewIntObj(interp, w);
9838 /* Adjust the number-of-chars scanned so far */
9839 scanned += endp - tok;
9841 else {
9842 /* Nothing was scanned. We have to determine if this
9843 * happened due to e.g. prefix mismatch or input str
9844 * exhausted */
9845 scanned = *tok ? 0 : -1;
9847 break;
9849 case 's':
9850 case '[':{
9851 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9852 scanned += Jim_Length(*valObjPtr);
9853 break;
9855 case 'e':
9856 case 'f':
9857 case 'g':{
9858 char *endp;
9859 double value = strtod(tok, &endp);
9861 if (endp != tok) {
9862 /* There was some number sucessfully scanned! */
9863 *valObjPtr = Jim_NewDoubleObj(interp, value);
9864 /* Adjust the number-of-chars scanned so far */
9865 scanned += endp - tok;
9867 else {
9868 /* Nothing was scanned. We have to determine if this
9869 * happened due to e.g. prefix mismatch or input str
9870 * exhausted */
9871 scanned = *tok ? 0 : -1;
9873 break;
9876 /* If a substring was allocated (due to pre-defined width) do not
9877 * forget to free it */
9878 if (tmpObj) {
9879 Jim_FreeNewObj(interp, tmpObj);
9882 return scanned;
9885 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9886 * string and returns all converted (and not ignored) values in a list back
9887 * to the caller. If an error occured, a NULL pointer will be returned */
9889 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9891 size_t i, pos;
9892 int scanned = 1;
9893 const char *str = Jim_String(strObjPtr);
9894 int strLen = Jim_Utf8Length(interp, strObjPtr);
9895 Jim_Obj *resultList = 0;
9896 Jim_Obj **resultVec = 0;
9897 int resultc;
9898 Jim_Obj *emptyStr = 0;
9899 ScanFmtStringObj *fmtObj;
9901 /* This should never happen. The format object should already be of the correct type */
9902 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9904 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9905 /* Check if format specification was valid */
9906 if (fmtObj->error != 0) {
9907 if (flags & JIM_ERRMSG)
9908 Jim_SetResultString(interp, fmtObj->error, -1);
9909 return 0;
9911 /* Allocate a new "shared" empty string for all unassigned conversions */
9912 emptyStr = Jim_NewEmptyStringObj(interp);
9913 Jim_IncrRefCount(emptyStr);
9914 /* Create a list and fill it with empty strings up to max specified XPG3 */
9915 resultList = Jim_NewListObj(interp, NULL, 0);
9916 if (fmtObj->maxPos > 0) {
9917 for (i = 0; i < fmtObj->maxPos; ++i)
9918 Jim_ListAppendElement(interp, resultList, emptyStr);
9919 JimListGetElements(interp, resultList, &resultc, &resultVec);
9921 /* Now handle every partial format description */
9922 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9923 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9924 Jim_Obj *value = 0;
9926 /* Only last type may be "literal" w/o conversion - skip it! */
9927 if (descr->type == 0)
9928 continue;
9929 /* As long as any conversion could be done, we will proceed */
9930 if (scanned > 0)
9931 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9932 /* In case our first try results in EOF, we will leave */
9933 if (scanned == -1 && i == 0)
9934 goto eof;
9935 /* Advance next pos-to-be-scanned for the amount scanned already */
9936 pos += scanned;
9938 /* value == 0 means no conversion took place so take empty string */
9939 if (value == 0)
9940 value = Jim_NewEmptyStringObj(interp);
9941 /* If value is a non-assignable one, skip it */
9942 if (descr->pos == -1) {
9943 Jim_FreeNewObj(interp, value);
9945 else if (descr->pos == 0)
9946 /* Otherwise append it to the result list if no XPG3 was given */
9947 Jim_ListAppendElement(interp, resultList, value);
9948 else if (resultVec[descr->pos - 1] == emptyStr) {
9949 /* But due to given XPG3, put the value into the corr. slot */
9950 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9951 Jim_IncrRefCount(value);
9952 resultVec[descr->pos - 1] = value;
9954 else {
9955 /* Otherwise, the slot was already used - free obj and ERROR */
9956 Jim_FreeNewObj(interp, value);
9957 goto err;
9960 Jim_DecrRefCount(interp, emptyStr);
9961 return resultList;
9962 eof:
9963 Jim_DecrRefCount(interp, emptyStr);
9964 Jim_FreeNewObj(interp, resultList);
9965 return (Jim_Obj *)EOF;
9966 err:
9967 Jim_DecrRefCount(interp, emptyStr);
9968 Jim_FreeNewObj(interp, resultList);
9969 return 0;
9972 /* -----------------------------------------------------------------------------
9973 * Pseudo Random Number Generation
9974 * ---------------------------------------------------------------------------*/
9975 /* Initialize the sbox with the numbers from 0 to 255 */
9976 static void JimPrngInit(Jim_Interp *interp)
9978 #define PRNG_SEED_SIZE 256
9979 int i;
9980 unsigned int *seed;
9981 time_t t = time(NULL);
9983 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9985 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9986 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9987 seed[i] = (rand() ^ t ^ clock());
9989 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9990 Jim_Free(seed);
9993 /* Generates N bytes of random data */
9994 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9996 Jim_PrngState *prng;
9997 unsigned char *destByte = (unsigned char *)dest;
9998 unsigned int si, sj, x;
10000 /* initialization, only needed the first time */
10001 if (interp->prngState == NULL)
10002 JimPrngInit(interp);
10003 prng = interp->prngState;
10004 /* generates 'len' bytes of pseudo-random numbers */
10005 for (x = 0; x < len; x++) {
10006 prng->i = (prng->i + 1) & 0xff;
10007 si = prng->sbox[prng->i];
10008 prng->j = (prng->j + si) & 0xff;
10009 sj = prng->sbox[prng->j];
10010 prng->sbox[prng->i] = sj;
10011 prng->sbox[prng->j] = si;
10012 *destByte++ = prng->sbox[(si + sj) & 0xff];
10016 /* Re-seed the generator with user-provided bytes */
10017 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10019 int i;
10020 Jim_PrngState *prng;
10022 /* initialization, only needed the first time */
10023 if (interp->prngState == NULL)
10024 JimPrngInit(interp);
10025 prng = interp->prngState;
10027 /* Set the sbox[i] with i */
10028 for (i = 0; i < 256; i++)
10029 prng->sbox[i] = i;
10030 /* Now use the seed to perform a random permutation of the sbox */
10031 for (i = 0; i < seedLen; i++) {
10032 unsigned char t;
10034 t = prng->sbox[i & 0xFF];
10035 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10036 prng->sbox[seed[i]] = t;
10038 prng->i = prng->j = 0;
10040 /* discard at least the first 256 bytes of stream.
10041 * borrow the seed buffer for this
10043 for (i = 0; i < 256; i += seedLen) {
10044 JimRandomBytes(interp, seed, seedLen);
10048 /* [incr] */
10049 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10051 jim_wide wideValue, increment = 1;
10052 Jim_Obj *intObjPtr;
10054 if (argc != 2 && argc != 3) {
10055 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10056 return JIM_ERR;
10058 if (argc == 3) {
10059 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10060 return JIM_ERR;
10062 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10063 if (!intObjPtr) {
10064 /* Set missing variable to 0 */
10065 wideValue = 0;
10067 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10068 return JIM_ERR;
10070 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10071 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10072 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10073 Jim_FreeNewObj(interp, intObjPtr);
10074 return JIM_ERR;
10077 else {
10078 /* Can do it the quick way */
10079 Jim_InvalidateStringRep(intObjPtr);
10080 JimWideValue(intObjPtr) = wideValue + increment;
10082 /* The following step is required in order to invalidate the
10083 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10084 if (argv[1]->typePtr != &variableObjType) {
10085 /* Note that this can't fail since GetVariable already succeeded */
10086 Jim_SetVariable(interp, argv[1], intObjPtr);
10089 Jim_SetResult(interp, intObjPtr);
10090 return JIM_OK;
10094 /* -----------------------------------------------------------------------------
10095 * Eval
10096 * ---------------------------------------------------------------------------*/
10097 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10098 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10100 /* Handle calls to the [unknown] command */
10101 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10103 int retcode;
10105 /* If JimUnknown() is recursively called too many times...
10106 * done here
10108 if (interp->unknown_called > 50) {
10109 return JIM_ERR;
10112 /* The object interp->unknown just contains
10113 * the "unknown" string, it is used in order to
10114 * avoid to lookup the unknown command every time
10115 * but instead to cache the result. */
10117 /* If the [unknown] command does not exist ... */
10118 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10119 return JIM_ERR;
10121 interp->unknown_called++;
10122 /* XXX: Are we losing fileNameObj and linenr? */
10123 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10124 interp->unknown_called--;
10126 return retcode;
10129 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10131 int retcode;
10132 Jim_Cmd *cmdPtr;
10133 void *prevPrivData;
10135 #if 0
10136 printf("invoke");
10137 int j;
10138 for (j = 0; j < objc; j++) {
10139 printf(" '%s'", Jim_String(objv[j]));
10141 printf("\n");
10142 #endif
10144 if (interp->framePtr->tailcallCmd) {
10145 /* Special tailcall command was pre-resolved */
10146 cmdPtr = interp->framePtr->tailcallCmd;
10147 interp->framePtr->tailcallCmd = NULL;
10149 else {
10150 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10151 if (cmdPtr == NULL) {
10152 return JimUnknown(interp, objc, objv);
10154 JimIncrCmdRefCount(cmdPtr);
10157 if (interp->evalDepth == interp->maxEvalDepth) {
10158 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10159 retcode = JIM_ERR;
10160 goto out;
10162 interp->evalDepth++;
10163 prevPrivData = interp->cmdPrivData;
10165 /* Call it -- Make sure result is an empty object. */
10166 Jim_SetEmptyResult(interp);
10167 if (cmdPtr->isproc) {
10168 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10170 else {
10171 interp->cmdPrivData = cmdPtr->u.native.privData;
10172 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10174 interp->cmdPrivData = prevPrivData;
10175 interp->evalDepth--;
10177 out:
10178 JimDecrCmdRefCount(interp, cmdPtr);
10180 return retcode;
10183 /* Eval the object vector 'objv' composed of 'objc' elements.
10184 * Every element is used as single argument.
10185 * Jim_EvalObj() will call this function every time its object
10186 * argument is of "list" type, with no string representation.
10188 * This is possible because the string representation of a
10189 * list object generated by the UpdateStringOfList is made
10190 * in a way that ensures that every list element is a different
10191 * command argument. */
10192 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10194 int i, retcode;
10196 /* Incr refcount of arguments. */
10197 for (i = 0; i < objc; i++)
10198 Jim_IncrRefCount(objv[i]);
10200 retcode = JimInvokeCommand(interp, objc, objv);
10202 /* Decr refcount of arguments and return the retcode */
10203 for (i = 0; i < objc; i++)
10204 Jim_DecrRefCount(interp, objv[i]);
10206 return retcode;
10210 * Invokes 'prefix' as a command with the objv array as arguments.
10212 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10214 int ret;
10215 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10217 nargv[0] = prefix;
10218 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10219 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10220 Jim_Free(nargv);
10221 return ret;
10224 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10226 if (!interp->errorFlag) {
10227 /* This is the first error, so save the file/line information and reset the stack */
10228 interp->errorFlag = 1;
10229 Jim_IncrRefCount(script->fileNameObj);
10230 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10231 interp->errorFileNameObj = script->fileNameObj;
10232 interp->errorLine = script->linenr;
10234 JimResetStackTrace(interp);
10235 /* Always add a level where the error first occurs */
10236 interp->addStackTrace++;
10239 /* Now if this is an "interesting" level, add it to the stack trace */
10240 if (interp->addStackTrace > 0) {
10241 /* Add the stack info for the current level */
10243 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10245 /* Note: if we didn't have a filename for this level,
10246 * don't clear the addStackTrace flag
10247 * so we can pick it up at the next level
10249 if (Jim_Length(script->fileNameObj)) {
10250 interp->addStackTrace = 0;
10253 Jim_DecrRefCount(interp, interp->errorProc);
10254 interp->errorProc = interp->emptyObj;
10255 Jim_IncrRefCount(interp->errorProc);
10259 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10261 Jim_Obj *objPtr;
10263 switch (token->type) {
10264 case JIM_TT_STR:
10265 case JIM_TT_ESC:
10266 objPtr = token->objPtr;
10267 break;
10268 case JIM_TT_VAR:
10269 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10270 break;
10271 case JIM_TT_DICTSUGAR:
10272 objPtr = JimExpandDictSugar(interp, token->objPtr);
10273 break;
10274 case JIM_TT_EXPRSUGAR:
10275 objPtr = JimExpandExprSugar(interp, token->objPtr);
10276 break;
10277 case JIM_TT_CMD:
10278 switch (Jim_EvalObj(interp, token->objPtr)) {
10279 case JIM_OK:
10280 case JIM_RETURN:
10281 objPtr = interp->result;
10282 break;
10283 case JIM_BREAK:
10284 /* Stop substituting */
10285 return JIM_BREAK;
10286 case JIM_CONTINUE:
10287 /* just skip this one */
10288 return JIM_CONTINUE;
10289 default:
10290 return JIM_ERR;
10292 break;
10293 default:
10294 JimPanic((1,
10295 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10296 objPtr = NULL;
10297 break;
10299 if (objPtr) {
10300 *objPtrPtr = objPtr;
10301 return JIM_OK;
10303 return JIM_ERR;
10306 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10307 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10308 * The returned object has refcount = 0.
10310 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10312 int totlen = 0, i;
10313 Jim_Obj **intv;
10314 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10315 Jim_Obj *objPtr;
10316 char *s;
10318 if (tokens <= JIM_EVAL_SINTV_LEN)
10319 intv = sintv;
10320 else
10321 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10323 /* Compute every token forming the argument
10324 * in the intv objects vector. */
10325 for (i = 0; i < tokens; i++) {
10326 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10327 case JIM_OK:
10328 case JIM_RETURN:
10329 break;
10330 case JIM_BREAK:
10331 if (flags & JIM_SUBST_FLAG) {
10332 /* Stop here */
10333 tokens = i;
10334 continue;
10336 /* XXX: Should probably set an error about break outside loop */
10337 /* fall through to error */
10338 case JIM_CONTINUE:
10339 if (flags & JIM_SUBST_FLAG) {
10340 intv[i] = NULL;
10341 continue;
10343 /* XXX: Ditto continue outside loop */
10344 /* fall through to error */
10345 default:
10346 while (i--) {
10347 Jim_DecrRefCount(interp, intv[i]);
10349 if (intv != sintv) {
10350 Jim_Free(intv);
10352 return NULL;
10354 Jim_IncrRefCount(intv[i]);
10355 Jim_String(intv[i]);
10356 totlen += intv[i]->length;
10359 /* Fast path return for a single token */
10360 if (tokens == 1 && intv[0] && intv == sintv) {
10361 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10362 intv[0]->refCount--;
10363 return intv[0];
10366 /* Concatenate every token in an unique
10367 * object. */
10368 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10370 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10371 && token[2].type == JIM_TT_VAR) {
10372 /* May be able to do fast interpolated object -> dictSubst */
10373 objPtr->typePtr = &interpolatedObjType;
10374 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10375 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10376 Jim_IncrRefCount(intv[2]);
10378 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10379 /* The first interpolated token is source, so preserve the source info */
10380 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10384 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10385 objPtr->length = totlen;
10386 for (i = 0; i < tokens; i++) {
10387 if (intv[i]) {
10388 memcpy(s, intv[i]->bytes, intv[i]->length);
10389 s += intv[i]->length;
10390 Jim_DecrRefCount(interp, intv[i]);
10393 objPtr->bytes[totlen] = '\0';
10394 /* Free the intv vector if not static. */
10395 if (intv != sintv) {
10396 Jim_Free(intv);
10399 return objPtr;
10403 /* listPtr *must* be a list.
10404 * The contents of the list is evaluated with the first element as the command and
10405 * the remaining elements as the arguments.
10407 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10409 int retcode = JIM_OK;
10411 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10413 if (listPtr->internalRep.listValue.len) {
10414 Jim_IncrRefCount(listPtr);
10415 retcode = JimInvokeCommand(interp,
10416 listPtr->internalRep.listValue.len,
10417 listPtr->internalRep.listValue.ele);
10418 Jim_DecrRefCount(interp, listPtr);
10420 return retcode;
10423 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10425 SetListFromAny(interp, listPtr);
10426 return JimEvalObjList(interp, listPtr);
10429 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10431 int i;
10432 ScriptObj *script;
10433 ScriptToken *token;
10434 int retcode = JIM_OK;
10435 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10436 Jim_Obj *prevScriptObj;
10438 /* If the object is of type "list", with no string rep we can call
10439 * a specialized version of Jim_EvalObj() */
10440 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10441 return JimEvalObjList(interp, scriptObjPtr);
10444 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10445 script = JimGetScript(interp, scriptObjPtr);
10446 if (!JimScriptValid(interp, script)) {
10447 Jim_DecrRefCount(interp, scriptObjPtr);
10448 return JIM_ERR;
10451 /* Reset the interpreter result. This is useful to
10452 * return the empty result in the case of empty program. */
10453 Jim_SetEmptyResult(interp);
10455 token = script->token;
10457 #ifdef JIM_OPTIMIZATION
10458 /* Check for one of the following common scripts used by for, while
10460 * {}
10461 * incr a
10463 if (script->len == 0) {
10464 Jim_DecrRefCount(interp, scriptObjPtr);
10465 return JIM_OK;
10467 if (script->len == 3
10468 && token[1].objPtr->typePtr == &commandObjType
10469 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10470 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10471 && token[2].objPtr->typePtr == &variableObjType) {
10473 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10475 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10476 JimWideValue(objPtr)++;
10477 Jim_InvalidateStringRep(objPtr);
10478 Jim_DecrRefCount(interp, scriptObjPtr);
10479 Jim_SetResult(interp, objPtr);
10480 return JIM_OK;
10483 #endif
10485 /* Now we have to make sure the internal repr will not be
10486 * freed on shimmering.
10488 * Think for example to this:
10490 * set x {llength $x; ... some more code ...}; eval $x
10492 * In order to preserve the internal rep, we increment the
10493 * inUse field of the script internal rep structure. */
10494 script->inUse++;
10496 /* Stash the current script */
10497 prevScriptObj = interp->currentScriptObj;
10498 interp->currentScriptObj = scriptObjPtr;
10500 interp->errorFlag = 0;
10501 argv = sargv;
10503 /* Execute every command sequentially until the end of the script
10504 * or an error occurs.
10506 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10507 int argc;
10508 int j;
10510 /* First token of the line is always JIM_TT_LINE */
10511 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10512 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10514 /* Allocate the arguments vector if required */
10515 if (argc > JIM_EVAL_SARGV_LEN)
10516 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10518 /* Skip the JIM_TT_LINE token */
10519 i++;
10521 /* Populate the arguments objects.
10522 * If an error occurs, retcode will be set and
10523 * 'j' will be set to the number of args expanded
10525 for (j = 0; j < argc; j++) {
10526 long wordtokens = 1;
10527 int expand = 0;
10528 Jim_Obj *wordObjPtr = NULL;
10530 if (token[i].type == JIM_TT_WORD) {
10531 wordtokens = JimWideValue(token[i++].objPtr);
10532 if (wordtokens < 0) {
10533 expand = 1;
10534 wordtokens = -wordtokens;
10538 if (wordtokens == 1) {
10539 /* Fast path if the token does not
10540 * need interpolation */
10542 switch (token[i].type) {
10543 case JIM_TT_ESC:
10544 case JIM_TT_STR:
10545 wordObjPtr = token[i].objPtr;
10546 break;
10547 case JIM_TT_VAR:
10548 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10549 break;
10550 case JIM_TT_EXPRSUGAR:
10551 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10552 break;
10553 case JIM_TT_DICTSUGAR:
10554 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10555 break;
10556 case JIM_TT_CMD:
10557 retcode = Jim_EvalObj(interp, token[i].objPtr);
10558 if (retcode == JIM_OK) {
10559 wordObjPtr = Jim_GetResult(interp);
10561 break;
10562 default:
10563 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10566 else {
10567 /* For interpolation we call a helper
10568 * function to do the work for us. */
10569 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10572 if (!wordObjPtr) {
10573 if (retcode == JIM_OK) {
10574 retcode = JIM_ERR;
10576 break;
10579 Jim_IncrRefCount(wordObjPtr);
10580 i += wordtokens;
10582 if (!expand) {
10583 argv[j] = wordObjPtr;
10585 else {
10586 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10587 int len = Jim_ListLength(interp, wordObjPtr);
10588 int newargc = argc + len - 1;
10589 int k;
10591 if (len > 1) {
10592 if (argv == sargv) {
10593 if (newargc > JIM_EVAL_SARGV_LEN) {
10594 argv = Jim_Alloc(sizeof(*argv) * newargc);
10595 memcpy(argv, sargv, sizeof(*argv) * j);
10598 else {
10599 /* Need to realloc to make room for (len - 1) more entries */
10600 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10604 /* Now copy in the expanded version */
10605 for (k = 0; k < len; k++) {
10606 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10607 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10610 /* The original object reference is no longer needed,
10611 * after the expansion it is no longer present on
10612 * the argument vector, but the single elements are
10613 * in its place. */
10614 Jim_DecrRefCount(interp, wordObjPtr);
10616 /* And update the indexes */
10617 j--;
10618 argc += len - 1;
10622 if (retcode == JIM_OK && argc) {
10623 /* Invoke the command */
10624 retcode = JimInvokeCommand(interp, argc, argv);
10625 /* Check for a signal after each command */
10626 if (Jim_CheckSignal(interp)) {
10627 retcode = JIM_SIGNAL;
10631 /* Finished with the command, so decrement ref counts of each argument */
10632 while (j-- > 0) {
10633 Jim_DecrRefCount(interp, argv[j]);
10636 if (argv != sargv) {
10637 Jim_Free(argv);
10638 argv = sargv;
10642 /* Possibly add to the error stack trace */
10643 if (retcode == JIM_ERR) {
10644 JimAddErrorToStack(interp, script);
10646 /* Propagate the addStackTrace value through 'return -code error' */
10647 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10648 /* No need to add stack trace */
10649 interp->addStackTrace = 0;
10652 /* Restore the current script */
10653 interp->currentScriptObj = prevScriptObj;
10655 /* Note that we don't have to decrement inUse, because the
10656 * following code transfers our use of the reference again to
10657 * the script object. */
10658 Jim_FreeIntRep(interp, scriptObjPtr);
10659 scriptObjPtr->typePtr = &scriptObjType;
10660 Jim_SetIntRepPtr(scriptObjPtr, script);
10661 Jim_DecrRefCount(interp, scriptObjPtr);
10663 return retcode;
10666 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10668 int retcode;
10669 /* If argObjPtr begins with '&', do an automatic upvar */
10670 const char *varname = Jim_String(argNameObj);
10671 if (*varname == '&') {
10672 /* First check that the target variable exists */
10673 Jim_Obj *objPtr;
10674 Jim_CallFrame *savedCallFrame = interp->framePtr;
10676 interp->framePtr = interp->framePtr->parent;
10677 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10678 interp->framePtr = savedCallFrame;
10679 if (!objPtr) {
10680 return JIM_ERR;
10683 /* It exists, so perform the binding. */
10684 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10685 Jim_IncrRefCount(objPtr);
10686 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10687 Jim_DecrRefCount(interp, objPtr);
10689 else {
10690 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10692 return retcode;
10696 * Sets the interp result to be an error message indicating the required proc args.
10698 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10700 /* Create a nice error message, consistent with Tcl 8.5 */
10701 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10702 int i;
10704 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10705 Jim_AppendString(interp, argmsg, " ", 1);
10707 if (i == cmd->u.proc.argsPos) {
10708 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10709 /* Renamed args */
10710 Jim_AppendString(interp, argmsg, "?", 1);
10711 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10712 Jim_AppendString(interp, argmsg, " ...?", -1);
10714 else {
10715 /* We have plain args */
10716 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10719 else {
10720 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10721 Jim_AppendString(interp, argmsg, "?", 1);
10722 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10723 Jim_AppendString(interp, argmsg, "?", 1);
10725 else {
10726 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10727 if (*arg == '&') {
10728 arg++;
10730 Jim_AppendString(interp, argmsg, arg, -1);
10734 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10737 #ifdef jim_ext_namespace
10739 * [namespace eval]
10741 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10743 Jim_CallFrame *callFramePtr;
10744 int retcode;
10746 /* Create a new callframe */
10747 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10748 callFramePtr->argv = &interp->emptyObj;
10749 callFramePtr->argc = 0;
10750 callFramePtr->procArgsObjPtr = NULL;
10751 callFramePtr->procBodyObjPtr = scriptObj;
10752 callFramePtr->staticVars = NULL;
10753 callFramePtr->fileNameObj = interp->emptyObj;
10754 callFramePtr->line = 0;
10755 Jim_IncrRefCount(scriptObj);
10756 interp->framePtr = callFramePtr;
10758 /* Check if there are too nested calls */
10759 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10760 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10761 retcode = JIM_ERR;
10763 else {
10764 /* Eval the body */
10765 retcode = Jim_EvalObj(interp, scriptObj);
10768 /* Destroy the callframe */
10769 interp->framePtr = interp->framePtr->parent;
10770 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10772 return retcode;
10774 #endif
10776 /* Call a procedure implemented in Tcl.
10777 * It's possible to speed-up a lot this function, currently
10778 * the callframes are not cached, but allocated and
10779 * destroied every time. What is expecially costly is
10780 * to create/destroy the local vars hash table every time.
10782 * This can be fixed just implementing callframes caching
10783 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10784 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10786 Jim_CallFrame *callFramePtr;
10787 int i, d, retcode, optargs;
10788 ScriptObj *script;
10790 /* Check arity */
10791 if (argc - 1 < cmd->u.proc.reqArity ||
10792 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10793 JimSetProcWrongArgs(interp, argv[0], cmd);
10794 return JIM_ERR;
10797 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10798 /* Optimise for procedure with no body - useful for optional debugging */
10799 return JIM_OK;
10802 /* Check if there are too nested calls */
10803 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10804 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10805 return JIM_ERR;
10808 /* Create a new callframe */
10809 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10810 callFramePtr->argv = argv;
10811 callFramePtr->argc = argc;
10812 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10813 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10814 callFramePtr->staticVars = cmd->u.proc.staticVars;
10816 /* Remember where we were called from. */
10817 script = JimGetScript(interp, interp->currentScriptObj);
10818 callFramePtr->fileNameObj = script->fileNameObj;
10819 callFramePtr->line = script->linenr;
10821 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10822 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10823 interp->framePtr = callFramePtr;
10825 /* How many optional args are available */
10826 optargs = (argc - 1 - cmd->u.proc.reqArity);
10828 /* Step 'i' along the actual args, and step 'd' along the formal args */
10829 i = 1;
10830 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10831 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10832 if (d == cmd->u.proc.argsPos) {
10833 /* assign $args */
10834 Jim_Obj *listObjPtr;
10835 int argsLen = 0;
10836 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10837 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10839 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10841 /* It is possible to rename args. */
10842 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10843 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10845 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10846 if (retcode != JIM_OK) {
10847 goto badargset;
10850 i += argsLen;
10851 continue;
10854 /* Optional or required? */
10855 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10856 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10858 else {
10859 /* Ran out, so use the default */
10860 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10862 if (retcode != JIM_OK) {
10863 goto badargset;
10867 /* Eval the body */
10868 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10870 badargset:
10872 /* Invoke $jim::defer then destroy the callframe */
10873 retcode = JimInvokeDefer(interp, retcode);
10874 interp->framePtr = interp->framePtr->parent;
10875 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10877 /* Now chain any tailcalls in the parent frame */
10878 if (interp->framePtr->tailcallObj) {
10879 do {
10880 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10882 interp->framePtr->tailcallObj = NULL;
10884 if (retcode == JIM_EVAL) {
10885 retcode = Jim_EvalObjList(interp, tailcallObj);
10886 if (retcode == JIM_RETURN) {
10887 /* If the result of the tailcall is 'return', push
10888 * it up to the caller
10890 interp->returnLevel++;
10893 Jim_DecrRefCount(interp, tailcallObj);
10894 } while (interp->framePtr->tailcallObj);
10896 /* If the tailcall chain finished early, may need to manually discard the command */
10897 if (interp->framePtr->tailcallCmd) {
10898 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10899 interp->framePtr->tailcallCmd = NULL;
10903 /* Handle the JIM_RETURN return code */
10904 if (retcode == JIM_RETURN) {
10905 if (--interp->returnLevel <= 0) {
10906 retcode = interp->returnCode;
10907 interp->returnCode = JIM_OK;
10908 interp->returnLevel = 0;
10911 else if (retcode == JIM_ERR) {
10912 interp->addStackTrace++;
10913 Jim_DecrRefCount(interp, interp->errorProc);
10914 interp->errorProc = argv[0];
10915 Jim_IncrRefCount(interp->errorProc);
10918 return retcode;
10921 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10923 int retval;
10924 Jim_Obj *scriptObjPtr;
10926 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10927 Jim_IncrRefCount(scriptObjPtr);
10929 if (filename) {
10930 Jim_Obj *prevScriptObj;
10932 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10934 prevScriptObj = interp->currentScriptObj;
10935 interp->currentScriptObj = scriptObjPtr;
10937 retval = Jim_EvalObj(interp, scriptObjPtr);
10939 interp->currentScriptObj = prevScriptObj;
10941 else {
10942 retval = Jim_EvalObj(interp, scriptObjPtr);
10944 Jim_DecrRefCount(interp, scriptObjPtr);
10945 return retval;
10948 int Jim_Eval(Jim_Interp *interp, const char *script)
10950 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10953 /* Execute script in the scope of the global level */
10954 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10956 int retval;
10957 Jim_CallFrame *savedFramePtr = interp->framePtr;
10959 interp->framePtr = interp->topFramePtr;
10960 retval = Jim_Eval(interp, script);
10961 interp->framePtr = savedFramePtr;
10963 return retval;
10966 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10968 int retval;
10969 Jim_CallFrame *savedFramePtr = interp->framePtr;
10971 interp->framePtr = interp->topFramePtr;
10972 retval = Jim_EvalFile(interp, filename);
10973 interp->framePtr = savedFramePtr;
10975 return retval;
10978 #include <sys/stat.h>
10980 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10982 FILE *fp;
10983 char *buf;
10984 Jim_Obj *scriptObjPtr;
10985 Jim_Obj *prevScriptObj;
10986 struct stat sb;
10987 int retcode;
10988 int readlen;
10990 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10991 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10992 return JIM_ERR;
10994 if (sb.st_size == 0) {
10995 fclose(fp);
10996 return JIM_OK;
10999 buf = Jim_Alloc(sb.st_size + 1);
11000 readlen = fread(buf, 1, sb.st_size, fp);
11001 if (ferror(fp)) {
11002 fclose(fp);
11003 Jim_Free(buf);
11004 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11005 return JIM_ERR;
11007 fclose(fp);
11008 buf[readlen] = 0;
11010 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11011 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11012 Jim_IncrRefCount(scriptObjPtr);
11014 prevScriptObj = interp->currentScriptObj;
11015 interp->currentScriptObj = scriptObjPtr;
11017 retcode = Jim_EvalObj(interp, scriptObjPtr);
11019 /* Handle the JIM_RETURN return code */
11020 if (retcode == JIM_RETURN) {
11021 if (--interp->returnLevel <= 0) {
11022 retcode = interp->returnCode;
11023 interp->returnCode = JIM_OK;
11024 interp->returnLevel = 0;
11027 if (retcode == JIM_ERR) {
11028 /* EvalFile changes context, so add a stack frame here */
11029 interp->addStackTrace++;
11032 interp->currentScriptObj = prevScriptObj;
11034 Jim_DecrRefCount(interp, scriptObjPtr);
11036 return retcode;
11039 /* -----------------------------------------------------------------------------
11040 * Subst
11041 * ---------------------------------------------------------------------------*/
11042 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11044 pc->tstart = pc->p;
11045 pc->tline = pc->linenr;
11047 if (pc->len == 0) {
11048 pc->tend = pc->p;
11049 pc->tt = JIM_TT_EOL;
11050 pc->eof = 1;
11051 return;
11053 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11054 JimParseCmd(pc);
11055 return;
11057 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11058 if (JimParseVar(pc) == JIM_OK) {
11059 return;
11061 /* Not a var, so treat as a string */
11062 pc->tstart = pc->p;
11063 flags |= JIM_SUBST_NOVAR;
11065 while (pc->len) {
11066 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11067 break;
11069 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11070 break;
11072 if (*pc->p == '\\' && pc->len > 1) {
11073 pc->p++;
11074 pc->len--;
11076 pc->p++;
11077 pc->len--;
11079 pc->tend = pc->p - 1;
11080 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11083 /* The subst object type reuses most of the data structures and functions
11084 * of the script object. Script's data structures are a bit more complex
11085 * for what is needed for [subst]itution tasks, but the reuse helps to
11086 * deal with a single data structure at the cost of some more memory
11087 * usage for substitutions. */
11089 /* This method takes the string representation of an object
11090 * as a Tcl string where to perform [subst]itution, and generates
11091 * the pre-parsed internal representation. */
11092 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11094 int scriptTextLen;
11095 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11096 struct JimParserCtx parser;
11097 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11098 ParseTokenList tokenlist;
11100 /* Initially parse the subst into tokens (in tokenlist) */
11101 ScriptTokenListInit(&tokenlist);
11103 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11104 while (1) {
11105 JimParseSubst(&parser, flags);
11106 if (parser.eof) {
11107 /* Note that subst doesn't need the EOL token */
11108 break;
11110 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11111 parser.tline);
11114 /* Create the "real" subst/script tokens from the initial token list */
11115 script->inUse = 1;
11116 script->substFlags = flags;
11117 script->fileNameObj = interp->emptyObj;
11118 Jim_IncrRefCount(script->fileNameObj);
11119 SubstObjAddTokens(interp, script, &tokenlist);
11121 /* No longer need the token list */
11122 ScriptTokenListFree(&tokenlist);
11124 #ifdef DEBUG_SHOW_SUBST
11126 int i;
11128 printf("==== Subst ====\n");
11129 for (i = 0; i < script->len; i++) {
11130 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11131 Jim_String(script->token[i].objPtr));
11134 #endif
11136 /* Free the old internal rep and set the new one. */
11137 Jim_FreeIntRep(interp, objPtr);
11138 Jim_SetIntRepPtr(objPtr, script);
11139 objPtr->typePtr = &scriptObjType;
11140 return JIM_OK;
11143 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11145 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11146 SetSubstFromAny(interp, objPtr, flags);
11147 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11150 /* Performs commands,variables,blackslashes substitution,
11151 * storing the result object (with refcount 0) into
11152 * resObjPtrPtr. */
11153 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11155 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11157 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11158 /* In order to preserve the internal rep, we increment the
11159 * inUse field of the script internal rep structure. */
11160 script->inUse++;
11162 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11164 script->inUse--;
11165 Jim_DecrRefCount(interp, substObjPtr);
11166 if (*resObjPtrPtr == NULL) {
11167 return JIM_ERR;
11169 return JIM_OK;
11172 /* -----------------------------------------------------------------------------
11173 * Core commands utility functions
11174 * ---------------------------------------------------------------------------*/
11175 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11177 Jim_Obj *objPtr;
11178 Jim_Obj *listObjPtr;
11180 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11182 listObjPtr = Jim_NewListObj(interp, argv, argc);
11184 if (*msg) {
11185 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11187 Jim_IncrRefCount(listObjPtr);
11188 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11189 Jim_DecrRefCount(interp, listObjPtr);
11191 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11195 * May add the key and/or value to the list.
11197 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11198 Jim_HashEntry *he, int type);
11200 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11203 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11204 * invoke the callback to add entries to a list.
11205 * Returns the list.
11207 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11208 JimHashtableIteratorCallbackType *callback, int type)
11210 Jim_HashEntry *he;
11211 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11213 /* Check for the non-pattern case. We can do this much more efficiently. */
11214 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11215 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11216 if (he) {
11217 callback(interp, listObjPtr, he, type);
11220 else {
11221 Jim_HashTableIterator htiter;
11222 JimInitHashTableIterator(ht, &htiter);
11223 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11224 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11225 callback(interp, listObjPtr, he, type);
11229 return listObjPtr;
11232 /* Keep these in order */
11233 #define JIM_CMDLIST_COMMANDS 0
11234 #define JIM_CMDLIST_PROCS 1
11235 #define JIM_CMDLIST_CHANNELS 2
11238 * Adds matching command names (procs, channels) to the list.
11240 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11241 Jim_HashEntry *he, int type)
11243 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11244 Jim_Obj *objPtr;
11246 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11247 /* not a proc */
11248 return;
11251 objPtr = Jim_NewStringObj(interp, he->key, -1);
11252 Jim_IncrRefCount(objPtr);
11254 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11255 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11257 Jim_DecrRefCount(interp, objPtr);
11260 /* type is JIM_CMDLIST_xxx */
11261 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11263 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11266 /* Keep these in order */
11267 #define JIM_VARLIST_GLOBALS 0
11268 #define JIM_VARLIST_LOCALS 1
11269 #define JIM_VARLIST_VARS 2
11271 #define JIM_VARLIST_VALUES 0x1000
11274 * Adds matching variable names to the list.
11276 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11277 Jim_HashEntry *he, int type)
11279 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11281 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11282 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11283 if (type & JIM_VARLIST_VALUES) {
11284 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11289 /* mode is JIM_VARLIST_xxx */
11290 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11292 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11293 /* For [info locals], if we are at top level an emtpy list
11294 * is returned. I don't agree, but we aim at compatibility (SS) */
11295 return interp->emptyObj;
11297 else {
11298 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11299 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11303 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11304 Jim_Obj **objPtrPtr, int info_level_cmd)
11306 Jim_CallFrame *targetCallFrame;
11308 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11309 if (targetCallFrame == NULL) {
11310 return JIM_ERR;
11312 /* No proc call at toplevel callframe */
11313 if (targetCallFrame == interp->topFramePtr) {
11314 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11315 return JIM_ERR;
11317 if (info_level_cmd) {
11318 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11320 else {
11321 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11323 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11324 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11325 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11326 *objPtrPtr = listObj;
11328 return JIM_OK;
11331 /* -----------------------------------------------------------------------------
11332 * Core commands
11333 * ---------------------------------------------------------------------------*/
11335 /* fake [puts] -- not the real puts, just for debugging. */
11336 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11338 if (argc != 2 && argc != 3) {
11339 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11340 return JIM_ERR;
11342 if (argc == 3) {
11343 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11344 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11345 return JIM_ERR;
11347 else {
11348 fputs(Jim_String(argv[2]), stdout);
11351 else {
11352 puts(Jim_String(argv[1]));
11354 return JIM_OK;
11357 /* Helper for [+] and [*] */
11358 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11360 jim_wide wideValue, res;
11361 double doubleValue, doubleRes;
11362 int i;
11364 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11366 for (i = 1; i < argc; i++) {
11367 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11368 goto trydouble;
11369 if (op == JIM_EXPROP_ADD)
11370 res += wideValue;
11371 else
11372 res *= wideValue;
11374 Jim_SetResultInt(interp, res);
11375 return JIM_OK;
11376 trydouble:
11377 doubleRes = (double)res;
11378 for (; i < argc; i++) {
11379 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11380 return JIM_ERR;
11381 if (op == JIM_EXPROP_ADD)
11382 doubleRes += doubleValue;
11383 else
11384 doubleRes *= doubleValue;
11386 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11387 return JIM_OK;
11390 /* Helper for [-] and [/] */
11391 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11393 jim_wide wideValue, res = 0;
11394 double doubleValue, doubleRes = 0;
11395 int i = 2;
11397 if (argc < 2) {
11398 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11399 return JIM_ERR;
11401 else if (argc == 2) {
11402 /* The arity = 2 case is different. For [- x] returns -x,
11403 * while [/ x] returns 1/x. */
11404 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11405 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11406 return JIM_ERR;
11408 else {
11409 if (op == JIM_EXPROP_SUB)
11410 doubleRes = -doubleValue;
11411 else
11412 doubleRes = 1.0 / doubleValue;
11413 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11414 return JIM_OK;
11417 if (op == JIM_EXPROP_SUB) {
11418 res = -wideValue;
11419 Jim_SetResultInt(interp, res);
11421 else {
11422 doubleRes = 1.0 / wideValue;
11423 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11425 return JIM_OK;
11427 else {
11428 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11429 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11430 != JIM_OK) {
11431 return JIM_ERR;
11433 else {
11434 goto trydouble;
11438 for (i = 2; i < argc; i++) {
11439 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11440 doubleRes = (double)res;
11441 goto trydouble;
11443 if (op == JIM_EXPROP_SUB)
11444 res -= wideValue;
11445 else {
11446 if (wideValue == 0) {
11447 Jim_SetResultString(interp, "Division by zero", -1);
11448 return JIM_ERR;
11450 res /= wideValue;
11453 Jim_SetResultInt(interp, res);
11454 return JIM_OK;
11455 trydouble:
11456 for (; i < argc; i++) {
11457 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11458 return JIM_ERR;
11459 if (op == JIM_EXPROP_SUB)
11460 doubleRes -= doubleValue;
11461 else
11462 doubleRes /= doubleValue;
11464 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11465 return JIM_OK;
11469 /* [+] */
11470 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11472 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11475 /* [*] */
11476 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11478 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11481 /* [-] */
11482 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11484 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11487 /* [/] */
11488 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11490 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11493 /* [set] */
11494 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11496 if (argc != 2 && argc != 3) {
11497 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11498 return JIM_ERR;
11500 if (argc == 2) {
11501 Jim_Obj *objPtr;
11503 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11504 if (!objPtr)
11505 return JIM_ERR;
11506 Jim_SetResult(interp, objPtr);
11507 return JIM_OK;
11509 /* argc == 3 case. */
11510 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11511 return JIM_ERR;
11512 Jim_SetResult(interp, argv[2]);
11513 return JIM_OK;
11516 /* [unset]
11518 * unset ?-nocomplain? ?--? ?varName ...?
11520 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11522 int i = 1;
11523 int complain = 1;
11525 while (i < argc) {
11526 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11527 i++;
11528 break;
11530 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11531 complain = 0;
11532 i++;
11533 continue;
11535 break;
11538 while (i < argc) {
11539 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11540 && complain) {
11541 return JIM_ERR;
11543 i++;
11545 return JIM_OK;
11548 /* [while] */
11549 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11551 if (argc != 3) {
11552 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11553 return JIM_ERR;
11556 /* The general purpose implementation of while starts here */
11557 while (1) {
11558 int boolean, retval;
11560 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11561 return retval;
11562 if (!boolean)
11563 break;
11565 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11566 switch (retval) {
11567 case JIM_BREAK:
11568 goto out;
11569 break;
11570 case JIM_CONTINUE:
11571 continue;
11572 break;
11573 default:
11574 return retval;
11578 out:
11579 Jim_SetEmptyResult(interp);
11580 return JIM_OK;
11583 /* [for] */
11584 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11586 int retval;
11587 int boolean = 1;
11588 Jim_Obj *varNamePtr = NULL;
11589 Jim_Obj *stopVarNamePtr = NULL;
11591 if (argc != 5) {
11592 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11593 return JIM_ERR;
11596 /* Do the initialisation */
11597 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11598 return retval;
11601 /* And do the first test now. Better for optimisation
11602 * if we can do next/test at the bottom of the loop
11604 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11606 /* Ready to do the body as follows:
11607 * while (1) {
11608 * body // check retcode
11609 * next // check retcode
11610 * test // check retcode/test bool
11614 #ifdef JIM_OPTIMIZATION
11615 /* Check if the for is on the form:
11616 * for ... {$i < CONST} {incr i}
11617 * for ... {$i < $j} {incr i}
11619 if (retval == JIM_OK && boolean) {
11620 ScriptObj *incrScript;
11621 struct ExprTree *expr;
11622 jim_wide stop, currentVal;
11623 Jim_Obj *objPtr;
11624 int cmpOffset;
11626 /* Do it only if there aren't shared arguments */
11627 expr = JimGetExpression(interp, argv[2]);
11628 incrScript = JimGetScript(interp, argv[3]);
11630 /* Ensure proper lengths to start */
11631 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11632 goto evalstart;
11634 /* Ensure proper token types. */
11635 if (incrScript->token[1].type != JIM_TT_ESC) {
11636 goto evalstart;
11639 if (expr->expr->type == JIM_EXPROP_LT) {
11640 cmpOffset = 0;
11642 else if (expr->expr->type == JIM_EXPROP_LTE) {
11643 cmpOffset = 1;
11645 else {
11646 goto evalstart;
11649 if (expr->expr->left->type != JIM_TT_VAR) {
11650 goto evalstart;
11653 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11654 goto evalstart;
11657 /* Update command must be incr */
11658 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11659 goto evalstart;
11662 /* incr, expression must be about the same variable */
11663 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11664 goto evalstart;
11667 /* Get the stop condition (must be a variable or integer) */
11668 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11669 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11670 goto evalstart;
11673 else {
11674 stopVarNamePtr = expr->expr->right->objPtr;
11675 Jim_IncrRefCount(stopVarNamePtr);
11676 /* Keep the compiler happy */
11677 stop = 0;
11680 /* Initialization */
11681 varNamePtr = expr->expr->left->objPtr;
11682 Jim_IncrRefCount(varNamePtr);
11684 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11685 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11686 goto testcond;
11689 /* --- OPTIMIZED FOR --- */
11690 while (retval == JIM_OK) {
11691 /* === Check condition === */
11692 /* Note that currentVal is already set here */
11694 /* Immediate or Variable? get the 'stop' value if the latter. */
11695 if (stopVarNamePtr) {
11696 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11697 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11698 goto testcond;
11702 if (currentVal >= stop + cmpOffset) {
11703 break;
11706 /* Eval body */
11707 retval = Jim_EvalObj(interp, argv[4]);
11708 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11709 retval = JIM_OK;
11711 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11713 /* Increment */
11714 if (objPtr == NULL) {
11715 retval = JIM_ERR;
11716 goto out;
11718 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11719 currentVal = ++JimWideValue(objPtr);
11720 Jim_InvalidateStringRep(objPtr);
11722 else {
11723 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11724 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11725 ++currentVal)) != JIM_OK) {
11726 goto evalnext;
11731 goto out;
11733 evalstart:
11734 #endif
11736 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11737 /* Body */
11738 retval = Jim_EvalObj(interp, argv[4]);
11740 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11741 /* increment */
11742 JIM_IF_OPTIM(evalnext:)
11743 retval = Jim_EvalObj(interp, argv[3]);
11744 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11745 /* test */
11746 JIM_IF_OPTIM(testcond:)
11747 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11751 JIM_IF_OPTIM(out:)
11752 if (stopVarNamePtr) {
11753 Jim_DecrRefCount(interp, stopVarNamePtr);
11755 if (varNamePtr) {
11756 Jim_DecrRefCount(interp, varNamePtr);
11759 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11760 Jim_SetEmptyResult(interp);
11761 return JIM_OK;
11764 return retval;
11767 /* [loop] */
11768 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11770 int retval;
11771 jim_wide i;
11772 jim_wide limit;
11773 jim_wide incr = 1;
11774 Jim_Obj *bodyObjPtr;
11776 if (argc != 5 && argc != 6) {
11777 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11778 return JIM_ERR;
11781 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11782 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11783 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11784 return JIM_ERR;
11786 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11788 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11790 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11791 retval = Jim_EvalObj(interp, bodyObjPtr);
11792 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11793 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11795 retval = JIM_OK;
11797 /* Increment */
11798 i += incr;
11800 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11801 if (argv[1]->typePtr != &variableObjType) {
11802 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11803 return JIM_ERR;
11806 JimWideValue(objPtr) = i;
11807 Jim_InvalidateStringRep(objPtr);
11809 /* The following step is required in order to invalidate the
11810 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11811 if (argv[1]->typePtr != &variableObjType) {
11812 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11813 retval = JIM_ERR;
11814 break;
11818 else {
11819 objPtr = Jim_NewIntObj(interp, i);
11820 retval = Jim_SetVariable(interp, argv[1], objPtr);
11821 if (retval != JIM_OK) {
11822 Jim_FreeNewObj(interp, objPtr);
11828 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11829 Jim_SetEmptyResult(interp);
11830 return JIM_OK;
11832 return retval;
11835 /* List iterators make it easy to iterate over a list.
11836 * At some point iterators will be expanded to support generators.
11838 typedef struct {
11839 Jim_Obj *objPtr;
11840 int idx;
11841 } Jim_ListIter;
11844 * Initialise the iterator at the start of the list.
11846 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11848 iter->objPtr = objPtr;
11849 iter->idx = 0;
11853 * Returns the next object from the list, or NULL on end-of-list.
11855 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11857 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11858 return NULL;
11860 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11864 * Returns 1 if end-of-list has been reached.
11866 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11868 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11871 /* foreach + lmap implementation. */
11872 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11874 int result = JIM_OK;
11875 int i, numargs;
11876 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11877 Jim_ListIter *iters;
11878 Jim_Obj *script;
11879 Jim_Obj *resultObj;
11881 if (argc < 4 || argc % 2 != 0) {
11882 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11883 return JIM_ERR;
11885 script = argv[argc - 1]; /* Last argument is a script */
11886 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11888 if (numargs == 2) {
11889 iters = twoiters;
11891 else {
11892 iters = Jim_Alloc(numargs * sizeof(*iters));
11894 for (i = 0; i < numargs; i++) {
11895 JimListIterInit(&iters[i], argv[i + 1]);
11896 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11897 result = JIM_ERR;
11900 if (result != JIM_OK) {
11901 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11902 return result;
11905 if (doMap) {
11906 resultObj = Jim_NewListObj(interp, NULL, 0);
11908 else {
11909 resultObj = interp->emptyObj;
11911 Jim_IncrRefCount(resultObj);
11913 while (1) {
11914 /* Have we expired all lists? */
11915 for (i = 0; i < numargs; i += 2) {
11916 if (!JimListIterDone(interp, &iters[i + 1])) {
11917 break;
11920 if (i == numargs) {
11921 /* All done */
11922 break;
11925 /* For each list */
11926 for (i = 0; i < numargs; i += 2) {
11927 Jim_Obj *varName;
11929 /* foreach var */
11930 JimListIterInit(&iters[i], argv[i + 1]);
11931 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11932 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11933 if (!valObj) {
11934 /* Ran out, so store the empty string */
11935 valObj = interp->emptyObj;
11937 /* Avoid shimmering */
11938 Jim_IncrRefCount(valObj);
11939 result = Jim_SetVariable(interp, varName, valObj);
11940 Jim_DecrRefCount(interp, valObj);
11941 if (result != JIM_OK) {
11942 goto err;
11946 switch (result = Jim_EvalObj(interp, script)) {
11947 case JIM_OK:
11948 if (doMap) {
11949 Jim_ListAppendElement(interp, resultObj, interp->result);
11951 break;
11952 case JIM_CONTINUE:
11953 break;
11954 case JIM_BREAK:
11955 goto out;
11956 default:
11957 goto err;
11960 out:
11961 result = JIM_OK;
11962 Jim_SetResult(interp, resultObj);
11963 err:
11964 Jim_DecrRefCount(interp, resultObj);
11965 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 /* Check to see if trying to replace past the end of the list */
12499 if (first < len) {
12500 /* OK. Not past the end */
12502 else if (len == 0) {
12503 /* Special for empty list, adjust first to 0 */
12504 first = 0;
12506 else {
12507 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12508 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12509 return JIM_ERR;
12512 /* Add the first set of elements */
12513 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12515 /* Add supplied elements */
12516 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12518 /* Add the remaining elements */
12519 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12521 Jim_SetResult(interp, newListObj);
12522 return JIM_OK;
12525 /* [lset] */
12526 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12528 if (argc < 3) {
12529 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12530 return JIM_ERR;
12532 else if (argc == 3) {
12533 /* With no indexes, simply implements [set] */
12534 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12535 return JIM_ERR;
12536 Jim_SetResult(interp, argv[2]);
12537 return JIM_OK;
12539 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12542 /* [lsort] */
12543 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12545 static const char * const options[] = {
12546 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12548 enum
12549 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12550 Jim_Obj *resObj;
12551 int i;
12552 int retCode;
12553 int shared;
12555 struct lsort_info info;
12557 if (argc < 2) {
12558 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12559 return JIM_ERR;
12562 info.type = JIM_LSORT_ASCII;
12563 info.order = 1;
12564 info.indexed = 0;
12565 info.unique = 0;
12566 info.command = NULL;
12567 info.interp = interp;
12569 for (i = 1; i < (argc - 1); i++) {
12570 int option;
12572 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12573 != JIM_OK)
12574 return JIM_ERR;
12575 switch (option) {
12576 case OPT_ASCII:
12577 info.type = JIM_LSORT_ASCII;
12578 break;
12579 case OPT_NOCASE:
12580 info.type = JIM_LSORT_NOCASE;
12581 break;
12582 case OPT_INTEGER:
12583 info.type = JIM_LSORT_INTEGER;
12584 break;
12585 case OPT_REAL:
12586 info.type = JIM_LSORT_REAL;
12587 break;
12588 case OPT_INCREASING:
12589 info.order = 1;
12590 break;
12591 case OPT_DECREASING:
12592 info.order = -1;
12593 break;
12594 case OPT_UNIQUE:
12595 info.unique = 1;
12596 break;
12597 case OPT_COMMAND:
12598 if (i >= (argc - 2)) {
12599 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12600 return JIM_ERR;
12602 info.type = JIM_LSORT_COMMAND;
12603 info.command = argv[i + 1];
12604 i++;
12605 break;
12606 case OPT_INDEX:
12607 if (i >= (argc - 2)) {
12608 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12609 return JIM_ERR;
12611 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12612 return JIM_ERR;
12614 info.indexed = 1;
12615 i++;
12616 break;
12619 resObj = argv[argc - 1];
12620 if ((shared = Jim_IsShared(resObj)))
12621 resObj = Jim_DuplicateObj(interp, resObj);
12622 retCode = ListSortElements(interp, resObj, &info);
12623 if (retCode == JIM_OK) {
12624 Jim_SetResult(interp, resObj);
12626 else if (shared) {
12627 Jim_FreeNewObj(interp, resObj);
12629 return retCode;
12632 /* [append] */
12633 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12635 Jim_Obj *stringObjPtr;
12636 int i;
12638 if (argc < 2) {
12639 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12640 return JIM_ERR;
12642 if (argc == 2) {
12643 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12644 if (!stringObjPtr)
12645 return JIM_ERR;
12647 else {
12648 int new_obj = 0;
12649 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12650 if (!stringObjPtr) {
12651 /* Create the string if it doesn't exist */
12652 stringObjPtr = Jim_NewEmptyStringObj(interp);
12653 new_obj = 1;
12655 else if (Jim_IsShared(stringObjPtr)) {
12656 new_obj = 1;
12657 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12659 for (i = 2; i < argc; i++) {
12660 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12662 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12663 if (new_obj) {
12664 Jim_FreeNewObj(interp, stringObjPtr);
12666 return JIM_ERR;
12669 Jim_SetResult(interp, stringObjPtr);
12670 return JIM_OK;
12673 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12675 * Returns a zero-refcount list describing the expression at 'node'
12677 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12679 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12681 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12682 if (TOKEN_IS_EXPR_OP(node->type)) {
12683 if (node->left) {
12684 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12686 if (node->right) {
12687 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12689 if (node->ternary) {
12690 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12693 else {
12694 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12696 return listObjPtr;
12698 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12700 /* [debug] */
12701 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12703 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12704 static const char * const options[] = {
12705 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12706 "exprbc", "show",
12707 NULL
12709 enum
12711 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12712 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12714 int option;
12716 if (argc < 2) {
12717 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12718 return JIM_ERR;
12720 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12721 return Jim_CheckShowCommands(interp, argv[1], options);
12722 if (option == OPT_REFCOUNT) {
12723 if (argc != 3) {
12724 Jim_WrongNumArgs(interp, 2, argv, "object");
12725 return JIM_ERR;
12727 Jim_SetResultInt(interp, argv[2]->refCount);
12728 return JIM_OK;
12730 else if (option == OPT_OBJCOUNT) {
12731 int freeobj = 0, liveobj = 0;
12732 char buf[256];
12733 Jim_Obj *objPtr;
12735 if (argc != 2) {
12736 Jim_WrongNumArgs(interp, 2, argv, "");
12737 return JIM_ERR;
12739 /* Count the number of free objects. */
12740 objPtr = interp->freeList;
12741 while (objPtr) {
12742 freeobj++;
12743 objPtr = objPtr->nextObjPtr;
12745 /* Count the number of live objects. */
12746 objPtr = interp->liveList;
12747 while (objPtr) {
12748 liveobj++;
12749 objPtr = objPtr->nextObjPtr;
12751 /* Set the result string and return. */
12752 sprintf(buf, "free %d used %d", freeobj, liveobj);
12753 Jim_SetResultString(interp, buf, -1);
12754 return JIM_OK;
12756 else if (option == OPT_OBJECTS) {
12757 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12759 /* Count the number of live objects. */
12760 objPtr = interp->liveList;
12761 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12762 while (objPtr) {
12763 char buf[128];
12764 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12766 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12767 sprintf(buf, "%p", objPtr);
12768 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12769 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12770 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12771 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12772 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12773 objPtr = objPtr->nextObjPtr;
12775 Jim_SetResult(interp, listObjPtr);
12776 return JIM_OK;
12778 else if (option == OPT_INVSTR) {
12779 Jim_Obj *objPtr;
12781 if (argc != 3) {
12782 Jim_WrongNumArgs(interp, 2, argv, "object");
12783 return JIM_ERR;
12785 objPtr = argv[2];
12786 if (objPtr->typePtr != NULL)
12787 Jim_InvalidateStringRep(objPtr);
12788 Jim_SetEmptyResult(interp);
12789 return JIM_OK;
12791 else if (option == OPT_SHOW) {
12792 const char *s;
12793 int len, charlen;
12795 if (argc != 3) {
12796 Jim_WrongNumArgs(interp, 2, argv, "object");
12797 return JIM_ERR;
12799 s = Jim_GetString(argv[2], &len);
12800 #ifdef JIM_UTF8
12801 charlen = utf8_strlen(s, len);
12802 #else
12803 charlen = len;
12804 #endif
12805 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12806 printf("chars (%d): <<%s>>\n", charlen, s);
12807 printf("bytes (%d):", len);
12808 while (len--) {
12809 printf(" %02x", (unsigned char)*s++);
12811 printf("\n");
12812 return JIM_OK;
12814 else if (option == OPT_SCRIPTLEN) {
12815 ScriptObj *script;
12817 if (argc != 3) {
12818 Jim_WrongNumArgs(interp, 2, argv, "script");
12819 return JIM_ERR;
12821 script = JimGetScript(interp, argv[2]);
12822 if (script == NULL)
12823 return JIM_ERR;
12824 Jim_SetResultInt(interp, script->len);
12825 return JIM_OK;
12827 else if (option == OPT_EXPRLEN) {
12828 struct ExprTree *expr;
12830 if (argc != 3) {
12831 Jim_WrongNumArgs(interp, 2, argv, "expression");
12832 return JIM_ERR;
12834 expr = JimGetExpression(interp, argv[2]);
12835 if (expr == NULL)
12836 return JIM_ERR;
12837 Jim_SetResultInt(interp, expr->len);
12838 return JIM_OK;
12840 else if (option == OPT_EXPRBC) {
12841 struct ExprTree *expr;
12843 if (argc != 3) {
12844 Jim_WrongNumArgs(interp, 2, argv, "expression");
12845 return JIM_ERR;
12847 expr = JimGetExpression(interp, argv[2]);
12848 if (expr == NULL)
12849 return JIM_ERR;
12850 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12851 return JIM_OK;
12853 else {
12854 Jim_SetResultString(interp,
12855 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12856 return JIM_ERR;
12858 /* unreached */
12859 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12860 #if !defined(JIM_DEBUG_COMMAND)
12861 Jim_SetResultString(interp, "unsupported", -1);
12862 return JIM_ERR;
12863 #endif
12866 /* [eval] */
12867 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12869 int rc;
12871 if (argc < 2) {
12872 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12873 return JIM_ERR;
12876 if (argc == 2) {
12877 rc = Jim_EvalObj(interp, argv[1]);
12879 else {
12880 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12883 if (rc == JIM_ERR) {
12884 /* eval is "interesting", so add a stack frame here */
12885 interp->addStackTrace++;
12887 return rc;
12890 /* [uplevel] */
12891 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12893 if (argc >= 2) {
12894 int retcode;
12895 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12896 const char *str;
12898 /* Save the old callframe pointer */
12899 savedCallFrame = interp->framePtr;
12901 /* Lookup the target frame pointer */
12902 str = Jim_String(argv[1]);
12903 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12904 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12905 argc--;
12906 argv++;
12908 else {
12909 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12911 if (targetCallFrame == NULL) {
12912 return JIM_ERR;
12914 if (argc < 2) {
12915 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12916 return JIM_ERR;
12918 /* Eval the code in the target callframe. */
12919 interp->framePtr = targetCallFrame;
12920 if (argc == 2) {
12921 retcode = Jim_EvalObj(interp, argv[1]);
12923 else {
12924 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12926 interp->framePtr = savedCallFrame;
12927 return retcode;
12929 else {
12930 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12931 return JIM_ERR;
12935 /* [expr] */
12936 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12938 int retcode;
12940 if (argc == 2) {
12941 retcode = Jim_EvalExpression(interp, argv[1]);
12943 else if (argc > 2) {
12944 Jim_Obj *objPtr;
12946 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12947 Jim_IncrRefCount(objPtr);
12948 retcode = Jim_EvalExpression(interp, objPtr);
12949 Jim_DecrRefCount(interp, objPtr);
12951 else {
12952 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12953 return JIM_ERR;
12955 if (retcode != JIM_OK)
12956 return retcode;
12957 return JIM_OK;
12960 /* [break] */
12961 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12963 if (argc != 1) {
12964 Jim_WrongNumArgs(interp, 1, argv, "");
12965 return JIM_ERR;
12967 return JIM_BREAK;
12970 /* [continue] */
12971 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12973 if (argc != 1) {
12974 Jim_WrongNumArgs(interp, 1, argv, "");
12975 return JIM_ERR;
12977 return JIM_CONTINUE;
12980 /* [return] */
12981 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12983 int i;
12984 Jim_Obj *stackTraceObj = NULL;
12985 Jim_Obj *errorCodeObj = NULL;
12986 int returnCode = JIM_OK;
12987 long level = 1;
12989 for (i = 1; i < argc - 1; i += 2) {
12990 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12991 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12992 return JIM_ERR;
12995 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12996 stackTraceObj = argv[i + 1];
12998 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12999 errorCodeObj = argv[i + 1];
13001 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13002 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13003 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13004 return JIM_ERR;
13007 else {
13008 break;
13012 if (i != argc - 1 && i != argc) {
13013 Jim_WrongNumArgs(interp, 1, argv,
13014 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13017 /* If a stack trace is supplied and code is error, set the stack trace */
13018 if (stackTraceObj && returnCode == JIM_ERR) {
13019 JimSetStackTrace(interp, stackTraceObj);
13021 /* If an error code list is supplied, set the global $errorCode */
13022 if (errorCodeObj && returnCode == JIM_ERR) {
13023 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13025 interp->returnCode = returnCode;
13026 interp->returnLevel = level;
13028 if (i == argc - 1) {
13029 Jim_SetResult(interp, argv[i]);
13031 return JIM_RETURN;
13034 /* [tailcall] */
13035 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13037 if (interp->framePtr->level == 0) {
13038 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13039 return JIM_ERR;
13041 else if (argc >= 2) {
13042 /* Need to resolve the tailcall command in the current context */
13043 Jim_CallFrame *cf = interp->framePtr->parent;
13045 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13046 if (cmdPtr == NULL) {
13047 return JIM_ERR;
13050 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13052 /* And stash this pre-resolved command */
13053 JimIncrCmdRefCount(cmdPtr);
13054 cf->tailcallCmd = cmdPtr;
13056 /* And stash the command list */
13057 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13059 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13060 Jim_IncrRefCount(cf->tailcallObj);
13062 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13063 return JIM_EVAL;
13065 return JIM_OK;
13068 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13070 Jim_Obj *cmdList;
13071 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13073 /* prefixListObj is a list to which the args need to be appended */
13074 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13075 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13077 return JimEvalObjList(interp, cmdList);
13080 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13082 Jim_Obj *prefixListObj = privData;
13083 Jim_DecrRefCount(interp, prefixListObj);
13086 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13088 Jim_Obj *prefixListObj;
13089 const char *newname;
13091 if (argc < 3) {
13092 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13093 return JIM_ERR;
13096 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13097 Jim_IncrRefCount(prefixListObj);
13098 newname = Jim_String(argv[1]);
13099 if (newname[0] == ':' && newname[1] == ':') {
13100 while (*++newname == ':') {
13104 Jim_SetResult(interp, argv[1]);
13106 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13109 /* [proc] */
13110 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13112 Jim_Cmd *cmd;
13114 if (argc != 4 && argc != 5) {
13115 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13116 return JIM_ERR;
13119 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13120 return JIM_ERR;
13123 if (argc == 4) {
13124 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13126 else {
13127 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13130 if (cmd) {
13131 /* Add the new command */
13132 Jim_Obj *qualifiedCmdNameObj;
13133 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13135 JimCreateCommand(interp, cmdname, cmd);
13137 /* Calculate and set the namespace for this proc */
13138 JimUpdateProcNamespace(interp, cmd, cmdname);
13140 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13142 /* Unlike Tcl, set the name of the proc as the result */
13143 Jim_SetResult(interp, argv[1]);
13144 return JIM_OK;
13146 return JIM_ERR;
13149 /* [local] */
13150 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13152 int retcode;
13154 if (argc < 2) {
13155 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13156 return JIM_ERR;
13159 /* Evaluate the arguments with 'local' in force */
13160 interp->local++;
13161 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13162 interp->local--;
13165 /* If OK, and the result is a proc, add it to the list of local procs */
13166 if (retcode == 0) {
13167 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13169 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13170 return JIM_ERR;
13172 if (interp->framePtr->localCommands == NULL) {
13173 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13174 Jim_InitStack(interp->framePtr->localCommands);
13176 Jim_IncrRefCount(cmdNameObj);
13177 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13180 return retcode;
13183 /* [upcall] */
13184 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13186 if (argc < 2) {
13187 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13188 return JIM_ERR;
13190 else {
13191 int retcode;
13193 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13194 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13195 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13196 return JIM_ERR;
13198 /* OK. Mark this command as being in an upcall */
13199 cmdPtr->u.proc.upcall++;
13200 JimIncrCmdRefCount(cmdPtr);
13202 /* Invoke the command as normal */
13203 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13205 /* No longer in an upcall */
13206 cmdPtr->u.proc.upcall--;
13207 JimDecrCmdRefCount(interp, cmdPtr);
13209 return retcode;
13213 /* [apply] */
13214 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13216 if (argc < 2) {
13217 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13218 return JIM_ERR;
13220 else {
13221 int ret;
13222 Jim_Cmd *cmd;
13223 Jim_Obj *argListObjPtr;
13224 Jim_Obj *bodyObjPtr;
13225 Jim_Obj *nsObj = NULL;
13226 Jim_Obj **nargv;
13228 int len = Jim_ListLength(interp, argv[1]);
13229 if (len != 2 && len != 3) {
13230 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13231 return JIM_ERR;
13234 if (len == 3) {
13235 #ifdef jim_ext_namespace
13236 /* Need to canonicalise the given namespace. */
13237 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13238 #else
13239 Jim_SetResultString(interp, "namespaces not enabled", -1);
13240 return JIM_ERR;
13241 #endif
13243 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13244 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13246 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13248 if (cmd) {
13249 /* Create a new argv array with a dummy argv[0], for error messages */
13250 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13251 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13252 Jim_IncrRefCount(nargv[0]);
13253 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13254 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13255 Jim_DecrRefCount(interp, nargv[0]);
13256 Jim_Free(nargv);
13258 JimDecrCmdRefCount(interp, cmd);
13259 return ret;
13261 return JIM_ERR;
13266 /* [concat] */
13267 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13269 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13270 return JIM_OK;
13273 /* [upvar] */
13274 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13276 int i;
13277 Jim_CallFrame *targetCallFrame;
13279 /* Lookup the target frame pointer */
13280 if (argc > 3 && (argc % 2 == 0)) {
13281 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13282 argc--;
13283 argv++;
13285 else {
13286 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13288 if (targetCallFrame == NULL) {
13289 return JIM_ERR;
13292 /* Check for arity */
13293 if (argc < 3) {
13294 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13295 return JIM_ERR;
13298 /* Now... for every other/local couple: */
13299 for (i = 1; i < argc; i += 2) {
13300 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13301 return JIM_ERR;
13303 return JIM_OK;
13306 /* [global] */
13307 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13309 int i;
13311 if (argc < 2) {
13312 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13313 return JIM_ERR;
13315 /* Link every var to the toplevel having the same name */
13316 if (interp->framePtr->level == 0)
13317 return JIM_OK; /* global at toplevel... */
13318 for (i = 1; i < argc; i++) {
13319 /* global ::blah does nothing */
13320 const char *name = Jim_String(argv[i]);
13321 if (name[0] != ':' || name[1] != ':') {
13322 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13323 return JIM_ERR;
13326 return JIM_OK;
13329 /* does the [string map] operation. On error NULL is returned,
13330 * otherwise a new string object with the result, having refcount = 0,
13331 * is returned. */
13332 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13333 Jim_Obj *objPtr, int nocase)
13335 int numMaps;
13336 const char *str, *noMatchStart = NULL;
13337 int strLen, i;
13338 Jim_Obj *resultObjPtr;
13340 numMaps = Jim_ListLength(interp, mapListObjPtr);
13341 if (numMaps % 2) {
13342 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13343 return NULL;
13346 str = Jim_String(objPtr);
13347 strLen = Jim_Utf8Length(interp, objPtr);
13349 /* Map it */
13350 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13351 while (strLen) {
13352 for (i = 0; i < numMaps; i += 2) {
13353 Jim_Obj *eachObjPtr;
13354 const char *k;
13355 int kl;
13357 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13358 k = Jim_String(eachObjPtr);
13359 kl = Jim_Utf8Length(interp, eachObjPtr);
13361 if (strLen >= kl && kl) {
13362 int rc;
13363 rc = JimStringCompareLen(str, k, kl, nocase);
13364 if (rc == 0) {
13365 if (noMatchStart) {
13366 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13367 noMatchStart = NULL;
13369 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13370 str += utf8_index(str, kl);
13371 strLen -= kl;
13372 break;
13376 if (i == numMaps) { /* no match */
13377 int c;
13378 if (noMatchStart == NULL)
13379 noMatchStart = str;
13380 str += utf8_tounicode(str, &c);
13381 strLen--;
13384 if (noMatchStart) {
13385 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13387 return resultObjPtr;
13390 /* [string] */
13391 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13393 int len;
13394 int opt_case = 1;
13395 int option;
13396 static const char * const options[] = {
13397 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13398 "map", "repeat", "reverse", "index", "first", "last", "cat",
13399 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13401 enum
13403 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13404 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13405 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13407 static const char * const nocase_options[] = {
13408 "-nocase", NULL
13410 static const char * const nocase_length_options[] = {
13411 "-nocase", "-length", NULL
13414 if (argc < 2) {
13415 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13416 return JIM_ERR;
13418 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13419 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13420 return Jim_CheckShowCommands(interp, argv[1], options);
13422 switch (option) {
13423 case OPT_LENGTH:
13424 case OPT_BYTELENGTH:
13425 if (argc != 3) {
13426 Jim_WrongNumArgs(interp, 2, argv, "string");
13427 return JIM_ERR;
13429 if (option == OPT_LENGTH) {
13430 len = Jim_Utf8Length(interp, argv[2]);
13432 else {
13433 len = Jim_Length(argv[2]);
13435 Jim_SetResultInt(interp, len);
13436 return JIM_OK;
13438 case OPT_CAT:{
13439 Jim_Obj *objPtr;
13440 if (argc == 3) {
13441 /* optimise the one-arg case */
13442 objPtr = argv[2];
13444 else {
13445 int i;
13447 objPtr = Jim_NewStringObj(interp, "", 0);
13449 for (i = 2; i < argc; i++) {
13450 Jim_AppendObj(interp, objPtr, argv[i]);
13453 Jim_SetResult(interp, objPtr);
13454 return JIM_OK;
13457 case OPT_COMPARE:
13458 case OPT_EQUAL:
13460 /* n is the number of remaining option args */
13461 long opt_length = -1;
13462 int n = argc - 4;
13463 int i = 2;
13464 while (n > 0) {
13465 int subopt;
13466 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13467 JIM_ENUM_ABBREV) != JIM_OK) {
13468 badcompareargs:
13469 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13470 return JIM_ERR;
13472 if (subopt == 0) {
13473 /* -nocase */
13474 opt_case = 0;
13475 n--;
13477 else {
13478 /* -length */
13479 if (n < 2) {
13480 goto badcompareargs;
13482 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13483 return JIM_ERR;
13485 n -= 2;
13488 if (n) {
13489 goto badcompareargs;
13491 argv += argc - 2;
13492 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13493 /* Fast version - [string equal], case sensitive, no length */
13494 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13496 else {
13497 if (opt_length >= 0) {
13498 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13500 else {
13501 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13503 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13505 return JIM_OK;
13508 case OPT_MATCH:
13509 if (argc != 4 &&
13510 (argc != 5 ||
13511 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13512 JIM_ENUM_ABBREV) != JIM_OK)) {
13513 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13514 return JIM_ERR;
13516 if (opt_case == 0) {
13517 argv++;
13519 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13520 return JIM_OK;
13522 case OPT_MAP:{
13523 Jim_Obj *objPtr;
13525 if (argc != 4 &&
13526 (argc != 5 ||
13527 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13528 JIM_ENUM_ABBREV) != JIM_OK)) {
13529 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13530 return JIM_ERR;
13533 if (opt_case == 0) {
13534 argv++;
13536 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13537 if (objPtr == NULL) {
13538 return JIM_ERR;
13540 Jim_SetResult(interp, objPtr);
13541 return JIM_OK;
13544 case OPT_RANGE:
13545 case OPT_BYTERANGE:{
13546 Jim_Obj *objPtr;
13548 if (argc != 5) {
13549 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13550 return JIM_ERR;
13552 if (option == OPT_RANGE) {
13553 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13555 else
13557 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13560 if (objPtr == NULL) {
13561 return JIM_ERR;
13563 Jim_SetResult(interp, objPtr);
13564 return JIM_OK;
13567 case OPT_REPLACE:{
13568 Jim_Obj *objPtr;
13570 if (argc != 5 && argc != 6) {
13571 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13572 return JIM_ERR;
13574 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13575 if (objPtr == NULL) {
13576 return JIM_ERR;
13578 Jim_SetResult(interp, objPtr);
13579 return JIM_OK;
13583 case OPT_REPEAT:{
13584 Jim_Obj *objPtr;
13585 jim_wide count;
13587 if (argc != 4) {
13588 Jim_WrongNumArgs(interp, 2, argv, "string count");
13589 return JIM_ERR;
13591 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13592 return JIM_ERR;
13594 objPtr = Jim_NewStringObj(interp, "", 0);
13595 if (count > 0) {
13596 while (count--) {
13597 Jim_AppendObj(interp, objPtr, argv[2]);
13600 Jim_SetResult(interp, objPtr);
13601 return JIM_OK;
13604 case OPT_REVERSE:{
13605 char *buf, *p;
13606 const char *str;
13607 int i;
13609 if (argc != 3) {
13610 Jim_WrongNumArgs(interp, 2, argv, "string");
13611 return JIM_ERR;
13614 str = Jim_GetString(argv[2], &len);
13615 buf = Jim_Alloc(len + 1);
13616 p = buf + len;
13617 *p = 0;
13618 for (i = 0; i < len; ) {
13619 int c;
13620 int l = utf8_tounicode(str, &c);
13621 memcpy(p - l, str, l);
13622 p -= l;
13623 i += l;
13624 str += l;
13626 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13627 return JIM_OK;
13630 case OPT_INDEX:{
13631 int idx;
13632 const char *str;
13634 if (argc != 4) {
13635 Jim_WrongNumArgs(interp, 2, argv, "string index");
13636 return JIM_ERR;
13638 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13639 return JIM_ERR;
13641 str = Jim_String(argv[2]);
13642 len = Jim_Utf8Length(interp, argv[2]);
13643 if (idx != INT_MIN && idx != INT_MAX) {
13644 idx = JimRelToAbsIndex(len, idx);
13646 if (idx < 0 || idx >= len || str == NULL) {
13647 Jim_SetResultString(interp, "", 0);
13649 else if (len == Jim_Length(argv[2])) {
13650 /* ASCII optimisation */
13651 Jim_SetResultString(interp, str + idx, 1);
13653 else {
13654 int c;
13655 int i = utf8_index(str, idx);
13656 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13658 return JIM_OK;
13661 case OPT_FIRST:
13662 case OPT_LAST:{
13663 int idx = 0, l1, l2;
13664 const char *s1, *s2;
13666 if (argc != 4 && argc != 5) {
13667 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13668 return JIM_ERR;
13670 s1 = Jim_String(argv[2]);
13671 s2 = Jim_String(argv[3]);
13672 l1 = Jim_Utf8Length(interp, argv[2]);
13673 l2 = Jim_Utf8Length(interp, argv[3]);
13674 if (argc == 5) {
13675 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13676 return JIM_ERR;
13678 idx = JimRelToAbsIndex(l2, idx);
13680 else if (option == OPT_LAST) {
13681 idx = l2;
13683 if (option == OPT_FIRST) {
13684 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13686 else {
13687 #ifdef JIM_UTF8
13688 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13689 #else
13690 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13691 #endif
13693 return JIM_OK;
13696 case OPT_TRIM:
13697 case OPT_TRIMLEFT:
13698 case OPT_TRIMRIGHT:{
13699 Jim_Obj *trimchars;
13701 if (argc != 3 && argc != 4) {
13702 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13703 return JIM_ERR;
13705 trimchars = (argc == 4 ? argv[3] : NULL);
13706 if (option == OPT_TRIM) {
13707 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13709 else if (option == OPT_TRIMLEFT) {
13710 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13712 else if (option == OPT_TRIMRIGHT) {
13713 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13715 return JIM_OK;
13718 case OPT_TOLOWER:
13719 case OPT_TOUPPER:
13720 case OPT_TOTITLE:
13721 if (argc != 3) {
13722 Jim_WrongNumArgs(interp, 2, argv, "string");
13723 return JIM_ERR;
13725 if (option == OPT_TOLOWER) {
13726 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13728 else if (option == OPT_TOUPPER) {
13729 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13731 else {
13732 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13734 return JIM_OK;
13736 case OPT_IS:
13737 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13738 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13740 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13741 return JIM_ERR;
13743 return JIM_OK;
13746 /* [time] */
13747 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13749 long i, count = 1;
13750 jim_wide start, elapsed;
13751 char buf[60];
13752 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13754 if (argc < 2) {
13755 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13756 return JIM_ERR;
13758 if (argc == 3) {
13759 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13760 return JIM_ERR;
13762 if (count < 0)
13763 return JIM_OK;
13764 i = count;
13765 start = JimClock();
13766 while (i-- > 0) {
13767 int retval;
13769 retval = Jim_EvalObj(interp, argv[1]);
13770 if (retval != JIM_OK) {
13771 return retval;
13774 elapsed = JimClock() - start;
13775 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13776 Jim_SetResultString(interp, buf, -1);
13777 return JIM_OK;
13780 /* [exit] */
13781 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13783 long exitCode = 0;
13785 if (argc > 2) {
13786 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13787 return JIM_ERR;
13789 if (argc == 2) {
13790 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13791 return JIM_ERR;
13793 interp->exitCode = exitCode;
13794 return JIM_EXIT;
13797 /* [catch] */
13798 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13800 int exitCode = 0;
13801 int i;
13802 int sig = 0;
13804 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13805 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13806 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13808 /* Reset the error code before catch.
13809 * Note that this is not strictly correct.
13811 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13813 for (i = 1; i < argc - 1; i++) {
13814 const char *arg = Jim_String(argv[i]);
13815 jim_wide option;
13816 int ignore;
13818 /* It's a pity we can't use Jim_GetEnum here :-( */
13819 if (strcmp(arg, "--") == 0) {
13820 i++;
13821 break;
13823 if (*arg != '-') {
13824 break;
13827 if (strncmp(arg, "-no", 3) == 0) {
13828 arg += 3;
13829 ignore = 1;
13831 else {
13832 arg++;
13833 ignore = 0;
13836 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13837 option = -1;
13839 if (option < 0) {
13840 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13842 if (option < 0) {
13843 goto wrongargs;
13846 if (ignore) {
13847 ignore_mask |= ((jim_wide)1 << option);
13849 else {
13850 ignore_mask &= (~((jim_wide)1 << option));
13854 argc -= i;
13855 if (argc < 1 || argc > 3) {
13856 wrongargs:
13857 Jim_WrongNumArgs(interp, 1, argv,
13858 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13859 return JIM_ERR;
13861 argv += i;
13863 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13864 sig++;
13867 interp->signal_level += sig;
13868 if (Jim_CheckSignal(interp)) {
13869 /* If a signal is set, don't even try to execute the body */
13870 exitCode = JIM_SIGNAL;
13872 else {
13873 exitCode = Jim_EvalObj(interp, argv[0]);
13874 /* Don't want any caught error included in a later stack trace */
13875 interp->errorFlag = 0;
13877 interp->signal_level -= sig;
13879 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13880 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13881 /* Not caught, pass it up */
13882 return exitCode;
13885 if (sig && exitCode == JIM_SIGNAL) {
13886 /* Catch the signal at this level */
13887 if (interp->signal_set_result) {
13888 interp->signal_set_result(interp, interp->sigmask);
13890 else {
13891 Jim_SetResultInt(interp, interp->sigmask);
13893 interp->sigmask = 0;
13896 if (argc >= 2) {
13897 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13898 return JIM_ERR;
13900 if (argc == 3) {
13901 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13903 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13904 Jim_ListAppendElement(interp, optListObj,
13905 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13906 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13907 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13908 if (exitCode == JIM_ERR) {
13909 Jim_Obj *errorCode;
13910 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13911 -1));
13912 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13914 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13915 if (errorCode) {
13916 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13917 Jim_ListAppendElement(interp, optListObj, errorCode);
13920 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13921 return JIM_ERR;
13925 Jim_SetResultInt(interp, exitCode);
13926 return JIM_OK;
13929 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13931 /* [ref] */
13932 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13934 if (argc != 3 && argc != 4) {
13935 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13936 return JIM_ERR;
13938 if (argc == 3) {
13939 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13941 else {
13942 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13944 return JIM_OK;
13947 /* [getref] */
13948 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13950 Jim_Reference *refPtr;
13952 if (argc != 2) {
13953 Jim_WrongNumArgs(interp, 1, argv, "reference");
13954 return JIM_ERR;
13956 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13957 return JIM_ERR;
13958 Jim_SetResult(interp, refPtr->objPtr);
13959 return JIM_OK;
13962 /* [setref] */
13963 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13965 Jim_Reference *refPtr;
13967 if (argc != 3) {
13968 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13969 return JIM_ERR;
13971 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13972 return JIM_ERR;
13973 Jim_IncrRefCount(argv[2]);
13974 Jim_DecrRefCount(interp, refPtr->objPtr);
13975 refPtr->objPtr = argv[2];
13976 Jim_SetResult(interp, argv[2]);
13977 return JIM_OK;
13980 /* [collect] */
13981 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13983 if (argc != 1) {
13984 Jim_WrongNumArgs(interp, 1, argv, "");
13985 return JIM_ERR;
13987 Jim_SetResultInt(interp, Jim_Collect(interp));
13989 /* Free all the freed objects. */
13990 while (interp->freeList) {
13991 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13992 Jim_Free(interp->freeList);
13993 interp->freeList = nextObjPtr;
13996 return JIM_OK;
13999 /* [finalize] reference ?newValue? */
14000 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14002 if (argc != 2 && argc != 3) {
14003 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14004 return JIM_ERR;
14006 if (argc == 2) {
14007 Jim_Obj *cmdNamePtr;
14009 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14010 return JIM_ERR;
14011 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14012 Jim_SetResult(interp, cmdNamePtr);
14014 else {
14015 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14016 return JIM_ERR;
14017 Jim_SetResult(interp, argv[2]);
14019 return JIM_OK;
14022 /* [info references] */
14023 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14025 Jim_Obj *listObjPtr;
14026 Jim_HashTableIterator htiter;
14027 Jim_HashEntry *he;
14029 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14031 JimInitHashTableIterator(&interp->references, &htiter);
14032 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14033 char buf[JIM_REFERENCE_SPACE + 1];
14034 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14035 const unsigned long *refId = he->key;
14037 JimFormatReference(buf, refPtr, *refId);
14038 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14040 Jim_SetResult(interp, listObjPtr);
14041 return JIM_OK;
14043 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14045 /* [rename] */
14046 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14048 if (argc != 3) {
14049 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14050 return JIM_ERR;
14053 if (JimValidName(interp, "new procedure", argv[2])) {
14054 return JIM_ERR;
14057 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14060 #define JIM_DICTMATCH_KEYS 0x0001
14061 #define JIM_DICTMATCH_VALUES 0x002
14064 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14065 * return_types should be either or both
14067 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14069 Jim_HashEntry *he;
14070 Jim_Obj *listObjPtr;
14071 Jim_HashTableIterator htiter;
14073 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14074 return JIM_ERR;
14077 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14079 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14080 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14081 if (patternObj) {
14082 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14083 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14084 /* no match */
14085 continue;
14088 if (return_types & JIM_DICTMATCH_KEYS) {
14089 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14091 if (return_types & JIM_DICTMATCH_VALUES) {
14092 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14096 Jim_SetResult(interp, listObjPtr);
14097 return JIM_OK;
14100 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14102 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14103 return -1;
14105 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14109 * Must be called with at least one object.
14110 * Returns the new dictionary, or NULL on error.
14112 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14114 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14115 int i;
14117 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14119 /* Note that we don't optimise the trivial case of a single argument */
14121 for (i = 0; i < objc; i++) {
14122 Jim_HashTable *ht;
14123 Jim_HashTableIterator htiter;
14124 Jim_HashEntry *he;
14126 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14127 Jim_FreeNewObj(interp, objPtr);
14128 return NULL;
14130 ht = objv[i]->internalRep.ptr;
14131 JimInitHashTableIterator(ht, &htiter);
14132 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14133 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14136 return objPtr;
14139 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14141 Jim_HashTable *ht;
14142 unsigned int i;
14143 char buffer[100];
14144 int sum = 0;
14145 int nonzero_count = 0;
14146 Jim_Obj *output;
14147 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14149 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14150 return JIM_ERR;
14153 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14155 /* Note that this uses internal knowledge of the hash table */
14156 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14157 output = Jim_NewStringObj(interp, buffer, -1);
14159 for (i = 0; i < ht->size; i++) {
14160 Jim_HashEntry *he = ht->table[i];
14161 int entries = 0;
14162 while (he) {
14163 entries++;
14164 he = he->next;
14166 if (entries > 9) {
14167 bucket_counts[10]++;
14169 else {
14170 bucket_counts[entries]++;
14172 if (entries) {
14173 sum += entries;
14174 nonzero_count++;
14177 for (i = 0; i < 10; i++) {
14178 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14179 Jim_AppendString(interp, output, buffer, -1);
14181 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14182 Jim_AppendString(interp, output, buffer, -1);
14183 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14184 Jim_AppendString(interp, output, buffer, -1);
14185 Jim_SetResult(interp, output);
14186 return JIM_OK;
14189 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14191 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14193 Jim_AppendString(interp, prefixObj, " ", 1);
14194 Jim_AppendString(interp, prefixObj, subcmd, -1);
14196 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14200 * Implements the [dict with] command
14202 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14204 int i;
14205 Jim_Obj *objPtr;
14206 Jim_Obj *dictObj;
14207 Jim_Obj **dictValues;
14208 int len;
14209 int ret = JIM_OK;
14211 /* Open up the appropriate level of the dictionary */
14212 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14213 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14214 return JIM_ERR;
14216 /* Set the local variables */
14217 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14218 return JIM_ERR;
14220 for (i = 0; i < len; i += 2) {
14221 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14222 Jim_Free(dictValues);
14223 return JIM_ERR;
14227 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14228 if (Jim_Length(scriptObj)) {
14229 ret = Jim_EvalObj(interp, scriptObj);
14231 /* Now if the dictionary still exists, update it based on the local variables */
14232 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14233 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14234 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14235 for (i = 0; i < keyc; i++) {
14236 newkeyv[i] = keyv[i];
14239 for (i = 0; i < len; i += 2) {
14240 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14241 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14242 newkeyv[keyc] = dictValues[i];
14243 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14245 Jim_Free(newkeyv);
14249 Jim_Free(dictValues);
14251 return ret;
14254 /* [dict] */
14255 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14257 Jim_Obj *objPtr;
14258 int types = JIM_DICTMATCH_KEYS;
14259 int option;
14260 static const char * const options[] = {
14261 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14262 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14263 "replace", "update", NULL
14265 enum
14267 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14268 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14269 OPT_REPLACE, OPT_UPDATE,
14272 if (argc < 2) {
14273 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14274 return JIM_ERR;
14277 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14278 return Jim_CheckShowCommands(interp, argv[1], options);
14281 switch (option) {
14282 case OPT_GET:
14283 if (argc < 3) {
14284 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14285 return JIM_ERR;
14287 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14288 JIM_ERRMSG) != JIM_OK) {
14289 return JIM_ERR;
14291 Jim_SetResult(interp, objPtr);
14292 return JIM_OK;
14294 case OPT_SET:
14295 if (argc < 5) {
14296 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14297 return JIM_ERR;
14299 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14301 case OPT_EXISTS:
14302 if (argc < 4) {
14303 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14304 return JIM_ERR;
14306 else {
14307 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14308 if (rc < 0) {
14309 return JIM_ERR;
14311 Jim_SetResultBool(interp, rc == JIM_OK);
14312 return JIM_OK;
14315 case OPT_UNSET:
14316 if (argc < 4) {
14317 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14318 return JIM_ERR;
14320 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14321 return JIM_ERR;
14323 return JIM_OK;
14325 case OPT_VALUES:
14326 types = JIM_DICTMATCH_VALUES;
14327 /* fallthru */
14328 case OPT_KEYS:
14329 if (argc != 3 && argc != 4) {
14330 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14331 return JIM_ERR;
14333 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14335 case OPT_SIZE:
14336 if (argc != 3) {
14337 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14338 return JIM_ERR;
14340 else if (Jim_DictSize(interp, argv[2]) < 0) {
14341 return JIM_ERR;
14343 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14344 return JIM_OK;
14346 case OPT_MERGE:
14347 if (argc == 2) {
14348 return JIM_OK;
14350 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14351 if (objPtr == NULL) {
14352 return JIM_ERR;
14354 Jim_SetResult(interp, objPtr);
14355 return JIM_OK;
14357 case OPT_UPDATE:
14358 if (argc < 6 || argc % 2) {
14359 /* Better error message */
14360 argc = 2;
14362 break;
14364 case OPT_CREATE:
14365 if (argc % 2) {
14366 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14367 return JIM_ERR;
14369 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14370 Jim_SetResult(interp, objPtr);
14371 return JIM_OK;
14373 case OPT_INFO:
14374 if (argc != 3) {
14375 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14376 return JIM_ERR;
14378 return Jim_DictInfo(interp, argv[2]);
14380 case OPT_WITH:
14381 if (argc < 4) {
14382 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14383 return JIM_ERR;
14385 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14387 /* Handle command as an ensemble */
14388 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14391 /* [subst] */
14392 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14394 static const char * const options[] = {
14395 "-nobackslashes", "-nocommands", "-novariables", NULL
14397 enum
14398 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14399 int i;
14400 int flags = JIM_SUBST_FLAG;
14401 Jim_Obj *objPtr;
14403 if (argc < 2) {
14404 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14405 return JIM_ERR;
14407 for (i = 1; i < (argc - 1); i++) {
14408 int option;
14410 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14411 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14412 return JIM_ERR;
14414 switch (option) {
14415 case OPT_NOBACKSLASHES:
14416 flags |= JIM_SUBST_NOESC;
14417 break;
14418 case OPT_NOCOMMANDS:
14419 flags |= JIM_SUBST_NOCMD;
14420 break;
14421 case OPT_NOVARIABLES:
14422 flags |= JIM_SUBST_NOVAR;
14423 break;
14426 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14427 return JIM_ERR;
14429 Jim_SetResult(interp, objPtr);
14430 return JIM_OK;
14433 /* [info] */
14434 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14436 int cmd;
14437 Jim_Obj *objPtr;
14438 int mode = 0;
14440 static const char * const commands[] = {
14441 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14442 "vars", "version", "patchlevel", "complete", "args", "hostname",
14443 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14444 "references", "alias", NULL
14446 enum
14447 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14448 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14449 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14450 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14453 #ifdef jim_ext_namespace
14454 int nons = 0;
14456 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14457 /* This is for internal use only */
14458 argc--;
14459 argv++;
14460 nons = 1;
14462 #endif
14464 if (argc < 2) {
14465 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14466 return JIM_ERR;
14468 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14469 return Jim_CheckShowCommands(interp, argv[1], commands);
14472 /* Test for the most common commands first, just in case it makes a difference */
14473 switch (cmd) {
14474 case INFO_EXISTS:
14475 if (argc != 3) {
14476 Jim_WrongNumArgs(interp, 2, argv, "varName");
14477 return JIM_ERR;
14479 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14480 break;
14482 case INFO_ALIAS:{
14483 Jim_Cmd *cmdPtr;
14485 if (argc != 3) {
14486 Jim_WrongNumArgs(interp, 2, argv, "command");
14487 return JIM_ERR;
14489 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14490 return JIM_ERR;
14492 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14493 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14494 return JIM_ERR;
14496 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14497 return JIM_OK;
14500 case INFO_CHANNELS:
14501 mode++; /* JIM_CMDLIST_CHANNELS */
14502 #ifndef jim_ext_aio
14503 Jim_SetResultString(interp, "aio not enabled", -1);
14504 return JIM_ERR;
14505 #endif
14506 /* fall through */
14507 case INFO_PROCS:
14508 mode++; /* JIM_CMDLIST_PROCS */
14509 /* fall through */
14510 case INFO_COMMANDS:
14511 /* mode 0 => JIM_CMDLIST_COMMANDS */
14512 if (argc != 2 && argc != 3) {
14513 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14514 return JIM_ERR;
14516 #ifdef jim_ext_namespace
14517 if (!nons) {
14518 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14519 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14522 #endif
14523 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14524 break;
14526 case INFO_VARS:
14527 mode++; /* JIM_VARLIST_VARS */
14528 /* fall through */
14529 case INFO_LOCALS:
14530 mode++; /* JIM_VARLIST_LOCALS */
14531 /* fall through */
14532 case INFO_GLOBALS:
14533 /* mode 0 => JIM_VARLIST_GLOBALS */
14534 if (argc != 2 && argc != 3) {
14535 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14536 return JIM_ERR;
14538 #ifdef jim_ext_namespace
14539 if (!nons) {
14540 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14541 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14544 #endif
14545 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14546 break;
14548 case INFO_SCRIPT:
14549 if (argc != 2) {
14550 Jim_WrongNumArgs(interp, 2, argv, "");
14551 return JIM_ERR;
14553 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14554 break;
14556 case INFO_SOURCE:{
14557 jim_wide line;
14558 Jim_Obj *resObjPtr;
14559 Jim_Obj *fileNameObj;
14561 if (argc != 3 && argc != 5) {
14562 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14563 return JIM_ERR;
14565 if (argc == 5) {
14566 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14567 return JIM_ERR;
14569 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14570 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14572 else {
14573 if (argv[2]->typePtr == &sourceObjType) {
14574 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14575 line = argv[2]->internalRep.sourceValue.lineNumber;
14577 else if (argv[2]->typePtr == &scriptObjType) {
14578 ScriptObj *script = JimGetScript(interp, argv[2]);
14579 fileNameObj = script->fileNameObj;
14580 line = script->firstline;
14582 else {
14583 fileNameObj = interp->emptyObj;
14584 line = 1;
14586 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14587 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14588 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14590 Jim_SetResult(interp, resObjPtr);
14591 break;
14594 case INFO_STACKTRACE:
14595 Jim_SetResult(interp, interp->stackTrace);
14596 break;
14598 case INFO_LEVEL:
14599 case INFO_FRAME:
14600 switch (argc) {
14601 case 2:
14602 Jim_SetResultInt(interp, interp->framePtr->level);
14603 break;
14605 case 3:
14606 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14607 return JIM_ERR;
14609 Jim_SetResult(interp, objPtr);
14610 break;
14612 default:
14613 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14614 return JIM_ERR;
14616 break;
14618 case INFO_BODY:
14619 case INFO_STATICS:
14620 case INFO_ARGS:{
14621 Jim_Cmd *cmdPtr;
14623 if (argc != 3) {
14624 Jim_WrongNumArgs(interp, 2, argv, "procname");
14625 return JIM_ERR;
14627 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14628 return JIM_ERR;
14630 if (!cmdPtr->isproc) {
14631 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14632 return JIM_ERR;
14634 switch (cmd) {
14635 case INFO_BODY:
14636 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14637 break;
14638 case INFO_ARGS:
14639 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14640 break;
14641 case INFO_STATICS:
14642 if (cmdPtr->u.proc.staticVars) {
14643 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14644 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14646 break;
14648 break;
14651 case INFO_VERSION:
14652 case INFO_PATCHLEVEL:{
14653 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14655 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14656 Jim_SetResultString(interp, buf, -1);
14657 break;
14660 case INFO_COMPLETE:
14661 if (argc != 3 && argc != 4) {
14662 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14663 return JIM_ERR;
14665 else {
14666 char missing;
14668 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14669 if (missing != ' ' && argc == 4) {
14670 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14673 break;
14675 case INFO_HOSTNAME:
14676 /* Redirect to os.gethostname if it exists */
14677 return Jim_Eval(interp, "os.gethostname");
14679 case INFO_NAMEOFEXECUTABLE:
14680 /* Redirect to Tcl proc */
14681 return Jim_Eval(interp, "{info nameofexecutable}");
14683 case INFO_RETURNCODES:
14684 if (argc == 2) {
14685 int i;
14686 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14688 for (i = 0; jimReturnCodes[i]; i++) {
14689 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14690 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14691 jimReturnCodes[i], -1));
14694 Jim_SetResult(interp, listObjPtr);
14696 else if (argc == 3) {
14697 long code;
14698 const char *name;
14700 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14701 return JIM_ERR;
14703 name = Jim_ReturnCode(code);
14704 if (*name == '?') {
14705 Jim_SetResultInt(interp, code);
14707 else {
14708 Jim_SetResultString(interp, name, -1);
14711 else {
14712 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14713 return JIM_ERR;
14715 break;
14716 case INFO_REFERENCES:
14717 #ifdef JIM_REFERENCES
14718 return JimInfoReferences(interp, argc, argv);
14719 #else
14720 Jim_SetResultString(interp, "not supported", -1);
14721 return JIM_ERR;
14722 #endif
14724 return JIM_OK;
14727 /* [exists] */
14728 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14730 Jim_Obj *objPtr;
14731 int result = 0;
14733 static const char * const options[] = {
14734 "-command", "-proc", "-alias", "-var", NULL
14736 enum
14738 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14740 int option;
14742 if (argc == 2) {
14743 option = OPT_VAR;
14744 objPtr = argv[1];
14746 else if (argc == 3) {
14747 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14748 return JIM_ERR;
14750 objPtr = argv[2];
14752 else {
14753 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14754 return JIM_ERR;
14757 if (option == OPT_VAR) {
14758 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14760 else {
14761 /* Now different kinds of commands */
14762 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14764 if (cmd) {
14765 switch (option) {
14766 case OPT_COMMAND:
14767 result = 1;
14768 break;
14770 case OPT_ALIAS:
14771 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14772 break;
14774 case OPT_PROC:
14775 result = cmd->isproc;
14776 break;
14780 Jim_SetResultBool(interp, result);
14781 return JIM_OK;
14784 /* [split] */
14785 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14787 const char *str, *splitChars, *noMatchStart;
14788 int splitLen, strLen;
14789 Jim_Obj *resObjPtr;
14790 int c;
14791 int len;
14793 if (argc != 2 && argc != 3) {
14794 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14795 return JIM_ERR;
14798 str = Jim_GetString(argv[1], &len);
14799 if (len == 0) {
14800 return JIM_OK;
14802 strLen = Jim_Utf8Length(interp, argv[1]);
14804 /* Init */
14805 if (argc == 2) {
14806 splitChars = " \n\t\r";
14807 splitLen = 4;
14809 else {
14810 splitChars = Jim_String(argv[2]);
14811 splitLen = Jim_Utf8Length(interp, argv[2]);
14814 noMatchStart = str;
14815 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14817 /* Split */
14818 if (splitLen) {
14819 Jim_Obj *objPtr;
14820 while (strLen--) {
14821 const char *sc = splitChars;
14822 int scLen = splitLen;
14823 int sl = utf8_tounicode(str, &c);
14824 while (scLen--) {
14825 int pc;
14826 sc += utf8_tounicode(sc, &pc);
14827 if (c == pc) {
14828 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14829 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14830 noMatchStart = str + sl;
14831 break;
14834 str += sl;
14836 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14837 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14839 else {
14840 /* This handles the special case of splitchars eq {}
14841 * Optimise by sharing common (ASCII) characters
14843 Jim_Obj **commonObj = NULL;
14844 #define NUM_COMMON (128 - 9)
14845 while (strLen--) {
14846 int n = utf8_tounicode(str, &c);
14847 #ifdef JIM_OPTIMIZATION
14848 if (c >= 9 && c < 128) {
14849 /* Common ASCII char. Note that 9 is the tab character */
14850 c -= 9;
14851 if (!commonObj) {
14852 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14853 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14855 if (!commonObj[c]) {
14856 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14858 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14859 str++;
14860 continue;
14862 #endif
14863 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14864 str += n;
14866 Jim_Free(commonObj);
14869 Jim_SetResult(interp, resObjPtr);
14870 return JIM_OK;
14873 /* [join] */
14874 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14876 const char *joinStr;
14877 int joinStrLen;
14879 if (argc != 2 && argc != 3) {
14880 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14881 return JIM_ERR;
14883 /* Init */
14884 if (argc == 2) {
14885 joinStr = " ";
14886 joinStrLen = 1;
14888 else {
14889 joinStr = Jim_GetString(argv[2], &joinStrLen);
14891 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14892 return JIM_OK;
14895 /* [format] */
14896 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14898 Jim_Obj *objPtr;
14900 if (argc < 2) {
14901 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14902 return JIM_ERR;
14904 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14905 if (objPtr == NULL)
14906 return JIM_ERR;
14907 Jim_SetResult(interp, objPtr);
14908 return JIM_OK;
14911 /* [scan] */
14912 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14914 Jim_Obj *listPtr, **outVec;
14915 int outc, i;
14917 if (argc < 3) {
14918 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14919 return JIM_ERR;
14921 if (argv[2]->typePtr != &scanFmtStringObjType)
14922 SetScanFmtFromAny(interp, argv[2]);
14923 if (FormatGetError(argv[2]) != 0) {
14924 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14925 return JIM_ERR;
14927 if (argc > 3) {
14928 int maxPos = FormatGetMaxPos(argv[2]);
14929 int count = FormatGetCnvCount(argv[2]);
14931 if (maxPos > argc - 3) {
14932 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14933 return JIM_ERR;
14935 else if (count > argc - 3) {
14936 Jim_SetResultString(interp, "different numbers of variable names and "
14937 "field specifiers", -1);
14938 return JIM_ERR;
14940 else if (count < argc - 3) {
14941 Jim_SetResultString(interp, "variable is not assigned by any "
14942 "conversion specifiers", -1);
14943 return JIM_ERR;
14946 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14947 if (listPtr == 0)
14948 return JIM_ERR;
14949 if (argc > 3) {
14950 int rc = JIM_OK;
14951 int count = 0;
14953 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14954 int len = Jim_ListLength(interp, listPtr);
14956 if (len != 0) {
14957 JimListGetElements(interp, listPtr, &outc, &outVec);
14958 for (i = 0; i < outc; ++i) {
14959 if (Jim_Length(outVec[i]) > 0) {
14960 ++count;
14961 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14962 rc = JIM_ERR;
14967 Jim_FreeNewObj(interp, listPtr);
14969 else {
14970 count = -1;
14972 if (rc == JIM_OK) {
14973 Jim_SetResultInt(interp, count);
14975 return rc;
14977 else {
14978 if (listPtr == (Jim_Obj *)EOF) {
14979 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14980 return JIM_OK;
14982 Jim_SetResult(interp, listPtr);
14984 return JIM_OK;
14987 /* [error] */
14988 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14990 if (argc != 2 && argc != 3) {
14991 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14992 return JIM_ERR;
14994 Jim_SetResult(interp, argv[1]);
14995 if (argc == 3) {
14996 JimSetStackTrace(interp, argv[2]);
14997 return JIM_ERR;
14999 interp->addStackTrace++;
15000 return JIM_ERR;
15003 /* [lrange] */
15004 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15006 Jim_Obj *objPtr;
15008 if (argc != 4) {
15009 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15010 return JIM_ERR;
15012 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15013 return JIM_ERR;
15014 Jim_SetResult(interp, objPtr);
15015 return JIM_OK;
15018 /* [lrepeat] */
15019 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15021 Jim_Obj *objPtr;
15022 long count;
15024 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15025 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15026 return JIM_ERR;
15029 if (count == 0 || argc == 2) {
15030 return JIM_OK;
15033 argc -= 2;
15034 argv += 2;
15036 objPtr = Jim_NewListObj(interp, argv, argc);
15037 while (--count) {
15038 ListInsertElements(objPtr, -1, argc, argv);
15041 Jim_SetResult(interp, objPtr);
15042 return JIM_OK;
15045 char **Jim_GetEnviron(void)
15047 #if defined(HAVE__NSGETENVIRON)
15048 return *_NSGetEnviron();
15049 #else
15050 #if !defined(NO_ENVIRON_EXTERN)
15051 extern char **environ;
15052 #endif
15054 return environ;
15055 #endif
15058 void Jim_SetEnviron(char **env)
15060 #if defined(HAVE__NSGETENVIRON)
15061 *_NSGetEnviron() = env;
15062 #else
15063 #if !defined(NO_ENVIRON_EXTERN)
15064 extern char **environ;
15065 #endif
15067 environ = env;
15068 #endif
15071 /* [env] */
15072 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15074 const char *key;
15075 const char *val;
15077 if (argc == 1) {
15078 char **e = Jim_GetEnviron();
15080 int i;
15081 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15083 for (i = 0; e[i]; i++) {
15084 const char *equals = strchr(e[i], '=');
15086 if (equals) {
15087 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15088 equals - e[i]));
15089 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15093 Jim_SetResult(interp, listObjPtr);
15094 return JIM_OK;
15097 if (argc < 2) {
15098 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15099 return JIM_ERR;
15101 key = Jim_String(argv[1]);
15102 val = getenv(key);
15103 if (val == NULL) {
15104 if (argc < 3) {
15105 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15106 return JIM_ERR;
15108 val = Jim_String(argv[2]);
15110 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15111 return JIM_OK;
15114 /* [source] */
15115 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15117 int retval;
15119 if (argc != 2) {
15120 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15121 return JIM_ERR;
15123 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15124 if (retval == JIM_RETURN)
15125 return JIM_OK;
15126 return retval;
15129 /* [lreverse] */
15130 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15132 Jim_Obj *revObjPtr, **ele;
15133 int len;
15135 if (argc != 2) {
15136 Jim_WrongNumArgs(interp, 1, argv, "list");
15137 return JIM_ERR;
15139 JimListGetElements(interp, argv[1], &len, &ele);
15140 len--;
15141 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15142 while (len >= 0)
15143 ListAppendElement(revObjPtr, ele[len--]);
15144 Jim_SetResult(interp, revObjPtr);
15145 return JIM_OK;
15148 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15150 jim_wide len;
15152 if (step == 0)
15153 return -1;
15154 if (start == end)
15155 return 0;
15156 else if (step > 0 && start > end)
15157 return -1;
15158 else if (step < 0 && end > start)
15159 return -1;
15160 len = end - start;
15161 if (len < 0)
15162 len = -len; /* abs(len) */
15163 if (step < 0)
15164 step = -step; /* abs(step) */
15165 len = 1 + ((len - 1) / step);
15166 /* We can truncate safely to INT_MAX, the range command
15167 * will always return an error for a such long range
15168 * because Tcl lists can't be so long. */
15169 if (len > INT_MAX)
15170 len = INT_MAX;
15171 return (int)((len < 0) ? -1 : len);
15174 /* [range] */
15175 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15177 jim_wide start = 0, end, step = 1;
15178 int len, i;
15179 Jim_Obj *objPtr;
15181 if (argc < 2 || argc > 4) {
15182 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15183 return JIM_ERR;
15185 if (argc == 2) {
15186 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15187 return JIM_ERR;
15189 else {
15190 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15191 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15192 return JIM_ERR;
15193 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15194 return JIM_ERR;
15196 if ((len = JimRangeLen(start, end, step)) == -1) {
15197 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15198 return JIM_ERR;
15200 objPtr = Jim_NewListObj(interp, NULL, 0);
15201 for (i = 0; i < len; i++)
15202 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15203 Jim_SetResult(interp, objPtr);
15204 return JIM_OK;
15207 /* [rand] */
15208 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15210 jim_wide min = 0, max = 0, len, maxMul;
15212 if (argc < 1 || argc > 3) {
15213 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15214 return JIM_ERR;
15216 if (argc == 1) {
15217 max = JIM_WIDE_MAX;
15218 } else if (argc == 2) {
15219 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15220 return JIM_ERR;
15221 } else if (argc == 3) {
15222 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15223 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15224 return JIM_ERR;
15226 len = max-min;
15227 if (len < 0) {
15228 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15229 return JIM_ERR;
15231 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15232 while (1) {
15233 jim_wide r;
15235 JimRandomBytes(interp, &r, sizeof(jim_wide));
15236 if (r < 0 || r >= maxMul) continue;
15237 r = (len == 0) ? 0 : r%len;
15238 Jim_SetResultInt(interp, min+r);
15239 return JIM_OK;
15243 static const struct {
15244 const char *name;
15245 Jim_CmdProc *cmdProc;
15246 } Jim_CoreCommandsTable[] = {
15247 {"alias", Jim_AliasCoreCommand},
15248 {"set", Jim_SetCoreCommand},
15249 {"unset", Jim_UnsetCoreCommand},
15250 {"puts", Jim_PutsCoreCommand},
15251 {"+", Jim_AddCoreCommand},
15252 {"*", Jim_MulCoreCommand},
15253 {"-", Jim_SubCoreCommand},
15254 {"/", Jim_DivCoreCommand},
15255 {"incr", Jim_IncrCoreCommand},
15256 {"while", Jim_WhileCoreCommand},
15257 {"loop", Jim_LoopCoreCommand},
15258 {"for", Jim_ForCoreCommand},
15259 {"foreach", Jim_ForeachCoreCommand},
15260 {"lmap", Jim_LmapCoreCommand},
15261 {"lassign", Jim_LassignCoreCommand},
15262 {"if", Jim_IfCoreCommand},
15263 {"switch", Jim_SwitchCoreCommand},
15264 {"list", Jim_ListCoreCommand},
15265 {"lindex", Jim_LindexCoreCommand},
15266 {"lset", Jim_LsetCoreCommand},
15267 {"lsearch", Jim_LsearchCoreCommand},
15268 {"llength", Jim_LlengthCoreCommand},
15269 {"lappend", Jim_LappendCoreCommand},
15270 {"linsert", Jim_LinsertCoreCommand},
15271 {"lreplace", Jim_LreplaceCoreCommand},
15272 {"lsort", Jim_LsortCoreCommand},
15273 {"append", Jim_AppendCoreCommand},
15274 {"debug", Jim_DebugCoreCommand},
15275 {"eval", Jim_EvalCoreCommand},
15276 {"uplevel", Jim_UplevelCoreCommand},
15277 {"expr", Jim_ExprCoreCommand},
15278 {"break", Jim_BreakCoreCommand},
15279 {"continue", Jim_ContinueCoreCommand},
15280 {"proc", Jim_ProcCoreCommand},
15281 {"concat", Jim_ConcatCoreCommand},
15282 {"return", Jim_ReturnCoreCommand},
15283 {"upvar", Jim_UpvarCoreCommand},
15284 {"global", Jim_GlobalCoreCommand},
15285 {"string", Jim_StringCoreCommand},
15286 {"time", Jim_TimeCoreCommand},
15287 {"exit", Jim_ExitCoreCommand},
15288 {"catch", Jim_CatchCoreCommand},
15289 #ifdef JIM_REFERENCES
15290 {"ref", Jim_RefCoreCommand},
15291 {"getref", Jim_GetrefCoreCommand},
15292 {"setref", Jim_SetrefCoreCommand},
15293 {"finalize", Jim_FinalizeCoreCommand},
15294 {"collect", Jim_CollectCoreCommand},
15295 #endif
15296 {"rename", Jim_RenameCoreCommand},
15297 {"dict", Jim_DictCoreCommand},
15298 {"subst", Jim_SubstCoreCommand},
15299 {"info", Jim_InfoCoreCommand},
15300 {"exists", Jim_ExistsCoreCommand},
15301 {"split", Jim_SplitCoreCommand},
15302 {"join", Jim_JoinCoreCommand},
15303 {"format", Jim_FormatCoreCommand},
15304 {"scan", Jim_ScanCoreCommand},
15305 {"error", Jim_ErrorCoreCommand},
15306 {"lrange", Jim_LrangeCoreCommand},
15307 {"lrepeat", Jim_LrepeatCoreCommand},
15308 {"env", Jim_EnvCoreCommand},
15309 {"source", Jim_SourceCoreCommand},
15310 {"lreverse", Jim_LreverseCoreCommand},
15311 {"range", Jim_RangeCoreCommand},
15312 {"rand", Jim_RandCoreCommand},
15313 {"tailcall", Jim_TailcallCoreCommand},
15314 {"local", Jim_LocalCoreCommand},
15315 {"upcall", Jim_UpcallCoreCommand},
15316 {"apply", Jim_ApplyCoreCommand},
15317 {NULL, NULL},
15320 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15322 int i = 0;
15324 while (Jim_CoreCommandsTable[i].name != NULL) {
15325 Jim_CreateCommand(interp,
15326 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15327 i++;
15331 /* -----------------------------------------------------------------------------
15332 * Interactive prompt
15333 * ---------------------------------------------------------------------------*/
15334 void Jim_MakeErrorMessage(Jim_Interp *interp)
15336 Jim_Obj *argv[2];
15338 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15339 argv[1] = interp->result;
15341 Jim_EvalObjVector(interp, 2, argv);
15345 * Given a null terminated array of strings, returns an allocated, sorted
15346 * copy of the array.
15348 static char **JimSortStringTable(const char *const *tablePtr)
15350 int count;
15351 char **tablePtrSorted;
15353 /* Find the size of the table */
15354 for (count = 0; tablePtr[count]; count++) {
15357 /* Allocate one extra for the terminating NULL pointer */
15358 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15359 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15360 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15361 tablePtrSorted[count] = NULL;
15363 return tablePtrSorted;
15366 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15367 const char *prefix, const char *const *tablePtr, const char *name)
15369 char **tablePtrSorted;
15370 int i;
15372 if (name == NULL) {
15373 name = "option";
15376 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15377 tablePtrSorted = JimSortStringTable(tablePtr);
15378 for (i = 0; tablePtrSorted[i]; i++) {
15379 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15380 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15382 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15383 if (tablePtrSorted[i + 1]) {
15384 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15387 Jim_Free(tablePtrSorted);
15392 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15393 * and returns JIM_OK.
15395 * Otherwise returns JIM_ERR.
15397 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15399 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15400 int i;
15401 char **tablePtrSorted = JimSortStringTable(tablePtr);
15402 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15403 for (i = 0; tablePtrSorted[i]; i++) {
15404 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15406 Jim_Free(tablePtrSorted);
15407 return JIM_OK;
15409 return JIM_ERR;
15412 /* internal rep is stored in ptrIntvalue
15413 * ptr = tablePtr
15414 * int1 = flags
15415 * int2 = index
15417 static const Jim_ObjType getEnumObjType = {
15418 "get-enum",
15419 NULL,
15420 NULL,
15421 NULL,
15422 JIM_TYPE_REFERENCES
15425 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15426 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15428 const char *bad = "bad ";
15429 const char *const *entryPtr = NULL;
15430 int i;
15431 int match = -1;
15432 int arglen;
15433 const char *arg;
15435 if (objPtr->typePtr == &getEnumObjType) {
15436 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15437 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15438 return JIM_OK;
15442 arg = Jim_GetString(objPtr, &arglen);
15444 *indexPtr = -1;
15446 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15447 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15448 /* Found an exact match */
15449 match = i;
15450 goto found;
15452 if (flags & JIM_ENUM_ABBREV) {
15453 /* Accept an unambiguous abbreviation.
15454 * Note that '-' doesnt' consitute a valid abbreviation
15456 if (strncmp(arg, *entryPtr, arglen) == 0) {
15457 if (*arg == '-' && arglen == 1) {
15458 break;
15460 if (match >= 0) {
15461 bad = "ambiguous ";
15462 goto ambiguous;
15464 match = i;
15469 /* If we had an unambiguous partial match */
15470 if (match >= 0) {
15471 found:
15472 /* Record the match in the object */
15473 Jim_FreeIntRep(interp, objPtr);
15474 objPtr->typePtr = &getEnumObjType;
15475 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15476 objPtr->internalRep.ptrIntValue.int1 = flags;
15477 objPtr->internalRep.ptrIntValue.int2 = match;
15478 /* Return the result */
15479 *indexPtr = match;
15480 return JIM_OK;
15483 ambiguous:
15484 if (flags & JIM_ERRMSG) {
15485 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15487 return JIM_ERR;
15490 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15492 int i;
15494 for (i = 0; i < (int)len; i++) {
15495 if (array[i] && strcmp(array[i], name) == 0) {
15496 return i;
15499 return -1;
15502 int Jim_IsDict(Jim_Obj *objPtr)
15504 return objPtr->typePtr == &dictObjType;
15507 int Jim_IsList(Jim_Obj *objPtr)
15509 return objPtr->typePtr == &listObjType;
15513 * Very simple printf-like formatting, designed for error messages.
15515 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15516 * The resulting string is created and set as the result.
15518 * Each '%s' should correspond to a regular string parameter.
15519 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15520 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15522 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15524 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15526 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15528 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15530 /* Initial space needed */
15531 int len = strlen(format);
15532 int extra = 0;
15533 int n = 0;
15534 const char *params[5];
15535 int nobjparam = 0;
15536 Jim_Obj *objparam[5];
15537 char *buf;
15538 va_list args;
15539 int i;
15541 va_start(args, format);
15543 for (i = 0; i < len && n < 5; i++) {
15544 int l;
15546 if (strncmp(format + i, "%s", 2) == 0) {
15547 params[n] = va_arg(args, char *);
15549 l = strlen(params[n]);
15551 else if (strncmp(format + i, "%#s", 3) == 0) {
15552 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15554 params[n] = Jim_GetString(objPtr, &l);
15555 objparam[nobjparam++] = objPtr;
15556 Jim_IncrRefCount(objPtr);
15558 else {
15559 if (format[i] == '%') {
15560 i++;
15562 continue;
15564 n++;
15565 extra += l;
15568 len += extra;
15569 buf = Jim_Alloc(len + 1);
15570 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15572 va_end(args);
15574 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15576 for (i = 0; i < nobjparam; i++) {
15577 Jim_DecrRefCount(interp, objparam[i]);
15581 /* stubs */
15582 #ifndef jim_ext_package
15583 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15585 return JIM_OK;
15587 #endif
15588 #ifndef jim_ext_aio
15589 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15591 Jim_SetResultString(interp, "aio not enabled", -1);
15592 return NULL;
15594 #endif
15598 * Local Variables: ***
15599 * c-basic-offset: 4 ***
15600 * tab-width: 4 ***
15601 * End: ***