perf: cache successful Jim_GetEnum() results
[jimtcl.git] / jim.c
blob4a7d2de4429c8f6eb9ece9d59a1c9273e6d83aa4
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 += utf8_tounicode(pattern, &pchar);
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 '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. */
374 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
376 int i;
377 int l1bytelen;
379 if (!l1 || !l2 || l1 > l2) {
380 return -1;
382 if (idx < 0)
383 idx = 0;
384 s2 += utf8_index(s2, idx);
386 l1bytelen = utf8_index(s1, l1);
388 for (i = idx; i <= l2 - l1; i++) {
389 int c;
390 if (memcmp(s2, s1, l1bytelen) == 0) {
391 return i;
393 s2 += utf8_tounicode(s2, &c);
395 return -1;
399 * Note: Lengths and return value are in bytes, not chars.
401 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
403 const char *p;
405 if (!l1 || !l2 || l1 > l2)
406 return -1;
408 /* Now search for the needle */
409 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
410 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
411 return p - s2;
414 return -1;
417 #ifdef JIM_UTF8
419 * Note: Lengths and return value are in chars.
421 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
423 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
424 if (n > 0) {
425 n = utf8_strlen(s2, n);
427 return n;
429 #endif
432 * After an strtol()/strtod()-like conversion,
433 * check whether something was converted and that
434 * the only thing left is white space.
436 * Returns JIM_OK or JIM_ERR.
438 static int JimCheckConversion(const char *str, const char *endptr)
440 if (str[0] == '\0' || str == endptr) {
441 return JIM_ERR;
444 if (endptr[0] != '\0') {
445 while (*endptr) {
446 if (!isspace(UCHAR(*endptr))) {
447 return JIM_ERR;
449 endptr++;
452 return JIM_OK;
455 /* Parses the front of a number to determine it's sign and base
456 * Returns the index to start parsing according to the given base
458 static int JimNumberBase(const char *str, int *base, int *sign)
460 int i = 0;
462 *base = 10;
464 while (isspace(UCHAR(str[i]))) {
465 i++;
468 if (str[i] == '-') {
469 *sign = -1;
470 i++;
472 else {
473 if (str[i] == '+') {
474 i++;
476 *sign = 1;
479 if (str[i] != '0') {
480 /* base 10 */
481 return 0;
484 /* We have 0<x>, so see if we can convert it */
485 switch (str[i + 1]) {
486 case 'x': case 'X': *base = 16; break;
487 case 'o': case 'O': *base = 8; break;
488 case 'b': case 'B': *base = 2; break;
489 default: return 0;
491 i += 2;
492 /* Ensure that (e.g.) 0x-5 fails to parse */
493 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
494 /* Parse according to this base */
495 return i;
497 /* Parse as base 10 */
498 *base = 10;
499 return 0;
502 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
503 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
505 static long jim_strtol(const char *str, char **endptr)
507 int sign;
508 int base;
509 int i = JimNumberBase(str, &base, &sign);
511 if (base != 10) {
512 long value = strtol(str + i, endptr, base);
513 if (endptr == NULL || *endptr != str + i) {
514 return value * sign;
518 /* Can just do a regular base-10 conversion */
519 return strtol(str, endptr, 10);
523 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
524 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
526 static jim_wide jim_strtoull(const char *str, char **endptr)
528 #ifdef HAVE_LONG_LONG
529 int sign;
530 int base;
531 int i = JimNumberBase(str, &base, &sign);
533 if (base != 10) {
534 jim_wide value = strtoull(str + i, endptr, base);
535 if (endptr == NULL || *endptr != str + i) {
536 return value * sign;
540 /* Can just do a regular base-10 conversion */
541 return strtoull(str, endptr, 10);
542 #else
543 return (unsigned long)jim_strtol(str, endptr);
544 #endif
547 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
549 char *endptr;
551 if (base) {
552 *widePtr = strtoull(str, &endptr, base);
554 else {
555 *widePtr = jim_strtoull(str, &endptr);
558 return JimCheckConversion(str, endptr);
561 int Jim_StringToDouble(const char *str, double *doublePtr)
563 char *endptr;
565 /* Callers can check for underflow via ERANGE */
566 errno = 0;
568 *doublePtr = strtod(str, &endptr);
570 return JimCheckConversion(str, endptr);
573 static jim_wide JimPowWide(jim_wide b, jim_wide e)
575 jim_wide res = 1;
577 /* Special cases */
578 if (b == 1) {
579 /* 1 ^ any = 1 */
580 return 1;
582 if (e < 0) {
583 if (b != -1) {
584 return 0;
586 /* Only special case is -1 ^ -n
587 * -1^-1 = -1
588 * -1^-2 = 1
589 * i.e. same as +ve n
591 e = -e;
593 while (e)
595 if (e & 1) {
596 res *= b;
598 e >>= 1;
599 b *= b;
601 return res;
604 /* -----------------------------------------------------------------------------
605 * Special functions
606 * ---------------------------------------------------------------------------*/
607 #ifdef JIM_DEBUG_PANIC
608 static void JimPanicDump(int condition, const char *fmt, ...)
610 va_list ap;
612 if (!condition) {
613 return;
616 va_start(ap, fmt);
618 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
619 vfprintf(stderr, fmt, ap);
620 fprintf(stderr, "\n\n");
621 va_end(ap);
623 #ifdef HAVE_BACKTRACE
625 void *array[40];
626 int size, i;
627 char **strings;
629 size = backtrace(array, 40);
630 strings = backtrace_symbols(array, size);
631 for (i = 0; i < size; i++)
632 fprintf(stderr, "[backtrace] %s\n", strings[i]);
633 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
634 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
636 #endif
638 exit(1);
640 #endif
642 /* -----------------------------------------------------------------------------
643 * Memory allocation
644 * ---------------------------------------------------------------------------*/
646 void *Jim_Alloc(int size)
648 return size ? malloc(size) : NULL;
651 void Jim_Free(void *ptr)
653 free(ptr);
656 void *Jim_Realloc(void *ptr, int size)
658 return realloc(ptr, size);
661 char *Jim_StrDup(const char *s)
663 return strdup(s);
666 char *Jim_StrDupLen(const char *s, int l)
668 char *copy = Jim_Alloc(l + 1);
670 memcpy(copy, s, l + 1);
671 copy[l] = 0; /* Just to be sure, original could be substring */
672 return copy;
675 /* -----------------------------------------------------------------------------
676 * Time related functions
677 * ---------------------------------------------------------------------------*/
679 /* Returns current time in microseconds */
680 static jim_wide JimClock(void)
682 struct timeval tv;
684 gettimeofday(&tv, NULL);
685 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
688 /* -----------------------------------------------------------------------------
689 * Hash Tables
690 * ---------------------------------------------------------------------------*/
692 /* -------------------------- private prototypes ---------------------------- */
693 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
694 static unsigned int JimHashTableNextPower(unsigned int size);
695 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
697 /* -------------------------- hash functions -------------------------------- */
699 /* Thomas Wang's 32 bit Mix Function */
700 unsigned int Jim_IntHashFunction(unsigned int key)
702 key += ~(key << 15);
703 key ^= (key >> 10);
704 key += (key << 3);
705 key ^= (key >> 6);
706 key += ~(key << 11);
707 key ^= (key >> 16);
708 return key;
711 /* Generic hash function (we are using to multiply by 9 and add the byte
712 * as Tcl) */
713 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
715 unsigned int h = 0;
717 while (len--)
718 h += (h << 3) + *buf++;
719 return h;
722 /* ----------------------------- API implementation ------------------------- */
724 /* reset a hashtable already initialized */
725 static void JimResetHashTable(Jim_HashTable *ht)
727 ht->table = NULL;
728 ht->size = 0;
729 ht->sizemask = 0;
730 ht->used = 0;
731 ht->collisions = 0;
732 #ifdef JIM_RANDOMISE_HASH
733 /* This is initialised to a random value to avoid a hash collision attack.
734 * See: n.runs-SA-2011.004
736 ht->uniq = (rand() ^ time(NULL) ^ clock());
737 #else
738 ht->uniq = 0;
739 #endif
742 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
744 iter->ht = ht;
745 iter->index = -1;
746 iter->entry = NULL;
747 iter->nextEntry = NULL;
750 /* Initialize the hash table */
751 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
753 JimResetHashTable(ht);
754 ht->type = type;
755 ht->privdata = privDataPtr;
756 return JIM_OK;
759 /* Resize the table to the minimal size that contains all the elements,
760 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
761 void Jim_ResizeHashTable(Jim_HashTable *ht)
763 int minimal = ht->used;
765 if (minimal < JIM_HT_INITIAL_SIZE)
766 minimal = JIM_HT_INITIAL_SIZE;
767 Jim_ExpandHashTable(ht, minimal);
770 /* Expand or create the hashtable */
771 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
773 Jim_HashTable n; /* the new hashtable */
774 unsigned int realsize = JimHashTableNextPower(size), i;
776 /* the size is invalid if it is smaller than the number of
777 * elements already inside the hashtable */
778 if (size <= ht->used)
779 return;
781 Jim_InitHashTable(&n, ht->type, ht->privdata);
782 n.size = realsize;
783 n.sizemask = realsize - 1;
784 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
785 /* Keep the same 'uniq' as the original */
786 n.uniq = ht->uniq;
788 /* Initialize all the pointers to NULL */
789 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
791 /* Copy all the elements from the old to the new table:
792 * note that if the old hash table is empty ht->used is zero,
793 * so Jim_ExpandHashTable just creates an empty hash table. */
794 n.used = ht->used;
795 for (i = 0; ht->used > 0; i++) {
796 Jim_HashEntry *he, *nextHe;
798 if (ht->table[i] == NULL)
799 continue;
801 /* For each hash entry on this slot... */
802 he = ht->table[i];
803 while (he) {
804 unsigned int h;
806 nextHe = he->next;
807 /* Get the new element index */
808 h = Jim_HashKey(ht, he->key) & n.sizemask;
809 he->next = n.table[h];
810 n.table[h] = he;
811 ht->used--;
812 /* Pass to the next element */
813 he = nextHe;
816 assert(ht->used == 0);
817 Jim_Free(ht->table);
819 /* Remap the new hashtable in the old */
820 *ht = n;
823 /* Add an element to the target hash table */
824 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
826 Jim_HashEntry *entry;
828 /* Get the index of the new element, or -1 if
829 * the element already exists. */
830 entry = JimInsertHashEntry(ht, key, 0);
831 if (entry == NULL)
832 return JIM_ERR;
834 /* Set the hash entry fields. */
835 Jim_SetHashKey(ht, entry, key);
836 Jim_SetHashVal(ht, entry, val);
837 return JIM_OK;
840 /* Add an element, discarding the old if the key already exists */
841 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
843 int existed;
844 Jim_HashEntry *entry;
846 /* Get the index of the new element, or -1 if
847 * the element already exists. */
848 entry = JimInsertHashEntry(ht, key, 1);
849 if (entry->key) {
850 /* It already exists, so only replace the value.
851 * Note if both a destructor and a duplicate function exist,
852 * need to dup before destroy. perhaps they are the same
853 * reference counted object
855 if (ht->type->valDestructor && ht->type->valDup) {
856 void *newval = ht->type->valDup(ht->privdata, val);
857 ht->type->valDestructor(ht->privdata, entry->u.val);
858 entry->u.val = newval;
860 else {
861 Jim_FreeEntryVal(ht, entry);
862 Jim_SetHashVal(ht, entry, val);
864 existed = 1;
866 else {
867 /* Doesn't exist, so set the key */
868 Jim_SetHashKey(ht, entry, key);
869 Jim_SetHashVal(ht, entry, val);
870 existed = 0;
873 return existed;
876 /* Search and remove an element */
877 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
879 unsigned int h;
880 Jim_HashEntry *he, *prevHe;
882 if (ht->used == 0)
883 return JIM_ERR;
884 h = Jim_HashKey(ht, key) & ht->sizemask;
885 he = ht->table[h];
887 prevHe = NULL;
888 while (he) {
889 if (Jim_CompareHashKeys(ht, key, he->key)) {
890 /* Unlink the element from the list */
891 if (prevHe)
892 prevHe->next = he->next;
893 else
894 ht->table[h] = he->next;
895 Jim_FreeEntryKey(ht, he);
896 Jim_FreeEntryVal(ht, he);
897 Jim_Free(he);
898 ht->used--;
899 return JIM_OK;
901 prevHe = he;
902 he = he->next;
904 return JIM_ERR; /* not found */
907 /* Destroy an entire hash table and leave it ready for reuse */
908 int Jim_FreeHashTable(Jim_HashTable *ht)
910 unsigned int i;
912 /* Free all the elements */
913 for (i = 0; ht->used > 0; i++) {
914 Jim_HashEntry *he, *nextHe;
916 if ((he = ht->table[i]) == NULL)
917 continue;
918 while (he) {
919 nextHe = he->next;
920 Jim_FreeEntryKey(ht, he);
921 Jim_FreeEntryVal(ht, he);
922 Jim_Free(he);
923 ht->used--;
924 he = nextHe;
927 /* Free the table and the allocated cache structure */
928 Jim_Free(ht->table);
929 /* Re-initialize the table */
930 JimResetHashTable(ht);
931 return JIM_OK; /* never fails */
934 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
936 Jim_HashEntry *he;
937 unsigned int h;
939 if (ht->used == 0)
940 return NULL;
941 h = Jim_HashKey(ht, key) & ht->sizemask;
942 he = ht->table[h];
943 while (he) {
944 if (Jim_CompareHashKeys(ht, key, he->key))
945 return he;
946 he = he->next;
948 return NULL;
951 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
953 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
954 JimInitHashTableIterator(ht, iter);
955 return iter;
958 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
960 while (1) {
961 if (iter->entry == NULL) {
962 iter->index++;
963 if (iter->index >= (signed)iter->ht->size)
964 break;
965 iter->entry = iter->ht->table[iter->index];
967 else {
968 iter->entry = iter->nextEntry;
970 if (iter->entry) {
971 /* We need to save the 'next' here, the iterator user
972 * may delete the entry we are returning. */
973 iter->nextEntry = iter->entry->next;
974 return iter->entry;
977 return NULL;
980 /* ------------------------- private functions ------------------------------ */
982 /* Expand the hash table if needed */
983 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
985 /* If the hash table is empty expand it to the intial size,
986 * if the table is "full" dobule its size. */
987 if (ht->size == 0)
988 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
989 if (ht->size == ht->used)
990 Jim_ExpandHashTable(ht, ht->size * 2);
993 /* Our hash table capability is a power of two */
994 static unsigned int JimHashTableNextPower(unsigned int size)
996 unsigned int i = JIM_HT_INITIAL_SIZE;
998 if (size >= 2147483648U)
999 return 2147483648U;
1000 while (1) {
1001 if (i >= size)
1002 return i;
1003 i *= 2;
1007 /* Returns the index of a free slot that can be populated with
1008 * a hash entry for the given 'key'.
1009 * If the key already exists, -1 is returned. */
1010 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1012 unsigned int h;
1013 Jim_HashEntry *he;
1015 /* Expand the hashtable if needed */
1016 JimExpandHashTableIfNeeded(ht);
1018 /* Compute the key hash value */
1019 h = Jim_HashKey(ht, key) & ht->sizemask;
1020 /* Search if this slot does not already contain the given key */
1021 he = ht->table[h];
1022 while (he) {
1023 if (Jim_CompareHashKeys(ht, key, he->key))
1024 return replace ? he : NULL;
1025 he = he->next;
1028 /* Allocates the memory and stores key */
1029 he = Jim_Alloc(sizeof(*he));
1030 he->next = ht->table[h];
1031 ht->table[h] = he;
1032 ht->used++;
1033 he->key = NULL;
1035 return he;
1038 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1040 static unsigned int JimStringCopyHTHashFunction(const void *key)
1042 return Jim_GenHashFunction(key, strlen(key));
1045 static void *JimStringCopyHTDup(void *privdata, const void *key)
1047 return Jim_StrDup(key);
1050 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1052 return strcmp(key1, key2) == 0;
1055 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1057 Jim_Free(key);
1060 static const Jim_HashTableType JimPackageHashTableType = {
1061 JimStringCopyHTHashFunction, /* hash function */
1062 JimStringCopyHTDup, /* key dup */
1063 NULL, /* val dup */
1064 JimStringCopyHTKeyCompare, /* key compare */
1065 JimStringCopyHTKeyDestructor, /* key destructor */
1066 NULL /* val destructor */
1069 typedef struct AssocDataValue
1071 Jim_InterpDeleteProc *delProc;
1072 void *data;
1073 } AssocDataValue;
1075 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1077 AssocDataValue *assocPtr = (AssocDataValue *) data;
1079 if (assocPtr->delProc != NULL)
1080 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1081 Jim_Free(data);
1084 static const Jim_HashTableType JimAssocDataHashTableType = {
1085 JimStringCopyHTHashFunction, /* hash function */
1086 JimStringCopyHTDup, /* key dup */
1087 NULL, /* val dup */
1088 JimStringCopyHTKeyCompare, /* key compare */
1089 JimStringCopyHTKeyDestructor, /* key destructor */
1090 JimAssocDataHashTableValueDestructor /* val destructor */
1093 /* -----------------------------------------------------------------------------
1094 * Stack - This is a simple generic stack implementation. It is used for
1095 * example in the 'expr' expression compiler.
1096 * ---------------------------------------------------------------------------*/
1097 void Jim_InitStack(Jim_Stack *stack)
1099 stack->len = 0;
1100 stack->maxlen = 0;
1101 stack->vector = NULL;
1104 void Jim_FreeStack(Jim_Stack *stack)
1106 Jim_Free(stack->vector);
1109 int Jim_StackLen(Jim_Stack *stack)
1111 return stack->len;
1114 void Jim_StackPush(Jim_Stack *stack, void *element)
1116 int neededLen = stack->len + 1;
1118 if (neededLen > stack->maxlen) {
1119 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1120 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1122 stack->vector[stack->len] = element;
1123 stack->len++;
1126 void *Jim_StackPop(Jim_Stack *stack)
1128 if (stack->len == 0)
1129 return NULL;
1130 stack->len--;
1131 return stack->vector[stack->len];
1134 void *Jim_StackPeek(Jim_Stack *stack)
1136 if (stack->len == 0)
1137 return NULL;
1138 return stack->vector[stack->len - 1];
1141 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1143 int i;
1145 for (i = 0; i < stack->len; i++)
1146 freeFunc(stack->vector[i]);
1149 /* -----------------------------------------------------------------------------
1150 * Tcl Parser
1151 * ---------------------------------------------------------------------------*/
1153 /* Token types */
1154 #define JIM_TT_NONE 0 /* No token returned */
1155 #define JIM_TT_STR 1 /* simple string */
1156 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1157 #define JIM_TT_VAR 3 /* var substitution */
1158 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1159 #define JIM_TT_CMD 5 /* command substitution */
1160 /* Note: Keep these three together for TOKEN_IS_SEP() */
1161 #define JIM_TT_SEP 6 /* word separator (white space) */
1162 #define JIM_TT_EOL 7 /* line separator */
1163 #define JIM_TT_EOF 8 /* end of script */
1165 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1166 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1168 /* Additional token types needed for expressions */
1169 #define JIM_TT_SUBEXPR_START 11
1170 #define JIM_TT_SUBEXPR_END 12
1171 #define JIM_TT_SUBEXPR_COMMA 13
1172 #define JIM_TT_EXPR_INT 14
1173 #define JIM_TT_EXPR_DOUBLE 15
1174 #define JIM_TT_EXPR_BOOLEAN 16
1176 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1178 /* Operator token types start here */
1179 #define JIM_TT_EXPR_OP 20
1181 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1182 /* Can this token start an expression? */
1183 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1184 /* Is this token an expression operator? */
1185 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1188 * Results of missing quotes, braces, etc. from parsing.
1190 struct JimParseMissing {
1191 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1192 int line; /* Line number starting the missing token */
1195 /* Parser context structure. The same context is used both to parse
1196 * Tcl scripts and lists. */
1197 struct JimParserCtx
1199 const char *p; /* Pointer to the point of the program we are parsing */
1200 int len; /* Remaining length */
1201 int linenr; /* Current line number */
1202 const char *tstart;
1203 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1204 int tline; /* Line number of the returned token */
1205 int tt; /* Token type */
1206 int eof; /* Non zero if EOF condition is true. */
1207 int inquote; /* Parsing a quoted string */
1208 int comment; /* Non zero if the next chars may be a comment. */
1209 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1212 static int JimParseScript(struct JimParserCtx *pc);
1213 static int JimParseSep(struct JimParserCtx *pc);
1214 static int JimParseEol(struct JimParserCtx *pc);
1215 static int JimParseCmd(struct JimParserCtx *pc);
1216 static int JimParseQuote(struct JimParserCtx *pc);
1217 static int JimParseVar(struct JimParserCtx *pc);
1218 static int JimParseBrace(struct JimParserCtx *pc);
1219 static int JimParseStr(struct JimParserCtx *pc);
1220 static int JimParseComment(struct JimParserCtx *pc);
1221 static void JimParseSubCmd(struct JimParserCtx *pc);
1222 static int JimParseSubQuote(struct JimParserCtx *pc);
1223 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1225 /* Initialize a parser context.
1226 * 'prg' is a pointer to the program text, linenr is the line
1227 * number of the first line contained in the program. */
1228 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1230 pc->p = prg;
1231 pc->len = len;
1232 pc->tstart = NULL;
1233 pc->tend = NULL;
1234 pc->tline = 0;
1235 pc->tt = JIM_TT_NONE;
1236 pc->eof = 0;
1237 pc->inquote = 0;
1238 pc->linenr = linenr;
1239 pc->comment = 1;
1240 pc->missing.ch = ' ';
1241 pc->missing.line = linenr;
1244 static int JimParseScript(struct JimParserCtx *pc)
1246 while (1) { /* the while is used to reiterate with continue if needed */
1247 if (!pc->len) {
1248 pc->tstart = pc->p;
1249 pc->tend = pc->p - 1;
1250 pc->tline = pc->linenr;
1251 pc->tt = JIM_TT_EOL;
1252 pc->eof = 1;
1253 return JIM_OK;
1255 switch (*(pc->p)) {
1256 case '\\':
1257 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1258 return JimParseSep(pc);
1260 pc->comment = 0;
1261 return JimParseStr(pc);
1262 case ' ':
1263 case '\t':
1264 case '\r':
1265 case '\f':
1266 if (!pc->inquote)
1267 return JimParseSep(pc);
1268 pc->comment = 0;
1269 return JimParseStr(pc);
1270 case '\n':
1271 case ';':
1272 pc->comment = 1;
1273 if (!pc->inquote)
1274 return JimParseEol(pc);
1275 return JimParseStr(pc);
1276 case '[':
1277 pc->comment = 0;
1278 return JimParseCmd(pc);
1279 case '$':
1280 pc->comment = 0;
1281 if (JimParseVar(pc) == JIM_ERR) {
1282 /* An orphan $. Create as a separate token */
1283 pc->tstart = pc->tend = pc->p++;
1284 pc->len--;
1285 pc->tt = JIM_TT_ESC;
1287 return JIM_OK;
1288 case '#':
1289 if (pc->comment) {
1290 JimParseComment(pc);
1291 continue;
1293 return JimParseStr(pc);
1294 default:
1295 pc->comment = 0;
1296 return JimParseStr(pc);
1298 return JIM_OK;
1302 static int JimParseSep(struct JimParserCtx *pc)
1304 pc->tstart = pc->p;
1305 pc->tline = pc->linenr;
1306 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1307 if (*pc->p == '\n') {
1308 break;
1310 if (*pc->p == '\\') {
1311 pc->p++;
1312 pc->len--;
1313 pc->linenr++;
1315 pc->p++;
1316 pc->len--;
1318 pc->tend = pc->p - 1;
1319 pc->tt = JIM_TT_SEP;
1320 return JIM_OK;
1323 static int JimParseEol(struct JimParserCtx *pc)
1325 pc->tstart = pc->p;
1326 pc->tline = pc->linenr;
1327 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1328 if (*pc->p == '\n')
1329 pc->linenr++;
1330 pc->p++;
1331 pc->len--;
1333 pc->tend = pc->p - 1;
1334 pc->tt = JIM_TT_EOL;
1335 return JIM_OK;
1339 ** Here are the rules for parsing:
1340 ** {braced expression}
1341 ** - Count open and closing braces
1342 ** - Backslash escapes meaning of braces
1344 ** "quoted expression"
1345 ** - First double quote at start of word terminates the expression
1346 ** - Backslash escapes quote and bracket
1347 ** - [commands brackets] are counted/nested
1348 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1350 ** [command expression]
1351 ** - Count open and closing brackets
1352 ** - Backslash escapes quote, bracket and brace
1353 ** - [commands brackets] are counted/nested
1354 ** - "quoted expressions" are parsed according to quoting rules
1355 ** - {braced expressions} are parsed according to brace rules
1357 ** For everything, backslash escapes the next char, newline increments current line
1361 * Parses a braced expression starting at pc->p.
1363 * Positions the parser at the end of the braced expression,
1364 * sets pc->tend and possibly pc->missing.
1366 static void JimParseSubBrace(struct JimParserCtx *pc)
1368 int level = 1;
1370 /* Skip the brace */
1371 pc->p++;
1372 pc->len--;
1373 while (pc->len) {
1374 switch (*pc->p) {
1375 case '\\':
1376 if (pc->len > 1) {
1377 if (*++pc->p == '\n') {
1378 pc->linenr++;
1380 pc->len--;
1382 break;
1384 case '{':
1385 level++;
1386 break;
1388 case '}':
1389 if (--level == 0) {
1390 pc->tend = pc->p - 1;
1391 pc->p++;
1392 pc->len--;
1393 return;
1395 break;
1397 case '\n':
1398 pc->linenr++;
1399 break;
1401 pc->p++;
1402 pc->len--;
1404 pc->missing.ch = '{';
1405 pc->missing.line = pc->tline;
1406 pc->tend = pc->p - 1;
1410 * Parses a quoted expression starting at pc->p.
1412 * Positions the parser at the end of the quoted expression,
1413 * sets pc->tend and possibly pc->missing.
1415 * Returns the type of the token of the string,
1416 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1417 * or JIM_TT_STR.
1419 static int JimParseSubQuote(struct JimParserCtx *pc)
1421 int tt = JIM_TT_STR;
1422 int line = pc->tline;
1424 /* Skip the quote */
1425 pc->p++;
1426 pc->len--;
1427 while (pc->len) {
1428 switch (*pc->p) {
1429 case '\\':
1430 if (pc->len > 1) {
1431 if (*++pc->p == '\n') {
1432 pc->linenr++;
1434 pc->len--;
1435 tt = JIM_TT_ESC;
1437 break;
1439 case '"':
1440 pc->tend = pc->p - 1;
1441 pc->p++;
1442 pc->len--;
1443 return tt;
1445 case '[':
1446 JimParseSubCmd(pc);
1447 tt = JIM_TT_ESC;
1448 continue;
1450 case '\n':
1451 pc->linenr++;
1452 break;
1454 case '$':
1455 tt = JIM_TT_ESC;
1456 break;
1458 pc->p++;
1459 pc->len--;
1461 pc->missing.ch = '"';
1462 pc->missing.line = line;
1463 pc->tend = pc->p - 1;
1464 return tt;
1468 * Parses a [command] expression starting at pc->p.
1470 * Positions the parser at the end of the command expression,
1471 * sets pc->tend and possibly pc->missing.
1473 static void JimParseSubCmd(struct JimParserCtx *pc)
1475 int level = 1;
1476 int startofword = 1;
1477 int line = pc->tline;
1479 /* Skip the bracket */
1480 pc->p++;
1481 pc->len--;
1482 while (pc->len) {
1483 switch (*pc->p) {
1484 case '\\':
1485 if (pc->len > 1) {
1486 if (*++pc->p == '\n') {
1487 pc->linenr++;
1489 pc->len--;
1491 break;
1493 case '[':
1494 level++;
1495 break;
1497 case ']':
1498 if (--level == 0) {
1499 pc->tend = pc->p - 1;
1500 pc->p++;
1501 pc->len--;
1502 return;
1504 break;
1506 case '"':
1507 if (startofword) {
1508 JimParseSubQuote(pc);
1509 continue;
1511 break;
1513 case '{':
1514 JimParseSubBrace(pc);
1515 startofword = 0;
1516 continue;
1518 case '\n':
1519 pc->linenr++;
1520 break;
1522 startofword = isspace(UCHAR(*pc->p));
1523 pc->p++;
1524 pc->len--;
1526 pc->missing.ch = '[';
1527 pc->missing.line = line;
1528 pc->tend = pc->p - 1;
1531 static int JimParseBrace(struct JimParserCtx *pc)
1533 pc->tstart = pc->p + 1;
1534 pc->tline = pc->linenr;
1535 pc->tt = JIM_TT_STR;
1536 JimParseSubBrace(pc);
1537 return JIM_OK;
1540 static int JimParseCmd(struct JimParserCtx *pc)
1542 pc->tstart = pc->p + 1;
1543 pc->tline = pc->linenr;
1544 pc->tt = JIM_TT_CMD;
1545 JimParseSubCmd(pc);
1546 return JIM_OK;
1549 static int JimParseQuote(struct JimParserCtx *pc)
1551 pc->tstart = pc->p + 1;
1552 pc->tline = pc->linenr;
1553 pc->tt = JimParseSubQuote(pc);
1554 return JIM_OK;
1557 static int JimParseVar(struct JimParserCtx *pc)
1559 /* skip the $ */
1560 pc->p++;
1561 pc->len--;
1563 #ifdef EXPRSUGAR_BRACKET
1564 if (*pc->p == '[') {
1565 /* Parse $[...] expr shorthand syntax */
1566 JimParseCmd(pc);
1567 pc->tt = JIM_TT_EXPRSUGAR;
1568 return JIM_OK;
1570 #endif
1572 pc->tstart = pc->p;
1573 pc->tt = JIM_TT_VAR;
1574 pc->tline = pc->linenr;
1576 if (*pc->p == '{') {
1577 pc->tstart = ++pc->p;
1578 pc->len--;
1580 while (pc->len && *pc->p != '}') {
1581 if (*pc->p == '\n') {
1582 pc->linenr++;
1584 pc->p++;
1585 pc->len--;
1587 pc->tend = pc->p - 1;
1588 if (pc->len) {
1589 pc->p++;
1590 pc->len--;
1593 else {
1594 while (1) {
1595 /* Skip double colon, but not single colon! */
1596 if (pc->p[0] == ':' && pc->p[1] == ':') {
1597 while (*pc->p == ':') {
1598 pc->p++;
1599 pc->len--;
1601 continue;
1603 /* Note that any char >= 0x80 must be part of a utf-8 char.
1604 * We consider all unicode points outside of ASCII as letters
1606 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1607 pc->p++;
1608 pc->len--;
1609 continue;
1611 break;
1613 /* Parse [dict get] syntax sugar. */
1614 if (*pc->p == '(') {
1615 int count = 1;
1616 const char *paren = NULL;
1618 pc->tt = JIM_TT_DICTSUGAR;
1620 while (count && pc->len) {
1621 pc->p++;
1622 pc->len--;
1623 if (*pc->p == '\\' && pc->len >= 1) {
1624 pc->p++;
1625 pc->len--;
1627 else if (*pc->p == '(') {
1628 count++;
1630 else if (*pc->p == ')') {
1631 paren = pc->p;
1632 count--;
1635 if (count == 0) {
1636 pc->p++;
1637 pc->len--;
1639 else if (paren) {
1640 /* Did not find a matching paren. Back up */
1641 paren++;
1642 pc->len += (pc->p - paren);
1643 pc->p = paren;
1645 #ifndef EXPRSUGAR_BRACKET
1646 if (*pc->tstart == '(') {
1647 pc->tt = JIM_TT_EXPRSUGAR;
1649 #endif
1651 pc->tend = pc->p - 1;
1653 /* Check if we parsed just the '$' character.
1654 * That's not a variable so an error is returned
1655 * to tell the state machine to consider this '$' just
1656 * a string. */
1657 if (pc->tstart == pc->p) {
1658 pc->p--;
1659 pc->len++;
1660 return JIM_ERR;
1662 return JIM_OK;
1665 static int JimParseStr(struct JimParserCtx *pc)
1667 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1668 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1669 /* Starting a new word */
1670 if (*pc->p == '{') {
1671 return JimParseBrace(pc);
1673 if (*pc->p == '"') {
1674 pc->inquote = 1;
1675 pc->p++;
1676 pc->len--;
1677 /* In case the end quote is missing */
1678 pc->missing.line = pc->tline;
1681 pc->tstart = pc->p;
1682 pc->tline = pc->linenr;
1683 while (1) {
1684 if (pc->len == 0) {
1685 if (pc->inquote) {
1686 pc->missing.ch = '"';
1688 pc->tend = pc->p - 1;
1689 pc->tt = JIM_TT_ESC;
1690 return JIM_OK;
1692 switch (*pc->p) {
1693 case '\\':
1694 if (!pc->inquote && *(pc->p + 1) == '\n') {
1695 pc->tend = pc->p - 1;
1696 pc->tt = JIM_TT_ESC;
1697 return JIM_OK;
1699 if (pc->len >= 2) {
1700 if (*(pc->p + 1) == '\n') {
1701 pc->linenr++;
1703 pc->p++;
1704 pc->len--;
1706 else if (pc->len == 1) {
1707 /* End of script with trailing backslash */
1708 pc->missing.ch = '\\';
1710 break;
1711 case '(':
1712 /* If the following token is not '$' just keep going */
1713 if (pc->len > 1 && pc->p[1] != '$') {
1714 break;
1716 /* fall through */
1717 case ')':
1718 /* Only need a separate ')' token if the previous was a var */
1719 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1720 if (pc->p == pc->tstart) {
1721 /* At the start of the token, so just return this char */
1722 pc->p++;
1723 pc->len--;
1725 pc->tend = pc->p - 1;
1726 pc->tt = JIM_TT_ESC;
1727 return JIM_OK;
1729 break;
1731 case '$':
1732 case '[':
1733 pc->tend = pc->p - 1;
1734 pc->tt = JIM_TT_ESC;
1735 return JIM_OK;
1736 case ' ':
1737 case '\t':
1738 case '\n':
1739 case '\r':
1740 case '\f':
1741 case ';':
1742 if (!pc->inquote) {
1743 pc->tend = pc->p - 1;
1744 pc->tt = JIM_TT_ESC;
1745 return JIM_OK;
1747 else if (*pc->p == '\n') {
1748 pc->linenr++;
1750 break;
1751 case '"':
1752 if (pc->inquote) {
1753 pc->tend = pc->p - 1;
1754 pc->tt = JIM_TT_ESC;
1755 pc->p++;
1756 pc->len--;
1757 pc->inquote = 0;
1758 return JIM_OK;
1760 break;
1762 pc->p++;
1763 pc->len--;
1765 return JIM_OK; /* unreached */
1768 static int JimParseComment(struct JimParserCtx *pc)
1770 while (*pc->p) {
1771 if (*pc->p == '\\') {
1772 pc->p++;
1773 pc->len--;
1774 if (pc->len == 0) {
1775 pc->missing.ch = '\\';
1776 return JIM_OK;
1778 if (*pc->p == '\n') {
1779 pc->linenr++;
1782 else if (*pc->p == '\n') {
1783 pc->p++;
1784 pc->len--;
1785 pc->linenr++;
1786 break;
1788 pc->p++;
1789 pc->len--;
1791 return JIM_OK;
1794 /* xdigitval and odigitval are helper functions for JimEscape() */
1795 static int xdigitval(int c)
1797 if (c >= '0' && c <= '9')
1798 return c - '0';
1799 if (c >= 'a' && c <= 'f')
1800 return c - 'a' + 10;
1801 if (c >= 'A' && c <= 'F')
1802 return c - 'A' + 10;
1803 return -1;
1806 static int odigitval(int c)
1808 if (c >= '0' && c <= '7')
1809 return c - '0';
1810 return -1;
1813 /* Perform Tcl escape substitution of 's', storing the result
1814 * string into 'dest'. The escaped string is guaranteed to
1815 * be the same length or shorted than the source string.
1816 * Slen is the length of the string at 's'.
1818 * The function returns the length of the resulting string. */
1819 static int JimEscape(char *dest, const char *s, int slen)
1821 char *p = dest;
1822 int i, len;
1824 for (i = 0; i < slen; i++) {
1825 switch (s[i]) {
1826 case '\\':
1827 switch (s[i + 1]) {
1828 case 'a':
1829 *p++ = 0x7;
1830 i++;
1831 break;
1832 case 'b':
1833 *p++ = 0x8;
1834 i++;
1835 break;
1836 case 'f':
1837 *p++ = 0xc;
1838 i++;
1839 break;
1840 case 'n':
1841 *p++ = 0xa;
1842 i++;
1843 break;
1844 case 'r':
1845 *p++ = 0xd;
1846 i++;
1847 break;
1848 case 't':
1849 *p++ = 0x9;
1850 i++;
1851 break;
1852 case 'u':
1853 case 'U':
1854 case 'x':
1855 /* A unicode or hex sequence.
1856 * \x Expect 1-2 hex chars and convert to hex.
1857 * \u Expect 1-4 hex chars and convert to utf-8.
1858 * \U Expect 1-8 hex chars and convert to utf-8.
1859 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1860 * An invalid sequence means simply the escaped char.
1863 unsigned val = 0;
1864 int k;
1865 int maxchars = 2;
1867 i++;
1869 if (s[i] == 'U') {
1870 maxchars = 8;
1872 else if (s[i] == 'u') {
1873 if (s[i + 1] == '{') {
1874 maxchars = 6;
1875 i++;
1877 else {
1878 maxchars = 4;
1882 for (k = 0; k < maxchars; k++) {
1883 int c = xdigitval(s[i + k + 1]);
1884 if (c == -1) {
1885 break;
1887 val = (val << 4) | c;
1889 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1890 if (s[i] == '{') {
1891 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1892 /* Back up */
1893 i--;
1894 k = 0;
1896 else {
1897 /* Skip the closing brace */
1898 k++;
1901 if (k) {
1902 /* Got a valid sequence, so convert */
1903 if (s[i] == 'x') {
1904 *p++ = val;
1906 else {
1907 p += utf8_fromunicode(p, val);
1909 i += k;
1910 break;
1912 /* Not a valid codepoint, just an escaped char */
1913 *p++ = s[i];
1915 break;
1916 case 'v':
1917 *p++ = 0xb;
1918 i++;
1919 break;
1920 case '\0':
1921 *p++ = '\\';
1922 i++;
1923 break;
1924 case '\n':
1925 /* Replace all spaces and tabs after backslash newline with a single space*/
1926 *p++ = ' ';
1927 do {
1928 i++;
1929 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1930 break;
1931 case '0':
1932 case '1':
1933 case '2':
1934 case '3':
1935 case '4':
1936 case '5':
1937 case '6':
1938 case '7':
1939 /* octal escape */
1941 int val = 0;
1942 int c = odigitval(s[i + 1]);
1944 val = c;
1945 c = odigitval(s[i + 2]);
1946 if (c == -1) {
1947 *p++ = val;
1948 i++;
1949 break;
1951 val = (val * 8) + c;
1952 c = odigitval(s[i + 3]);
1953 if (c == -1) {
1954 *p++ = val;
1955 i += 2;
1956 break;
1958 val = (val * 8) + c;
1959 *p++ = val;
1960 i += 3;
1962 break;
1963 default:
1964 *p++ = s[i + 1];
1965 i++;
1966 break;
1968 break;
1969 default:
1970 *p++ = s[i];
1971 break;
1974 len = p - dest;
1975 *p = '\0';
1976 return len;
1979 /* Returns a dynamically allocated copy of the current token in the
1980 * parser context. The function performs conversion of escapes if
1981 * the token is of type JIM_TT_ESC.
1983 * Note that after the conversion, tokens that are grouped with
1984 * braces in the source code, are always recognizable from the
1985 * identical string obtained in a different way from the type.
1987 * For example the string:
1989 * {*}$a
1991 * will return as first token "*", of type JIM_TT_STR
1993 * While the string:
1995 * *$a
1997 * will return as first token "*", of type JIM_TT_ESC
1999 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
2001 const char *start, *end;
2002 char *token;
2003 int len;
2005 start = pc->tstart;
2006 end = pc->tend;
2007 if (start > end) {
2008 len = 0;
2009 token = Jim_Alloc(1);
2010 token[0] = '\0';
2012 else {
2013 len = (end - start) + 1;
2014 token = Jim_Alloc(len + 1);
2015 if (pc->tt != JIM_TT_ESC) {
2016 /* No escape conversion needed? Just copy it. */
2017 memcpy(token, start, len);
2018 token[len] = '\0';
2020 else {
2021 /* Else convert the escape chars. */
2022 len = JimEscape(token, start, len);
2026 return Jim_NewStringObjNoAlloc(interp, token, len);
2029 /* -----------------------------------------------------------------------------
2030 * Tcl Lists parsing
2031 * ---------------------------------------------------------------------------*/
2032 static int JimParseListSep(struct JimParserCtx *pc);
2033 static int JimParseListStr(struct JimParserCtx *pc);
2034 static int JimParseListQuote(struct JimParserCtx *pc);
2036 static int JimParseList(struct JimParserCtx *pc)
2038 if (isspace(UCHAR(*pc->p))) {
2039 return JimParseListSep(pc);
2041 switch (*pc->p) {
2042 case '"':
2043 return JimParseListQuote(pc);
2045 case '{':
2046 return JimParseBrace(pc);
2048 default:
2049 if (pc->len) {
2050 return JimParseListStr(pc);
2052 break;
2055 pc->tstart = pc->tend = pc->p;
2056 pc->tline = pc->linenr;
2057 pc->tt = JIM_TT_EOL;
2058 pc->eof = 1;
2059 return JIM_OK;
2062 static int JimParseListSep(struct JimParserCtx *pc)
2064 pc->tstart = pc->p;
2065 pc->tline = pc->linenr;
2066 while (isspace(UCHAR(*pc->p))) {
2067 if (*pc->p == '\n') {
2068 pc->linenr++;
2070 pc->p++;
2071 pc->len--;
2073 pc->tend = pc->p - 1;
2074 pc->tt = JIM_TT_SEP;
2075 return JIM_OK;
2078 static int JimParseListQuote(struct JimParserCtx *pc)
2080 pc->p++;
2081 pc->len--;
2083 pc->tstart = pc->p;
2084 pc->tline = pc->linenr;
2085 pc->tt = JIM_TT_STR;
2087 while (pc->len) {
2088 switch (*pc->p) {
2089 case '\\':
2090 pc->tt = JIM_TT_ESC;
2091 if (--pc->len == 0) {
2092 /* Trailing backslash */
2093 pc->tend = pc->p;
2094 return JIM_OK;
2096 pc->p++;
2097 break;
2098 case '\n':
2099 pc->linenr++;
2100 break;
2101 case '"':
2102 pc->tend = pc->p - 1;
2103 pc->p++;
2104 pc->len--;
2105 return JIM_OK;
2107 pc->p++;
2108 pc->len--;
2111 pc->tend = pc->p - 1;
2112 return JIM_OK;
2115 static int JimParseListStr(struct JimParserCtx *pc)
2117 pc->tstart = pc->p;
2118 pc->tline = pc->linenr;
2119 pc->tt = JIM_TT_STR;
2121 while (pc->len) {
2122 if (isspace(UCHAR(*pc->p))) {
2123 pc->tend = pc->p - 1;
2124 return JIM_OK;
2126 if (*pc->p == '\\') {
2127 if (--pc->len == 0) {
2128 /* Trailing backslash */
2129 pc->tend = pc->p;
2130 return JIM_OK;
2132 pc->tt = JIM_TT_ESC;
2133 pc->p++;
2135 pc->p++;
2136 pc->len--;
2138 pc->tend = pc->p - 1;
2139 return JIM_OK;
2142 /* -----------------------------------------------------------------------------
2143 * Jim_Obj related functions
2144 * ---------------------------------------------------------------------------*/
2146 /* Return a new initialized object. */
2147 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2149 Jim_Obj *objPtr;
2151 /* -- Check if there are objects in the free list -- */
2152 if (interp->freeList != NULL) {
2153 /* -- Unlink the object from the free list -- */
2154 objPtr = interp->freeList;
2155 interp->freeList = objPtr->nextObjPtr;
2157 else {
2158 /* -- No ready to use objects: allocate a new one -- */
2159 objPtr = Jim_Alloc(sizeof(*objPtr));
2162 /* Object is returned with refCount of 0. Every
2163 * kind of GC implemented should take care to don't try
2164 * to scan objects with refCount == 0. */
2165 objPtr->refCount = 0;
2166 /* All the other fields are left not initialized to save time.
2167 * The caller will probably want to set them to the right
2168 * value anyway. */
2170 /* -- Put the object into the live list -- */
2171 objPtr->prevObjPtr = NULL;
2172 objPtr->nextObjPtr = interp->liveList;
2173 if (interp->liveList)
2174 interp->liveList->prevObjPtr = objPtr;
2175 interp->liveList = objPtr;
2177 return objPtr;
2180 /* Free an object. Actually objects are never freed, but
2181 * just moved to the free objects list, where they will be
2182 * reused by Jim_NewObj(). */
2183 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2185 /* Check if the object was already freed, panic. */
2186 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2187 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2189 /* Free the internal representation */
2190 Jim_FreeIntRep(interp, objPtr);
2191 /* Free the string representation */
2192 if (objPtr->bytes != NULL) {
2193 if (objPtr->bytes != JimEmptyStringRep)
2194 Jim_Free(objPtr->bytes);
2196 /* Unlink the object from the live objects list */
2197 if (objPtr->prevObjPtr)
2198 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2199 if (objPtr->nextObjPtr)
2200 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2201 if (interp->liveList == objPtr)
2202 interp->liveList = objPtr->nextObjPtr;
2203 #ifdef JIM_DISABLE_OBJECT_POOL
2204 Jim_Free(objPtr);
2205 #else
2206 /* Link the object into the free objects list */
2207 objPtr->prevObjPtr = NULL;
2208 objPtr->nextObjPtr = interp->freeList;
2209 if (interp->freeList)
2210 interp->freeList->prevObjPtr = objPtr;
2211 interp->freeList = objPtr;
2212 objPtr->refCount = -1;
2213 #endif
2216 /* Invalidate the string representation of an object. */
2217 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2219 if (objPtr->bytes != NULL) {
2220 if (objPtr->bytes != JimEmptyStringRep)
2221 Jim_Free(objPtr->bytes);
2223 objPtr->bytes = NULL;
2226 /* Duplicate an object. The returned object has refcount = 0. */
2227 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2229 Jim_Obj *dupPtr;
2231 dupPtr = Jim_NewObj(interp);
2232 if (objPtr->bytes == NULL) {
2233 /* Object does not have a valid string representation. */
2234 dupPtr->bytes = NULL;
2236 else if (objPtr->length == 0) {
2237 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2238 dupPtr->bytes = JimEmptyStringRep;
2239 dupPtr->length = 0;
2240 dupPtr->typePtr = NULL;
2241 return dupPtr;
2243 else {
2244 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2245 dupPtr->length = objPtr->length;
2246 /* Copy the null byte too */
2247 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2250 /* By default, the new object has the same type as the old object */
2251 dupPtr->typePtr = objPtr->typePtr;
2252 if (objPtr->typePtr != NULL) {
2253 if (objPtr->typePtr->dupIntRepProc == NULL) {
2254 dupPtr->internalRep = objPtr->internalRep;
2256 else {
2257 /* The dup proc may set a different type, e.g. NULL */
2258 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2261 return dupPtr;
2264 /* Return the string representation for objPtr. If the object's
2265 * string representation is invalid, calls the updateStringProc method to create
2266 * a new one from the internal representation of the object.
2268 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2270 if (objPtr->bytes == NULL) {
2271 /* Invalid string repr. Generate it. */
2272 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2273 objPtr->typePtr->updateStringProc(objPtr);
2275 if (lenPtr)
2276 *lenPtr = objPtr->length;
2277 return objPtr->bytes;
2280 /* Just returns the length of the object's string rep */
2281 int Jim_Length(Jim_Obj *objPtr)
2283 if (objPtr->bytes == NULL) {
2284 /* Invalid string repr. Generate it. */
2285 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2286 objPtr->typePtr->updateStringProc(objPtr);
2288 return objPtr->length;
2291 /* Just returns object's string rep */
2292 const char *Jim_String(Jim_Obj *objPtr)
2294 if (objPtr->bytes == NULL) {
2295 /* Invalid string repr. Generate it. */
2296 JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value."));
2297 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2298 objPtr->typePtr->updateStringProc(objPtr);
2300 return objPtr->bytes;
2303 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2305 objPtr->bytes = Jim_StrDup(str);
2306 objPtr->length = strlen(str);
2309 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2310 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2312 static const Jim_ObjType dictSubstObjType = {
2313 "dict-substitution",
2314 FreeDictSubstInternalRep,
2315 DupDictSubstInternalRep,
2316 NULL,
2317 JIM_TYPE_NONE,
2320 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2321 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2323 static const Jim_ObjType interpolatedObjType = {
2324 "interpolated",
2325 FreeInterpolatedInternalRep,
2326 DupInterpolatedInternalRep,
2327 NULL,
2328 JIM_TYPE_NONE,
2331 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2333 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2336 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2338 /* Copy the interal rep */
2339 dupPtr->internalRep = srcPtr->internalRep;
2340 /* Need to increment the key ref count */
2341 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2344 /* -----------------------------------------------------------------------------
2345 * String Object
2346 * ---------------------------------------------------------------------------*/
2347 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2348 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2350 static const Jim_ObjType stringObjType = {
2351 "string",
2352 NULL,
2353 DupStringInternalRep,
2354 NULL,
2355 JIM_TYPE_REFERENCES,
2358 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2360 JIM_NOTUSED(interp);
2362 /* This is a bit subtle: the only caller of this function
2363 * should be Jim_DuplicateObj(), that will copy the
2364 * string representaion. After the copy, the duplicated
2365 * object will not have more room in the buffer than
2366 * srcPtr->length bytes. So we just set it to length. */
2367 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2368 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2371 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2373 if (objPtr->typePtr != &stringObjType) {
2374 /* Get a fresh string representation. */
2375 if (objPtr->bytes == NULL) {
2376 /* Invalid string repr. Generate it. */
2377 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2378 objPtr->typePtr->updateStringProc(objPtr);
2380 /* Free any other internal representation. */
2381 Jim_FreeIntRep(interp, objPtr);
2382 /* Set it as string, i.e. just set the maxLength field. */
2383 objPtr->typePtr = &stringObjType;
2384 objPtr->internalRep.strValue.maxLength = objPtr->length;
2385 /* Don't know the utf-8 length yet */
2386 objPtr->internalRep.strValue.charLength = -1;
2388 return JIM_OK;
2392 * Returns the length of the object string in chars, not bytes.
2394 * These may be different for a utf-8 string.
2396 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2398 #ifdef JIM_UTF8
2399 SetStringFromAny(interp, objPtr);
2401 if (objPtr->internalRep.strValue.charLength < 0) {
2402 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2404 return objPtr->internalRep.strValue.charLength;
2405 #else
2406 return Jim_Length(objPtr);
2407 #endif
2410 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2411 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2413 Jim_Obj *objPtr = Jim_NewObj(interp);
2415 /* Need to find out how many bytes the string requires */
2416 if (len == -1)
2417 len = strlen(s);
2418 /* Alloc/Set the string rep. */
2419 if (len == 0) {
2420 objPtr->bytes = JimEmptyStringRep;
2422 else {
2423 objPtr->bytes = Jim_Alloc(len + 1);
2424 memcpy(objPtr->bytes, s, len);
2425 objPtr->bytes[len] = '\0';
2427 objPtr->length = len;
2429 /* No typePtr field for the vanilla string object. */
2430 objPtr->typePtr = NULL;
2431 return objPtr;
2434 /* charlen is in characters -- see also Jim_NewStringObj() */
2435 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2437 #ifdef JIM_UTF8
2438 /* Need to find out how many bytes the string requires */
2439 int bytelen = utf8_index(s, charlen);
2441 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2443 /* Remember the utf8 length, so set the type */
2444 objPtr->typePtr = &stringObjType;
2445 objPtr->internalRep.strValue.maxLength = bytelen;
2446 objPtr->internalRep.strValue.charLength = charlen;
2448 return objPtr;
2449 #else
2450 return Jim_NewStringObj(interp, s, charlen);
2451 #endif
2454 /* This version does not try to duplicate the 's' pointer, but
2455 * use it directly. */
2456 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2458 Jim_Obj *objPtr = Jim_NewObj(interp);
2460 objPtr->bytes = s;
2461 objPtr->length = (len == -1) ? strlen(s) : len;
2462 objPtr->typePtr = NULL;
2463 return objPtr;
2466 /* Low-level string append. Use it only against unshared objects
2467 * of type "string". */
2468 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2470 int needlen;
2472 if (len == -1)
2473 len = strlen(str);
2474 needlen = objPtr->length + len;
2475 if (objPtr->internalRep.strValue.maxLength < needlen ||
2476 objPtr->internalRep.strValue.maxLength == 0) {
2477 needlen *= 2;
2478 /* Inefficient to malloc() for less than 8 bytes */
2479 if (needlen < 7) {
2480 needlen = 7;
2482 if (objPtr->bytes == JimEmptyStringRep) {
2483 objPtr->bytes = Jim_Alloc(needlen + 1);
2485 else {
2486 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2488 objPtr->internalRep.strValue.maxLength = needlen;
2490 memcpy(objPtr->bytes + objPtr->length, str, len);
2491 objPtr->bytes[objPtr->length + len] = '\0';
2493 if (objPtr->internalRep.strValue.charLength >= 0) {
2494 /* Update the utf-8 char length */
2495 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2497 objPtr->length += len;
2500 /* Higher level API to append strings to objects.
2501 * Object must not be unshared for each of these.
2503 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2505 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2506 SetStringFromAny(interp, objPtr);
2507 StringAppendString(objPtr, str, len);
2510 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2512 int len;
2513 const char *str = Jim_GetString(appendObjPtr, &len);
2514 Jim_AppendString(interp, objPtr, str, len);
2517 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2519 va_list ap;
2521 SetStringFromAny(interp, objPtr);
2522 va_start(ap, objPtr);
2523 while (1) {
2524 const char *s = va_arg(ap, const char *);
2526 if (s == NULL)
2527 break;
2528 Jim_AppendString(interp, objPtr, s, -1);
2530 va_end(ap);
2533 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2535 if (aObjPtr == bObjPtr) {
2536 return 1;
2538 else {
2539 int Alen, Blen;
2540 const char *sA = Jim_GetString(aObjPtr, &Alen);
2541 const char *sB = Jim_GetString(bObjPtr, &Blen);
2543 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2548 * Note. Does not support embedded nulls in either the pattern or the object.
2550 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2552 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2556 * Note: does not support embedded nulls for the nocase option.
2558 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2560 int l1, l2;
2561 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2562 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2564 if (nocase) {
2565 /* Do a character compare for nocase */
2566 return JimStringCompareLen(s1, s2, -1, nocase);
2568 return JimStringCompare(s1, l1, s2, l2);
2572 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2574 * Note: does not support embedded nulls
2576 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2578 const char *s1 = Jim_String(firstObjPtr);
2579 const char *s2 = Jim_String(secondObjPtr);
2581 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2584 /* Convert a range, as returned by Jim_GetRange(), into
2585 * an absolute index into an object of the specified length.
2586 * This function may return negative values, or values
2587 * greater than or equal to the length of the list if the index
2588 * is out of range. */
2589 static int JimRelToAbsIndex(int len, int idx)
2591 if (idx < 0)
2592 return len + idx;
2593 return idx;
2596 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2597 * into a form suitable for implementation of commands like [string range] and [lrange].
2599 * The resulting range is guaranteed to address valid elements of
2600 * the structure.
2602 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2604 int rangeLen;
2606 if (*firstPtr > *lastPtr) {
2607 rangeLen = 0;
2609 else {
2610 rangeLen = *lastPtr - *firstPtr + 1;
2611 if (rangeLen) {
2612 if (*firstPtr < 0) {
2613 rangeLen += *firstPtr;
2614 *firstPtr = 0;
2616 if (*lastPtr >= len) {
2617 rangeLen -= (*lastPtr - (len - 1));
2618 *lastPtr = len - 1;
2622 if (rangeLen < 0)
2623 rangeLen = 0;
2625 *rangeLenPtr = rangeLen;
2628 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2629 int len, int *first, int *last, int *range)
2631 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2632 return JIM_ERR;
2634 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2635 return JIM_ERR;
2637 *first = JimRelToAbsIndex(len, *first);
2638 *last = JimRelToAbsIndex(len, *last);
2639 JimRelToAbsRange(len, first, last, range);
2640 return JIM_OK;
2643 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2644 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2646 int first, last;
2647 const char *str;
2648 int rangeLen;
2649 int bytelen;
2651 str = Jim_GetString(strObjPtr, &bytelen);
2653 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2654 return NULL;
2657 if (first == 0 && rangeLen == bytelen) {
2658 return strObjPtr;
2660 return Jim_NewStringObj(interp, str + first, rangeLen);
2663 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2664 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2666 #ifdef JIM_UTF8
2667 int first, last;
2668 const char *str;
2669 int len, rangeLen;
2670 int bytelen;
2672 str = Jim_GetString(strObjPtr, &bytelen);
2673 len = Jim_Utf8Length(interp, strObjPtr);
2675 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2676 return NULL;
2679 if (first == 0 && rangeLen == len) {
2680 return strObjPtr;
2682 if (len == bytelen) {
2683 /* ASCII optimisation */
2684 return Jim_NewStringObj(interp, str + first, rangeLen);
2686 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2687 #else
2688 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2689 #endif
2692 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2693 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2695 int first, last;
2696 const char *str;
2697 int len, rangeLen;
2698 Jim_Obj *objPtr;
2700 len = Jim_Utf8Length(interp, strObjPtr);
2702 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2703 return NULL;
2706 if (last < first) {
2707 return strObjPtr;
2710 str = Jim_String(strObjPtr);
2712 /* Before part */
2713 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2715 /* Replacement */
2716 if (newStrObj) {
2717 Jim_AppendObj(interp, objPtr, newStrObj);
2720 /* After part */
2721 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2723 return objPtr;
2727 * Note: does not support embedded nulls.
2729 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2731 while (*str) {
2732 int c;
2733 str += utf8_tounicode(str, &c);
2734 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2736 *dest = 0;
2740 * Note: does not support embedded nulls.
2742 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2744 char *buf;
2745 int len;
2746 const char *str;
2748 SetStringFromAny(interp, strObjPtr);
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 if (strObjPtr->typePtr != &stringObjType) {
2773 SetStringFromAny(interp, strObjPtr);
2776 str = Jim_GetString(strObjPtr, &len);
2778 #ifdef JIM_UTF8
2779 /* Case mapping can change the utf-8 length of the string.
2780 * But at worst it will be by one extra byte per char
2782 len *= 2;
2783 #endif
2784 buf = Jim_Alloc(len + 1);
2785 JimStrCopyUpperLower(buf, str, 1);
2786 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2790 * Note: does not support embedded nulls.
2792 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2794 char *buf, *p;
2795 int len;
2796 int c;
2797 const char *str;
2799 str = Jim_GetString(strObjPtr, &len);
2800 if (len == 0) {
2801 return strObjPtr;
2803 #ifdef JIM_UTF8
2804 /* Case mapping can change the utf-8 length of the string.
2805 * But at worst it will be by one extra byte per char
2807 len *= 2;
2808 #endif
2809 buf = p = Jim_Alloc(len + 1);
2811 str += utf8_tounicode(str, &c);
2812 p += utf8_getchars(p, utf8_title(c));
2814 JimStrCopyUpperLower(p, str, 0);
2816 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2819 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2820 * for unicode character 'c'.
2821 * Returns the position if found or NULL if not
2823 static const char *utf8_memchr(const char *str, int len, int c)
2825 #ifdef JIM_UTF8
2826 while (len) {
2827 int sc;
2828 int n = utf8_tounicode(str, &sc);
2829 if (sc == c) {
2830 return str;
2832 str += n;
2833 len -= n;
2835 return NULL;
2836 #else
2837 return memchr(str, c, len);
2838 #endif
2842 * Searches for the first non-trim char in string (str, len)
2844 * If none is found, returns just past the last char.
2846 * Lengths are in bytes.
2848 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2850 while (len) {
2851 int c;
2852 int n = utf8_tounicode(str, &c);
2854 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2855 /* Not a trim char, so stop */
2856 break;
2858 str += n;
2859 len -= n;
2861 return str;
2865 * Searches backwards for a non-trim char in string (str, len).
2867 * Returns a pointer to just after the non-trim char, or NULL if not found.
2869 * Lengths are in bytes.
2871 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2873 str += len;
2875 while (len) {
2876 int c;
2877 int n = utf8_prev_len(str, len);
2879 len -= n;
2880 str -= n;
2882 n = utf8_tounicode(str, &c);
2884 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2885 return str + n;
2889 return NULL;
2892 static const char default_trim_chars[] = " \t\n\r";
2893 /* sizeof() here includes the null byte */
2894 static int default_trim_chars_len = sizeof(default_trim_chars);
2896 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2898 int len;
2899 const char *str = Jim_GetString(strObjPtr, &len);
2900 const char *trimchars = default_trim_chars;
2901 int trimcharslen = default_trim_chars_len;
2902 const char *newstr;
2904 if (trimcharsObjPtr) {
2905 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2908 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2909 if (newstr == str) {
2910 return strObjPtr;
2913 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2916 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2918 int len;
2919 const char *trimchars = default_trim_chars;
2920 int trimcharslen = default_trim_chars_len;
2921 const char *nontrim;
2923 if (trimcharsObjPtr) {
2924 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2927 SetStringFromAny(interp, strObjPtr);
2929 len = Jim_Length(strObjPtr);
2930 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2932 if (nontrim == NULL) {
2933 /* All trim, so return a zero-length string */
2934 return Jim_NewEmptyStringObj(interp);
2936 if (nontrim == strObjPtr->bytes + len) {
2937 /* All non-trim, so return the original object */
2938 return strObjPtr;
2941 if (Jim_IsShared(strObjPtr)) {
2942 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2944 else {
2945 /* Can modify this string in place */
2946 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2947 strObjPtr->length = (nontrim - strObjPtr->bytes);
2950 return strObjPtr;
2953 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2955 /* First trim left. */
2956 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2958 /* Now trim right */
2959 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2961 /* Note: refCount check is needed since objPtr may be emptyObj */
2962 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2963 /* We don't want this object to be leaked */
2964 Jim_FreeNewObj(interp, objPtr);
2967 return strObjPtr;
2970 /* Some platforms don't have isascii - need a non-macro version */
2971 #ifdef HAVE_ISASCII
2972 #define jim_isascii isascii
2973 #else
2974 static int jim_isascii(int c)
2976 return !(c & ~0x7f);
2978 #endif
2980 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2982 static const char * const strclassnames[] = {
2983 "integer", "alpha", "alnum", "ascii", "digit",
2984 "double", "lower", "upper", "space", "xdigit",
2985 "control", "print", "graph", "punct", "boolean",
2986 NULL
2988 enum {
2989 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2990 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2991 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2993 int strclass;
2994 int len;
2995 int i;
2996 const char *str;
2997 int (*isclassfunc)(int c) = NULL;
2999 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
3000 return JIM_ERR;
3003 str = Jim_GetString(strObjPtr, &len);
3004 if (len == 0) {
3005 Jim_SetResultBool(interp, !strict);
3006 return JIM_OK;
3009 switch (strclass) {
3010 case STR_IS_INTEGER:
3012 jim_wide w;
3013 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3014 return JIM_OK;
3017 case STR_IS_DOUBLE:
3019 double d;
3020 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3021 return JIM_OK;
3024 case STR_IS_BOOLEAN:
3026 int b;
3027 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3028 return JIM_OK;
3031 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3032 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3033 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3034 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3035 case STR_IS_LOWER: isclassfunc = islower; break;
3036 case STR_IS_UPPER: isclassfunc = isupper; break;
3037 case STR_IS_SPACE: isclassfunc = isspace; break;
3038 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3039 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3040 case STR_IS_PRINT: isclassfunc = isprint; break;
3041 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3042 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3043 default:
3044 return JIM_ERR;
3047 for (i = 0; i < len; i++) {
3048 if (!isclassfunc(UCHAR(str[i]))) {
3049 Jim_SetResultBool(interp, 0);
3050 return JIM_OK;
3053 Jim_SetResultBool(interp, 1);
3054 return JIM_OK;
3057 /* -----------------------------------------------------------------------------
3058 * Compared String Object
3059 * ---------------------------------------------------------------------------*/
3061 /* This is strange object that allows comparison of a C literal string
3062 * with a Jim object in a very short time if the same comparison is done
3063 * multiple times. For example every time the [if] command is executed,
3064 * Jim has to check if a given argument is "else".
3065 * If the code has no errors, this comparison is true most of the time,
3066 * so we can cache the pointer of the string of the last matching
3067 * comparison inside the object. Because most C compilers perform literal sharing,
3068 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3069 * this works pretty well even if comparisons are at different places
3070 * inside the C code. */
3072 static const Jim_ObjType comparedStringObjType = {
3073 "compared-string",
3074 NULL,
3075 NULL,
3076 NULL,
3077 JIM_TYPE_REFERENCES,
3080 /* The only way this object is exposed to the API is via the following
3081 * function. Returns true if the string and the object string repr.
3082 * are the same, otherwise zero is returned.
3084 * Note: this isn't binary safe, but it hardly needs to be.*/
3085 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3087 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3088 return 1;
3090 else {
3091 const char *objStr = Jim_String(objPtr);
3093 if (strcmp(str, objStr) != 0)
3094 return 0;
3096 if (objPtr->typePtr != &comparedStringObjType) {
3097 Jim_FreeIntRep(interp, objPtr);
3098 objPtr->typePtr = &comparedStringObjType;
3100 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3101 return 1;
3105 static int qsortCompareStringPointers(const void *a, const void *b)
3107 char *const *sa = (char *const *)a;
3108 char *const *sb = (char *const *)b;
3110 return strcmp(*sa, *sb);
3114 /* -----------------------------------------------------------------------------
3115 * Source Object
3117 * This object is just a string from the language point of view, but
3118 * the internal representation contains the filename and line number
3119 * where this token was read. This information is used by
3120 * Jim_EvalObj() if the object passed happens to be of type "source".
3122 * This allows propagation of the information about line numbers and file
3123 * names and gives error messages with absolute line numbers.
3125 * Note that this object uses the internal representation of the Jim_Object,
3126 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3128 * Also the object will be converted to something else if the given
3129 * token it represents in the source file is not something to be
3130 * evaluated (not a script), and will be specialized in some other way,
3131 * so the time overhead is also almost zero.
3132 * ---------------------------------------------------------------------------*/
3134 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3135 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3137 static const Jim_ObjType sourceObjType = {
3138 "source",
3139 FreeSourceInternalRep,
3140 DupSourceInternalRep,
3141 NULL,
3142 JIM_TYPE_REFERENCES,
3145 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3147 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3150 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3152 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3153 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3156 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3157 Jim_Obj *fileNameObj, int lineNumber)
3159 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3160 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3161 Jim_IncrRefCount(fileNameObj);
3162 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3163 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3164 objPtr->typePtr = &sourceObjType;
3167 /* -----------------------------------------------------------------------------
3168 * ScriptLine Object
3170 * This object is used only in the Script internal represenation.
3171 * For each line of the script, it holds the number of tokens on the line
3172 * and the source line number.
3174 static const Jim_ObjType scriptLineObjType = {
3175 "scriptline",
3176 NULL,
3177 NULL,
3178 NULL,
3179 JIM_NONE,
3182 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3184 Jim_Obj *objPtr;
3186 #ifdef DEBUG_SHOW_SCRIPT
3187 char buf[100];
3188 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3189 objPtr = Jim_NewStringObj(interp, buf, -1);
3190 #else
3191 objPtr = Jim_NewEmptyStringObj(interp);
3192 #endif
3193 objPtr->typePtr = &scriptLineObjType;
3194 objPtr->internalRep.scriptLineValue.argc = argc;
3195 objPtr->internalRep.scriptLineValue.line = line;
3197 return objPtr;
3200 /* -----------------------------------------------------------------------------
3201 * Script Object
3203 * This object holds the parsed internal representation of a script.
3204 * This representation is help within an allocated ScriptObj (see below)
3206 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3207 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3209 static const Jim_ObjType scriptObjType = {
3210 "script",
3211 FreeScriptInternalRep,
3212 DupScriptInternalRep,
3213 NULL,
3214 JIM_TYPE_REFERENCES,
3217 /* Each token of a script is represented by a ScriptToken.
3218 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3219 * can be specialized by commands operating on it.
3221 typedef struct ScriptToken
3223 Jim_Obj *objPtr;
3224 int type;
3225 } ScriptToken;
3227 /* This is the script object internal representation. An array of
3228 * ScriptToken structures, including a pre-computed representation of the
3229 * command length and arguments.
3231 * For example the script:
3233 * puts hello
3234 * set $i $x$y [foo]BAR
3236 * will produce a ScriptObj with the following ScriptToken's:
3238 * LIN 2
3239 * ESC puts
3240 * ESC hello
3241 * LIN 4
3242 * ESC set
3243 * VAR i
3244 * WRD 2
3245 * VAR x
3246 * VAR y
3247 * WRD 2
3248 * CMD foo
3249 * ESC BAR
3251 * "puts hello" has two args (LIN 2), composed of single tokens.
3252 * (Note that the WRD token is omitted for the common case of a single token.)
3254 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3255 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3257 * The precomputation of the command structure makes Jim_Eval() faster,
3258 * and simpler because there aren't dynamic lengths / allocations.
3260 * -- {expand}/{*} handling --
3262 * Expand is handled in a special way.
3264 * If a "word" begins with {*}, the word token count is -ve.
3266 * For example the command:
3268 * list {*}{a b}
3270 * Will produce the following cmdstruct array:
3272 * LIN 2
3273 * ESC list
3274 * WRD -1
3275 * STR a b
3277 * Note that the 'LIN' token also contains the source information for the
3278 * first word of the line for error reporting purposes
3280 * -- the substFlags field of the structure --
3282 * The scriptObj structure is used to represent both "script" objects
3283 * and "subst" objects. In the second case, there are no LIN and WRD
3284 * tokens. Instead SEP and EOL tokens are added as-is.
3285 * In addition, the field 'substFlags' is used to represent the flags used to turn
3286 * the string into the internal representation.
3287 * If these flags do not match what the application requires,
3288 * the scriptObj is created again. For example the script:
3290 * subst -nocommands $string
3291 * subst -novariables $string
3293 * Will (re)create the internal representation of the $string object
3294 * two times.
3296 typedef struct ScriptObj
3298 ScriptToken *token; /* Tokens array. */
3299 Jim_Obj *fileNameObj; /* Filename */
3300 int len; /* Length of token[] */
3301 int substFlags; /* flags used for the compilation of "subst" objects */
3302 int inUse; /* Used to share a ScriptObj. Currently
3303 only used by Jim_EvalObj() as protection against
3304 shimmering of the currently evaluated object. */
3305 int firstline; /* Line number of the first line */
3306 int linenr; /* Error line number, if any */
3307 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3308 } ScriptObj;
3310 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3311 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3312 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3314 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3316 int i;
3317 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3319 if (--script->inUse != 0)
3320 return;
3321 for (i = 0; i < script->len; i++) {
3322 Jim_DecrRefCount(interp, script->token[i].objPtr);
3324 Jim_Free(script->token);
3325 Jim_DecrRefCount(interp, script->fileNameObj);
3326 Jim_Free(script);
3329 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3331 JIM_NOTUSED(interp);
3332 JIM_NOTUSED(srcPtr);
3334 /* Just return a simple string. We don't try to preserve the source info
3335 * since in practice scripts are never duplicated
3337 dupPtr->typePtr = NULL;
3340 /* A simple parse token.
3341 * As the script is parsed, the created tokens point into the script string rep.
3343 typedef struct
3345 const char *token; /* Pointer to the start of the token */
3346 int len; /* Length of this token */
3347 int type; /* Token type */
3348 int line; /* Line number */
3349 } ParseToken;
3351 /* A list of parsed tokens representing a script.
3352 * Tokens are added to this list as the script is parsed.
3353 * It grows as needed.
3355 typedef struct
3357 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3358 ParseToken *list; /* Array of tokens */
3359 int size; /* Current size of the list */
3360 int count; /* Number of entries used */
3361 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3362 } ParseTokenList;
3364 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3366 tokenlist->list = tokenlist->static_list;
3367 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3368 tokenlist->count = 0;
3371 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3373 if (tokenlist->list != tokenlist->static_list) {
3374 Jim_Free(tokenlist->list);
3379 * Adds the new token to the tokenlist.
3380 * The token has the given length, type and line number.
3381 * The token list is resized as necessary.
3383 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3384 int line)
3386 ParseToken *t;
3388 if (tokenlist->count == tokenlist->size) {
3389 /* Resize the list */
3390 tokenlist->size *= 2;
3391 if (tokenlist->list != tokenlist->static_list) {
3392 tokenlist->list =
3393 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3395 else {
3396 /* The list needs to become allocated */
3397 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3398 memcpy(tokenlist->list, tokenlist->static_list,
3399 tokenlist->count * sizeof(*tokenlist->list));
3402 t = &tokenlist->list[tokenlist->count++];
3403 t->token = token;
3404 t->len = len;
3405 t->type = type;
3406 t->line = line;
3409 /* Counts the number of adjoining non-separator tokens.
3411 * Returns -ve if the first token is the expansion
3412 * operator (in which case the count doesn't include
3413 * that token).
3415 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3417 int expand = 1;
3418 int count = 0;
3420 /* Is the first word {*} or {expand}? */
3421 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3422 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3423 /* Create an expand token */
3424 expand = -1;
3425 t++;
3427 else {
3428 if (script->missing == ' ') {
3429 /* This is a "extra characters after close-brace" error. Report the first error */
3430 script->missing = '}';
3431 script->linenr = t[1].line;
3436 /* Now count non-separator words */
3437 while (!TOKEN_IS_SEP(t->type)) {
3438 t++;
3439 count++;
3442 return count * expand;
3446 * Create a script/subst object from the given token.
3448 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3450 Jim_Obj *objPtr;
3452 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3453 /* Convert backlash escapes. The result will never be longer than the original */
3454 int len = t->len;
3455 char *str = Jim_Alloc(len + 1);
3456 len = JimEscape(str, t->token, len);
3457 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3459 else {
3460 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3461 * with a single space.
3463 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3465 return objPtr;
3469 * Takes a tokenlist and creates the allocated list of script tokens
3470 * in script->token, of length script->len.
3472 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3473 * as required.
3475 * Also sets script->line to the line number of the first token
3477 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3478 ParseTokenList *tokenlist)
3480 int i;
3481 struct ScriptToken *token;
3482 /* Number of tokens so far for the current command */
3483 int lineargs = 0;
3484 /* This is the first token for the current command */
3485 ScriptToken *linefirst;
3486 int count;
3487 int linenr;
3489 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3490 printf("==== Tokens ====\n");
3491 for (i = 0; i < tokenlist->count; i++) {
3492 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3493 tokenlist->list[i].len, tokenlist->list[i].token);
3495 #endif
3497 /* May need up to one extra script token for each EOL in the worst case */
3498 count = tokenlist->count;
3499 for (i = 0; i < tokenlist->count; i++) {
3500 if (tokenlist->list[i].type == JIM_TT_EOL) {
3501 count++;
3504 linenr = script->firstline = tokenlist->list[0].line;
3506 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3508 /* This is the first token for the current command */
3509 linefirst = token++;
3511 for (i = 0; i < tokenlist->count; ) {
3512 /* Look ahead to find out how many tokens make up the next word */
3513 int wordtokens;
3515 /* Skip any leading separators */
3516 while (tokenlist->list[i].type == JIM_TT_SEP) {
3517 i++;
3520 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3522 if (wordtokens == 0) {
3523 /* None, so at end of line */
3524 if (lineargs) {
3525 linefirst->type = JIM_TT_LINE;
3526 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3527 Jim_IncrRefCount(linefirst->objPtr);
3529 /* Reset for new line */
3530 lineargs = 0;
3531 linefirst = token++;
3533 i++;
3534 continue;
3536 else if (wordtokens != 1) {
3537 /* More than 1, or {*}, so insert a WORD token */
3538 token->type = JIM_TT_WORD;
3539 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3540 Jim_IncrRefCount(token->objPtr);
3541 token++;
3542 if (wordtokens < 0) {
3543 /* Skip the expand token */
3544 i++;
3545 wordtokens = -wordtokens - 1;
3546 lineargs--;
3550 if (lineargs == 0) {
3551 /* First real token on the line, so record the line number */
3552 linenr = tokenlist->list[i].line;
3554 lineargs++;
3556 /* Add each non-separator word token to the line */
3557 while (wordtokens--) {
3558 const ParseToken *t = &tokenlist->list[i++];
3560 token->type = t->type;
3561 token->objPtr = JimMakeScriptObj(interp, t);
3562 Jim_IncrRefCount(token->objPtr);
3564 /* Every object is initially a string of type 'source', but the
3565 * internal type may be specialized during execution of the
3566 * script. */
3567 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3568 token++;
3572 if (lineargs == 0) {
3573 token--;
3576 script->len = token - script->token;
3578 JimPanic((script->len >= count, "allocated script array is too short"));
3580 #ifdef DEBUG_SHOW_SCRIPT
3581 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3582 for (i = 0; i < script->len; i++) {
3583 const ScriptToken *t = &script->token[i];
3584 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3586 #endif
3590 /* Parses the given string object to determine if it represents a complete script.
3592 * This is useful for interactive shells implementation, for [info complete].
3594 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3595 * '{' on scripts incomplete missing one or more '}' to be balanced.
3596 * '[' on scripts incomplete missing one or more ']' to be balanced.
3597 * '"' on scripts incomplete missing a '"' char.
3598 * '\\' on scripts with a trailing backslash.
3600 * If the script is complete, 1 is returned, otherwise 0.
3602 * If the script has extra characters after a close brace, this still returns 1,
3603 * but sets *stateCharPtr to '}'
3604 * Evaluating the script will give the error "extra characters after close-brace".
3606 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3608 ScriptObj *script = JimGetScript(interp, scriptObj);
3609 if (stateCharPtr) {
3610 *stateCharPtr = script->missing;
3612 return script->missing == ' ' || script->missing == '}';
3616 * Sets an appropriate error message for a missing script/expression terminator.
3618 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3620 * Note that a trailing backslash is not considered to be an error.
3622 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3624 const char *msg;
3626 switch (ch) {
3627 case '\\':
3628 case ' ':
3629 return JIM_OK;
3631 case '[':
3632 msg = "unmatched \"[\"";
3633 break;
3634 case '{':
3635 msg = "missing close-brace";
3636 break;
3637 case '}':
3638 msg = "extra characters after close-brace";
3639 break;
3640 case '"':
3641 default:
3642 msg = "missing quote";
3643 break;
3646 Jim_SetResultString(interp, msg, -1);
3647 return JIM_ERR;
3651 * Similar to ScriptObjAddTokens(), but for subst objects.
3653 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3654 ParseTokenList *tokenlist)
3656 int i;
3657 struct ScriptToken *token;
3659 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3661 for (i = 0; i < tokenlist->count; i++) {
3662 const ParseToken *t = &tokenlist->list[i];
3664 /* Create a token for 't' */
3665 token->type = t->type;
3666 token->objPtr = JimMakeScriptObj(interp, t);
3667 Jim_IncrRefCount(token->objPtr);
3668 token++;
3671 script->len = i;
3674 /* This method takes the string representation of an object
3675 * as a Tcl script, and generates the pre-parsed internal representation
3676 * of the script.
3678 * On parse error, sets an error message and returns JIM_ERR
3679 * (Note: the object is still converted to a script, even if an error occurs)
3681 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3683 int scriptTextLen;
3684 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3685 struct JimParserCtx parser;
3686 struct ScriptObj *script;
3687 ParseTokenList tokenlist;
3688 int line = 1;
3690 /* Try to get information about filename / line number */
3691 if (objPtr->typePtr == &sourceObjType) {
3692 line = objPtr->internalRep.sourceValue.lineNumber;
3695 /* Initially parse the script into tokens (in tokenlist) */
3696 ScriptTokenListInit(&tokenlist);
3698 JimParserInit(&parser, scriptText, scriptTextLen, line);
3699 while (!parser.eof) {
3700 JimParseScript(&parser);
3701 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3702 parser.tline);
3705 /* Add a final EOF token */
3706 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3708 /* Create the "real" script tokens from the parsed tokens */
3709 script = Jim_Alloc(sizeof(*script));
3710 memset(script, 0, sizeof(*script));
3711 script->inUse = 1;
3712 if (objPtr->typePtr == &sourceObjType) {
3713 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3715 else {
3716 script->fileNameObj = interp->emptyObj;
3718 Jim_IncrRefCount(script->fileNameObj);
3719 script->missing = parser.missing.ch;
3720 script->linenr = parser.missing.line;
3722 ScriptObjAddTokens(interp, script, &tokenlist);
3724 /* No longer need the token list */
3725 ScriptTokenListFree(&tokenlist);
3727 /* Free the old internal rep and set the new one. */
3728 Jim_FreeIntRep(interp, objPtr);
3729 Jim_SetIntRepPtr(objPtr, script);
3730 objPtr->typePtr = &scriptObjType;
3733 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3736 * Returns the parsed script.
3737 * Note that if there is any possibility that the script is not valid,
3738 * call JimScriptValid() to check
3740 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3742 if (objPtr == interp->emptyObj) {
3743 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3744 objPtr = interp->nullScriptObj;
3747 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3748 JimSetScriptFromAny(interp, objPtr);
3751 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3755 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3756 * and leaves an error message in the interp result.
3759 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3761 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3762 JimAddErrorToStack(interp, script);
3763 return 0;
3765 return 1;
3769 /* -----------------------------------------------------------------------------
3770 * Commands
3771 * ---------------------------------------------------------------------------*/
3772 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3774 cmdPtr->inUse++;
3777 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3779 if (--cmdPtr->inUse == 0) {
3780 if (cmdPtr->isproc) {
3781 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3782 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3783 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3784 if (cmdPtr->u.proc.staticVars) {
3785 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3786 Jim_Free(cmdPtr->u.proc.staticVars);
3789 else {
3790 /* native (C) */
3791 if (cmdPtr->u.native.delProc) {
3792 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3795 if (cmdPtr->prevCmd) {
3796 /* Delete any pushed command too */
3797 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3799 Jim_Free(cmdPtr);
3803 /* Variables HashTable Type.
3805 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3808 /* Variables HashTable Type.
3810 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3811 static void JimVariablesHTValDestructor(void *interp, void *val)
3813 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3814 Jim_Free(val);
3817 static const Jim_HashTableType JimVariablesHashTableType = {
3818 JimStringCopyHTHashFunction, /* hash function */
3819 JimStringCopyHTDup, /* key dup */
3820 NULL, /* val dup */
3821 JimStringCopyHTKeyCompare, /* key compare */
3822 JimStringCopyHTKeyDestructor, /* key destructor */
3823 JimVariablesHTValDestructor /* val destructor */
3826 /* Commands HashTable Type.
3828 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3830 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3832 JimDecrCmdRefCount(interp, val);
3835 static const Jim_HashTableType JimCommandsHashTableType = {
3836 JimStringCopyHTHashFunction, /* hash function */
3837 JimStringCopyHTDup, /* key dup */
3838 NULL, /* val dup */
3839 JimStringCopyHTKeyCompare, /* key compare */
3840 JimStringCopyHTKeyDestructor, /* key destructor */
3841 JimCommandsHT_ValDestructor /* val destructor */
3844 /* ------------------------- Commands related functions --------------------- */
3846 #ifdef jim_ext_namespace
3848 * Returns the "unscoped" version of the given namespace.
3849 * That is, the fully qualified name without the leading ::
3850 * The returned value is either nsObj, or an object with a zero ref count.
3852 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3854 const char *name = Jim_String(nsObj);
3855 if (name[0] == ':' && name[1] == ':') {
3856 /* This command is being defined in the global namespace */
3857 while (*++name == ':') {
3859 nsObj = Jim_NewStringObj(interp, name, -1);
3861 else if (Jim_Length(interp->framePtr->nsObj)) {
3862 /* This command is being defined in a non-global namespace */
3863 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3864 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3866 return nsObj;
3869 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3871 Jim_Obj *resultObj;
3873 const char *name = Jim_String(nameObjPtr);
3874 if (name[0] == ':' && name[1] == ':') {
3875 return nameObjPtr;
3877 Jim_IncrRefCount(nameObjPtr);
3878 resultObj = Jim_NewStringObj(interp, "::", -1);
3879 Jim_AppendObj(interp, resultObj, nameObjPtr);
3880 Jim_DecrRefCount(interp, nameObjPtr);
3882 return resultObj;
3886 * An efficient version of JimQualifyNameObj() where the name is
3887 * available (and needed) as a 'const char *'.
3888 * Avoids creating an object if not necessary.
3889 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3891 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3893 Jim_Obj *objPtr = interp->emptyObj;
3895 if (name[0] == ':' && name[1] == ':') {
3896 /* This command is being defined in the global namespace */
3897 while (*++name == ':') {
3900 else if (Jim_Length(interp->framePtr->nsObj)) {
3901 /* This command is being defined in a non-global namespace */
3902 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3903 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3904 name = Jim_String(objPtr);
3906 Jim_IncrRefCount(objPtr);
3907 *objPtrPtr = objPtr;
3908 return name;
3911 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3913 #else
3914 /* We can be more efficient in the no-namespace case */
3915 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3916 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3918 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3920 return nameObjPtr;
3922 #endif
3924 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3926 /* It may already exist, so we try to delete the old one.
3927 * Note that reference count means that it won't be deleted yet if
3928 * it exists in the call stack.
3930 * BUT, if 'local' is in force, instead of deleting the existing
3931 * proc, we stash a reference to the old proc here.
3933 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3934 if (he) {
3935 /* There was an old cmd with the same name,
3936 * so this requires a 'proc epoch' update. */
3938 /* If a procedure with the same name didn't exist there is no need
3939 * to increment the 'proc epoch' because creation of a new procedure
3940 * can never affect existing cached commands. We don't do
3941 * negative caching. */
3942 Jim_InterpIncrProcEpoch(interp);
3945 if (he && interp->local) {
3946 /* Push this command over the top of the previous one */
3947 cmd->prevCmd = Jim_GetHashEntryVal(he);
3948 Jim_SetHashVal(&interp->commands, he, cmd);
3950 else {
3951 if (he) {
3952 /* Replace the existing command */
3953 Jim_DeleteHashEntry(&interp->commands, name);
3956 Jim_AddHashEntry(&interp->commands, name, cmd);
3958 return JIM_OK;
3962 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3963 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3965 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3967 /* Store the new details for this command */
3968 memset(cmdPtr, 0, sizeof(*cmdPtr));
3969 cmdPtr->inUse = 1;
3970 cmdPtr->u.native.delProc = delProc;
3971 cmdPtr->u.native.cmdProc = cmdProc;
3972 cmdPtr->u.native.privData = privData;
3974 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3976 return JIM_OK;
3979 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3981 int len, i;
3983 len = Jim_ListLength(interp, staticsListObjPtr);
3984 if (len == 0) {
3985 return JIM_OK;
3988 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3989 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3990 for (i = 0; i < len; i++) {
3991 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3992 Jim_Var *varPtr;
3993 int subLen;
3995 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3996 /* Check if it's composed of two elements. */
3997 subLen = Jim_ListLength(interp, objPtr);
3998 if (subLen == 1 || subLen == 2) {
3999 /* Try to get the variable value from the current
4000 * environment. */
4001 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
4002 if (subLen == 1) {
4003 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
4004 if (initObjPtr == NULL) {
4005 Jim_SetResultFormatted(interp,
4006 "variable for initialization of static \"%#s\" not found in the local context",
4007 nameObjPtr);
4008 return JIM_ERR;
4011 else {
4012 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
4014 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
4015 return JIM_ERR;
4018 varPtr = Jim_Alloc(sizeof(*varPtr));
4019 varPtr->objPtr = initObjPtr;
4020 Jim_IncrRefCount(initObjPtr);
4021 varPtr->linkFramePtr = NULL;
4022 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
4023 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
4024 Jim_SetResultFormatted(interp,
4025 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4026 Jim_DecrRefCount(interp, initObjPtr);
4027 Jim_Free(varPtr);
4028 return JIM_ERR;
4031 else {
4032 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4033 objPtr);
4034 return JIM_ERR;
4037 return JIM_OK;
4040 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4042 #ifdef jim_ext_namespace
4043 if (cmdPtr->isproc) {
4044 /* XXX: Really need JimNamespaceSplit() */
4045 const char *pt = strrchr(cmdname, ':');
4046 if (pt && pt != cmdname && pt[-1] == ':') {
4047 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4048 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4049 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4051 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4052 /* This commands shadows a global command, so a proc epoch update is required */
4053 Jim_InterpIncrProcEpoch(interp);
4057 #endif
4060 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4061 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4063 Jim_Cmd *cmdPtr;
4064 int argListLen;
4065 int i;
4067 argListLen = Jim_ListLength(interp, argListObjPtr);
4069 /* Allocate space for both the command pointer and the arg list */
4070 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4071 memset(cmdPtr, 0, sizeof(*cmdPtr));
4072 cmdPtr->inUse = 1;
4073 cmdPtr->isproc = 1;
4074 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4075 cmdPtr->u.proc.argListLen = argListLen;
4076 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4077 cmdPtr->u.proc.argsPos = -1;
4078 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4079 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4080 Jim_IncrRefCount(argListObjPtr);
4081 Jim_IncrRefCount(bodyObjPtr);
4082 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4084 /* Create the statics hash table. */
4085 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4086 goto err;
4089 /* Parse the args out into arglist, validating as we go */
4090 /* Examine the argument list for default parameters and 'args' */
4091 for (i = 0; i < argListLen; i++) {
4092 Jim_Obj *argPtr;
4093 Jim_Obj *nameObjPtr;
4094 Jim_Obj *defaultObjPtr;
4095 int len;
4097 /* Examine a parameter */
4098 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4099 len = Jim_ListLength(interp, argPtr);
4100 if (len == 0) {
4101 Jim_SetResultString(interp, "argument with no name", -1);
4102 err:
4103 JimDecrCmdRefCount(interp, cmdPtr);
4104 return NULL;
4106 if (len > 2) {
4107 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4108 goto err;
4111 if (len == 2) {
4112 /* Optional parameter */
4113 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4114 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4116 else {
4117 /* Required parameter */
4118 nameObjPtr = argPtr;
4119 defaultObjPtr = NULL;
4123 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4124 if (cmdPtr->u.proc.argsPos >= 0) {
4125 Jim_SetResultString(interp, "'args' specified more than once", -1);
4126 goto err;
4128 cmdPtr->u.proc.argsPos = i;
4130 else {
4131 if (len == 2) {
4132 cmdPtr->u.proc.optArity++;
4134 else {
4135 cmdPtr->u.proc.reqArity++;
4139 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4140 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4143 return cmdPtr;
4146 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4148 int ret = JIM_OK;
4149 Jim_Obj *qualifiedNameObj;
4150 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4152 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4153 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4154 ret = JIM_ERR;
4156 else {
4157 Jim_InterpIncrProcEpoch(interp);
4160 JimFreeQualifiedName(interp, qualifiedNameObj);
4162 return ret;
4165 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4167 int ret = JIM_ERR;
4168 Jim_HashEntry *he;
4169 Jim_Cmd *cmdPtr;
4170 Jim_Obj *qualifiedOldNameObj;
4171 Jim_Obj *qualifiedNewNameObj;
4172 const char *fqold;
4173 const char *fqnew;
4175 if (newName[0] == 0) {
4176 return Jim_DeleteCommand(interp, oldName);
4179 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4180 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4182 /* Does it exist? */
4183 he = Jim_FindHashEntry(&interp->commands, fqold);
4184 if (he == NULL) {
4185 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4187 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4188 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4190 else {
4191 /* Add the new name first */
4192 cmdPtr = Jim_GetHashEntryVal(he);
4193 JimIncrCmdRefCount(cmdPtr);
4194 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4195 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4197 /* Now remove the old name */
4198 Jim_DeleteHashEntry(&interp->commands, fqold);
4200 /* Increment the epoch */
4201 Jim_InterpIncrProcEpoch(interp);
4203 ret = JIM_OK;
4206 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4207 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4209 return ret;
4212 /* -----------------------------------------------------------------------------
4213 * Command object
4214 * ---------------------------------------------------------------------------*/
4216 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4218 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4221 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4223 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4224 dupPtr->typePtr = srcPtr->typePtr;
4225 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4228 static const Jim_ObjType commandObjType = {
4229 "command",
4230 FreeCommandInternalRep,
4231 DupCommandInternalRep,
4232 NULL,
4233 JIM_TYPE_REFERENCES,
4236 /* This function returns the command structure for the command name
4237 * stored in objPtr. It tries to specialize the objPtr to contain
4238 * a cached info instead to perform the lookup into the hash table
4239 * every time. The information cached may not be uptodate, in such
4240 * a case the lookup is performed and the cache updated.
4242 * Respects the 'upcall' setting
4244 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4246 Jim_Cmd *cmd;
4248 /* In order to be valid, the proc epoch must match and
4249 * the lookup must have occurred in the same namespace
4251 if (objPtr->typePtr != &commandObjType ||
4252 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4253 #ifdef jim_ext_namespace
4254 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4255 #endif
4257 /* Not cached or out of date, so lookup */
4259 /* Do we need to try the local namespace? */
4260 const char *name = Jim_String(objPtr);
4261 Jim_HashEntry *he;
4263 if (name[0] == ':' && name[1] == ':') {
4264 while (*++name == ':') {
4267 #ifdef jim_ext_namespace
4268 else if (Jim_Length(interp->framePtr->nsObj)) {
4269 /* This command is being defined in a non-global namespace */
4270 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4271 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4272 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4273 Jim_FreeNewObj(interp, nameObj);
4274 if (he) {
4275 goto found;
4278 #endif
4280 /* Lookup in the global namespace */
4281 he = Jim_FindHashEntry(&interp->commands, name);
4282 if (he == NULL) {
4283 if (flags & JIM_ERRMSG) {
4284 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4286 return NULL;
4288 #ifdef jim_ext_namespace
4289 found:
4290 #endif
4291 cmd = Jim_GetHashEntryVal(he);
4293 /* Free the old internal repr and set the new one. */
4294 Jim_FreeIntRep(interp, objPtr);
4295 objPtr->typePtr = &commandObjType;
4296 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4297 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4298 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4299 Jim_IncrRefCount(interp->framePtr->nsObj);
4301 else {
4302 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4304 while (cmd->u.proc.upcall) {
4305 cmd = cmd->prevCmd;
4307 return cmd;
4310 /* -----------------------------------------------------------------------------
4311 * Variables
4312 * ---------------------------------------------------------------------------*/
4314 /* -----------------------------------------------------------------------------
4315 * Variable object
4316 * ---------------------------------------------------------------------------*/
4318 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4320 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4322 static const Jim_ObjType variableObjType = {
4323 "variable",
4324 NULL,
4325 NULL,
4326 NULL,
4327 JIM_TYPE_REFERENCES,
4331 * Check that the name does not contain embedded nulls.
4333 * Variable and procedure names are manipulated as null terminated strings, so
4334 * don't allow names with embedded nulls.
4336 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4338 /* Variable names and proc names can't contain embedded nulls */
4339 if (nameObjPtr->typePtr != &variableObjType) {
4340 int len;
4341 const char *str = Jim_GetString(nameObjPtr, &len);
4342 if (memchr(str, '\0', len)) {
4343 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4344 return JIM_ERR;
4347 return JIM_OK;
4350 /* This method should be called only by the variable API.
4351 * It returns JIM_OK on success (variable already exists),
4352 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4353 * a variable name, but syntax glue for [dict] i.e. the last
4354 * character is ')' */
4355 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4357 const char *varName;
4358 Jim_CallFrame *framePtr;
4359 Jim_HashEntry *he;
4360 int global;
4361 int len;
4363 /* Check if the object is already an uptodate variable */
4364 if (objPtr->typePtr == &variableObjType) {
4365 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4366 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4367 /* nothing to do */
4368 return JIM_OK;
4370 /* Need to re-resolve the variable in the updated callframe */
4372 else if (objPtr->typePtr == &dictSubstObjType) {
4373 return JIM_DICT_SUGAR;
4375 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4376 return JIM_ERR;
4380 varName = Jim_GetString(objPtr, &len);
4382 /* Make sure it's not syntax glue to get/set dict. */
4383 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4384 return JIM_DICT_SUGAR;
4387 if (varName[0] == ':' && varName[1] == ':') {
4388 while (*++varName == ':') {
4390 global = 1;
4391 framePtr = interp->topFramePtr;
4393 else {
4394 global = 0;
4395 framePtr = interp->framePtr;
4398 /* Resolve this name in the variables hash table */
4399 he = Jim_FindHashEntry(&framePtr->vars, varName);
4400 if (he == NULL) {
4401 if (!global && framePtr->staticVars) {
4402 /* Try with static vars. */
4403 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4405 if (he == NULL) {
4406 return JIM_ERR;
4410 /* Free the old internal repr and set the new one. */
4411 Jim_FreeIntRep(interp, objPtr);
4412 objPtr->typePtr = &variableObjType;
4413 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4414 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4415 objPtr->internalRep.varValue.global = global;
4416 return JIM_OK;
4419 /* -------------------- Variables related functions ------------------------- */
4420 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4421 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4423 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4425 const char *name;
4426 Jim_CallFrame *framePtr;
4427 int global;
4429 /* New variable to create */
4430 Jim_Var *var = Jim_Alloc(sizeof(*var));
4432 var->objPtr = valObjPtr;
4433 Jim_IncrRefCount(valObjPtr);
4434 var->linkFramePtr = NULL;
4436 name = Jim_String(nameObjPtr);
4437 if (name[0] == ':' && name[1] == ':') {
4438 while (*++name == ':') {
4440 framePtr = interp->topFramePtr;
4441 global = 1;
4443 else {
4444 framePtr = interp->framePtr;
4445 global = 0;
4448 /* Insert the new variable */
4449 Jim_AddHashEntry(&framePtr->vars, name, var);
4451 /* Make the object int rep a variable */
4452 Jim_FreeIntRep(interp, nameObjPtr);
4453 nameObjPtr->typePtr = &variableObjType;
4454 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4455 nameObjPtr->internalRep.varValue.varPtr = var;
4456 nameObjPtr->internalRep.varValue.global = global;
4458 return var;
4461 /* For now that's dummy. Variables lookup should be optimized
4462 * in many ways, with caching of lookups, and possibly with
4463 * a table of pre-allocated vars in every CallFrame for local vars.
4464 * All the caching should also have an 'epoch' mechanism similar
4465 * to the one used by Tcl for procedures lookup caching. */
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 *nameObjPtr, *valObjPtr;
4531 int result;
4533 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4534 valObjPtr = Jim_NewStringObj(interp, val, -1);
4535 Jim_IncrRefCount(nameObjPtr);
4536 Jim_IncrRefCount(valObjPtr);
4537 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4538 Jim_DecrRefCount(interp, nameObjPtr);
4539 Jim_DecrRefCount(interp, valObjPtr);
4540 return result;
4543 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4544 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4546 const char *varName;
4547 const char *targetName;
4548 Jim_CallFrame *framePtr;
4549 Jim_Var *varPtr;
4551 /* Check for an existing variable or link */
4552 switch (SetVariableFromAny(interp, nameObjPtr)) {
4553 case JIM_DICT_SUGAR:
4554 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4555 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4556 return JIM_ERR;
4558 case JIM_OK:
4559 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4561 if (varPtr->linkFramePtr == NULL) {
4562 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4563 return JIM_ERR;
4566 /* It exists, but is a link, so first delete the link */
4567 varPtr->linkFramePtr = NULL;
4568 break;
4571 /* Resolve the call frames for both variables */
4572 /* XXX: SetVariableFromAny() already did this! */
4573 varName = Jim_String(nameObjPtr);
4575 if (varName[0] == ':' && varName[1] == ':') {
4576 while (*++varName == ':') {
4578 /* Linking a global var does nothing */
4579 framePtr = interp->topFramePtr;
4581 else {
4582 framePtr = interp->framePtr;
4585 targetName = Jim_String(targetNameObjPtr);
4586 if (targetName[0] == ':' && targetName[1] == ':') {
4587 while (*++targetName == ':') {
4589 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4590 targetCallFrame = interp->topFramePtr;
4592 Jim_IncrRefCount(targetNameObjPtr);
4594 if (framePtr->level < targetCallFrame->level) {
4595 Jim_SetResultFormatted(interp,
4596 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4597 nameObjPtr);
4598 Jim_DecrRefCount(interp, targetNameObjPtr);
4599 return JIM_ERR;
4602 /* Check for cycles. */
4603 if (framePtr == targetCallFrame) {
4604 Jim_Obj *objPtr = targetNameObjPtr;
4606 /* Cycles are only possible with 'uplevel 0' */
4607 while (1) {
4608 if (strcmp(Jim_String(objPtr), varName) == 0) {
4609 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4610 Jim_DecrRefCount(interp, targetNameObjPtr);
4611 return JIM_ERR;
4613 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4614 break;
4615 varPtr = objPtr->internalRep.varValue.varPtr;
4616 if (varPtr->linkFramePtr != targetCallFrame)
4617 break;
4618 objPtr = varPtr->objPtr;
4622 /* Perform the binding */
4623 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4624 /* We are now sure 'nameObjPtr' type is variableObjType */
4625 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4626 Jim_DecrRefCount(interp, targetNameObjPtr);
4627 return JIM_OK;
4630 /* Return the Jim_Obj pointer associated with a variable name,
4631 * or NULL if the variable was not found in the current context.
4632 * The same optimization discussed in the comment to the
4633 * 'SetVariable' function should apply here.
4635 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4636 * in a dictionary which is shared, the array variable value is duplicated first.
4637 * This allows the array element to be updated (e.g. append, lappend) without
4638 * affecting other references to the dictionary.
4640 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4642 switch (SetVariableFromAny(interp, nameObjPtr)) {
4643 case JIM_OK:{
4644 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4646 if (varPtr->linkFramePtr == NULL) {
4647 return varPtr->objPtr;
4649 else {
4650 Jim_Obj *objPtr;
4652 /* The variable is a link? Resolve it. */
4653 Jim_CallFrame *savedCallFrame = interp->framePtr;
4655 interp->framePtr = varPtr->linkFramePtr;
4656 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4657 interp->framePtr = savedCallFrame;
4658 if (objPtr) {
4659 return objPtr;
4661 /* Error, so fall through to the error message */
4664 break;
4666 case JIM_DICT_SUGAR:
4667 /* [dict] syntax sugar. */
4668 return JimDictSugarGet(interp, nameObjPtr, flags);
4670 if (flags & JIM_ERRMSG) {
4671 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4673 return NULL;
4676 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4678 Jim_CallFrame *savedFramePtr;
4679 Jim_Obj *objPtr;
4681 savedFramePtr = interp->framePtr;
4682 interp->framePtr = interp->topFramePtr;
4683 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4684 interp->framePtr = savedFramePtr;
4686 return objPtr;
4689 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4691 Jim_Obj *nameObjPtr, *varObjPtr;
4693 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4694 Jim_IncrRefCount(nameObjPtr);
4695 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4696 Jim_DecrRefCount(interp, nameObjPtr);
4697 return varObjPtr;
4700 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4702 Jim_CallFrame *savedFramePtr;
4703 Jim_Obj *objPtr;
4705 savedFramePtr = interp->framePtr;
4706 interp->framePtr = interp->topFramePtr;
4707 objPtr = Jim_GetVariableStr(interp, name, flags);
4708 interp->framePtr = savedFramePtr;
4710 return objPtr;
4713 /* Unset a variable.
4714 * Note: On success unset invalidates all the variable objects created
4715 * in the current call frame incrementing. */
4716 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4718 Jim_Var *varPtr;
4719 int retval;
4720 Jim_CallFrame *framePtr;
4722 retval = SetVariableFromAny(interp, nameObjPtr);
4723 if (retval == JIM_DICT_SUGAR) {
4724 /* [dict] syntax sugar. */
4725 return JimDictSugarSet(interp, nameObjPtr, NULL);
4727 else if (retval == JIM_OK) {
4728 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4730 /* If it's a link call UnsetVariable recursively */
4731 if (varPtr->linkFramePtr) {
4732 framePtr = interp->framePtr;
4733 interp->framePtr = varPtr->linkFramePtr;
4734 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4735 interp->framePtr = framePtr;
4737 else {
4738 const char *name = Jim_String(nameObjPtr);
4739 if (nameObjPtr->internalRep.varValue.global) {
4740 name += 2;
4741 framePtr = interp->topFramePtr;
4743 else {
4744 framePtr = interp->framePtr;
4747 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4748 if (retval == JIM_OK) {
4749 /* Change the callframe id, invalidating var lookup caching */
4750 framePtr->id = interp->callFrameEpoch++;
4754 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4755 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4757 return retval;
4760 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4762 /* Given a variable name for [dict] operation syntax sugar,
4763 * this function returns two objects, the first with the name
4764 * of the variable to set, and the second with the respective key.
4765 * For example "foo(bar)" will return objects with string repr. of
4766 * "foo" and "bar".
4768 * The returned objects have refcount = 1. The function can't fail. */
4769 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4770 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4772 const char *str, *p;
4773 int len, keyLen;
4774 Jim_Obj *varObjPtr, *keyObjPtr;
4776 str = Jim_GetString(objPtr, &len);
4778 p = strchr(str, '(');
4779 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4781 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4783 p++;
4784 keyLen = (str + len) - p;
4785 if (str[len - 1] == ')') {
4786 keyLen--;
4789 /* Create the objects with the variable name and key. */
4790 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4792 Jim_IncrRefCount(varObjPtr);
4793 Jim_IncrRefCount(keyObjPtr);
4794 *varPtrPtr = varObjPtr;
4795 *keyPtrPtr = keyObjPtr;
4798 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4799 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4800 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4802 int err;
4804 SetDictSubstFromAny(interp, objPtr);
4806 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4807 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4809 if (err == JIM_OK) {
4810 /* Don't keep an extra ref to the result */
4811 Jim_SetEmptyResult(interp);
4813 else {
4814 if (!valObjPtr) {
4815 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4816 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4817 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4818 objPtr);
4819 return err;
4822 /* Make the error more informative and Tcl-compatible */
4823 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4824 (valObjPtr ? "set" : "unset"), objPtr);
4826 return err;
4830 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4832 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4833 * and stored back to the variable before expansion.
4835 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4836 Jim_Obj *keyObjPtr, int flags)
4838 Jim_Obj *dictObjPtr;
4839 Jim_Obj *resObjPtr = NULL;
4840 int ret;
4842 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4843 if (!dictObjPtr) {
4844 return NULL;
4847 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4848 if (ret != JIM_OK) {
4849 Jim_SetResultFormatted(interp,
4850 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4851 ret < 0 ? "variable isn't" : "no such element in");
4853 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4854 /* Update the variable to have an unshared copy */
4855 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4858 return resObjPtr;
4861 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4862 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4864 SetDictSubstFromAny(interp, objPtr);
4866 return JimDictExpandArrayVariable(interp,
4867 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4868 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4871 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4873 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4875 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4876 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4879 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4881 /* Copy the internal rep */
4882 dupPtr->internalRep = srcPtr->internalRep;
4883 /* Need to increment the ref counts */
4884 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4885 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4888 /* Note: The object *must* be in dict-sugar format */
4889 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4891 if (objPtr->typePtr != &dictSubstObjType) {
4892 Jim_Obj *varObjPtr, *keyObjPtr;
4894 if (objPtr->typePtr == &interpolatedObjType) {
4895 /* An interpolated object in dict-sugar form */
4897 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4898 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4900 Jim_IncrRefCount(varObjPtr);
4901 Jim_IncrRefCount(keyObjPtr);
4903 else {
4904 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4907 Jim_FreeIntRep(interp, objPtr);
4908 objPtr->typePtr = &dictSubstObjType;
4909 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4910 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4914 /* This function is used to expand [dict get] sugar in the form
4915 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4916 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4917 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4918 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4919 * the [dict]ionary contained in variable VARNAME. */
4920 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4922 Jim_Obj *resObjPtr = NULL;
4923 Jim_Obj *substKeyObjPtr = NULL;
4925 SetDictSubstFromAny(interp, objPtr);
4927 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4928 &substKeyObjPtr, JIM_NONE)
4929 != JIM_OK) {
4930 return NULL;
4932 Jim_IncrRefCount(substKeyObjPtr);
4933 resObjPtr =
4934 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4935 substKeyObjPtr, 0);
4936 Jim_DecrRefCount(interp, substKeyObjPtr);
4938 return resObjPtr;
4941 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4943 if (Jim_EvalExpression(interp, objPtr) == JIM_OK) {
4944 return Jim_GetResult(interp);
4946 return NULL;
4949 /* -----------------------------------------------------------------------------
4950 * CallFrame
4951 * ---------------------------------------------------------------------------*/
4953 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4955 Jim_CallFrame *cf;
4957 if (interp->freeFramesList) {
4958 cf = interp->freeFramesList;
4959 interp->freeFramesList = cf->next;
4961 cf->argv = NULL;
4962 cf->argc = 0;
4963 cf->procArgsObjPtr = NULL;
4964 cf->procBodyObjPtr = NULL;
4965 cf->next = NULL;
4966 cf->staticVars = NULL;
4967 cf->localCommands = NULL;
4968 cf->tailcallObj = NULL;
4969 cf->tailcallCmd = NULL;
4971 else {
4972 cf = Jim_Alloc(sizeof(*cf));
4973 memset(cf, 0, sizeof(*cf));
4975 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4978 cf->id = interp->callFrameEpoch++;
4979 cf->parent = parent;
4980 cf->level = parent ? parent->level + 1 : 0;
4981 cf->nsObj = nsObj;
4982 Jim_IncrRefCount(nsObj);
4984 return cf;
4987 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4989 /* Delete any local procs */
4990 if (localCommands) {
4991 Jim_Obj *cmdNameObj;
4993 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4994 Jim_HashEntry *he;
4995 Jim_Obj *fqObjName;
4996 Jim_HashTable *ht = &interp->commands;
4998 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
5000 he = Jim_FindHashEntry(ht, fqname);
5002 if (he) {
5003 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
5004 if (cmd->prevCmd) {
5005 Jim_Cmd *prevCmd = cmd->prevCmd;
5006 cmd->prevCmd = NULL;
5008 /* Delete the old command */
5009 JimDecrCmdRefCount(interp, cmd);
5011 /* And restore the original */
5012 Jim_SetHashVal(ht, he, prevCmd);
5014 else {
5015 Jim_DeleteHashEntry(ht, fqname);
5017 Jim_InterpIncrProcEpoch(interp);
5019 Jim_DecrRefCount(interp, cmdNameObj);
5020 JimFreeQualifiedName(interp, fqObjName);
5022 Jim_FreeStack(localCommands);
5023 Jim_Free(localCommands);
5025 return JIM_OK;
5029 * Run any $jim::defer scripts for the current call frame.
5031 * retcode is the return code from the current proc.
5033 * Returns the new return code.
5035 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
5037 Jim_Obj *objPtr;
5039 /* Fast check for the likely case that the variable doesn't exist */
5040 if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
5041 return retcode;
5044 objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
5046 if (objPtr) {
5047 int ret = JIM_OK;
5048 int i;
5049 int listLen = Jim_ListLength(interp, objPtr);
5050 Jim_Obj *resultObjPtr;
5052 Jim_IncrRefCount(objPtr);
5054 /* Need to save away the current interp result and
5055 * restore it if appropriate
5057 resultObjPtr = Jim_GetResult(interp);
5058 Jim_IncrRefCount(resultObjPtr);
5059 Jim_SetEmptyResult(interp);
5061 /* Invoke in reverse order */
5062 for (i = listLen; i > 0; i--) {
5063 /* If a defer script returns an error, don't evaluate remaining scripts */
5064 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5065 ret = Jim_EvalObj(interp, scriptObjPtr);
5066 if (ret != JIM_OK) {
5067 break;
5071 if (ret == JIM_OK || retcode == JIM_ERR) {
5072 /* defer script had no error, or proc had an error so restore proc result */
5073 Jim_SetResult(interp, resultObjPtr);
5075 else {
5076 retcode = ret;
5079 Jim_DecrRefCount(interp, resultObjPtr);
5080 Jim_DecrRefCount(interp, objPtr);
5082 return retcode;
5085 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5086 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5087 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5089 JimDeleteLocalProcs(interp, cf->localCommands);
5091 if (cf->procArgsObjPtr)
5092 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5093 if (cf->procBodyObjPtr)
5094 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5095 Jim_DecrRefCount(interp, cf->nsObj);
5096 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5097 Jim_FreeHashTable(&cf->vars);
5098 else {
5099 int i;
5100 Jim_HashEntry **table = cf->vars.table, *he;
5102 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5103 he = table[i];
5104 while (he != NULL) {
5105 Jim_HashEntry *nextEntry = he->next;
5106 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5108 Jim_DecrRefCount(interp, varPtr->objPtr);
5109 Jim_Free(Jim_GetHashEntryKey(he));
5110 Jim_Free(varPtr);
5111 Jim_Free(he);
5112 table[i] = NULL;
5113 he = nextEntry;
5116 cf->vars.used = 0;
5118 cf->next = interp->freeFramesList;
5119 interp->freeFramesList = cf;
5123 /* -----------------------------------------------------------------------------
5124 * References
5125 * ---------------------------------------------------------------------------*/
5126 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5128 /* References HashTable Type.
5130 * Keys are unsigned long integers, dynamically allocated for now but in the
5131 * future it's worth to cache this 4 bytes objects. Values are pointers
5132 * to Jim_References. */
5133 static void JimReferencesHTValDestructor(void *interp, void *val)
5135 Jim_Reference *refPtr = (void *)val;
5137 Jim_DecrRefCount(interp, refPtr->objPtr);
5138 if (refPtr->finalizerCmdNamePtr != NULL) {
5139 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5141 Jim_Free(val);
5144 static unsigned int JimReferencesHTHashFunction(const void *key)
5146 /* Only the least significant bits are used. */
5147 const unsigned long *widePtr = key;
5148 unsigned int intValue = (unsigned int)*widePtr;
5150 return Jim_IntHashFunction(intValue);
5153 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5155 void *copy = Jim_Alloc(sizeof(unsigned long));
5157 JIM_NOTUSED(privdata);
5159 memcpy(copy, key, sizeof(unsigned long));
5160 return copy;
5163 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5165 JIM_NOTUSED(privdata);
5167 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5170 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5172 JIM_NOTUSED(privdata);
5174 Jim_Free(key);
5177 static const Jim_HashTableType JimReferencesHashTableType = {
5178 JimReferencesHTHashFunction, /* hash function */
5179 JimReferencesHTKeyDup, /* key dup */
5180 NULL, /* val dup */
5181 JimReferencesHTKeyCompare, /* key compare */
5182 JimReferencesHTKeyDestructor, /* key destructor */
5183 JimReferencesHTValDestructor /* val destructor */
5186 /* -----------------------------------------------------------------------------
5187 * Reference object type and References API
5188 * ---------------------------------------------------------------------------*/
5190 /* The string representation of references has two features in order
5191 * to make the GC faster. The first is that every reference starts
5192 * with a non common character '<', in order to make the string matching
5193 * faster. The second is that the reference string rep is 42 characters
5194 * in length, this means that it is not necessary to check any object with a string
5195 * repr < 42, and usually there aren't many of these objects. */
5197 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5199 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5201 const char *fmt = "<reference.<%s>.%020lu>";
5203 sprintf(buf, fmt, refPtr->tag, id);
5204 return JIM_REFERENCE_SPACE;
5207 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5209 static const Jim_ObjType referenceObjType = {
5210 "reference",
5211 NULL,
5212 NULL,
5213 UpdateStringOfReference,
5214 JIM_TYPE_REFERENCES,
5217 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5219 char buf[JIM_REFERENCE_SPACE + 1];
5221 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5222 JimSetStringBytes(objPtr, buf);
5225 /* returns true if 'c' is a valid reference tag character.
5226 * i.e. inside the range [_a-zA-Z0-9] */
5227 static int isrefchar(int c)
5229 return (c == '_' || isalnum(c));
5232 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5234 unsigned long value;
5235 int i, len;
5236 const char *str, *start, *end;
5237 char refId[21];
5238 Jim_Reference *refPtr;
5239 Jim_HashEntry *he;
5240 char *endptr;
5242 /* Get the string representation */
5243 str = Jim_GetString(objPtr, &len);
5244 /* Check if it looks like a reference */
5245 if (len < JIM_REFERENCE_SPACE)
5246 goto badformat;
5247 /* Trim spaces */
5248 start = str;
5249 end = str + len - 1;
5250 while (*start == ' ')
5251 start++;
5252 while (*end == ' ' && end > start)
5253 end--;
5254 if (end - start + 1 != JIM_REFERENCE_SPACE)
5255 goto badformat;
5256 /* <reference.<1234567>.%020> */
5257 if (memcmp(start, "<reference.<", 12) != 0)
5258 goto badformat;
5259 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5260 goto badformat;
5261 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5262 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5263 if (!isrefchar(start[12 + i]))
5264 goto badformat;
5266 /* Extract info from the reference. */
5267 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5268 refId[20] = '\0';
5269 /* Try to convert the ID into an unsigned long */
5270 value = strtoul(refId, &endptr, 10);
5271 if (JimCheckConversion(refId, endptr) != JIM_OK)
5272 goto badformat;
5273 /* Check if the reference really exists! */
5274 he = Jim_FindHashEntry(&interp->references, &value);
5275 if (he == NULL) {
5276 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5277 return JIM_ERR;
5279 refPtr = Jim_GetHashEntryVal(he);
5280 /* Free the old internal repr and set the new one. */
5281 Jim_FreeIntRep(interp, objPtr);
5282 objPtr->typePtr = &referenceObjType;
5283 objPtr->internalRep.refValue.id = value;
5284 objPtr->internalRep.refValue.refPtr = refPtr;
5285 return JIM_OK;
5287 badformat:
5288 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5289 return JIM_ERR;
5292 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5293 * as finalizer command (or NULL if there is no finalizer).
5294 * The returned reference object has refcount = 0. */
5295 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5297 struct Jim_Reference *refPtr;
5298 unsigned long id;
5299 Jim_Obj *refObjPtr;
5300 const char *tag;
5301 int tagLen, i;
5303 /* Perform the Garbage Collection if needed. */
5304 Jim_CollectIfNeeded(interp);
5306 refPtr = Jim_Alloc(sizeof(*refPtr));
5307 refPtr->objPtr = objPtr;
5308 Jim_IncrRefCount(objPtr);
5309 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5310 if (cmdNamePtr)
5311 Jim_IncrRefCount(cmdNamePtr);
5312 id = interp->referenceNextId++;
5313 Jim_AddHashEntry(&interp->references, &id, refPtr);
5314 refObjPtr = Jim_NewObj(interp);
5315 refObjPtr->typePtr = &referenceObjType;
5316 refObjPtr->bytes = NULL;
5317 refObjPtr->internalRep.refValue.id = id;
5318 refObjPtr->internalRep.refValue.refPtr = refPtr;
5319 interp->referenceNextId++;
5320 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5321 * that does not pass the 'isrefchar' test is replaced with '_' */
5322 tag = Jim_GetString(tagPtr, &tagLen);
5323 if (tagLen > JIM_REFERENCE_TAGLEN)
5324 tagLen = JIM_REFERENCE_TAGLEN;
5325 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5326 if (i < tagLen && isrefchar(tag[i]))
5327 refPtr->tag[i] = tag[i];
5328 else
5329 refPtr->tag[i] = '_';
5331 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5332 return refObjPtr;
5335 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5337 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5338 return NULL;
5339 return objPtr->internalRep.refValue.refPtr;
5342 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5344 Jim_Reference *refPtr;
5346 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5347 return JIM_ERR;
5348 Jim_IncrRefCount(cmdNamePtr);
5349 if (refPtr->finalizerCmdNamePtr)
5350 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5351 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5352 return JIM_OK;
5355 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5357 Jim_Reference *refPtr;
5359 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5360 return JIM_ERR;
5361 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5362 return JIM_OK;
5365 /* -----------------------------------------------------------------------------
5366 * References Garbage Collection
5367 * ---------------------------------------------------------------------------*/
5369 /* This the hash table type for the "MARK" phase of the GC */
5370 static const Jim_HashTableType JimRefMarkHashTableType = {
5371 JimReferencesHTHashFunction, /* hash function */
5372 JimReferencesHTKeyDup, /* key dup */
5373 NULL, /* val dup */
5374 JimReferencesHTKeyCompare, /* key compare */
5375 JimReferencesHTKeyDestructor, /* key destructor */
5376 NULL /* val destructor */
5379 /* Performs the garbage collection. */
5380 int Jim_Collect(Jim_Interp *interp)
5382 int collected = 0;
5383 Jim_HashTable marks;
5384 Jim_HashTableIterator htiter;
5385 Jim_HashEntry *he;
5386 Jim_Obj *objPtr;
5388 /* Avoid recursive calls */
5389 if (interp->lastCollectId == -1) {
5390 /* Jim_Collect() already running. Return just now. */
5391 return 0;
5393 interp->lastCollectId = -1;
5395 /* Mark all the references found into the 'mark' hash table.
5396 * The references are searched in every live object that
5397 * is of a type that can contain references. */
5398 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5399 objPtr = interp->liveList;
5400 while (objPtr) {
5401 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5402 const char *str, *p;
5403 int len;
5405 /* If the object is of type reference, to get the
5406 * Id is simple... */
5407 if (objPtr->typePtr == &referenceObjType) {
5408 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5409 #ifdef JIM_DEBUG_GC
5410 printf("MARK (reference): %d refcount: %d\n",
5411 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5412 #endif
5413 objPtr = objPtr->nextObjPtr;
5414 continue;
5416 /* Get the string repr of the object we want
5417 * to scan for references. */
5418 p = str = Jim_GetString(objPtr, &len);
5419 /* Skip objects too little to contain references. */
5420 if (len < JIM_REFERENCE_SPACE) {
5421 objPtr = objPtr->nextObjPtr;
5422 continue;
5424 /* Extract references from the object string repr. */
5425 while (1) {
5426 int i;
5427 unsigned long id;
5429 if ((p = strstr(p, "<reference.<")) == NULL)
5430 break;
5431 /* Check if it's a valid reference. */
5432 if (len - (p - str) < JIM_REFERENCE_SPACE)
5433 break;
5434 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5435 break;
5436 for (i = 21; i <= 40; i++)
5437 if (!isdigit(UCHAR(p[i])))
5438 break;
5439 /* Get the ID */
5440 id = strtoul(p + 21, NULL, 10);
5442 /* Ok, a reference for the given ID
5443 * was found. Mark it. */
5444 Jim_AddHashEntry(&marks, &id, NULL);
5445 #ifdef JIM_DEBUG_GC
5446 printf("MARK: %d\n", (int)id);
5447 #endif
5448 p += JIM_REFERENCE_SPACE;
5451 objPtr = objPtr->nextObjPtr;
5454 /* Run the references hash table to destroy every reference that
5455 * is not referenced outside (not present in the mark HT). */
5456 JimInitHashTableIterator(&interp->references, &htiter);
5457 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5458 const unsigned long *refId;
5459 Jim_Reference *refPtr;
5461 refId = he->key;
5462 /* Check if in the mark phase we encountered
5463 * this reference. */
5464 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5465 #ifdef JIM_DEBUG_GC
5466 printf("COLLECTING %d\n", (int)*refId);
5467 #endif
5468 collected++;
5469 /* Drop the reference, but call the
5470 * finalizer first if registered. */
5471 refPtr = Jim_GetHashEntryVal(he);
5472 if (refPtr->finalizerCmdNamePtr) {
5473 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5474 Jim_Obj *objv[3], *oldResult;
5476 JimFormatReference(refstr, refPtr, *refId);
5478 objv[0] = refPtr->finalizerCmdNamePtr;
5479 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5480 objv[2] = refPtr->objPtr;
5482 /* Drop the reference itself */
5483 /* Avoid the finaliser being freed here */
5484 Jim_IncrRefCount(objv[0]);
5485 /* Don't remove the reference from the hash table just yet
5486 * since that will free refPtr, and hence refPtr->objPtr
5489 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5490 oldResult = interp->result;
5491 Jim_IncrRefCount(oldResult);
5492 Jim_EvalObjVector(interp, 3, objv);
5493 Jim_SetResult(interp, oldResult);
5494 Jim_DecrRefCount(interp, oldResult);
5496 Jim_DecrRefCount(interp, objv[0]);
5498 Jim_DeleteHashEntry(&interp->references, refId);
5501 Jim_FreeHashTable(&marks);
5502 interp->lastCollectId = interp->referenceNextId;
5503 interp->lastCollectTime = time(NULL);
5504 return collected;
5507 #define JIM_COLLECT_ID_PERIOD 5000
5508 #define JIM_COLLECT_TIME_PERIOD 300
5510 void Jim_CollectIfNeeded(Jim_Interp *interp)
5512 unsigned long elapsedId;
5513 int elapsedTime;
5515 elapsedId = interp->referenceNextId - interp->lastCollectId;
5516 elapsedTime = time(NULL) - interp->lastCollectTime;
5519 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5520 Jim_Collect(interp);
5523 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5525 int Jim_IsBigEndian(void)
5527 union {
5528 unsigned short s;
5529 unsigned char c[2];
5530 } uval = {0x0102};
5532 return uval.c[0] == 1;
5535 /* -----------------------------------------------------------------------------
5536 * Interpreter related functions
5537 * ---------------------------------------------------------------------------*/
5539 Jim_Interp *Jim_CreateInterp(void)
5541 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5543 memset(i, 0, sizeof(*i));
5545 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5546 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5547 i->lastCollectTime = time(NULL);
5549 /* Note that we can create objects only after the
5550 * interpreter liveList and freeList pointers are
5551 * initialized to NULL. */
5552 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5553 #ifdef JIM_REFERENCES
5554 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5555 #endif
5556 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5557 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5558 i->emptyObj = Jim_NewEmptyStringObj(i);
5559 i->trueObj = Jim_NewIntObj(i, 1);
5560 i->falseObj = Jim_NewIntObj(i, 0);
5561 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5562 i->errorFileNameObj = i->emptyObj;
5563 i->result = i->emptyObj;
5564 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5565 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5566 i->errorProc = i->emptyObj;
5567 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5568 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5569 Jim_IncrRefCount(i->emptyObj);
5570 Jim_IncrRefCount(i->errorFileNameObj);
5571 Jim_IncrRefCount(i->result);
5572 Jim_IncrRefCount(i->stackTrace);
5573 Jim_IncrRefCount(i->unknown);
5574 Jim_IncrRefCount(i->currentScriptObj);
5575 Jim_IncrRefCount(i->nullScriptObj);
5576 Jim_IncrRefCount(i->errorProc);
5577 Jim_IncrRefCount(i->trueObj);
5578 Jim_IncrRefCount(i->falseObj);
5580 /* Initialize key variables every interpreter should contain */
5581 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5582 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5584 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5585 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5586 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5587 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5588 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5589 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5590 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5591 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5593 return i;
5596 void Jim_FreeInterp(Jim_Interp *i)
5598 Jim_CallFrame *cf, *cfx;
5600 Jim_Obj *objPtr, *nextObjPtr;
5602 /* Free the active call frames list - must be done before i->commands is destroyed */
5603 for (cf = i->framePtr; cf; cf = cfx) {
5604 /* Note that we ignore any errors */
5605 JimInvokeDefer(i, JIM_OK);
5606 cfx = cf->parent;
5607 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5610 Jim_DecrRefCount(i, i->emptyObj);
5611 Jim_DecrRefCount(i, i->trueObj);
5612 Jim_DecrRefCount(i, i->falseObj);
5613 Jim_DecrRefCount(i, i->result);
5614 Jim_DecrRefCount(i, i->stackTrace);
5615 Jim_DecrRefCount(i, i->errorProc);
5616 Jim_DecrRefCount(i, i->unknown);
5617 Jim_DecrRefCount(i, i->errorFileNameObj);
5618 Jim_DecrRefCount(i, i->currentScriptObj);
5619 Jim_DecrRefCount(i, i->nullScriptObj);
5620 Jim_FreeHashTable(&i->commands);
5621 #ifdef JIM_REFERENCES
5622 Jim_FreeHashTable(&i->references);
5623 #endif
5624 Jim_FreeHashTable(&i->packages);
5625 Jim_Free(i->prngState);
5626 Jim_FreeHashTable(&i->assocData);
5628 /* Check that the live object list is empty, otherwise
5629 * there is a memory leak. */
5630 #ifdef JIM_MAINTAINER
5631 if (i->liveList != NULL) {
5632 objPtr = i->liveList;
5634 printf("\n-------------------------------------\n");
5635 printf("Objects still in the free list:\n");
5636 while (objPtr) {
5637 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5638 Jim_String(objPtr);
5640 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5641 printf("%p (%d) %-10s: '%.20s...'\n",
5642 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5644 else {
5645 printf("%p (%d) %-10s: '%s'\n",
5646 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5648 if (objPtr->typePtr == &sourceObjType) {
5649 printf("FILE %s LINE %d\n",
5650 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5651 objPtr->internalRep.sourceValue.lineNumber);
5653 objPtr = objPtr->nextObjPtr;
5655 printf("-------------------------------------\n\n");
5656 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5658 #endif
5660 /* Free all the freed objects. */
5661 objPtr = i->freeList;
5662 while (objPtr) {
5663 nextObjPtr = objPtr->nextObjPtr;
5664 Jim_Free(objPtr);
5665 objPtr = nextObjPtr;
5668 /* Free the free call frames list */
5669 for (cf = i->freeFramesList; cf; cf = cfx) {
5670 cfx = cf->next;
5671 if (cf->vars.table)
5672 Jim_FreeHashTable(&cf->vars);
5673 Jim_Free(cf);
5676 /* Free the interpreter structure. */
5677 Jim_Free(i);
5680 /* Returns the call frame relative to the level represented by
5681 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5683 * This function accepts the 'level' argument in the form
5684 * of the commands [uplevel] and [upvar].
5686 * Returns NULL on error.
5688 * Note: for a function accepting a relative integer as level suitable
5689 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5691 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5693 long level;
5694 const char *str;
5695 Jim_CallFrame *framePtr;
5697 if (levelObjPtr) {
5698 str = Jim_String(levelObjPtr);
5699 if (str[0] == '#') {
5700 char *endptr;
5702 level = jim_strtol(str + 1, &endptr);
5703 if (str[1] == '\0' || endptr[0] != '\0') {
5704 level = -1;
5707 else {
5708 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5709 level = -1;
5711 else {
5712 /* Convert from a relative to an absolute level */
5713 level = interp->framePtr->level - level;
5717 else {
5718 str = "1"; /* Needed to format the error message. */
5719 level = interp->framePtr->level - 1;
5722 if (level == 0) {
5723 return interp->topFramePtr;
5725 if (level > 0) {
5726 /* Lookup */
5727 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5728 if (framePtr->level == level) {
5729 return framePtr;
5734 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5735 return NULL;
5738 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5739 * as a relative integer like in the [info level ?level?] command.
5741 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5743 long level;
5744 Jim_CallFrame *framePtr;
5746 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5747 if (level <= 0) {
5748 /* Convert from a relative to an absolute level */
5749 level = interp->framePtr->level + level;
5752 if (level == 0) {
5753 return interp->topFramePtr;
5756 /* Lookup */
5757 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5758 if (framePtr->level == level) {
5759 return framePtr;
5764 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5765 return NULL;
5768 static void JimResetStackTrace(Jim_Interp *interp)
5770 Jim_DecrRefCount(interp, interp->stackTrace);
5771 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5772 Jim_IncrRefCount(interp->stackTrace);
5775 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5777 int len;
5779 /* Increment reference first in case these are the same object */
5780 Jim_IncrRefCount(stackTraceObj);
5781 Jim_DecrRefCount(interp, interp->stackTrace);
5782 interp->stackTrace = stackTraceObj;
5783 interp->errorFlag = 1;
5785 /* This is a bit ugly.
5786 * If the filename of the last entry of the stack trace is empty,
5787 * the next stack level should be added.
5789 len = Jim_ListLength(interp, interp->stackTrace);
5790 if (len >= 3) {
5791 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5792 interp->addStackTrace = 1;
5797 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5798 Jim_Obj *fileNameObj, int linenr)
5800 if (strcmp(procname, "unknown") == 0) {
5801 procname = "";
5803 if (!*procname && !Jim_Length(fileNameObj)) {
5804 /* No useful info here */
5805 return;
5808 if (Jim_IsShared(interp->stackTrace)) {
5809 Jim_DecrRefCount(interp, interp->stackTrace);
5810 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5811 Jim_IncrRefCount(interp->stackTrace);
5814 /* If we have no procname but the previous element did, merge with that frame */
5815 if (!*procname && Jim_Length(fileNameObj)) {
5816 /* Just a filename. Check the previous entry */
5817 int len = Jim_ListLength(interp, interp->stackTrace);
5819 if (len >= 3) {
5820 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5821 if (Jim_Length(objPtr)) {
5822 /* Yes, the previous level had procname */
5823 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5824 if (Jim_Length(objPtr) == 0) {
5825 /* But no filename, so merge the new info with that frame */
5826 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5827 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5828 return;
5834 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5835 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5836 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5839 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5840 void *data)
5842 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5844 assocEntryPtr->delProc = delProc;
5845 assocEntryPtr->data = data;
5846 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5849 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5851 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5853 if (entryPtr != NULL) {
5854 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5855 return assocEntryPtr->data;
5857 return NULL;
5860 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5862 return Jim_DeleteHashEntry(&interp->assocData, key);
5865 int Jim_GetExitCode(Jim_Interp *interp)
5867 return interp->exitCode;
5870 /* -----------------------------------------------------------------------------
5871 * Integer object
5872 * ---------------------------------------------------------------------------*/
5873 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5874 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5876 static const Jim_ObjType intObjType = {
5877 "int",
5878 NULL,
5879 NULL,
5880 UpdateStringOfInt,
5881 JIM_TYPE_NONE,
5884 /* A coerced double is closer to an int than a double.
5885 * It is an int value temporarily masquerading as a double value.
5886 * i.e. it has the same string value as an int and Jim_GetWide()
5887 * succeeds, but also Jim_GetDouble() returns the value directly.
5889 static const Jim_ObjType coercedDoubleObjType = {
5890 "coerced-double",
5891 NULL,
5892 NULL,
5893 UpdateStringOfInt,
5894 JIM_TYPE_NONE,
5898 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5900 char buf[JIM_INTEGER_SPACE + 1];
5901 jim_wide wideValue = JimWideValue(objPtr);
5902 int pos = 0;
5904 if (wideValue == 0) {
5905 buf[pos++] = '0';
5907 else {
5908 char tmp[JIM_INTEGER_SPACE];
5909 int num = 0;
5910 int i;
5912 if (wideValue < 0) {
5913 buf[pos++] = '-';
5914 i = wideValue % 10;
5915 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5916 * whereas C99 is always -6
5917 * coverity[dead_error_line]
5919 tmp[num++] = (i > 0) ? (10 - i) : -i;
5920 wideValue /= -10;
5923 while (wideValue) {
5924 tmp[num++] = wideValue % 10;
5925 wideValue /= 10;
5928 for (i = 0; i < num; i++) {
5929 buf[pos++] = '0' + tmp[num - i - 1];
5932 buf[pos] = 0;
5934 JimSetStringBytes(objPtr, buf);
5937 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5939 jim_wide wideValue;
5940 const char *str;
5942 if (objPtr->typePtr == &coercedDoubleObjType) {
5943 /* Simple switch */
5944 objPtr->typePtr = &intObjType;
5945 return JIM_OK;
5948 /* Get the string representation */
5949 str = Jim_String(objPtr);
5950 /* Try to convert into a jim_wide */
5951 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5952 if (flags & JIM_ERRMSG) {
5953 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5955 return JIM_ERR;
5957 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5958 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5959 return JIM_ERR;
5961 /* Free the old internal repr and set the new one. */
5962 Jim_FreeIntRep(interp, objPtr);
5963 objPtr->typePtr = &intObjType;
5964 objPtr->internalRep.wideValue = wideValue;
5965 return JIM_OK;
5968 #ifdef JIM_OPTIMIZATION
5969 static int JimIsWide(Jim_Obj *objPtr)
5971 return objPtr->typePtr == &intObjType;
5973 #endif
5975 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5977 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5978 return JIM_ERR;
5979 *widePtr = JimWideValue(objPtr);
5980 return JIM_OK;
5983 /* Get a wide but does not set an error if the format is bad. */
5984 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5986 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5987 return JIM_ERR;
5988 *widePtr = JimWideValue(objPtr);
5989 return JIM_OK;
5992 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5994 jim_wide wideValue;
5995 int retval;
5997 retval = Jim_GetWide(interp, objPtr, &wideValue);
5998 if (retval == JIM_OK) {
5999 *longPtr = (long)wideValue;
6000 return JIM_OK;
6002 return JIM_ERR;
6005 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
6007 Jim_Obj *objPtr;
6009 objPtr = Jim_NewObj(interp);
6010 objPtr->typePtr = &intObjType;
6011 objPtr->bytes = NULL;
6012 objPtr->internalRep.wideValue = wideValue;
6013 return objPtr;
6016 /* -----------------------------------------------------------------------------
6017 * Double object
6018 * ---------------------------------------------------------------------------*/
6019 #define JIM_DOUBLE_SPACE 30
6021 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
6022 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6024 static const Jim_ObjType doubleObjType = {
6025 "double",
6026 NULL,
6027 NULL,
6028 UpdateStringOfDouble,
6029 JIM_TYPE_NONE,
6032 #ifndef HAVE_ISNAN
6033 #undef isnan
6034 #define isnan(X) ((X) != (X))
6035 #endif
6036 #ifndef HAVE_ISINF
6037 #undef isinf
6038 #define isinf(X) (1.0 / (X) == 0.0)
6039 #endif
6041 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
6043 double value = objPtr->internalRep.doubleValue;
6045 if (isnan(value)) {
6046 JimSetStringBytes(objPtr, "NaN");
6047 return;
6049 if (isinf(value)) {
6050 if (value < 0) {
6051 JimSetStringBytes(objPtr, "-Inf");
6053 else {
6054 JimSetStringBytes(objPtr, "Inf");
6056 return;
6059 char buf[JIM_DOUBLE_SPACE + 1];
6060 int i;
6061 int len = sprintf(buf, "%.12g", value);
6063 /* Add a final ".0" if necessary */
6064 for (i = 0; i < len; i++) {
6065 if (buf[i] == '.' || buf[i] == 'e') {
6066 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6067 /* If 'buf' ends in e-0nn or e+0nn, remove
6068 * the 0 after the + or - and reduce the length by 1
6070 char *e = strchr(buf, 'e');
6071 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6072 /* Move it up */
6073 e += 2;
6074 memmove(e, e + 1, len - (e - buf));
6076 #endif
6077 break;
6080 if (buf[i] == '\0') {
6081 buf[i++] = '.';
6082 buf[i++] = '0';
6083 buf[i] = '\0';
6085 JimSetStringBytes(objPtr, buf);
6089 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6091 double doubleValue;
6092 jim_wide wideValue;
6093 const char *str;
6095 #ifdef HAVE_LONG_LONG
6096 /* Assume a 53 bit mantissa */
6097 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6098 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6100 if (objPtr->typePtr == &intObjType
6101 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6102 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6104 /* Direct conversion to coerced double */
6105 objPtr->typePtr = &coercedDoubleObjType;
6106 return JIM_OK;
6108 #endif
6109 /* Preserve the string representation.
6110 * Needed so we can convert back to int without loss
6112 str = Jim_String(objPtr);
6114 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6115 /* Managed to convert to an int, so we can use this as a cooerced double */
6116 Jim_FreeIntRep(interp, objPtr);
6117 objPtr->typePtr = &coercedDoubleObjType;
6118 objPtr->internalRep.wideValue = wideValue;
6119 return JIM_OK;
6121 else {
6122 /* Try to convert into a double */
6123 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6124 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6125 return JIM_ERR;
6127 /* Free the old internal repr and set the new one. */
6128 Jim_FreeIntRep(interp, objPtr);
6130 objPtr->typePtr = &doubleObjType;
6131 objPtr->internalRep.doubleValue = doubleValue;
6132 return JIM_OK;
6135 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6137 if (objPtr->typePtr == &coercedDoubleObjType) {
6138 *doublePtr = JimWideValue(objPtr);
6139 return JIM_OK;
6141 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6142 return JIM_ERR;
6144 if (objPtr->typePtr == &coercedDoubleObjType) {
6145 *doublePtr = JimWideValue(objPtr);
6147 else {
6148 *doublePtr = objPtr->internalRep.doubleValue;
6150 return JIM_OK;
6153 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6155 Jim_Obj *objPtr;
6157 objPtr = Jim_NewObj(interp);
6158 objPtr->typePtr = &doubleObjType;
6159 objPtr->bytes = NULL;
6160 objPtr->internalRep.doubleValue = doubleValue;
6161 return objPtr;
6164 /* -----------------------------------------------------------------------------
6165 * Boolean conversion
6166 * ---------------------------------------------------------------------------*/
6167 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6169 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6171 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6172 return JIM_ERR;
6173 *booleanPtr = (int) JimWideValue(objPtr);
6174 return JIM_OK;
6177 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6179 static const char * const falses[] = {
6180 "0", "false", "no", "off", NULL
6182 static const char * const trues[] = {
6183 "1", "true", "yes", "on", NULL
6186 int boolean;
6188 int index;
6189 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6190 boolean = 0;
6191 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6192 boolean = 1;
6193 } else {
6194 if (flags & JIM_ERRMSG) {
6195 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6197 return JIM_ERR;
6200 /* Free the old internal repr and set the new one. */
6201 Jim_FreeIntRep(interp, objPtr);
6202 objPtr->typePtr = &intObjType;
6203 objPtr->internalRep.wideValue = boolean;
6204 return JIM_OK;
6207 /* -----------------------------------------------------------------------------
6208 * List object
6209 * ---------------------------------------------------------------------------*/
6210 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6211 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6212 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6213 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6214 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6215 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6217 /* Note that while the elements of the list may contain references,
6218 * the list object itself can't. This basically means that the
6219 * list object string representation as a whole can't contain references
6220 * that are not presents in the single elements. */
6221 static const Jim_ObjType listObjType = {
6222 "list",
6223 FreeListInternalRep,
6224 DupListInternalRep,
6225 UpdateStringOfList,
6226 JIM_TYPE_NONE,
6229 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6231 int i;
6233 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6234 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6236 Jim_Free(objPtr->internalRep.listValue.ele);
6239 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6241 int i;
6243 JIM_NOTUSED(interp);
6245 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6246 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6247 dupPtr->internalRep.listValue.ele =
6248 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6249 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6250 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6251 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6252 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6254 dupPtr->typePtr = &listObjType;
6257 /* The following function checks if a given string can be encoded
6258 * into a list element without any kind of quoting, surrounded by braces,
6259 * or using escapes to quote. */
6260 #define JIM_ELESTR_SIMPLE 0
6261 #define JIM_ELESTR_BRACE 1
6262 #define JIM_ELESTR_QUOTE 2
6263 static unsigned char ListElementQuotingType(const char *s, int len)
6265 int i, level, blevel, trySimple = 1;
6267 /* Try with the SIMPLE case */
6268 if (len == 0)
6269 return JIM_ELESTR_BRACE;
6270 if (s[0] == '"' || s[0] == '{') {
6271 trySimple = 0;
6272 goto testbrace;
6274 for (i = 0; i < len; i++) {
6275 switch (s[i]) {
6276 case ' ':
6277 case '$':
6278 case '"':
6279 case '[':
6280 case ']':
6281 case ';':
6282 case '\\':
6283 case '\r':
6284 case '\n':
6285 case '\t':
6286 case '\f':
6287 case '\v':
6288 trySimple = 0;
6289 /* fall through */
6290 case '{':
6291 case '}':
6292 goto testbrace;
6295 return JIM_ELESTR_SIMPLE;
6297 testbrace:
6298 /* Test if it's possible to do with braces */
6299 if (s[len - 1] == '\\')
6300 return JIM_ELESTR_QUOTE;
6301 level = 0;
6302 blevel = 0;
6303 for (i = 0; i < len; i++) {
6304 switch (s[i]) {
6305 case '{':
6306 level++;
6307 break;
6308 case '}':
6309 level--;
6310 if (level < 0)
6311 return JIM_ELESTR_QUOTE;
6312 break;
6313 case '[':
6314 blevel++;
6315 break;
6316 case ']':
6317 blevel--;
6318 break;
6319 case '\\':
6320 if (s[i + 1] == '\n')
6321 return JIM_ELESTR_QUOTE;
6322 else if (s[i + 1] != '\0')
6323 i++;
6324 break;
6327 if (blevel < 0) {
6328 return JIM_ELESTR_QUOTE;
6331 if (level == 0) {
6332 if (!trySimple)
6333 return JIM_ELESTR_BRACE;
6334 for (i = 0; i < len; i++) {
6335 switch (s[i]) {
6336 case ' ':
6337 case '$':
6338 case '"':
6339 case '[':
6340 case ']':
6341 case ';':
6342 case '\\':
6343 case '\r':
6344 case '\n':
6345 case '\t':
6346 case '\f':
6347 case '\v':
6348 return JIM_ELESTR_BRACE;
6349 break;
6352 return JIM_ELESTR_SIMPLE;
6354 return JIM_ELESTR_QUOTE;
6357 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6358 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6359 * scenario.
6360 * Returns the length of the result.
6362 static int BackslashQuoteString(const char *s, int len, char *q)
6364 char *p = q;
6366 while (len--) {
6367 switch (*s) {
6368 case ' ':
6369 case '$':
6370 case '"':
6371 case '[':
6372 case ']':
6373 case '{':
6374 case '}':
6375 case ';':
6376 case '\\':
6377 *p++ = '\\';
6378 *p++ = *s++;
6379 break;
6380 case '\n':
6381 *p++ = '\\';
6382 *p++ = 'n';
6383 s++;
6384 break;
6385 case '\r':
6386 *p++ = '\\';
6387 *p++ = 'r';
6388 s++;
6389 break;
6390 case '\t':
6391 *p++ = '\\';
6392 *p++ = 't';
6393 s++;
6394 break;
6395 case '\f':
6396 *p++ = '\\';
6397 *p++ = 'f';
6398 s++;
6399 break;
6400 case '\v':
6401 *p++ = '\\';
6402 *p++ = 'v';
6403 s++;
6404 break;
6405 default:
6406 *p++ = *s++;
6407 break;
6410 *p = '\0';
6412 return p - q;
6415 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6417 #define STATIC_QUOTING_LEN 32
6418 int i, bufLen, realLength;
6419 const char *strRep;
6420 char *p;
6421 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6423 /* Estimate the space needed. */
6424 if (objc > STATIC_QUOTING_LEN) {
6425 quotingType = Jim_Alloc(objc);
6427 else {
6428 quotingType = staticQuoting;
6430 bufLen = 0;
6431 for (i = 0; i < objc; i++) {
6432 int len;
6434 strRep = Jim_GetString(objv[i], &len);
6435 quotingType[i] = ListElementQuotingType(strRep, len);
6436 switch (quotingType[i]) {
6437 case JIM_ELESTR_SIMPLE:
6438 if (i != 0 || strRep[0] != '#') {
6439 bufLen += len;
6440 break;
6442 /* Special case '#' on first element needs braces */
6443 quotingType[i] = JIM_ELESTR_BRACE;
6444 /* fall through */
6445 case JIM_ELESTR_BRACE:
6446 bufLen += len + 2;
6447 break;
6448 case JIM_ELESTR_QUOTE:
6449 bufLen += len * 2;
6450 break;
6452 bufLen++; /* elements separator. */
6454 bufLen++;
6456 /* Generate the string rep. */
6457 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6458 realLength = 0;
6459 for (i = 0; i < objc; i++) {
6460 int len, qlen;
6462 strRep = Jim_GetString(objv[i], &len);
6464 switch (quotingType[i]) {
6465 case JIM_ELESTR_SIMPLE:
6466 memcpy(p, strRep, len);
6467 p += len;
6468 realLength += len;
6469 break;
6470 case JIM_ELESTR_BRACE:
6471 *p++ = '{';
6472 memcpy(p, strRep, len);
6473 p += len;
6474 *p++ = '}';
6475 realLength += len + 2;
6476 break;
6477 case JIM_ELESTR_QUOTE:
6478 if (i == 0 && strRep[0] == '#') {
6479 *p++ = '\\';
6480 realLength++;
6482 qlen = BackslashQuoteString(strRep, len, p);
6483 p += qlen;
6484 realLength += qlen;
6485 break;
6487 /* Add a separating space */
6488 if (i + 1 != objc) {
6489 *p++ = ' ';
6490 realLength++;
6493 *p = '\0'; /* nul term. */
6494 objPtr->length = realLength;
6496 if (quotingType != staticQuoting) {
6497 Jim_Free(quotingType);
6501 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6503 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6506 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6508 struct JimParserCtx parser;
6509 const char *str;
6510 int strLen;
6511 Jim_Obj *fileNameObj;
6512 int linenr;
6514 if (objPtr->typePtr == &listObjType) {
6515 return JIM_OK;
6518 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6519 * it also preserves any source location of the dict elements
6520 * which can be very useful
6522 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6523 Jim_Obj **listObjPtrPtr;
6524 int len;
6525 int i;
6527 listObjPtrPtr = JimDictPairs(objPtr, &len);
6528 for (i = 0; i < len; i++) {
6529 Jim_IncrRefCount(listObjPtrPtr[i]);
6532 /* Now just switch the internal rep */
6533 Jim_FreeIntRep(interp, objPtr);
6534 objPtr->typePtr = &listObjType;
6535 objPtr->internalRep.listValue.len = len;
6536 objPtr->internalRep.listValue.maxLen = len;
6537 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6539 return JIM_OK;
6542 /* Try to preserve information about filename / line number */
6543 if (objPtr->typePtr == &sourceObjType) {
6544 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6545 linenr = objPtr->internalRep.sourceValue.lineNumber;
6547 else {
6548 fileNameObj = interp->emptyObj;
6549 linenr = 1;
6551 Jim_IncrRefCount(fileNameObj);
6553 /* Get the string representation */
6554 str = Jim_GetString(objPtr, &strLen);
6556 /* Free the old internal repr just now and initialize the
6557 * new one just now. The string->list conversion can't fail. */
6558 Jim_FreeIntRep(interp, objPtr);
6559 objPtr->typePtr = &listObjType;
6560 objPtr->internalRep.listValue.len = 0;
6561 objPtr->internalRep.listValue.maxLen = 0;
6562 objPtr->internalRep.listValue.ele = NULL;
6564 /* Convert into a list */
6565 if (strLen) {
6566 JimParserInit(&parser, str, strLen, linenr);
6567 while (!parser.eof) {
6568 Jim_Obj *elementPtr;
6570 JimParseList(&parser);
6571 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6572 continue;
6573 elementPtr = JimParserGetTokenObj(interp, &parser);
6574 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6575 ListAppendElement(objPtr, elementPtr);
6578 Jim_DecrRefCount(interp, fileNameObj);
6579 return JIM_OK;
6582 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6584 Jim_Obj *objPtr;
6586 objPtr = Jim_NewObj(interp);
6587 objPtr->typePtr = &listObjType;
6588 objPtr->bytes = NULL;
6589 objPtr->internalRep.listValue.ele = NULL;
6590 objPtr->internalRep.listValue.len = 0;
6591 objPtr->internalRep.listValue.maxLen = 0;
6593 if (len) {
6594 ListInsertElements(objPtr, 0, len, elements);
6597 return objPtr;
6600 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6601 * length of the vector. Note that the user of this function should make
6602 * sure that the list object can't shimmer while the vector returned
6603 * is in use, this vector is the one stored inside the internal representation
6604 * of the list object. This function is not exported, extensions should
6605 * always access to the List object elements using Jim_ListIndex(). */
6606 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6607 Jim_Obj ***listVec)
6609 *listLen = Jim_ListLength(interp, listObj);
6610 *listVec = listObj->internalRep.listValue.ele;
6613 /* Sorting uses ints, but commands may return wide */
6614 static int JimSign(jim_wide w)
6616 if (w == 0) {
6617 return 0;
6619 else if (w < 0) {
6620 return -1;
6622 return 1;
6625 /* ListSortElements type values */
6626 struct lsort_info {
6627 jmp_buf jmpbuf;
6628 Jim_Obj *command;
6629 Jim_Interp *interp;
6630 enum {
6631 JIM_LSORT_ASCII,
6632 JIM_LSORT_NOCASE,
6633 JIM_LSORT_INTEGER,
6634 JIM_LSORT_REAL,
6635 JIM_LSORT_COMMAND
6636 } type;
6637 int order;
6638 int index;
6639 int indexed;
6640 int unique;
6641 int (*subfn)(Jim_Obj **, Jim_Obj **);
6644 static struct lsort_info *sort_info;
6646 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6648 Jim_Obj *lObj, *rObj;
6650 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6651 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6652 longjmp(sort_info->jmpbuf, JIM_ERR);
6654 return sort_info->subfn(&lObj, &rObj);
6657 /* Sort the internal rep of a list. */
6658 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6660 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6663 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6665 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6668 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6670 jim_wide lhs = 0, rhs = 0;
6672 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6673 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6674 longjmp(sort_info->jmpbuf, JIM_ERR);
6677 return JimSign(lhs - rhs) * sort_info->order;
6680 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6682 double lhs = 0, rhs = 0;
6684 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6685 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6686 longjmp(sort_info->jmpbuf, JIM_ERR);
6688 if (lhs == rhs) {
6689 return 0;
6691 if (lhs > rhs) {
6692 return sort_info->order;
6694 return -sort_info->order;
6697 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6699 Jim_Obj *compare_script;
6700 int rc;
6702 jim_wide ret = 0;
6704 /* This must be a valid list */
6705 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6706 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6707 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6709 rc = Jim_EvalObj(sort_info->interp, compare_script);
6711 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6712 longjmp(sort_info->jmpbuf, rc);
6715 return JimSign(ret) * sort_info->order;
6718 /* Remove duplicate elements from the (sorted) list in-place, according to the
6719 * comparison function, comp.
6721 * Note that the last unique value is kept, not the first
6723 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6725 int src;
6726 int dst = 0;
6727 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6729 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6730 if (comp(&ele[dst], &ele[src]) == 0) {
6731 /* Match, so replace the dest with the current source */
6732 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6734 else {
6735 /* No match, so keep the current source and move to the next destination */
6736 dst++;
6738 ele[dst] = ele[src];
6741 /* At end of list, keep the final element unless all elements were kept */
6742 dst++;
6743 if (dst < listObjPtr->internalRep.listValue.len) {
6744 ele[dst] = ele[src];
6747 /* Set the new length */
6748 listObjPtr->internalRep.listValue.len = dst;
6751 /* Sort a list *in place*. MUST be called with a non-shared list. */
6752 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6754 struct lsort_info *prev_info;
6756 typedef int (qsort_comparator) (const void *, const void *);
6757 int (*fn) (Jim_Obj **, Jim_Obj **);
6758 Jim_Obj **vector;
6759 int len;
6760 int rc;
6762 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6763 SetListFromAny(interp, listObjPtr);
6765 /* Allow lsort to be called reentrantly */
6766 prev_info = sort_info;
6767 sort_info = info;
6769 vector = listObjPtr->internalRep.listValue.ele;
6770 len = listObjPtr->internalRep.listValue.len;
6771 switch (info->type) {
6772 case JIM_LSORT_ASCII:
6773 fn = ListSortString;
6774 break;
6775 case JIM_LSORT_NOCASE:
6776 fn = ListSortStringNoCase;
6777 break;
6778 case JIM_LSORT_INTEGER:
6779 fn = ListSortInteger;
6780 break;
6781 case JIM_LSORT_REAL:
6782 fn = ListSortReal;
6783 break;
6784 case JIM_LSORT_COMMAND:
6785 fn = ListSortCommand;
6786 break;
6787 default:
6788 fn = NULL; /* avoid warning */
6789 JimPanic((1, "ListSort called with invalid sort type"));
6790 return -1; /* Should not be run but keeps static analysers happy */
6793 if (info->indexed) {
6794 /* Need to interpose a "list index" function */
6795 info->subfn = fn;
6796 fn = ListSortIndexHelper;
6799 if ((rc = setjmp(info->jmpbuf)) == 0) {
6800 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6802 if (info->unique && len > 1) {
6803 ListRemoveDuplicates(listObjPtr, fn);
6806 Jim_InvalidateStringRep(listObjPtr);
6808 sort_info = prev_info;
6810 return rc;
6813 /* This is the low-level function to insert elements into a list.
6814 * The higher-level Jim_ListInsertElements() performs shared object
6815 * check and invalidates the string repr. This version is used
6816 * in the internals of the List Object and is not exported.
6818 * NOTE: this function can be called only against objects
6819 * with internal type of List.
6821 * An insertion point (idx) of -1 means end-of-list.
6823 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6825 int currentLen = listPtr->internalRep.listValue.len;
6826 int requiredLen = currentLen + elemc;
6827 int i;
6828 Jim_Obj **point;
6830 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6831 if (requiredLen < 2) {
6832 /* Don't do allocations of under 4 pointers. */
6833 requiredLen = 4;
6835 else {
6836 requiredLen *= 2;
6839 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6840 sizeof(Jim_Obj *) * requiredLen);
6842 listPtr->internalRep.listValue.maxLen = requiredLen;
6844 if (idx < 0) {
6845 idx = currentLen;
6847 point = listPtr->internalRep.listValue.ele + idx;
6848 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6849 for (i = 0; i < elemc; ++i) {
6850 point[i] = elemVec[i];
6851 Jim_IncrRefCount(point[i]);
6853 listPtr->internalRep.listValue.len += elemc;
6856 /* Convenience call to ListInsertElements() to append a single element.
6858 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6860 ListInsertElements(listPtr, -1, 1, &objPtr);
6863 /* Appends every element of appendListPtr into listPtr.
6864 * Both have to be of the list type.
6865 * Convenience call to ListInsertElements()
6867 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6869 ListInsertElements(listPtr, -1,
6870 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6873 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6875 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6876 SetListFromAny(interp, listPtr);
6877 Jim_InvalidateStringRep(listPtr);
6878 ListAppendElement(listPtr, objPtr);
6881 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6883 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6884 SetListFromAny(interp, listPtr);
6885 SetListFromAny(interp, appendListPtr);
6886 Jim_InvalidateStringRep(listPtr);
6887 ListAppendList(listPtr, appendListPtr);
6890 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6892 SetListFromAny(interp, objPtr);
6893 return objPtr->internalRep.listValue.len;
6896 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6897 int objc, Jim_Obj *const *objVec)
6899 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6900 SetListFromAny(interp, listPtr);
6901 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6902 idx = listPtr->internalRep.listValue.len;
6903 else if (idx < 0)
6904 idx = 0;
6905 Jim_InvalidateStringRep(listPtr);
6906 ListInsertElements(listPtr, idx, objc, objVec);
6909 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6911 SetListFromAny(interp, listPtr);
6912 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6913 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6914 return NULL;
6916 if (idx < 0)
6917 idx = listPtr->internalRep.listValue.len + idx;
6918 return listPtr->internalRep.listValue.ele[idx];
6921 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6923 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6924 if (*objPtrPtr == NULL) {
6925 if (flags & JIM_ERRMSG) {
6926 Jim_SetResultString(interp, "list index out of range", -1);
6928 return JIM_ERR;
6930 return JIM_OK;
6933 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6934 Jim_Obj *newObjPtr, int flags)
6936 SetListFromAny(interp, listPtr);
6937 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6938 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6939 if (flags & JIM_ERRMSG) {
6940 Jim_SetResultString(interp, "list index out of range", -1);
6942 return JIM_ERR;
6944 if (idx < 0)
6945 idx = listPtr->internalRep.listValue.len + idx;
6946 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6947 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6948 Jim_IncrRefCount(newObjPtr);
6949 return JIM_OK;
6952 /* Modify the list stored in the variable named 'varNamePtr'
6953 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6954 * with the new element 'newObjptr'. (implements the [lset] command) */
6955 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6956 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6958 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6959 int shared, i, idx;
6961 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6962 if (objPtr == NULL)
6963 return JIM_ERR;
6964 if ((shared = Jim_IsShared(objPtr)))
6965 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6966 for (i = 0; i < indexc - 1; i++) {
6967 listObjPtr = objPtr;
6968 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6969 goto err;
6970 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6971 goto err;
6973 if (Jim_IsShared(objPtr)) {
6974 objPtr = Jim_DuplicateObj(interp, objPtr);
6975 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6977 Jim_InvalidateStringRep(listObjPtr);
6979 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6980 goto err;
6981 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6982 goto err;
6983 Jim_InvalidateStringRep(objPtr);
6984 Jim_InvalidateStringRep(varObjPtr);
6985 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6986 goto err;
6987 Jim_SetResult(interp, varObjPtr);
6988 return JIM_OK;
6989 err:
6990 if (shared) {
6991 Jim_FreeNewObj(interp, varObjPtr);
6993 return JIM_ERR;
6996 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6998 int i;
6999 int listLen = Jim_ListLength(interp, listObjPtr);
7000 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
7002 for (i = 0; i < listLen; ) {
7003 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
7004 if (++i != listLen) {
7005 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
7008 return resObjPtr;
7011 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
7013 int i;
7015 /* If all the objects in objv are lists,
7016 * it's possible to return a list as result, that's the
7017 * concatenation of all the lists. */
7018 for (i = 0; i < objc; i++) {
7019 if (!Jim_IsList(objv[i]))
7020 break;
7022 if (i == objc) {
7023 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
7025 for (i = 0; i < objc; i++)
7026 ListAppendList(objPtr, objv[i]);
7027 return objPtr;
7029 else {
7030 /* Else... we have to glue strings together */
7031 int len = 0, objLen;
7032 char *bytes, *p;
7034 /* Compute the length */
7035 for (i = 0; i < objc; i++) {
7036 len += Jim_Length(objv[i]);
7038 if (objc)
7039 len += objc - 1;
7040 /* Create the string rep, and a string object holding it. */
7041 p = bytes = Jim_Alloc(len + 1);
7042 for (i = 0; i < objc; i++) {
7043 const char *s = Jim_GetString(objv[i], &objLen);
7045 /* Remove leading space */
7046 while (objLen && isspace(UCHAR(*s))) {
7047 s++;
7048 objLen--;
7049 len--;
7051 /* And trailing space */
7052 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
7053 /* Handle trailing backslash-space case */
7054 if (objLen > 1 && s[objLen - 2] == '\\') {
7055 break;
7057 objLen--;
7058 len--;
7060 memcpy(p, s, objLen);
7061 p += objLen;
7062 if (i + 1 != objc) {
7063 if (objLen)
7064 *p++ = ' ';
7065 else {
7066 /* Drop the space calculated for this
7067 * element that is instead null. */
7068 len--;
7072 *p = '\0';
7073 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7077 /* Returns a list composed of the elements in the specified range.
7078 * first and start are directly accepted as Jim_Objects and
7079 * processed for the end?-index? case. */
7080 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7081 Jim_Obj *lastObjPtr)
7083 int first, last;
7084 int len, rangeLen;
7086 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7087 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7088 return NULL;
7089 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7090 first = JimRelToAbsIndex(len, first);
7091 last = JimRelToAbsIndex(len, last);
7092 JimRelToAbsRange(len, &first, &last, &rangeLen);
7093 if (first == 0 && last == len) {
7094 return listObjPtr;
7096 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7099 /* -----------------------------------------------------------------------------
7100 * Dict object
7101 * ---------------------------------------------------------------------------*/
7102 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7103 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7104 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7105 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7107 /* Dict HashTable Type.
7109 * Keys and Values are Jim objects. */
7111 static unsigned int JimObjectHTHashFunction(const void *key)
7113 int len;
7114 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7115 return Jim_GenHashFunction((const unsigned char *)str, len);
7118 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7120 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7123 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7125 Jim_IncrRefCount((Jim_Obj *)val);
7126 return (void *)val;
7129 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7131 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7134 static const Jim_HashTableType JimDictHashTableType = {
7135 JimObjectHTHashFunction, /* hash function */
7136 JimObjectHTKeyValDup, /* key dup */
7137 JimObjectHTKeyValDup, /* val dup */
7138 JimObjectHTKeyCompare, /* key compare */
7139 JimObjectHTKeyValDestructor, /* key destructor */
7140 JimObjectHTKeyValDestructor /* val destructor */
7143 /* Note that while the elements of the dict may contain references,
7144 * the list object itself can't. This basically means that the
7145 * dict object string representation as a whole can't contain references
7146 * that are not presents in the single elements. */
7147 static const Jim_ObjType dictObjType = {
7148 "dict",
7149 FreeDictInternalRep,
7150 DupDictInternalRep,
7151 UpdateStringOfDict,
7152 JIM_TYPE_NONE,
7155 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7157 JIM_NOTUSED(interp);
7159 Jim_FreeHashTable(objPtr->internalRep.ptr);
7160 Jim_Free(objPtr->internalRep.ptr);
7163 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7165 Jim_HashTable *ht, *dupHt;
7166 Jim_HashTableIterator htiter;
7167 Jim_HashEntry *he;
7169 /* Create a new hash table */
7170 ht = srcPtr->internalRep.ptr;
7171 dupHt = Jim_Alloc(sizeof(*dupHt));
7172 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7173 if (ht->size != 0)
7174 Jim_ExpandHashTable(dupHt, ht->size);
7175 /* Copy every element from the source to the dup hash table */
7176 JimInitHashTableIterator(ht, &htiter);
7177 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7178 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7181 dupPtr->internalRep.ptr = dupHt;
7182 dupPtr->typePtr = &dictObjType;
7185 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7187 Jim_HashTable *ht;
7188 Jim_HashTableIterator htiter;
7189 Jim_HashEntry *he;
7190 Jim_Obj **objv;
7191 int i;
7193 ht = dictPtr->internalRep.ptr;
7195 /* Turn the hash table into a flat vector of Jim_Objects. */
7196 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7197 JimInitHashTableIterator(ht, &htiter);
7198 i = 0;
7199 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7200 objv[i++] = Jim_GetHashEntryKey(he);
7201 objv[i++] = Jim_GetHashEntryVal(he);
7203 *len = i;
7204 return objv;
7207 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7209 /* Turn the hash table into a flat vector of Jim_Objects. */
7210 int len;
7211 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7213 /* And now generate the string rep as a list */
7214 JimMakeListStringRep(objPtr, objv, len);
7216 Jim_Free(objv);
7219 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7221 int listlen;
7223 if (objPtr->typePtr == &dictObjType) {
7224 return JIM_OK;
7227 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7228 /* A shared list, so get the string representation now to avoid
7229 * changing the order in case of fast conversion to dict.
7231 Jim_String(objPtr);
7234 /* For simplicity, convert a non-list object to a list and then to a dict */
7235 listlen = Jim_ListLength(interp, objPtr);
7236 if (listlen % 2) {
7237 Jim_SetResultString(interp, "missing value to go with key", -1);
7238 return JIM_ERR;
7240 else {
7241 /* Converting from a list to a dict can't fail */
7242 Jim_HashTable *ht;
7243 int i;
7245 ht = Jim_Alloc(sizeof(*ht));
7246 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7248 for (i = 0; i < listlen; i += 2) {
7249 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7250 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7252 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7255 Jim_FreeIntRep(interp, objPtr);
7256 objPtr->typePtr = &dictObjType;
7257 objPtr->internalRep.ptr = ht;
7259 return JIM_OK;
7263 /* Dict object API */
7265 /* Add an element to a dict. objPtr must be of the "dict" type.
7266 * The higher-level exported function is Jim_DictAddElement().
7267 * If an element with the specified key already exists, the value
7268 * associated is replaced with the new one.
7270 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7271 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7272 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7274 Jim_HashTable *ht = objPtr->internalRep.ptr;
7276 if (valueObjPtr == NULL) { /* unset */
7277 return Jim_DeleteHashEntry(ht, keyObjPtr);
7279 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7280 return JIM_OK;
7283 /* Add an element, higher-level interface for DictAddElement().
7284 * If valueObjPtr == NULL, the key is removed if it exists. */
7285 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7286 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7288 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7289 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7290 return JIM_ERR;
7292 Jim_InvalidateStringRep(objPtr);
7293 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7296 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7298 Jim_Obj *objPtr;
7299 int i;
7301 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7303 objPtr = Jim_NewObj(interp);
7304 objPtr->typePtr = &dictObjType;
7305 objPtr->bytes = NULL;
7306 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7307 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7308 for (i = 0; i < len; i += 2)
7309 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7310 return objPtr;
7313 /* Return the value associated to the specified dict key
7314 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7316 * Sets *objPtrPtr to non-NULL only upon success.
7318 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7319 Jim_Obj **objPtrPtr, int flags)
7321 Jim_HashEntry *he;
7322 Jim_HashTable *ht;
7324 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7325 return -1;
7327 ht = dictPtr->internalRep.ptr;
7328 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7329 if (flags & JIM_ERRMSG) {
7330 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7332 return JIM_ERR;
7334 else {
7335 *objPtrPtr = Jim_GetHashEntryVal(he);
7336 return JIM_OK;
7340 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7341 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7343 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7344 return JIM_ERR;
7346 *objPtrPtr = JimDictPairs(dictPtr, len);
7348 return JIM_OK;
7352 /* Return the value associated to the specified dict keys */
7353 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7354 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7356 int i;
7358 if (keyc == 0) {
7359 *objPtrPtr = dictPtr;
7360 return JIM_OK;
7363 for (i = 0; i < keyc; i++) {
7364 Jim_Obj *objPtr;
7366 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7367 if (rc != JIM_OK) {
7368 return rc;
7370 dictPtr = objPtr;
7372 *objPtrPtr = dictPtr;
7373 return JIM_OK;
7376 /* Modify the dict stored into the variable named 'varNamePtr'
7377 * setting the element specified by the 'keyc' keys objects in 'keyv',
7378 * with the new value of the element 'newObjPtr'.
7380 * If newObjPtr == NULL the operation is to remove the given key
7381 * from the dictionary.
7383 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7384 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7386 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7387 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7389 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7390 int shared, i;
7392 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7393 if (objPtr == NULL) {
7394 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7395 /* Cannot remove a key from non existing var */
7396 return JIM_ERR;
7398 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7399 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7400 Jim_FreeNewObj(interp, varObjPtr);
7401 return JIM_ERR;
7404 if ((shared = Jim_IsShared(objPtr)))
7405 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7406 for (i = 0; i < keyc; i++) {
7407 dictObjPtr = objPtr;
7409 /* Check if it's a valid dictionary */
7410 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7411 goto err;
7414 if (i == keyc - 1) {
7415 /* Last key: Note that error on unset with missing last key is OK */
7416 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7417 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7418 goto err;
7421 break;
7424 /* Check if the given key exists. */
7425 Jim_InvalidateStringRep(dictObjPtr);
7426 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7427 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7428 /* This key exists at the current level.
7429 * Make sure it's not shared!. */
7430 if (Jim_IsShared(objPtr)) {
7431 objPtr = Jim_DuplicateObj(interp, objPtr);
7432 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7435 else {
7436 /* Key not found. If it's an [unset] operation
7437 * this is an error. Only the last key may not
7438 * exist. */
7439 if (newObjPtr == NULL) {
7440 goto err;
7442 /* Otherwise set an empty dictionary
7443 * as key's value. */
7444 objPtr = Jim_NewDictObj(interp, NULL, 0);
7445 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7448 /* XXX: Is this necessary? */
7449 Jim_InvalidateStringRep(objPtr);
7450 Jim_InvalidateStringRep(varObjPtr);
7451 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7452 goto err;
7454 Jim_SetResult(interp, varObjPtr);
7455 return JIM_OK;
7456 err:
7457 if (shared) {
7458 Jim_FreeNewObj(interp, varObjPtr);
7460 return JIM_ERR;
7463 /* -----------------------------------------------------------------------------
7464 * Index object
7465 * ---------------------------------------------------------------------------*/
7466 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7467 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7469 static const Jim_ObjType indexObjType = {
7470 "index",
7471 NULL,
7472 NULL,
7473 UpdateStringOfIndex,
7474 JIM_TYPE_NONE,
7477 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7479 if (objPtr->internalRep.intValue == -1) {
7480 JimSetStringBytes(objPtr, "end");
7482 else {
7483 char buf[JIM_INTEGER_SPACE + 1];
7484 if (objPtr->internalRep.intValue >= 0) {
7485 sprintf(buf, "%d", objPtr->internalRep.intValue);
7487 else {
7488 /* Must be <= -2 */
7489 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7491 JimSetStringBytes(objPtr, buf);
7495 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7497 int idx, end = 0;
7498 const char *str;
7499 char *endptr;
7501 /* Get the string representation */
7502 str = Jim_String(objPtr);
7504 /* Try to convert into an index */
7505 if (strncmp(str, "end", 3) == 0) {
7506 end = 1;
7507 str += 3;
7508 idx = 0;
7510 else {
7511 idx = jim_strtol(str, &endptr);
7513 if (endptr == str) {
7514 goto badindex;
7516 str = endptr;
7519 /* Now str may include or +<num> or -<num> */
7520 if (*str == '+' || *str == '-') {
7521 int sign = (*str == '+' ? 1 : -1);
7523 idx += sign * jim_strtol(++str, &endptr);
7524 if (str == endptr || *endptr) {
7525 goto badindex;
7527 str = endptr;
7529 /* The only thing left should be spaces */
7530 while (isspace(UCHAR(*str))) {
7531 str++;
7533 if (*str) {
7534 goto badindex;
7536 if (end) {
7537 if (idx > 0) {
7538 idx = INT_MAX;
7540 else {
7541 /* end-1 is repesented as -2 */
7542 idx--;
7545 else if (idx < 0) {
7546 idx = -INT_MAX;
7549 /* Free the old internal repr and set the new one. */
7550 Jim_FreeIntRep(interp, objPtr);
7551 objPtr->typePtr = &indexObjType;
7552 objPtr->internalRep.intValue = idx;
7553 return JIM_OK;
7555 badindex:
7556 Jim_SetResultFormatted(interp,
7557 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7558 return JIM_ERR;
7561 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7563 /* Avoid shimmering if the object is an integer. */
7564 if (objPtr->typePtr == &intObjType) {
7565 jim_wide val = JimWideValue(objPtr);
7567 if (val < 0)
7568 *indexPtr = -INT_MAX;
7569 else if (val > INT_MAX)
7570 *indexPtr = INT_MAX;
7571 else
7572 *indexPtr = (int)val;
7573 return JIM_OK;
7575 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7576 return JIM_ERR;
7577 *indexPtr = objPtr->internalRep.intValue;
7578 return JIM_OK;
7581 /* -----------------------------------------------------------------------------
7582 * Return Code Object.
7583 * ---------------------------------------------------------------------------*/
7585 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7586 static const char * const jimReturnCodes[] = {
7587 "ok",
7588 "error",
7589 "return",
7590 "break",
7591 "continue",
7592 "signal",
7593 "exit",
7594 "eval",
7595 NULL
7598 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7600 static const Jim_ObjType returnCodeObjType = {
7601 "return-code",
7602 NULL,
7603 NULL,
7604 NULL,
7605 JIM_TYPE_NONE,
7608 /* Converts a (standard) return code to a string. Returns "?" for
7609 * non-standard return codes.
7611 const char *Jim_ReturnCode(int code)
7613 if (code < 0 || code >= (int)jimReturnCodesSize) {
7614 return "?";
7616 else {
7617 return jimReturnCodes[code];
7621 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7623 int returnCode;
7624 jim_wide wideValue;
7626 /* Try to convert into an integer */
7627 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7628 returnCode = (int)wideValue;
7629 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7630 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7631 return JIM_ERR;
7633 /* Free the old internal repr and set the new one. */
7634 Jim_FreeIntRep(interp, objPtr);
7635 objPtr->typePtr = &returnCodeObjType;
7636 objPtr->internalRep.intValue = returnCode;
7637 return JIM_OK;
7640 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7642 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7643 return JIM_ERR;
7644 *intPtr = objPtr->internalRep.intValue;
7645 return JIM_OK;
7648 /* -----------------------------------------------------------------------------
7649 * Expression Parsing
7650 * ---------------------------------------------------------------------------*/
7651 static int JimParseExprOperator(struct JimParserCtx *pc);
7652 static int JimParseExprNumber(struct JimParserCtx *pc);
7653 static int JimParseExprIrrational(struct JimParserCtx *pc);
7654 static int JimParseExprBoolean(struct JimParserCtx *pc);
7656 /* expr operator opcodes. */
7657 enum
7659 /* Continues on from the JIM_TT_ space */
7661 /* Binary operators (numbers) */
7662 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7663 JIM_EXPROP_DIV,
7664 JIM_EXPROP_MOD,
7665 JIM_EXPROP_SUB,
7666 JIM_EXPROP_ADD,
7667 JIM_EXPROP_LSHIFT,
7668 JIM_EXPROP_RSHIFT,
7669 JIM_EXPROP_ROTL,
7670 JIM_EXPROP_ROTR,
7671 JIM_EXPROP_LT,
7672 JIM_EXPROP_GT,
7673 JIM_EXPROP_LTE,
7674 JIM_EXPROP_GTE,
7675 JIM_EXPROP_NUMEQ,
7676 JIM_EXPROP_NUMNE,
7677 JIM_EXPROP_BITAND, /* 35 */
7678 JIM_EXPROP_BITXOR,
7679 JIM_EXPROP_BITOR,
7680 JIM_EXPROP_LOGICAND, /* 38 */
7681 JIM_EXPROP_LOGICOR, /* 39 */
7682 JIM_EXPROP_TERNARY, /* 40 */
7683 JIM_EXPROP_COLON, /* 41 */
7684 JIM_EXPROP_POW, /* 42 */
7686 /* Binary operators (strings) */
7687 JIM_EXPROP_STREQ, /* 43 */
7688 JIM_EXPROP_STRNE,
7689 JIM_EXPROP_STRIN,
7690 JIM_EXPROP_STRNI,
7692 /* Unary operators (numbers) */
7693 JIM_EXPROP_NOT, /* 47 */
7694 JIM_EXPROP_BITNOT,
7695 JIM_EXPROP_UNARYMINUS,
7696 JIM_EXPROP_UNARYPLUS,
7698 /* Functions */
7699 JIM_EXPROP_FUNC_INT, /* 51 */
7700 JIM_EXPROP_FUNC_WIDE,
7701 JIM_EXPROP_FUNC_ABS,
7702 JIM_EXPROP_FUNC_DOUBLE,
7703 JIM_EXPROP_FUNC_ROUND,
7704 JIM_EXPROP_FUNC_RAND,
7705 JIM_EXPROP_FUNC_SRAND,
7707 /* math functions from libm */
7708 JIM_EXPROP_FUNC_SIN, /* 65 */
7709 JIM_EXPROP_FUNC_COS,
7710 JIM_EXPROP_FUNC_TAN,
7711 JIM_EXPROP_FUNC_ASIN,
7712 JIM_EXPROP_FUNC_ACOS,
7713 JIM_EXPROP_FUNC_ATAN,
7714 JIM_EXPROP_FUNC_ATAN2,
7715 JIM_EXPROP_FUNC_SINH,
7716 JIM_EXPROP_FUNC_COSH,
7717 JIM_EXPROP_FUNC_TANH,
7718 JIM_EXPROP_FUNC_CEIL,
7719 JIM_EXPROP_FUNC_FLOOR,
7720 JIM_EXPROP_FUNC_EXP,
7721 JIM_EXPROP_FUNC_LOG,
7722 JIM_EXPROP_FUNC_LOG10,
7723 JIM_EXPROP_FUNC_SQRT,
7724 JIM_EXPROP_FUNC_POW,
7725 JIM_EXPROP_FUNC_HYPOT,
7726 JIM_EXPROP_FUNC_FMOD,
7729 /* A expression node is either a term or an operator
7730 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7732 struct JimExprNode {
7733 int type; /* JIM_TT_xxx */
7734 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7736 struct JimExprNode *left; /* For all operators */
7737 struct JimExprNode *right; /* For binary operators */
7738 struct JimExprNode *ternary; /* For ternary operator only */
7741 /* Operators table */
7742 typedef struct Jim_ExprOperator
7744 const char *name;
7745 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7746 unsigned char precedence;
7747 unsigned char arity;
7748 unsigned char attr;
7749 unsigned char namelen;
7750 } Jim_ExprOperator;
7752 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7753 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7754 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7756 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7758 int intresult = 1;
7759 int rc;
7760 double dA, dC = 0;
7761 jim_wide wA, wC = 0;
7762 Jim_Obj *A;
7764 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7765 return rc;
7768 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7769 switch (node->type) {
7770 case JIM_EXPROP_FUNC_INT:
7771 case JIM_EXPROP_FUNC_WIDE:
7772 case JIM_EXPROP_FUNC_ROUND:
7773 case JIM_EXPROP_UNARYPLUS:
7774 wC = wA;
7775 break;
7776 case JIM_EXPROP_FUNC_DOUBLE:
7777 dC = wA;
7778 intresult = 0;
7779 break;
7780 case JIM_EXPROP_FUNC_ABS:
7781 wC = wA >= 0 ? wA : -wA;
7782 break;
7783 case JIM_EXPROP_UNARYMINUS:
7784 wC = -wA;
7785 break;
7786 case JIM_EXPROP_NOT:
7787 wC = !wA;
7788 break;
7789 default:
7790 abort();
7793 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7794 switch (node->type) {
7795 case JIM_EXPROP_FUNC_INT:
7796 case JIM_EXPROP_FUNC_WIDE:
7797 wC = dA;
7798 break;
7799 case JIM_EXPROP_FUNC_ROUND:
7800 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7801 break;
7802 case JIM_EXPROP_FUNC_DOUBLE:
7803 case JIM_EXPROP_UNARYPLUS:
7804 dC = dA;
7805 intresult = 0;
7806 break;
7807 case JIM_EXPROP_FUNC_ABS:
7808 #ifdef JIM_MATH_FUNCTIONS
7809 dC = fabs(dA);
7810 #else
7811 dC = dA >= 0 ? dA : -dA;
7812 #endif
7813 intresult = 0;
7814 break;
7815 case JIM_EXPROP_UNARYMINUS:
7816 dC = -dA;
7817 intresult = 0;
7818 break;
7819 case JIM_EXPROP_NOT:
7820 wC = !dA;
7821 break;
7822 default:
7823 abort();
7827 if (rc == JIM_OK) {
7828 if (intresult) {
7829 Jim_SetResultInt(interp, wC);
7831 else {
7832 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7836 Jim_DecrRefCount(interp, A);
7838 return rc;
7841 static double JimRandDouble(Jim_Interp *interp)
7843 unsigned long x;
7844 JimRandomBytes(interp, &x, sizeof(x));
7846 return (double)x / (unsigned long)~0;
7849 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7851 jim_wide wA;
7852 Jim_Obj *A;
7853 int rc;
7855 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7856 return rc;
7859 rc = Jim_GetWide(interp, A, &wA);
7860 if (rc == JIM_OK) {
7861 switch (node->type) {
7862 case JIM_EXPROP_BITNOT:
7863 Jim_SetResultInt(interp, ~wA);
7864 break;
7865 case JIM_EXPROP_FUNC_SRAND:
7866 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7867 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7868 break;
7869 default:
7870 abort();
7874 Jim_DecrRefCount(interp, A);
7876 return rc;
7879 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7881 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7883 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7885 return JIM_OK;
7888 #ifdef JIM_MATH_FUNCTIONS
7889 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7891 int rc;
7892 double dA, dC;
7893 Jim_Obj *A;
7895 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7896 return rc;
7899 rc = Jim_GetDouble(interp, A, &dA);
7900 if (rc == JIM_OK) {
7901 switch (node->type) {
7902 case JIM_EXPROP_FUNC_SIN:
7903 dC = sin(dA);
7904 break;
7905 case JIM_EXPROP_FUNC_COS:
7906 dC = cos(dA);
7907 break;
7908 case JIM_EXPROP_FUNC_TAN:
7909 dC = tan(dA);
7910 break;
7911 case JIM_EXPROP_FUNC_ASIN:
7912 dC = asin(dA);
7913 break;
7914 case JIM_EXPROP_FUNC_ACOS:
7915 dC = acos(dA);
7916 break;
7917 case JIM_EXPROP_FUNC_ATAN:
7918 dC = atan(dA);
7919 break;
7920 case JIM_EXPROP_FUNC_SINH:
7921 dC = sinh(dA);
7922 break;
7923 case JIM_EXPROP_FUNC_COSH:
7924 dC = cosh(dA);
7925 break;
7926 case JIM_EXPROP_FUNC_TANH:
7927 dC = tanh(dA);
7928 break;
7929 case JIM_EXPROP_FUNC_CEIL:
7930 dC = ceil(dA);
7931 break;
7932 case JIM_EXPROP_FUNC_FLOOR:
7933 dC = floor(dA);
7934 break;
7935 case JIM_EXPROP_FUNC_EXP:
7936 dC = exp(dA);
7937 break;
7938 case JIM_EXPROP_FUNC_LOG:
7939 dC = log(dA);
7940 break;
7941 case JIM_EXPROP_FUNC_LOG10:
7942 dC = log10(dA);
7943 break;
7944 case JIM_EXPROP_FUNC_SQRT:
7945 dC = sqrt(dA);
7946 break;
7947 default:
7948 abort();
7950 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7953 Jim_DecrRefCount(interp, A);
7955 return rc;
7957 #endif
7959 /* A binary operation on two ints */
7960 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7962 jim_wide wA, wB;
7963 int rc;
7964 Jim_Obj *A, *B;
7966 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7967 return rc;
7969 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7970 Jim_DecrRefCount(interp, A);
7971 return rc;
7974 rc = JIM_ERR;
7976 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7977 jim_wide wC;
7979 rc = JIM_OK;
7981 switch (node->type) {
7982 case JIM_EXPROP_LSHIFT:
7983 wC = wA << wB;
7984 break;
7985 case JIM_EXPROP_RSHIFT:
7986 wC = wA >> wB;
7987 break;
7988 case JIM_EXPROP_BITAND:
7989 wC = wA & wB;
7990 break;
7991 case JIM_EXPROP_BITXOR:
7992 wC = wA ^ wB;
7993 break;
7994 case JIM_EXPROP_BITOR:
7995 wC = wA | wB;
7996 break;
7997 case JIM_EXPROP_MOD:
7998 if (wB == 0) {
7999 wC = 0;
8000 Jim_SetResultString(interp, "Division by zero", -1);
8001 rc = JIM_ERR;
8003 else {
8005 * From Tcl 8.x
8007 * This code is tricky: C doesn't guarantee much
8008 * about the quotient or remainder, but Tcl does.
8009 * The remainder always has the same sign as the
8010 * divisor and a smaller absolute value.
8012 int negative = 0;
8014 if (wB < 0) {
8015 wB = -wB;
8016 wA = -wA;
8017 negative = 1;
8019 wC = wA % wB;
8020 if (wC < 0) {
8021 wC += wB;
8023 if (negative) {
8024 wC = -wC;
8027 break;
8028 case JIM_EXPROP_ROTL:
8029 case JIM_EXPROP_ROTR:{
8030 /* uint32_t would be better. But not everyone has inttypes.h? */
8031 unsigned long uA = (unsigned long)wA;
8032 unsigned long uB = (unsigned long)wB;
8033 const unsigned int S = sizeof(unsigned long) * 8;
8035 /* Shift left by the word size or more is undefined. */
8036 uB %= S;
8038 if (node->type == JIM_EXPROP_ROTR) {
8039 uB = S - uB;
8041 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
8042 break;
8044 default:
8045 abort();
8047 Jim_SetResultInt(interp, wC);
8050 Jim_DecrRefCount(interp, A);
8051 Jim_DecrRefCount(interp, B);
8053 return rc;
8057 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8058 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8060 int rc = JIM_OK;
8061 double dA, dB, dC = 0;
8062 jim_wide wA, wB, wC = 0;
8063 Jim_Obj *A, *B;
8065 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8066 return rc;
8068 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8069 Jim_DecrRefCount(interp, A);
8070 return rc;
8073 if ((A->typePtr != &doubleObjType || A->bytes) &&
8074 (B->typePtr != &doubleObjType || B->bytes) &&
8075 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8077 /* Both are ints */
8079 switch (node->type) {
8080 case JIM_EXPROP_POW:
8081 case JIM_EXPROP_FUNC_POW:
8082 if (wA == 0 && wB < 0) {
8083 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8084 rc = JIM_ERR;
8085 goto done;
8087 wC = JimPowWide(wA, wB);
8088 goto intresult;
8089 case JIM_EXPROP_ADD:
8090 wC = wA + wB;
8091 goto intresult;
8092 case JIM_EXPROP_SUB:
8093 wC = wA - wB;
8094 goto intresult;
8095 case JIM_EXPROP_MUL:
8096 wC = wA * wB;
8097 goto intresult;
8098 case JIM_EXPROP_DIV:
8099 if (wB == 0) {
8100 Jim_SetResultString(interp, "Division by zero", -1);
8101 rc = JIM_ERR;
8102 goto done;
8104 else {
8106 * From Tcl 8.x
8108 * This code is tricky: C doesn't guarantee much
8109 * about the quotient or remainder, but Tcl does.
8110 * The remainder always has the same sign as the
8111 * divisor and a smaller absolute value.
8113 if (wB < 0) {
8114 wB = -wB;
8115 wA = -wA;
8117 wC = wA / wB;
8118 if (wA % wB < 0) {
8119 wC--;
8121 goto intresult;
8123 case JIM_EXPROP_LT:
8124 wC = wA < wB;
8125 goto intresult;
8126 case JIM_EXPROP_GT:
8127 wC = wA > wB;
8128 goto intresult;
8129 case JIM_EXPROP_LTE:
8130 wC = wA <= wB;
8131 goto intresult;
8132 case JIM_EXPROP_GTE:
8133 wC = wA >= wB;
8134 goto intresult;
8135 case JIM_EXPROP_NUMEQ:
8136 wC = wA == wB;
8137 goto intresult;
8138 case JIM_EXPROP_NUMNE:
8139 wC = wA != wB;
8140 goto intresult;
8143 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8144 switch (node->type) {
8145 #ifndef JIM_MATH_FUNCTIONS
8146 case JIM_EXPROP_POW:
8147 case JIM_EXPROP_FUNC_POW:
8148 case JIM_EXPROP_FUNC_ATAN2:
8149 case JIM_EXPROP_FUNC_HYPOT:
8150 case JIM_EXPROP_FUNC_FMOD:
8151 Jim_SetResultString(interp, "unsupported", -1);
8152 rc = JIM_ERR;
8153 goto done;
8154 #else
8155 case JIM_EXPROP_POW:
8156 case JIM_EXPROP_FUNC_POW:
8157 dC = pow(dA, dB);
8158 goto doubleresult;
8159 case JIM_EXPROP_FUNC_ATAN2:
8160 dC = atan2(dA, dB);
8161 goto doubleresult;
8162 case JIM_EXPROP_FUNC_HYPOT:
8163 dC = hypot(dA, dB);
8164 goto doubleresult;
8165 case JIM_EXPROP_FUNC_FMOD:
8166 dC = fmod(dA, dB);
8167 goto doubleresult;
8168 #endif
8169 case JIM_EXPROP_ADD:
8170 dC = dA + dB;
8171 goto doubleresult;
8172 case JIM_EXPROP_SUB:
8173 dC = dA - dB;
8174 goto doubleresult;
8175 case JIM_EXPROP_MUL:
8176 dC = dA * dB;
8177 goto doubleresult;
8178 case JIM_EXPROP_DIV:
8179 if (dB == 0) {
8180 #ifdef INFINITY
8181 dC = dA < 0 ? -INFINITY : INFINITY;
8182 #else
8183 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8184 #endif
8186 else {
8187 dC = dA / dB;
8189 goto doubleresult;
8190 case JIM_EXPROP_LT:
8191 wC = dA < dB;
8192 goto intresult;
8193 case JIM_EXPROP_GT:
8194 wC = dA > dB;
8195 goto intresult;
8196 case JIM_EXPROP_LTE:
8197 wC = dA <= dB;
8198 goto intresult;
8199 case JIM_EXPROP_GTE:
8200 wC = dA >= dB;
8201 goto intresult;
8202 case JIM_EXPROP_NUMEQ:
8203 wC = dA == dB;
8204 goto intresult;
8205 case JIM_EXPROP_NUMNE:
8206 wC = dA != dB;
8207 goto intresult;
8210 else {
8211 /* Handle the string case */
8213 /* XXX: Could optimise the eq/ne case by checking lengths */
8214 int i = Jim_StringCompareObj(interp, A, B, 0);
8216 switch (node->type) {
8217 case JIM_EXPROP_LT:
8218 wC = i < 0;
8219 goto intresult;
8220 case JIM_EXPROP_GT:
8221 wC = i > 0;
8222 goto intresult;
8223 case JIM_EXPROP_LTE:
8224 wC = i <= 0;
8225 goto intresult;
8226 case JIM_EXPROP_GTE:
8227 wC = i >= 0;
8228 goto intresult;
8229 case JIM_EXPROP_NUMEQ:
8230 wC = i == 0;
8231 goto intresult;
8232 case JIM_EXPROP_NUMNE:
8233 wC = i != 0;
8234 goto intresult;
8237 /* If we get here, it is an error */
8238 rc = JIM_ERR;
8239 done:
8240 Jim_DecrRefCount(interp, A);
8241 Jim_DecrRefCount(interp, B);
8242 return rc;
8243 intresult:
8244 Jim_SetResultInt(interp, wC);
8245 goto done;
8246 doubleresult:
8247 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8248 goto done;
8251 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8253 int listlen;
8254 int i;
8256 listlen = Jim_ListLength(interp, listObjPtr);
8257 for (i = 0; i < listlen; i++) {
8258 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8259 return 1;
8262 return 0;
8267 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8269 Jim_Obj *A, *B;
8270 jim_wide wC;
8271 int rc;
8273 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8274 return rc;
8276 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8277 Jim_DecrRefCount(interp, A);
8278 return rc;
8281 switch (node->type) {
8282 case JIM_EXPROP_STREQ:
8283 case JIM_EXPROP_STRNE:
8284 wC = Jim_StringEqObj(A, B);
8285 if (node->type == JIM_EXPROP_STRNE) {
8286 wC = !wC;
8288 break;
8289 case JIM_EXPROP_STRIN:
8290 wC = JimSearchList(interp, B, A);
8291 break;
8292 case JIM_EXPROP_STRNI:
8293 wC = !JimSearchList(interp, B, A);
8294 break;
8295 default:
8296 abort();
8298 Jim_SetResultInt(interp, wC);
8300 Jim_DecrRefCount(interp, A);
8301 Jim_DecrRefCount(interp, B);
8303 return rc;
8306 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8308 long l;
8309 double d;
8310 int b;
8311 int ret = -1;
8313 /* In case the object is interp->result with refcount 1*/
8314 Jim_IncrRefCount(obj);
8316 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8317 ret = (l != 0);
8319 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8320 ret = (d != 0);
8322 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8323 ret = (b != 0);
8326 Jim_DecrRefCount(interp, obj);
8327 return ret;
8330 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8332 /* evaluate left */
8333 int result = JimExprGetTermBoolean(interp, node->left);
8335 if (result == 1) {
8336 /* true so evaluate right */
8337 result = JimExprGetTermBoolean(interp, node->right);
8339 if (result == -1) {
8340 return JIM_ERR;
8342 Jim_SetResultInt(interp, result);
8343 return JIM_OK;
8346 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8348 /* evaluate left */
8349 int result = JimExprGetTermBoolean(interp, node->left);
8351 if (result == 0) {
8352 /* false so evaluate right */
8353 result = JimExprGetTermBoolean(interp, node->right);
8355 if (result == -1) {
8356 return JIM_ERR;
8358 Jim_SetResultInt(interp, result);
8359 return JIM_OK;
8362 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8364 /* evaluate left */
8365 int result = JimExprGetTermBoolean(interp, node->left);
8367 if (result == 1) {
8368 /* true so select right */
8369 return JimExprEvalTermNode(interp, node->right);
8371 else if (result == 0) {
8372 /* false so select ternary */
8373 return JimExprEvalTermNode(interp, node->ternary);
8375 /* error */
8376 return JIM_ERR;
8379 enum
8381 OP_FUNC = 0x0001, /* function syntax */
8382 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8385 /* name - precedence - arity - opcode
8387 * This array *must* be kept in sync with the JIM_EXPROP enum.
8389 * The following macros pre-compute the string length at compile time.
8391 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8392 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8394 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8395 OPRINIT("*", 110, 2, JimExprOpBin),
8396 OPRINIT("/", 110, 2, JimExprOpBin),
8397 OPRINIT("%", 110, 2, JimExprOpIntBin),
8399 OPRINIT("-", 100, 2, JimExprOpBin),
8400 OPRINIT("+", 100, 2, JimExprOpBin),
8402 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8403 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8405 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8406 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8408 OPRINIT("<", 80, 2, JimExprOpBin),
8409 OPRINIT(">", 80, 2, JimExprOpBin),
8410 OPRINIT("<=", 80, 2, JimExprOpBin),
8411 OPRINIT(">=", 80, 2, JimExprOpBin),
8413 OPRINIT("==", 70, 2, JimExprOpBin),
8414 OPRINIT("!=", 70, 2, JimExprOpBin),
8416 OPRINIT("&", 50, 2, JimExprOpIntBin),
8417 OPRINIT("^", 49, 2, JimExprOpIntBin),
8418 OPRINIT("|", 48, 2, JimExprOpIntBin),
8420 OPRINIT("&&", 10, 2, JimExprOpAnd),
8421 OPRINIT("||", 9, 2, JimExprOpOr),
8422 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8423 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8425 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8426 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8428 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8429 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8431 OPRINIT("in", 55, 2, JimExprOpStrBin),
8432 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8434 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8435 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8436 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8437 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8441 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8442 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8443 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8444 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8445 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8446 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8447 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8449 #ifdef JIM_MATH_FUNCTIONS
8450 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8451 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8452 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8453 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8454 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8455 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8456 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8457 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8458 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8459 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8460 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8461 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8462 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8463 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8464 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8465 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8466 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8467 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8468 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8469 #endif
8471 #undef OPRINIT
8472 #undef OPRINIT_ATTR
8474 #define JIM_EXPR_OPERATORS_NUM \
8475 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8477 static int JimParseExpression(struct JimParserCtx *pc)
8479 /* Discard spaces and quoted newline */
8480 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8481 if (*pc->p == '\n') {
8482 pc->linenr++;
8484 pc->p++;
8485 pc->len--;
8488 /* Common case */
8489 pc->tline = pc->linenr;
8490 pc->tstart = pc->p;
8492 if (pc->len == 0) {
8493 pc->tend = pc->p;
8494 pc->tt = JIM_TT_EOL;
8495 pc->eof = 1;
8496 return JIM_OK;
8498 switch (*(pc->p)) {
8499 case '(':
8500 pc->tt = JIM_TT_SUBEXPR_START;
8501 goto singlechar;
8502 case ')':
8503 pc->tt = JIM_TT_SUBEXPR_END;
8504 goto singlechar;
8505 case ',':
8506 pc->tt = JIM_TT_SUBEXPR_COMMA;
8507 singlechar:
8508 pc->tend = pc->p;
8509 pc->p++;
8510 pc->len--;
8511 break;
8512 case '[':
8513 return JimParseCmd(pc);
8514 case '$':
8515 if (JimParseVar(pc) == JIM_ERR)
8516 return JimParseExprOperator(pc);
8517 else {
8518 /* Don't allow expr sugar in expressions */
8519 if (pc->tt == JIM_TT_EXPRSUGAR) {
8520 return JIM_ERR;
8522 return JIM_OK;
8524 break;
8525 case '0':
8526 case '1':
8527 case '2':
8528 case '3':
8529 case '4':
8530 case '5':
8531 case '6':
8532 case '7':
8533 case '8':
8534 case '9':
8535 case '.':
8536 return JimParseExprNumber(pc);
8537 case '"':
8538 return JimParseQuote(pc);
8539 case '{':
8540 return JimParseBrace(pc);
8542 case 'N':
8543 case 'I':
8544 case 'n':
8545 case 'i':
8546 if (JimParseExprIrrational(pc) == JIM_ERR)
8547 if (JimParseExprBoolean(pc) == JIM_ERR)
8548 return JimParseExprOperator(pc);
8549 break;
8550 case 't':
8551 case 'f':
8552 case 'o':
8553 case 'y':
8554 if (JimParseExprBoolean(pc) == JIM_ERR)
8555 return JimParseExprOperator(pc);
8556 break;
8557 default:
8558 return JimParseExprOperator(pc);
8559 break;
8561 return JIM_OK;
8564 static int JimParseExprNumber(struct JimParserCtx *pc)
8566 char *end;
8568 /* Assume an integer for now */
8569 pc->tt = JIM_TT_EXPR_INT;
8571 jim_strtoull(pc->p, (char **)&pc->p);
8572 /* Tried as an integer, but perhaps it parses as a double */
8573 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8574 /* Some stupid compilers insist they are cleverer that
8575 * we are. Even a (void) cast doesn't prevent this warning!
8577 if (strtod(pc->tstart, &end)) { /* nothing */ }
8578 if (end == pc->tstart)
8579 return JIM_ERR;
8580 if (end > pc->p) {
8581 /* Yes, double captured more chars */
8582 pc->tt = JIM_TT_EXPR_DOUBLE;
8583 pc->p = end;
8586 pc->tend = pc->p - 1;
8587 pc->len -= (pc->p - pc->tstart);
8588 return JIM_OK;
8591 static int JimParseExprIrrational(struct JimParserCtx *pc)
8593 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8594 int i;
8596 for (i = 0; irrationals[i]; i++) {
8597 const char *irr = irrationals[i];
8599 if (strncmp(irr, pc->p, 3) == 0) {
8600 pc->p += 3;
8601 pc->len -= 3;
8602 pc->tend = pc->p - 1;
8603 pc->tt = JIM_TT_EXPR_DOUBLE;
8604 return JIM_OK;
8607 return JIM_ERR;
8610 static int JimParseExprBoolean(struct JimParserCtx *pc)
8612 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8613 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8614 int i;
8616 for (i = 0; booleans[i]; i++) {
8617 const char *boolean = booleans[i];
8618 int length = lengths[i];
8620 if (strncmp(boolean, pc->p, length) == 0) {
8621 pc->p += length;
8622 pc->len -= length;
8623 pc->tend = pc->p - 1;
8624 pc->tt = JIM_TT_EXPR_BOOLEAN;
8625 return JIM_OK;
8628 return JIM_ERR;
8631 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8633 static Jim_ExprOperator dummy_op;
8634 if (opcode < JIM_TT_EXPR_OP) {
8635 return &dummy_op;
8637 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8640 static int JimParseExprOperator(struct JimParserCtx *pc)
8642 int i;
8643 const struct Jim_ExprOperator *bestOp = NULL;
8644 int bestLen = 0;
8646 /* Try to get the longest match. */
8647 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8648 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8650 if (op->name[0] != pc->p[0]) {
8651 continue;
8654 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8655 bestOp = op;
8656 bestLen = op->namelen;
8659 if (bestOp == NULL) {
8660 return JIM_ERR;
8663 /* Validate paretheses around function arguments */
8664 if (bestOp->attr & OP_FUNC) {
8665 const char *p = pc->p + bestLen;
8666 int len = pc->len - bestLen;
8668 while (len && isspace(UCHAR(*p))) {
8669 len--;
8670 p++;
8672 if (*p != '(') {
8673 return JIM_ERR;
8676 pc->tend = pc->p + bestLen - 1;
8677 pc->p += bestLen;
8678 pc->len -= bestLen;
8680 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8681 return JIM_OK;
8684 const char *jim_tt_name(int type)
8686 static const char * const tt_names[JIM_TT_EXPR_OP] =
8687 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8688 "DBL", "BOO", "$()" };
8689 if (type < JIM_TT_EXPR_OP) {
8690 return tt_names[type];
8692 else if (type == JIM_EXPROP_UNARYMINUS) {
8693 return "-VE";
8695 else if (type == JIM_EXPROP_UNARYPLUS) {
8696 return "+VE";
8698 else {
8699 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8700 static char buf[20];
8702 if (op->name) {
8703 return op->name;
8705 sprintf(buf, "(%d)", type);
8706 return buf;
8710 /* -----------------------------------------------------------------------------
8711 * Expression Object
8712 * ---------------------------------------------------------------------------*/
8713 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8714 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8715 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8717 static const Jim_ObjType exprObjType = {
8718 "expression",
8719 FreeExprInternalRep,
8720 DupExprInternalRep,
8721 NULL,
8722 JIM_TYPE_REFERENCES,
8725 /* expr tree structure */
8726 struct ExprTree
8728 struct JimExprNode *expr; /* The first operator or term */
8729 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8730 int len; /* Number of nodes in use */
8731 int inUse; /* Used for sharing. */
8734 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8736 int i;
8737 for (i = 0; i < num; i++) {
8738 if (nodes[i].objPtr) {
8739 Jim_DecrRefCount(interp, nodes[i].objPtr);
8742 Jim_Free(nodes);
8745 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8747 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8748 Jim_Free(expr);
8751 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8753 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8755 if (expr) {
8756 if (--expr->inUse != 0) {
8757 return;
8760 ExprTreeFree(interp, expr);
8764 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8766 JIM_NOTUSED(interp);
8767 JIM_NOTUSED(srcPtr);
8769 /* Just returns an simple string. */
8770 dupPtr->typePtr = NULL;
8773 struct ExprBuilder {
8774 int parencount; /* count of outstanding parentheses */
8775 int level; /* recursion depth */
8776 ParseToken *token; /* The current token */
8777 ParseToken *first_token; /* The first token */
8778 Jim_Stack stack; /* stack of pending terms */
8779 Jim_Obj *exprObjPtr; /* the original expression */
8780 Jim_Obj *fileNameObj; /* filename of the original expression */
8781 struct JimExprNode *nodes; /* storage for all nodes */
8782 struct JimExprNode *next; /* storage for the next node */
8785 #ifdef DEBUG_SHOW_EXPR
8786 static void JimShowExprNode(struct JimExprNode *node, int level)
8788 int i;
8789 for (i = 0; i < level; i++) {
8790 printf(" ");
8792 if (TOKEN_IS_EXPR_OP(node->type)) {
8793 printf("%s\n", jim_tt_name(node->type));
8794 if (node->left) {
8795 JimShowExprNode(node->left, level + 1);
8797 if (node->right) {
8798 JimShowExprNode(node->right, level + 1);
8800 if (node->ternary) {
8801 JimShowExprNode(node->ternary, level + 1);
8804 else {
8805 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8808 #endif
8810 #define EXPR_UNTIL_CLOSE 0x0001
8811 #define EXPR_FUNC_ARGS 0x0002
8812 #define EXPR_TERNARY 0x0004
8815 * Parse the subexpression at builder->token and return with the node on the stack.
8816 * builder->token is advanced to the next unconsumed token.
8817 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8819 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8820 * with an equal or lower precedence is reached (or strictly lower if right associative).
8822 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8823 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8824 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8826 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8828 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8830 int rc;
8831 struct JimExprNode *node;
8832 /* Calculate the stack length expected after pushing the number of expected terms */
8833 int exp_stacklen = builder->stack.len + exp_numterms;
8835 builder->level++;
8837 while (builder->token->type != JIM_TT_EOL) {
8838 ParseToken *t = builder->token++;
8839 int prevtt;
8841 if (t == builder->first_token) {
8842 prevtt = JIM_TT_NONE;
8844 else {
8845 prevtt = t[-1].type;
8848 if (t->type == JIM_TT_SUBEXPR_START) {
8849 if (builder->stack.len == exp_stacklen) {
8850 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8851 return JIM_ERR;
8853 builder->parencount++;
8854 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8855 if (rc != JIM_OK) {
8856 return rc;
8858 /* A complete subexpression is on the stack */
8860 else if (t->type == JIM_TT_SUBEXPR_END) {
8861 if (!(flags & EXPR_UNTIL_CLOSE)) {
8862 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8863 builder->token--;
8864 builder->level--;
8865 return JIM_OK;
8867 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8868 return JIM_ERR;
8870 builder->parencount--;
8871 if (builder->stack.len == exp_stacklen) {
8872 /* Return with the expected number of subexpressions on the stack */
8873 break;
8876 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8877 if (!(flags & EXPR_FUNC_ARGS)) {
8878 if (builder->stack.len == exp_stacklen) {
8879 /* handle the comma back at the parent level */
8880 builder->token--;
8881 builder->level--;
8882 return JIM_OK;
8884 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8885 return JIM_ERR;
8887 else {
8888 /* If we see more terms than expected, it is an error */
8889 if (builder->stack.len > exp_stacklen) {
8890 Jim_SetResultFormatted(interp, "too many arguments to math function");
8891 return JIM_ERR;
8894 /* just go onto the next arg */
8896 else if (t->type == JIM_EXPROP_COLON) {
8897 if (!(flags & EXPR_TERNARY)) {
8898 if (builder->level != 1) {
8899 /* handle the comma back at the parent level */
8900 builder->token--;
8901 builder->level--;
8902 return JIM_OK;
8904 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8905 return JIM_ERR;
8907 if (builder->stack.len == exp_stacklen) {
8908 /* handle the comma back at the parent level */
8909 builder->token--;
8910 builder->level--;
8911 return JIM_OK;
8913 /* just go onto the next term */
8915 else if (TOKEN_IS_EXPR_OP(t->type)) {
8916 const struct Jim_ExprOperator *op;
8918 /* Convert -/+ to unary minus or unary plus if necessary */
8919 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8920 if (t->type == JIM_EXPROP_SUB) {
8921 t->type = JIM_EXPROP_UNARYMINUS;
8923 else if (t->type == JIM_EXPROP_ADD) {
8924 t->type = JIM_EXPROP_UNARYPLUS;
8928 op = JimExprOperatorInfoByOpcode(t->type);
8930 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8931 /* next op is lower precedence, or equal and left associative, so done here */
8932 builder->token--;
8933 break;
8936 if (op->attr & OP_FUNC) {
8937 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8938 Jim_SetResultString(interp, "missing arguments for math function", -1);
8939 return JIM_ERR;
8941 builder->token++;
8942 if (op->arity == 0) {
8943 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8944 Jim_SetResultString(interp, "too many arguments for math function", -1);
8945 return JIM_ERR;
8947 builder->token++;
8948 goto noargs;
8950 builder->parencount++;
8952 /* This will push left and return right */
8953 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8955 else if (t->type == JIM_EXPROP_TERNARY) {
8956 /* Collect the two arguments to the ternary operator */
8957 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8959 else {
8960 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8961 * and push that on the term stack
8963 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8966 if (rc != JIM_OK) {
8967 return rc;
8970 noargs:
8971 node = builder->next++;
8972 node->type = t->type;
8974 if (op->arity >= 3) {
8975 node->ternary = Jim_StackPop(&builder->stack);
8976 if (node->ternary == NULL) {
8977 goto missingoperand;
8980 if (op->arity >= 2) {
8981 node->right = Jim_StackPop(&builder->stack);
8982 if (node->right == NULL) {
8983 goto missingoperand;
8986 if (op->arity >= 1) {
8987 node->left = Jim_StackPop(&builder->stack);
8988 if (node->left == NULL) {
8989 missingoperand:
8990 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8991 builder->next--;
8992 return JIM_ERR;
8997 /* Now push the node */
8998 Jim_StackPush(&builder->stack, node);
9000 else {
9001 Jim_Obj *objPtr = NULL;
9003 /* This is a simple non-operator term, so create and push the appropriate object */
9005 /* Two consecutive terms without an operator is invalid */
9006 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9007 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
9008 return JIM_ERR;
9011 /* Immediately create a double or int object? */
9012 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9013 char *endptr;
9014 if (t->type == JIM_TT_EXPR_INT) {
9015 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9017 else {
9018 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9020 if (endptr != t->token + t->len) {
9021 /* Conversion failed, so just store it as a string */
9022 Jim_FreeNewObj(interp, objPtr);
9023 objPtr = NULL;
9027 if (!objPtr) {
9028 /* Everything else is stored a simple string term */
9029 objPtr = Jim_NewStringObj(interp, t->token, t->len);
9030 if (t->type == JIM_TT_CMD) {
9031 /* Only commands need source info */
9032 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
9036 /* Now push a term node */
9037 node = builder->next++;
9038 node->objPtr = objPtr;
9039 Jim_IncrRefCount(node->objPtr);
9040 node->type = t->type;
9041 Jim_StackPush(&builder->stack, node);
9045 if (builder->stack.len == exp_stacklen) {
9046 builder->level--;
9047 return JIM_OK;
9050 if ((flags & EXPR_FUNC_ARGS)) {
9051 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9053 else {
9054 if (builder->stack.len < exp_stacklen) {
9055 if (builder->level == 0) {
9056 Jim_SetResultFormatted(interp, "empty expression");
9058 else {
9059 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9062 else {
9063 Jim_SetResultFormatted(interp, "extra terms after expression");
9067 return JIM_ERR;
9070 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9072 struct ExprTree *expr;
9073 struct ExprBuilder builder;
9074 int rc;
9075 struct JimExprNode *top;
9077 builder.parencount = 0;
9078 builder.level = 0;
9079 builder.token = builder.first_token = tokenlist->list;
9080 builder.exprObjPtr = exprObjPtr;
9081 builder.fileNameObj = fileNameObj;
9082 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9083 builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9084 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9085 builder.next = builder.nodes;
9086 Jim_InitStack(&builder.stack);
9088 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9090 if (rc == JIM_OK) {
9091 top = Jim_StackPop(&builder.stack);
9093 if (builder.parencount) {
9094 Jim_SetResultString(interp, "missing close parenthesis", -1);
9095 rc = JIM_ERR;
9099 /* Free the stack used for the compilation. */
9100 Jim_FreeStack(&builder.stack);
9102 if (rc != JIM_OK) {
9103 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9104 return NULL;
9107 expr = Jim_Alloc(sizeof(*expr));
9108 expr->inUse = 1;
9109 expr->expr = top;
9110 expr->nodes = builder.nodes;
9111 expr->len = builder.next - builder.nodes;
9113 assert(expr->len <= tokenlist->count - 1);
9115 return expr;
9118 /* This method takes the string representation of an expression
9119 * and generates a program for the expr engine */
9120 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9122 int exprTextLen;
9123 const char *exprText;
9124 struct JimParserCtx parser;
9125 struct ExprTree *expr;
9126 ParseTokenList tokenlist;
9127 int line;
9128 Jim_Obj *fileNameObj;
9129 int rc = JIM_ERR;
9131 /* Try to get information about filename / line number */
9132 if (objPtr->typePtr == &sourceObjType) {
9133 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9134 line = objPtr->internalRep.sourceValue.lineNumber;
9136 else {
9137 fileNameObj = interp->emptyObj;
9138 line = 1;
9140 Jim_IncrRefCount(fileNameObj);
9142 exprText = Jim_GetString(objPtr, &exprTextLen);
9144 /* Initially tokenise the expression into tokenlist */
9145 ScriptTokenListInit(&tokenlist);
9147 JimParserInit(&parser, exprText, exprTextLen, line);
9148 while (!parser.eof) {
9149 if (JimParseExpression(&parser) != JIM_OK) {
9150 ScriptTokenListFree(&tokenlist);
9151 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9152 expr = NULL;
9153 goto err;
9156 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9157 parser.tline);
9160 #ifdef DEBUG_SHOW_EXPR_TOKENS
9162 int i;
9163 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9164 for (i = 0; i < tokenlist.count; i++) {
9165 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9166 tokenlist.list[i].len, tokenlist.list[i].token);
9169 #endif
9171 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9172 ScriptTokenListFree(&tokenlist);
9173 Jim_DecrRefCount(interp, fileNameObj);
9174 return JIM_ERR;
9177 /* Now create the expression bytecode from the tokenlist */
9178 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9180 /* No longer need the token list */
9181 ScriptTokenListFree(&tokenlist);
9183 if (!expr) {
9184 goto err;
9187 #ifdef DEBUG_SHOW_EXPR
9188 printf("==== Expr ====\n");
9189 JimShowExprNode(expr->expr, 0);
9190 #endif
9192 rc = JIM_OK;
9194 err:
9195 /* Free the old internal rep and set the new one. */
9196 Jim_DecrRefCount(interp, fileNameObj);
9197 Jim_FreeIntRep(interp, objPtr);
9198 Jim_SetIntRepPtr(objPtr, expr);
9199 objPtr->typePtr = &exprObjType;
9200 return rc;
9203 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9205 if (objPtr->typePtr != &exprObjType) {
9206 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9207 return NULL;
9210 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9213 #ifdef JIM_OPTIMIZATION
9214 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9216 if (node->type == JIM_TT_EXPR_INT)
9217 return node->objPtr;
9218 else if (node->type == JIM_TT_VAR)
9219 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9220 else if (node->type == JIM_TT_DICTSUGAR)
9221 return JimExpandDictSugar(interp, node->objPtr);
9222 else
9223 return NULL;
9225 #endif
9227 /* -----------------------------------------------------------------------------
9228 * Expressions evaluation.
9229 * Jim uses a recursive evaluation engine for expressions,
9230 * that takes advantage of the fact that expr's operators
9231 * can't be redefined.
9233 * Jim_EvalExpression() uses the expression tree compiled by
9234 * SetExprFromAny() method of the "expression" object.
9236 * On success a Tcl Object containing the result of the evaluation
9237 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9238 * returned.
9239 * On error the function returns a retcode != to JIM_OK and set a suitable
9240 * error on the interp.
9241 * ---------------------------------------------------------------------------*/
9243 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9245 if (TOKEN_IS_EXPR_OP(node->type)) {
9246 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9247 return op->funcop(interp, node);
9249 else {
9250 Jim_Obj *objPtr;
9252 /* A term */
9253 switch (node->type) {
9254 case JIM_TT_EXPR_INT:
9255 case JIM_TT_EXPR_DOUBLE:
9256 case JIM_TT_EXPR_BOOLEAN:
9257 case JIM_TT_STR:
9258 Jim_SetResult(interp, node->objPtr);
9259 return JIM_OK;
9261 case JIM_TT_VAR:
9262 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9263 if (objPtr) {
9264 Jim_SetResult(interp, objPtr);
9265 return JIM_OK;
9267 return JIM_ERR;
9269 case JIM_TT_DICTSUGAR:
9270 objPtr = JimExpandDictSugar(interp, node->objPtr);
9271 if (objPtr) {
9272 Jim_SetResult(interp, objPtr);
9273 return JIM_OK;
9275 return JIM_ERR;
9277 case JIM_TT_ESC:
9278 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9279 Jim_SetResult(interp, objPtr);
9280 return JIM_OK;
9282 return JIM_ERR;
9284 case JIM_TT_CMD:
9285 return Jim_EvalObj(interp, node->objPtr);
9287 default:
9288 /* Should never get here */
9289 return JIM_ERR;
9294 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9296 int rc = JimExprEvalTermNode(interp, node);
9297 if (rc == JIM_OK) {
9298 *objPtrPtr = Jim_GetResult(interp);
9299 Jim_IncrRefCount(*objPtrPtr);
9301 return rc;
9304 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9306 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9307 return ExprBool(interp, Jim_GetResult(interp));
9309 return -1;
9312 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9314 struct ExprTree *expr;
9315 int retcode = JIM_OK;
9317 expr = JimGetExpression(interp, exprObjPtr);
9318 if (!expr) {
9319 return JIM_ERR; /* error in expression. */
9322 #ifdef JIM_OPTIMIZATION
9323 /* Check for one of the following common expressions used by while/for
9325 * CONST
9326 * $a
9327 * !$a
9328 * $a < CONST, $a < $b
9329 * $a <= CONST, $a <= $b
9330 * $a > CONST, $a > $b
9331 * $a >= CONST, $a >= $b
9332 * $a != CONST, $a != $b
9333 * $a == CONST, $a == $b
9336 Jim_Obj *objPtr;
9338 /* STEP 1 -- Check if there are the conditions to run the specialized
9339 * version of while */
9341 switch (expr->len) {
9342 case 1:
9343 objPtr = JimExprIntValOrVar(interp, expr->expr);
9344 if (objPtr) {
9345 Jim_SetResult(interp, objPtr);
9346 return JIM_OK;
9348 break;
9350 case 2:
9351 if (expr->expr->type == JIM_EXPROP_NOT) {
9352 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9354 if (objPtr && JimIsWide(objPtr)) {
9355 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9356 return JIM_OK;
9359 break;
9361 case 3:
9362 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9363 if (objPtr && JimIsWide(objPtr)) {
9364 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9365 if (objPtr2 && JimIsWide(objPtr2)) {
9366 jim_wide wideValueA = JimWideValue(objPtr);
9367 jim_wide wideValueB = JimWideValue(objPtr2);
9368 int cmpRes;
9369 switch (expr->expr->type) {
9370 case JIM_EXPROP_LT:
9371 cmpRes = wideValueA < wideValueB;
9372 break;
9373 case JIM_EXPROP_LTE:
9374 cmpRes = wideValueA <= wideValueB;
9375 break;
9376 case JIM_EXPROP_GT:
9377 cmpRes = wideValueA > wideValueB;
9378 break;
9379 case JIM_EXPROP_GTE:
9380 cmpRes = wideValueA >= wideValueB;
9381 break;
9382 case JIM_EXPROP_NUMEQ:
9383 cmpRes = wideValueA == wideValueB;
9384 break;
9385 case JIM_EXPROP_NUMNE:
9386 cmpRes = wideValueA != wideValueB;
9387 break;
9388 default:
9389 goto noopt;
9391 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9392 return JIM_OK;
9395 break;
9398 noopt:
9399 #endif
9401 /* In order to avoid the internal repr being freed due to
9402 * shimmering of the exprObjPtr's object, we make the internal rep
9403 * shared. */
9404 expr->inUse++;
9406 /* Evaluate with the recursive expr engine */
9407 retcode = JimExprEvalTermNode(interp, expr->expr);
9409 expr->inUse--;
9411 return retcode;
9414 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9416 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9418 if (retcode == JIM_OK) {
9419 switch (ExprBool(interp, Jim_GetResult(interp))) {
9420 case 0:
9421 *boolPtr = 0;
9422 break;
9424 case 1:
9425 *boolPtr = 1;
9426 break;
9428 case -1:
9429 retcode = JIM_ERR;
9430 break;
9433 return retcode;
9436 /* -----------------------------------------------------------------------------
9437 * ScanFormat String Object
9438 * ---------------------------------------------------------------------------*/
9440 /* This Jim_Obj will held a parsed representation of a format string passed to
9441 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9442 * to be parsed in its entirely first and then, if correct, can be used for
9443 * scanning. To avoid endless re-parsing, the parsed representation will be
9444 * stored in an internal representation and re-used for performance reason. */
9446 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9447 * scanformat string. This part will later be used to extract information
9448 * out from the string to be parsed by Jim_ScanString */
9450 typedef struct ScanFmtPartDescr
9452 char *arg; /* Specification of a CHARSET conversion */
9453 char *prefix; /* Prefix to be scanned literally before conversion */
9454 size_t width; /* Maximal width of input to be converted */
9455 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9456 char type; /* Type of conversion (e.g. c, d, f) */
9457 char modifier; /* Modify type (e.g. l - long, h - short */
9458 } ScanFmtPartDescr;
9460 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9461 * string parsed and separated in part descriptions. Furthermore it contains
9462 * the original string representation of the scanformat string to allow for
9463 * fast update of the Jim_Obj's string representation part.
9465 * As an add-on the internal object representation adds some scratch pad area
9466 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9467 * memory for purpose of string scanning.
9469 * The error member points to a static allocated string in case of a mal-
9470 * formed scanformat string or it contains '0' (NULL) in case of a valid
9471 * parse representation.
9473 * The whole memory of the internal representation is allocated as a single
9474 * area of memory that will be internally separated. So freeing and duplicating
9475 * of such an object is cheap */
9477 typedef struct ScanFmtStringObj
9479 jim_wide size; /* Size of internal repr in bytes */
9480 char *stringRep; /* Original string representation */
9481 size_t count; /* Number of ScanFmtPartDescr contained */
9482 size_t convCount; /* Number of conversions that will assign */
9483 size_t maxPos; /* Max position index if XPG3 is used */
9484 const char *error; /* Ptr to error text (NULL if no error */
9485 char *scratch; /* Some scratch pad used by Jim_ScanString */
9486 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9487 } ScanFmtStringObj;
9490 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9491 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9492 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9494 static const Jim_ObjType scanFmtStringObjType = {
9495 "scanformatstring",
9496 FreeScanFmtInternalRep,
9497 DupScanFmtInternalRep,
9498 UpdateStringOfScanFmt,
9499 JIM_TYPE_NONE,
9502 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9504 JIM_NOTUSED(interp);
9505 Jim_Free((char *)objPtr->internalRep.ptr);
9506 objPtr->internalRep.ptr = 0;
9509 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9511 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9512 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9514 JIM_NOTUSED(interp);
9515 memcpy(newVec, srcPtr->internalRep.ptr, size);
9516 dupPtr->internalRep.ptr = newVec;
9517 dupPtr->typePtr = &scanFmtStringObjType;
9520 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9522 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9525 /* SetScanFmtFromAny will parse a given string and create the internal
9526 * representation of the format specification. In case of an error
9527 * the error data member of the internal representation will be set
9528 * to an descriptive error text and the function will be left with
9529 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9530 * specification */
9532 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9534 ScanFmtStringObj *fmtObj;
9535 char *buffer;
9536 int maxCount, i, approxSize, lastPos = -1;
9537 const char *fmt = Jim_String(objPtr);
9538 int maxFmtLen = Jim_Length(objPtr);
9539 const char *fmtEnd = fmt + maxFmtLen;
9540 int curr;
9542 Jim_FreeIntRep(interp, objPtr);
9543 /* Count how many conversions could take place maximally */
9544 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9545 if (fmt[i] == '%')
9546 ++maxCount;
9547 /* Calculate an approximation of the memory necessary */
9548 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9549 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9550 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9551 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9552 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9553 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9554 +1; /* safety byte */
9555 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9556 memset(fmtObj, 0, approxSize);
9557 fmtObj->size = approxSize;
9558 fmtObj->maxPos = 0;
9559 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9560 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9561 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9562 buffer = fmtObj->stringRep + maxFmtLen + 1;
9563 objPtr->internalRep.ptr = fmtObj;
9564 objPtr->typePtr = &scanFmtStringObjType;
9565 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9566 int width = 0, skip;
9567 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9569 fmtObj->count++;
9570 descr->width = 0; /* Assume width unspecified */
9571 /* Overread and store any "literal" prefix */
9572 if (*fmt != '%' || fmt[1] == '%') {
9573 descr->type = 0;
9574 descr->prefix = &buffer[i];
9575 for (; fmt < fmtEnd; ++fmt) {
9576 if (*fmt == '%') {
9577 if (fmt[1] != '%')
9578 break;
9579 ++fmt;
9581 buffer[i++] = *fmt;
9583 buffer[i++] = 0;
9585 /* Skip the conversion introducing '%' sign */
9586 ++fmt;
9587 /* End reached due to non-conversion literal only? */
9588 if (fmt >= fmtEnd)
9589 goto done;
9590 descr->pos = 0; /* Assume "natural" positioning */
9591 if (*fmt == '*') {
9592 descr->pos = -1; /* Okay, conversion will not be assigned */
9593 ++fmt;
9595 else
9596 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9597 /* Check if next token is a number (could be width or pos */
9598 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9599 fmt += skip;
9600 /* Was the number a XPG3 position specifier? */
9601 if (descr->pos != -1 && *fmt == '$') {
9602 int prev;
9604 ++fmt;
9605 descr->pos = width;
9606 width = 0;
9607 /* Look if "natural" postioning and XPG3 one was mixed */
9608 if ((lastPos == 0 && descr->pos > 0)
9609 || (lastPos > 0 && descr->pos == 0)) {
9610 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9611 return JIM_ERR;
9613 /* Look if this position was already used */
9614 for (prev = 0; prev < curr; ++prev) {
9615 if (fmtObj->descr[prev].pos == -1)
9616 continue;
9617 if (fmtObj->descr[prev].pos == descr->pos) {
9618 fmtObj->error =
9619 "variable is assigned by multiple \"%n$\" conversion specifiers";
9620 return JIM_ERR;
9623 if (descr->pos < 0) {
9624 fmtObj->error =
9625 "\"%n$\" conversion specifier is negative";
9626 return JIM_ERR;
9628 /* Try to find a width after the XPG3 specifier */
9629 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9630 descr->width = width;
9631 fmt += skip;
9633 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9634 fmtObj->maxPos = descr->pos;
9636 else {
9637 /* Number was not a XPG3, so it has to be a width */
9638 descr->width = width;
9641 /* If positioning mode was undetermined yet, fix this */
9642 if (lastPos == -1)
9643 lastPos = descr->pos;
9644 /* Handle CHARSET conversion type ... */
9645 if (*fmt == '[') {
9646 int swapped = 1, beg = i, end, j;
9648 descr->type = '[';
9649 descr->arg = &buffer[i];
9650 ++fmt;
9651 if (*fmt == '^')
9652 buffer[i++] = *fmt++;
9653 if (*fmt == ']')
9654 buffer[i++] = *fmt++;
9655 while (*fmt && *fmt != ']')
9656 buffer[i++] = *fmt++;
9657 if (*fmt != ']') {
9658 fmtObj->error = "unmatched [ in format string";
9659 return JIM_ERR;
9661 end = i;
9662 buffer[i++] = 0;
9663 /* In case a range fence was given "backwards", swap it */
9664 while (swapped) {
9665 swapped = 0;
9666 for (j = beg + 1; j < end - 1; ++j) {
9667 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9668 char tmp = buffer[j - 1];
9670 buffer[j - 1] = buffer[j + 1];
9671 buffer[j + 1] = tmp;
9672 swapped = 1;
9677 else {
9678 /* Remember any valid modifier if given */
9679 if (fmt < fmtEnd && strchr("hlL", *fmt))
9680 descr->modifier = tolower((int)*fmt++);
9682 if (fmt >= fmtEnd) {
9683 fmtObj->error = "missing scan conversion character";
9684 return JIM_ERR;
9687 descr->type = *fmt;
9688 if (strchr("efgcsndoxui", *fmt) == 0) {
9689 fmtObj->error = "bad scan conversion character";
9690 return JIM_ERR;
9692 else if (*fmt == 'c' && descr->width != 0) {
9693 fmtObj->error = "field width may not be specified in %c " "conversion";
9694 return JIM_ERR;
9696 else if (*fmt == 'u' && descr->modifier == 'l') {
9697 fmtObj->error = "unsigned wide not supported";
9698 return JIM_ERR;
9701 curr++;
9703 done:
9704 return JIM_OK;
9707 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9709 #define FormatGetCnvCount(_fo_) \
9710 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9711 #define FormatGetMaxPos(_fo_) \
9712 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9713 #define FormatGetError(_fo_) \
9714 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9716 /* JimScanAString is used to scan an unspecified string that ends with
9717 * next WS, or a string that is specified via a charset.
9720 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9722 char *buffer = Jim_StrDup(str);
9723 char *p = buffer;
9725 while (*str) {
9726 int c;
9727 int n;
9729 if (!sdescr && isspace(UCHAR(*str)))
9730 break; /* EOS via WS if unspecified */
9732 n = utf8_tounicode(str, &c);
9733 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9734 break;
9735 while (n--)
9736 *p++ = *str++;
9738 *p = 0;
9739 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9742 /* ScanOneEntry will scan one entry out of the string passed as argument.
9743 * It use the sscanf() function for this task. After extracting and
9744 * converting of the value, the count of scanned characters will be
9745 * returned of -1 in case of no conversion tool place and string was
9746 * already scanned thru */
9748 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9749 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9751 const char *tok;
9752 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9753 size_t scanned = 0;
9754 size_t anchor = pos;
9755 int i;
9756 Jim_Obj *tmpObj = NULL;
9758 /* First pessimistically assume, we will not scan anything :-) */
9759 *valObjPtr = 0;
9760 if (descr->prefix) {
9761 /* There was a prefix given before the conversion, skip it and adjust
9762 * the string-to-be-parsed accordingly */
9763 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9764 /* If prefix require, skip WS */
9765 if (isspace(UCHAR(descr->prefix[i])))
9766 while (pos < strLen && isspace(UCHAR(str[pos])))
9767 ++pos;
9768 else if (descr->prefix[i] != str[pos])
9769 break; /* Prefix do not match here, leave the loop */
9770 else
9771 ++pos; /* Prefix matched so far, next round */
9773 if (pos >= strLen) {
9774 return -1; /* All of str consumed: EOF condition */
9776 else if (descr->prefix[i] != 0)
9777 return 0; /* Not whole prefix consumed, no conversion possible */
9779 /* For all but following conversion, skip leading WS */
9780 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9781 while (isspace(UCHAR(str[pos])))
9782 ++pos;
9783 /* Determine how much skipped/scanned so far */
9784 scanned = pos - anchor;
9786 /* %c is a special, simple case. no width */
9787 if (descr->type == 'n') {
9788 /* Return pseudo conversion means: how much scanned so far? */
9789 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9791 else if (pos >= strLen) {
9792 /* Cannot scan anything, as str is totally consumed */
9793 return -1;
9795 else if (descr->type == 'c') {
9796 int c;
9797 scanned += utf8_tounicode(&str[pos], &c);
9798 *valObjPtr = Jim_NewIntObj(interp, c);
9799 return scanned;
9801 else {
9802 /* Processing of conversions follows ... */
9803 if (descr->width > 0) {
9804 /* Do not try to scan as fas as possible but only the given width.
9805 * To ensure this, we copy the part that should be scanned. */
9806 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9807 size_t tLen = descr->width > sLen ? sLen : descr->width;
9809 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9810 tok = tmpObj->bytes;
9812 else {
9813 /* As no width was given, simply refer to the original string */
9814 tok = &str[pos];
9816 switch (descr->type) {
9817 case 'd':
9818 case 'o':
9819 case 'x':
9820 case 'u':
9821 case 'i':{
9822 char *endp; /* Position where the number finished */
9823 jim_wide w;
9825 int base = descr->type == 'o' ? 8
9826 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9828 /* Try to scan a number with the given base */
9829 if (base == 0) {
9830 w = jim_strtoull(tok, &endp);
9832 else {
9833 w = strtoull(tok, &endp, base);
9836 if (endp != tok) {
9837 /* There was some number sucessfully scanned! */
9838 *valObjPtr = Jim_NewIntObj(interp, w);
9840 /* Adjust the number-of-chars scanned so far */
9841 scanned += endp - tok;
9843 else {
9844 /* Nothing was scanned. We have to determine if this
9845 * happened due to e.g. prefix mismatch or input str
9846 * exhausted */
9847 scanned = *tok ? 0 : -1;
9849 break;
9851 case 's':
9852 case '[':{
9853 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9854 scanned += Jim_Length(*valObjPtr);
9855 break;
9857 case 'e':
9858 case 'f':
9859 case 'g':{
9860 char *endp;
9861 double value = strtod(tok, &endp);
9863 if (endp != tok) {
9864 /* There was some number sucessfully scanned! */
9865 *valObjPtr = Jim_NewDoubleObj(interp, value);
9866 /* Adjust the number-of-chars scanned so far */
9867 scanned += endp - tok;
9869 else {
9870 /* Nothing was scanned. We have to determine if this
9871 * happened due to e.g. prefix mismatch or input str
9872 * exhausted */
9873 scanned = *tok ? 0 : -1;
9875 break;
9878 /* If a substring was allocated (due to pre-defined width) do not
9879 * forget to free it */
9880 if (tmpObj) {
9881 Jim_FreeNewObj(interp, tmpObj);
9884 return scanned;
9887 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9888 * string and returns all converted (and not ignored) values in a list back
9889 * to the caller. If an error occured, a NULL pointer will be returned */
9891 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9893 size_t i, pos;
9894 int scanned = 1;
9895 const char *str = Jim_String(strObjPtr);
9896 int strLen = Jim_Utf8Length(interp, strObjPtr);
9897 Jim_Obj *resultList = 0;
9898 Jim_Obj **resultVec = 0;
9899 int resultc;
9900 Jim_Obj *emptyStr = 0;
9901 ScanFmtStringObj *fmtObj;
9903 /* This should never happen. The format object should already be of the correct type */
9904 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9906 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9907 /* Check if format specification was valid */
9908 if (fmtObj->error != 0) {
9909 if (flags & JIM_ERRMSG)
9910 Jim_SetResultString(interp, fmtObj->error, -1);
9911 return 0;
9913 /* Allocate a new "shared" empty string for all unassigned conversions */
9914 emptyStr = Jim_NewEmptyStringObj(interp);
9915 Jim_IncrRefCount(emptyStr);
9916 /* Create a list and fill it with empty strings up to max specified XPG3 */
9917 resultList = Jim_NewListObj(interp, NULL, 0);
9918 if (fmtObj->maxPos > 0) {
9919 for (i = 0; i < fmtObj->maxPos; ++i)
9920 Jim_ListAppendElement(interp, resultList, emptyStr);
9921 JimListGetElements(interp, resultList, &resultc, &resultVec);
9923 /* Now handle every partial format description */
9924 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9925 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9926 Jim_Obj *value = 0;
9928 /* Only last type may be "literal" w/o conversion - skip it! */
9929 if (descr->type == 0)
9930 continue;
9931 /* As long as any conversion could be done, we will proceed */
9932 if (scanned > 0)
9933 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9934 /* In case our first try results in EOF, we will leave */
9935 if (scanned == -1 && i == 0)
9936 goto eof;
9937 /* Advance next pos-to-be-scanned for the amount scanned already */
9938 pos += scanned;
9940 /* value == 0 means no conversion took place so take empty string */
9941 if (value == 0)
9942 value = Jim_NewEmptyStringObj(interp);
9943 /* If value is a non-assignable one, skip it */
9944 if (descr->pos == -1) {
9945 Jim_FreeNewObj(interp, value);
9947 else if (descr->pos == 0)
9948 /* Otherwise append it to the result list if no XPG3 was given */
9949 Jim_ListAppendElement(interp, resultList, value);
9950 else if (resultVec[descr->pos - 1] == emptyStr) {
9951 /* But due to given XPG3, put the value into the corr. slot */
9952 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9953 Jim_IncrRefCount(value);
9954 resultVec[descr->pos - 1] = value;
9956 else {
9957 /* Otherwise, the slot was already used - free obj and ERROR */
9958 Jim_FreeNewObj(interp, value);
9959 goto err;
9962 Jim_DecrRefCount(interp, emptyStr);
9963 return resultList;
9964 eof:
9965 Jim_DecrRefCount(interp, emptyStr);
9966 Jim_FreeNewObj(interp, resultList);
9967 return (Jim_Obj *)EOF;
9968 err:
9969 Jim_DecrRefCount(interp, emptyStr);
9970 Jim_FreeNewObj(interp, resultList);
9971 return 0;
9974 /* -----------------------------------------------------------------------------
9975 * Pseudo Random Number Generation
9976 * ---------------------------------------------------------------------------*/
9977 /* Initialize the sbox with the numbers from 0 to 255 */
9978 static void JimPrngInit(Jim_Interp *interp)
9980 #define PRNG_SEED_SIZE 256
9981 int i;
9982 unsigned int *seed;
9983 time_t t = time(NULL);
9985 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9987 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9988 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9989 seed[i] = (rand() ^ t ^ clock());
9991 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9992 Jim_Free(seed);
9995 /* Generates N bytes of random data */
9996 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9998 Jim_PrngState *prng;
9999 unsigned char *destByte = (unsigned char *)dest;
10000 unsigned int si, sj, x;
10002 /* initialization, only needed the first time */
10003 if (interp->prngState == NULL)
10004 JimPrngInit(interp);
10005 prng = interp->prngState;
10006 /* generates 'len' bytes of pseudo-random numbers */
10007 for (x = 0; x < len; x++) {
10008 prng->i = (prng->i + 1) & 0xff;
10009 si = prng->sbox[prng->i];
10010 prng->j = (prng->j + si) & 0xff;
10011 sj = prng->sbox[prng->j];
10012 prng->sbox[prng->i] = sj;
10013 prng->sbox[prng->j] = si;
10014 *destByte++ = prng->sbox[(si + sj) & 0xff];
10018 /* Re-seed the generator with user-provided bytes */
10019 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10021 int i;
10022 Jim_PrngState *prng;
10024 /* initialization, only needed the first time */
10025 if (interp->prngState == NULL)
10026 JimPrngInit(interp);
10027 prng = interp->prngState;
10029 /* Set the sbox[i] with i */
10030 for (i = 0; i < 256; i++)
10031 prng->sbox[i] = i;
10032 /* Now use the seed to perform a random permutation of the sbox */
10033 for (i = 0; i < seedLen; i++) {
10034 unsigned char t;
10036 t = prng->sbox[i & 0xFF];
10037 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10038 prng->sbox[seed[i]] = t;
10040 prng->i = prng->j = 0;
10042 /* discard at least the first 256 bytes of stream.
10043 * borrow the seed buffer for this
10045 for (i = 0; i < 256; i += seedLen) {
10046 JimRandomBytes(interp, seed, seedLen);
10050 /* [incr] */
10051 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10053 jim_wide wideValue, increment = 1;
10054 Jim_Obj *intObjPtr;
10056 if (argc != 2 && argc != 3) {
10057 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10058 return JIM_ERR;
10060 if (argc == 3) {
10061 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10062 return JIM_ERR;
10064 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10065 if (!intObjPtr) {
10066 /* Set missing variable to 0 */
10067 wideValue = 0;
10069 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10070 return JIM_ERR;
10072 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10073 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10074 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10075 Jim_FreeNewObj(interp, intObjPtr);
10076 return JIM_ERR;
10079 else {
10080 /* Can do it the quick way */
10081 Jim_InvalidateStringRep(intObjPtr);
10082 JimWideValue(intObjPtr) = wideValue + increment;
10084 /* The following step is required in order to invalidate the
10085 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10086 if (argv[1]->typePtr != &variableObjType) {
10087 /* Note that this can't fail since GetVariable already succeeded */
10088 Jim_SetVariable(interp, argv[1], intObjPtr);
10091 Jim_SetResult(interp, intObjPtr);
10092 return JIM_OK;
10096 /* -----------------------------------------------------------------------------
10097 * Eval
10098 * ---------------------------------------------------------------------------*/
10099 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10100 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10102 /* Handle calls to the [unknown] command */
10103 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10105 int retcode;
10107 /* If JimUnknown() is recursively called too many times...
10108 * done here
10110 if (interp->unknown_called > 50) {
10111 return JIM_ERR;
10114 /* The object interp->unknown just contains
10115 * the "unknown" string, it is used in order to
10116 * avoid to lookup the unknown command every time
10117 * but instead to cache the result. */
10119 /* If the [unknown] command does not exist ... */
10120 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10121 return JIM_ERR;
10123 interp->unknown_called++;
10124 /* XXX: Are we losing fileNameObj and linenr? */
10125 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10126 interp->unknown_called--;
10128 return retcode;
10131 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10133 int retcode;
10134 Jim_Cmd *cmdPtr;
10136 #if 0
10137 printf("invoke");
10138 int j;
10139 for (j = 0; j < objc; j++) {
10140 printf(" '%s'", Jim_String(objv[j]));
10142 printf("\n");
10143 #endif
10145 if (interp->framePtr->tailcallCmd) {
10146 /* Special tailcall command was pre-resolved */
10147 cmdPtr = interp->framePtr->tailcallCmd;
10148 interp->framePtr->tailcallCmd = NULL;
10150 else {
10151 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10152 if (cmdPtr == NULL) {
10153 return JimUnknown(interp, objc, objv);
10155 JimIncrCmdRefCount(cmdPtr);
10158 if (interp->evalDepth == interp->maxEvalDepth) {
10159 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10160 retcode = JIM_ERR;
10161 goto out;
10163 interp->evalDepth++;
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->evalDepth--;
10176 out:
10177 JimDecrCmdRefCount(interp, cmdPtr);
10179 return retcode;
10182 /* Eval the object vector 'objv' composed of 'objc' elements.
10183 * Every element is used as single argument.
10184 * Jim_EvalObj() will call this function every time its object
10185 * argument is of "list" type, with no string representation.
10187 * This is possible because the string representation of a
10188 * list object generated by the UpdateStringOfList is made
10189 * in a way that ensures that every list element is a different
10190 * command argument. */
10191 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10193 int i, retcode;
10195 /* Incr refcount of arguments. */
10196 for (i = 0; i < objc; i++)
10197 Jim_IncrRefCount(objv[i]);
10199 retcode = JimInvokeCommand(interp, objc, objv);
10201 /* Decr refcount of arguments and return the retcode */
10202 for (i = 0; i < objc; i++)
10203 Jim_DecrRefCount(interp, objv[i]);
10205 return retcode;
10209 * Invokes 'prefix' as a command with the objv array as arguments.
10211 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10213 int ret;
10214 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10216 nargv[0] = prefix;
10217 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10218 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10219 Jim_Free(nargv);
10220 return ret;
10223 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10225 if (!interp->errorFlag) {
10226 /* This is the first error, so save the file/line information and reset the stack */
10227 interp->errorFlag = 1;
10228 Jim_IncrRefCount(script->fileNameObj);
10229 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10230 interp->errorFileNameObj = script->fileNameObj;
10231 interp->errorLine = script->linenr;
10233 JimResetStackTrace(interp);
10234 /* Always add a level where the error first occurs */
10235 interp->addStackTrace++;
10238 /* Now if this is an "interesting" level, add it to the stack trace */
10239 if (interp->addStackTrace > 0) {
10240 /* Add the stack info for the current level */
10242 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10244 /* Note: if we didn't have a filename for this level,
10245 * don't clear the addStackTrace flag
10246 * so we can pick it up at the next level
10248 if (Jim_Length(script->fileNameObj)) {
10249 interp->addStackTrace = 0;
10252 Jim_DecrRefCount(interp, interp->errorProc);
10253 interp->errorProc = interp->emptyObj;
10254 Jim_IncrRefCount(interp->errorProc);
10258 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10260 Jim_Obj *objPtr;
10262 switch (token->type) {
10263 case JIM_TT_STR:
10264 case JIM_TT_ESC:
10265 objPtr = token->objPtr;
10266 break;
10267 case JIM_TT_VAR:
10268 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10269 break;
10270 case JIM_TT_DICTSUGAR:
10271 objPtr = JimExpandDictSugar(interp, token->objPtr);
10272 break;
10273 case JIM_TT_EXPRSUGAR:
10274 objPtr = JimExpandExprSugar(interp, token->objPtr);
10275 break;
10276 case JIM_TT_CMD:
10277 switch (Jim_EvalObj(interp, token->objPtr)) {
10278 case JIM_OK:
10279 case JIM_RETURN:
10280 objPtr = interp->result;
10281 break;
10282 case JIM_BREAK:
10283 /* Stop substituting */
10284 return JIM_BREAK;
10285 case JIM_CONTINUE:
10286 /* just skip this one */
10287 return JIM_CONTINUE;
10288 default:
10289 return JIM_ERR;
10291 break;
10292 default:
10293 JimPanic((1,
10294 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10295 objPtr = NULL;
10296 break;
10298 if (objPtr) {
10299 *objPtrPtr = objPtr;
10300 return JIM_OK;
10302 return JIM_ERR;
10305 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10306 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10307 * The returned object has refcount = 0.
10309 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10311 int totlen = 0, i;
10312 Jim_Obj **intv;
10313 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10314 Jim_Obj *objPtr;
10315 char *s;
10317 if (tokens <= JIM_EVAL_SINTV_LEN)
10318 intv = sintv;
10319 else
10320 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10322 /* Compute every token forming the argument
10323 * in the intv objects vector. */
10324 for (i = 0; i < tokens; i++) {
10325 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10326 case JIM_OK:
10327 case JIM_RETURN:
10328 break;
10329 case JIM_BREAK:
10330 if (flags & JIM_SUBST_FLAG) {
10331 /* Stop here */
10332 tokens = i;
10333 continue;
10335 /* XXX: Should probably set an error about break outside loop */
10336 /* fall through to error */
10337 case JIM_CONTINUE:
10338 if (flags & JIM_SUBST_FLAG) {
10339 intv[i] = NULL;
10340 continue;
10342 /* XXX: Ditto continue outside loop */
10343 /* fall through to error */
10344 default:
10345 while (i--) {
10346 Jim_DecrRefCount(interp, intv[i]);
10348 if (intv != sintv) {
10349 Jim_Free(intv);
10351 return NULL;
10353 Jim_IncrRefCount(intv[i]);
10354 Jim_String(intv[i]);
10355 totlen += intv[i]->length;
10358 /* Fast path return for a single token */
10359 if (tokens == 1 && intv[0] && intv == sintv) {
10360 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10361 intv[0]->refCount--;
10362 return intv[0];
10365 /* Concatenate every token in an unique
10366 * object. */
10367 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10369 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10370 && token[2].type == JIM_TT_VAR) {
10371 /* May be able to do fast interpolated object -> dictSubst */
10372 objPtr->typePtr = &interpolatedObjType;
10373 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10374 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10375 Jim_IncrRefCount(intv[2]);
10377 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10378 /* The first interpolated token is source, so preserve the source info */
10379 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10383 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10384 objPtr->length = totlen;
10385 for (i = 0; i < tokens; i++) {
10386 if (intv[i]) {
10387 memcpy(s, intv[i]->bytes, intv[i]->length);
10388 s += intv[i]->length;
10389 Jim_DecrRefCount(interp, intv[i]);
10392 objPtr->bytes[totlen] = '\0';
10393 /* Free the intv vector if not static. */
10394 if (intv != sintv) {
10395 Jim_Free(intv);
10398 return objPtr;
10402 /* listPtr *must* be a list.
10403 * The contents of the list is evaluated with the first element as the command and
10404 * the remaining elements as the arguments.
10406 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10408 int retcode = JIM_OK;
10410 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10412 if (listPtr->internalRep.listValue.len) {
10413 Jim_IncrRefCount(listPtr);
10414 retcode = JimInvokeCommand(interp,
10415 listPtr->internalRep.listValue.len,
10416 listPtr->internalRep.listValue.ele);
10417 Jim_DecrRefCount(interp, listPtr);
10419 return retcode;
10422 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10424 SetListFromAny(interp, listPtr);
10425 return JimEvalObjList(interp, listPtr);
10428 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10430 int i;
10431 ScriptObj *script;
10432 ScriptToken *token;
10433 int retcode = JIM_OK;
10434 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10435 Jim_Obj *prevScriptObj;
10437 /* If the object is of type "list", with no string rep we can call
10438 * a specialized version of Jim_EvalObj() */
10439 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10440 return JimEvalObjList(interp, scriptObjPtr);
10443 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10444 script = JimGetScript(interp, scriptObjPtr);
10445 if (!JimScriptValid(interp, script)) {
10446 Jim_DecrRefCount(interp, scriptObjPtr);
10447 return JIM_ERR;
10450 /* Reset the interpreter result. This is useful to
10451 * return the empty result in the case of empty program. */
10452 Jim_SetEmptyResult(interp);
10454 token = script->token;
10456 #ifdef JIM_OPTIMIZATION
10457 /* Check for one of the following common scripts used by for, while
10459 * {}
10460 * incr a
10462 if (script->len == 0) {
10463 Jim_DecrRefCount(interp, scriptObjPtr);
10464 return JIM_OK;
10466 if (script->len == 3
10467 && token[1].objPtr->typePtr == &commandObjType
10468 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10469 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10470 && token[2].objPtr->typePtr == &variableObjType) {
10472 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10474 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10475 JimWideValue(objPtr)++;
10476 Jim_InvalidateStringRep(objPtr);
10477 Jim_DecrRefCount(interp, scriptObjPtr);
10478 Jim_SetResult(interp, objPtr);
10479 return JIM_OK;
10482 #endif
10484 /* Now we have to make sure the internal repr will not be
10485 * freed on shimmering.
10487 * Think for example to this:
10489 * set x {llength $x; ... some more code ...}; eval $x
10491 * In order to preserve the internal rep, we increment the
10492 * inUse field of the script internal rep structure. */
10493 script->inUse++;
10495 /* Stash the current script */
10496 prevScriptObj = interp->currentScriptObj;
10497 interp->currentScriptObj = scriptObjPtr;
10499 interp->errorFlag = 0;
10500 argv = sargv;
10502 /* Execute every command sequentially until the end of the script
10503 * or an error occurs.
10505 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10506 int argc;
10507 int j;
10509 /* First token of the line is always JIM_TT_LINE */
10510 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10511 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10513 /* Allocate the arguments vector if required */
10514 if (argc > JIM_EVAL_SARGV_LEN)
10515 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10517 /* Skip the JIM_TT_LINE token */
10518 i++;
10520 /* Populate the arguments objects.
10521 * If an error occurs, retcode will be set and
10522 * 'j' will be set to the number of args expanded
10524 for (j = 0; j < argc; j++) {
10525 long wordtokens = 1;
10526 int expand = 0;
10527 Jim_Obj *wordObjPtr = NULL;
10529 if (token[i].type == JIM_TT_WORD) {
10530 wordtokens = JimWideValue(token[i++].objPtr);
10531 if (wordtokens < 0) {
10532 expand = 1;
10533 wordtokens = -wordtokens;
10537 if (wordtokens == 1) {
10538 /* Fast path if the token does not
10539 * need interpolation */
10541 switch (token[i].type) {
10542 case JIM_TT_ESC:
10543 case JIM_TT_STR:
10544 wordObjPtr = token[i].objPtr;
10545 break;
10546 case JIM_TT_VAR:
10547 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10548 break;
10549 case JIM_TT_EXPRSUGAR:
10550 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10551 break;
10552 case JIM_TT_DICTSUGAR:
10553 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10554 break;
10555 case JIM_TT_CMD:
10556 retcode = Jim_EvalObj(interp, token[i].objPtr);
10557 if (retcode == JIM_OK) {
10558 wordObjPtr = Jim_GetResult(interp);
10560 break;
10561 default:
10562 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10565 else {
10566 /* For interpolation we call a helper
10567 * function to do the work for us. */
10568 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10571 if (!wordObjPtr) {
10572 if (retcode == JIM_OK) {
10573 retcode = JIM_ERR;
10575 break;
10578 Jim_IncrRefCount(wordObjPtr);
10579 i += wordtokens;
10581 if (!expand) {
10582 argv[j] = wordObjPtr;
10584 else {
10585 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10586 int len = Jim_ListLength(interp, wordObjPtr);
10587 int newargc = argc + len - 1;
10588 int k;
10590 if (len > 1) {
10591 if (argv == sargv) {
10592 if (newargc > JIM_EVAL_SARGV_LEN) {
10593 argv = Jim_Alloc(sizeof(*argv) * newargc);
10594 memcpy(argv, sargv, sizeof(*argv) * j);
10597 else {
10598 /* Need to realloc to make room for (len - 1) more entries */
10599 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10603 /* Now copy in the expanded version */
10604 for (k = 0; k < len; k++) {
10605 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10606 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10609 /* The original object reference is no longer needed,
10610 * after the expansion it is no longer present on
10611 * the argument vector, but the single elements are
10612 * in its place. */
10613 Jim_DecrRefCount(interp, wordObjPtr);
10615 /* And update the indexes */
10616 j--;
10617 argc += len - 1;
10621 if (retcode == JIM_OK && argc) {
10622 /* Invoke the command */
10623 retcode = JimInvokeCommand(interp, argc, argv);
10624 /* Check for a signal after each command */
10625 if (Jim_CheckSignal(interp)) {
10626 retcode = JIM_SIGNAL;
10630 /* Finished with the command, so decrement ref counts of each argument */
10631 while (j-- > 0) {
10632 Jim_DecrRefCount(interp, argv[j]);
10635 if (argv != sargv) {
10636 Jim_Free(argv);
10637 argv = sargv;
10641 /* Possibly add to the error stack trace */
10642 if (retcode == JIM_ERR) {
10643 JimAddErrorToStack(interp, script);
10645 /* Propagate the addStackTrace value through 'return -code error' */
10646 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10647 /* No need to add stack trace */
10648 interp->addStackTrace = 0;
10651 /* Restore the current script */
10652 interp->currentScriptObj = prevScriptObj;
10654 /* Note that we don't have to decrement inUse, because the
10655 * following code transfers our use of the reference again to
10656 * the script object. */
10657 Jim_FreeIntRep(interp, scriptObjPtr);
10658 scriptObjPtr->typePtr = &scriptObjType;
10659 Jim_SetIntRepPtr(scriptObjPtr, script);
10660 Jim_DecrRefCount(interp, scriptObjPtr);
10662 return retcode;
10665 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10667 int retcode;
10668 /* If argObjPtr begins with '&', do an automatic upvar */
10669 const char *varname = Jim_String(argNameObj);
10670 if (*varname == '&') {
10671 /* First check that the target variable exists */
10672 Jim_Obj *objPtr;
10673 Jim_CallFrame *savedCallFrame = interp->framePtr;
10675 interp->framePtr = interp->framePtr->parent;
10676 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10677 interp->framePtr = savedCallFrame;
10678 if (!objPtr) {
10679 return JIM_ERR;
10682 /* It exists, so perform the binding. */
10683 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10684 Jim_IncrRefCount(objPtr);
10685 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10686 Jim_DecrRefCount(interp, objPtr);
10688 else {
10689 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10691 return retcode;
10695 * Sets the interp result to be an error message indicating the required proc args.
10697 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10699 /* Create a nice error message, consistent with Tcl 8.5 */
10700 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10701 int i;
10703 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10704 Jim_AppendString(interp, argmsg, " ", 1);
10706 if (i == cmd->u.proc.argsPos) {
10707 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10708 /* Renamed args */
10709 Jim_AppendString(interp, argmsg, "?", 1);
10710 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10711 Jim_AppendString(interp, argmsg, " ...?", -1);
10713 else {
10714 /* We have plain args */
10715 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10718 else {
10719 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10720 Jim_AppendString(interp, argmsg, "?", 1);
10721 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10722 Jim_AppendString(interp, argmsg, "?", 1);
10724 else {
10725 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10726 if (*arg == '&') {
10727 arg++;
10729 Jim_AppendString(interp, argmsg, arg, -1);
10733 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10736 #ifdef jim_ext_namespace
10738 * [namespace eval]
10740 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10742 Jim_CallFrame *callFramePtr;
10743 int retcode;
10745 /* Create a new callframe */
10746 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10747 callFramePtr->argv = &interp->emptyObj;
10748 callFramePtr->argc = 0;
10749 callFramePtr->procArgsObjPtr = NULL;
10750 callFramePtr->procBodyObjPtr = scriptObj;
10751 callFramePtr->staticVars = NULL;
10752 callFramePtr->fileNameObj = interp->emptyObj;
10753 callFramePtr->line = 0;
10754 Jim_IncrRefCount(scriptObj);
10755 interp->framePtr = callFramePtr;
10757 /* Check if there are too nested calls */
10758 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10759 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10760 retcode = JIM_ERR;
10762 else {
10763 /* Eval the body */
10764 retcode = Jim_EvalObj(interp, scriptObj);
10767 /* Destroy the callframe */
10768 interp->framePtr = interp->framePtr->parent;
10769 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10771 return retcode;
10773 #endif
10775 /* Call a procedure implemented in Tcl.
10776 * It's possible to speed-up a lot this function, currently
10777 * the callframes are not cached, but allocated and
10778 * destroied every time. What is expecially costly is
10779 * to create/destroy the local vars hash table every time.
10781 * This can be fixed just implementing callframes caching
10782 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10783 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10785 Jim_CallFrame *callFramePtr;
10786 int i, d, retcode, optargs;
10787 ScriptObj *script;
10789 /* Check arity */
10790 if (argc - 1 < cmd->u.proc.reqArity ||
10791 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10792 JimSetProcWrongArgs(interp, argv[0], cmd);
10793 return JIM_ERR;
10796 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10797 /* Optimise for procedure with no body - useful for optional debugging */
10798 return JIM_OK;
10801 /* Check if there are too nested calls */
10802 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10803 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10804 return JIM_ERR;
10807 /* Create a new callframe */
10808 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10809 callFramePtr->argv = argv;
10810 callFramePtr->argc = argc;
10811 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10812 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10813 callFramePtr->staticVars = cmd->u.proc.staticVars;
10815 /* Remember where we were called from. */
10816 script = JimGetScript(interp, interp->currentScriptObj);
10817 callFramePtr->fileNameObj = script->fileNameObj;
10818 callFramePtr->line = script->linenr;
10820 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10821 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10822 interp->framePtr = callFramePtr;
10824 /* How many optional args are available */
10825 optargs = (argc - 1 - cmd->u.proc.reqArity);
10827 /* Step 'i' along the actual args, and step 'd' along the formal args */
10828 i = 1;
10829 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10830 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10831 if (d == cmd->u.proc.argsPos) {
10832 /* assign $args */
10833 Jim_Obj *listObjPtr;
10834 int argsLen = 0;
10835 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10836 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10838 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10840 /* It is possible to rename args. */
10841 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10842 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10844 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10845 if (retcode != JIM_OK) {
10846 goto badargset;
10849 i += argsLen;
10850 continue;
10853 /* Optional or required? */
10854 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10855 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10857 else {
10858 /* Ran out, so use the default */
10859 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10861 if (retcode != JIM_OK) {
10862 goto badargset;
10866 /* Eval the body */
10867 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10869 badargset:
10871 /* Invoke $jim::defer then destroy the callframe */
10872 retcode = JimInvokeDefer(interp, retcode);
10873 interp->framePtr = interp->framePtr->parent;
10874 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10876 /* Now chain any tailcalls in the parent frame */
10877 if (interp->framePtr->tailcallObj) {
10878 do {
10879 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10881 interp->framePtr->tailcallObj = NULL;
10883 if (retcode == JIM_EVAL) {
10884 retcode = Jim_EvalObjList(interp, tailcallObj);
10885 if (retcode == JIM_RETURN) {
10886 /* If the result of the tailcall is 'return', push
10887 * it up to the caller
10889 interp->returnLevel++;
10892 Jim_DecrRefCount(interp, tailcallObj);
10893 } while (interp->framePtr->tailcallObj);
10895 /* If the tailcall chain finished early, may need to manually discard the command */
10896 if (interp->framePtr->tailcallCmd) {
10897 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10898 interp->framePtr->tailcallCmd = NULL;
10902 /* Handle the JIM_RETURN return code */
10903 if (retcode == JIM_RETURN) {
10904 if (--interp->returnLevel <= 0) {
10905 retcode = interp->returnCode;
10906 interp->returnCode = JIM_OK;
10907 interp->returnLevel = 0;
10910 else if (retcode == JIM_ERR) {
10911 interp->addStackTrace++;
10912 Jim_DecrRefCount(interp, interp->errorProc);
10913 interp->errorProc = argv[0];
10914 Jim_IncrRefCount(interp->errorProc);
10917 return retcode;
10920 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10922 int retval;
10923 Jim_Obj *scriptObjPtr;
10925 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10926 Jim_IncrRefCount(scriptObjPtr);
10928 if (filename) {
10929 Jim_Obj *prevScriptObj;
10931 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10933 prevScriptObj = interp->currentScriptObj;
10934 interp->currentScriptObj = scriptObjPtr;
10936 retval = Jim_EvalObj(interp, scriptObjPtr);
10938 interp->currentScriptObj = prevScriptObj;
10940 else {
10941 retval = Jim_EvalObj(interp, scriptObjPtr);
10943 Jim_DecrRefCount(interp, scriptObjPtr);
10944 return retval;
10947 int Jim_Eval(Jim_Interp *interp, const char *script)
10949 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10952 /* Execute script in the scope of the global level */
10953 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10955 int retval;
10956 Jim_CallFrame *savedFramePtr = interp->framePtr;
10958 interp->framePtr = interp->topFramePtr;
10959 retval = Jim_Eval(interp, script);
10960 interp->framePtr = savedFramePtr;
10962 return retval;
10965 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10967 int retval;
10968 Jim_CallFrame *savedFramePtr = interp->framePtr;
10970 interp->framePtr = interp->topFramePtr;
10971 retval = Jim_EvalFile(interp, filename);
10972 interp->framePtr = savedFramePtr;
10974 return retval;
10977 #include <sys/stat.h>
10979 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10981 FILE *fp;
10982 char *buf;
10983 Jim_Obj *scriptObjPtr;
10984 Jim_Obj *prevScriptObj;
10985 struct stat sb;
10986 int retcode;
10987 int readlen;
10989 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10990 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10991 return JIM_ERR;
10993 if (sb.st_size == 0) {
10994 fclose(fp);
10995 return JIM_OK;
10998 buf = Jim_Alloc(sb.st_size + 1);
10999 readlen = fread(buf, 1, sb.st_size, fp);
11000 if (ferror(fp)) {
11001 fclose(fp);
11002 Jim_Free(buf);
11003 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11004 return JIM_ERR;
11006 fclose(fp);
11007 buf[readlen] = 0;
11009 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11010 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11011 Jim_IncrRefCount(scriptObjPtr);
11013 prevScriptObj = interp->currentScriptObj;
11014 interp->currentScriptObj = scriptObjPtr;
11016 retcode = Jim_EvalObj(interp, scriptObjPtr);
11018 /* Handle the JIM_RETURN return code */
11019 if (retcode == JIM_RETURN) {
11020 if (--interp->returnLevel <= 0) {
11021 retcode = interp->returnCode;
11022 interp->returnCode = JIM_OK;
11023 interp->returnLevel = 0;
11026 if (retcode == JIM_ERR) {
11027 /* EvalFile changes context, so add a stack frame here */
11028 interp->addStackTrace++;
11031 interp->currentScriptObj = prevScriptObj;
11033 Jim_DecrRefCount(interp, scriptObjPtr);
11035 return retcode;
11038 /* -----------------------------------------------------------------------------
11039 * Subst
11040 * ---------------------------------------------------------------------------*/
11041 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11043 pc->tstart = pc->p;
11044 pc->tline = pc->linenr;
11046 if (pc->len == 0) {
11047 pc->tend = pc->p;
11048 pc->tt = JIM_TT_EOL;
11049 pc->eof = 1;
11050 return;
11052 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11053 JimParseCmd(pc);
11054 return;
11056 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11057 if (JimParseVar(pc) == JIM_OK) {
11058 return;
11060 /* Not a var, so treat as a string */
11061 pc->tstart = pc->p;
11062 flags |= JIM_SUBST_NOVAR;
11064 while (pc->len) {
11065 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11066 break;
11068 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11069 break;
11071 if (*pc->p == '\\' && pc->len > 1) {
11072 pc->p++;
11073 pc->len--;
11075 pc->p++;
11076 pc->len--;
11078 pc->tend = pc->p - 1;
11079 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11082 /* The subst object type reuses most of the data structures and functions
11083 * of the script object. Script's data structures are a bit more complex
11084 * for what is needed for [subst]itution tasks, but the reuse helps to
11085 * deal with a single data structure at the cost of some more memory
11086 * usage for substitutions. */
11088 /* This method takes the string representation of an object
11089 * as a Tcl string where to perform [subst]itution, and generates
11090 * the pre-parsed internal representation. */
11091 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11093 int scriptTextLen;
11094 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11095 struct JimParserCtx parser;
11096 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11097 ParseTokenList tokenlist;
11099 /* Initially parse the subst into tokens (in tokenlist) */
11100 ScriptTokenListInit(&tokenlist);
11102 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11103 while (1) {
11104 JimParseSubst(&parser, flags);
11105 if (parser.eof) {
11106 /* Note that subst doesn't need the EOL token */
11107 break;
11109 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11110 parser.tline);
11113 /* Create the "real" subst/script tokens from the initial token list */
11114 script->inUse = 1;
11115 script->substFlags = flags;
11116 script->fileNameObj = interp->emptyObj;
11117 Jim_IncrRefCount(script->fileNameObj);
11118 SubstObjAddTokens(interp, script, &tokenlist);
11120 /* No longer need the token list */
11121 ScriptTokenListFree(&tokenlist);
11123 #ifdef DEBUG_SHOW_SUBST
11125 int i;
11127 printf("==== Subst ====\n");
11128 for (i = 0; i < script->len; i++) {
11129 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11130 Jim_String(script->token[i].objPtr));
11133 #endif
11135 /* Free the old internal rep and set the new one. */
11136 Jim_FreeIntRep(interp, objPtr);
11137 Jim_SetIntRepPtr(objPtr, script);
11138 objPtr->typePtr = &scriptObjType;
11139 return JIM_OK;
11142 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11144 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11145 SetSubstFromAny(interp, objPtr, flags);
11146 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11149 /* Performs commands,variables,blackslashes substitution,
11150 * storing the result object (with refcount 0) into
11151 * resObjPtrPtr. */
11152 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11154 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11156 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11157 /* In order to preserve the internal rep, we increment the
11158 * inUse field of the script internal rep structure. */
11159 script->inUse++;
11161 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11163 script->inUse--;
11164 Jim_DecrRefCount(interp, substObjPtr);
11165 if (*resObjPtrPtr == NULL) {
11166 return JIM_ERR;
11168 return JIM_OK;
11171 /* -----------------------------------------------------------------------------
11172 * Core commands utility functions
11173 * ---------------------------------------------------------------------------*/
11174 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11176 Jim_Obj *objPtr;
11177 Jim_Obj *listObjPtr;
11179 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11181 listObjPtr = Jim_NewListObj(interp, argv, argc);
11183 if (*msg) {
11184 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11186 Jim_IncrRefCount(listObjPtr);
11187 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11188 Jim_DecrRefCount(interp, listObjPtr);
11190 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11194 * May add the key and/or value to the list.
11196 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11197 Jim_HashEntry *he, int type);
11199 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11202 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11203 * invoke the callback to add entries to a list.
11204 * Returns the list.
11206 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11207 JimHashtableIteratorCallbackType *callback, int type)
11209 Jim_HashEntry *he;
11210 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11212 /* Check for the non-pattern case. We can do this much more efficiently. */
11213 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11214 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11215 if (he) {
11216 callback(interp, listObjPtr, he, type);
11219 else {
11220 Jim_HashTableIterator htiter;
11221 JimInitHashTableIterator(ht, &htiter);
11222 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11223 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11224 callback(interp, listObjPtr, he, type);
11228 return listObjPtr;
11231 /* Keep these in order */
11232 #define JIM_CMDLIST_COMMANDS 0
11233 #define JIM_CMDLIST_PROCS 1
11234 #define JIM_CMDLIST_CHANNELS 2
11237 * Adds matching command names (procs, channels) to the list.
11239 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11240 Jim_HashEntry *he, int type)
11242 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11243 Jim_Obj *objPtr;
11245 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11246 /* not a proc */
11247 return;
11250 objPtr = Jim_NewStringObj(interp, he->key, -1);
11251 Jim_IncrRefCount(objPtr);
11253 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11254 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11256 Jim_DecrRefCount(interp, objPtr);
11259 /* type is JIM_CMDLIST_xxx */
11260 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11262 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11265 /* Keep these in order */
11266 #define JIM_VARLIST_GLOBALS 0
11267 #define JIM_VARLIST_LOCALS 1
11268 #define JIM_VARLIST_VARS 2
11270 #define JIM_VARLIST_VALUES 0x1000
11273 * Adds matching variable names to the list.
11275 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11276 Jim_HashEntry *he, int type)
11278 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11280 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11281 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11282 if (type & JIM_VARLIST_VALUES) {
11283 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11288 /* mode is JIM_VARLIST_xxx */
11289 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11291 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11292 /* For [info locals], if we are at top level an emtpy list
11293 * is returned. I don't agree, but we aim at compatibility (SS) */
11294 return interp->emptyObj;
11296 else {
11297 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11298 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11302 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11303 Jim_Obj **objPtrPtr, int info_level_cmd)
11305 Jim_CallFrame *targetCallFrame;
11307 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11308 if (targetCallFrame == NULL) {
11309 return JIM_ERR;
11311 /* No proc call at toplevel callframe */
11312 if (targetCallFrame == interp->topFramePtr) {
11313 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11314 return JIM_ERR;
11316 if (info_level_cmd) {
11317 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11319 else {
11320 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11322 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11323 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11324 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11325 *objPtrPtr = listObj;
11327 return JIM_OK;
11330 /* -----------------------------------------------------------------------------
11331 * Core commands
11332 * ---------------------------------------------------------------------------*/
11334 /* fake [puts] -- not the real puts, just for debugging. */
11335 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11337 if (argc != 2 && argc != 3) {
11338 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11339 return JIM_ERR;
11341 if (argc == 3) {
11342 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11343 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11344 return JIM_ERR;
11346 else {
11347 fputs(Jim_String(argv[2]), stdout);
11350 else {
11351 puts(Jim_String(argv[1]));
11353 return JIM_OK;
11356 /* Helper for [+] and [*] */
11357 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11359 jim_wide wideValue, res;
11360 double doubleValue, doubleRes;
11361 int i;
11363 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11365 for (i = 1; i < argc; i++) {
11366 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11367 goto trydouble;
11368 if (op == JIM_EXPROP_ADD)
11369 res += wideValue;
11370 else
11371 res *= wideValue;
11373 Jim_SetResultInt(interp, res);
11374 return JIM_OK;
11375 trydouble:
11376 doubleRes = (double)res;
11377 for (; i < argc; i++) {
11378 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11379 return JIM_ERR;
11380 if (op == JIM_EXPROP_ADD)
11381 doubleRes += doubleValue;
11382 else
11383 doubleRes *= doubleValue;
11385 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11386 return JIM_OK;
11389 /* Helper for [-] and [/] */
11390 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11392 jim_wide wideValue, res = 0;
11393 double doubleValue, doubleRes = 0;
11394 int i = 2;
11396 if (argc < 2) {
11397 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11398 return JIM_ERR;
11400 else if (argc == 2) {
11401 /* The arity = 2 case is different. For [- x] returns -x,
11402 * while [/ x] returns 1/x. */
11403 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11404 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11405 return JIM_ERR;
11407 else {
11408 if (op == JIM_EXPROP_SUB)
11409 doubleRes = -doubleValue;
11410 else
11411 doubleRes = 1.0 / doubleValue;
11412 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11413 return JIM_OK;
11416 if (op == JIM_EXPROP_SUB) {
11417 res = -wideValue;
11418 Jim_SetResultInt(interp, res);
11420 else {
11421 doubleRes = 1.0 / wideValue;
11422 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11424 return JIM_OK;
11426 else {
11427 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11428 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11429 != JIM_OK) {
11430 return JIM_ERR;
11432 else {
11433 goto trydouble;
11437 for (i = 2; i < argc; i++) {
11438 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11439 doubleRes = (double)res;
11440 goto trydouble;
11442 if (op == JIM_EXPROP_SUB)
11443 res -= wideValue;
11444 else {
11445 if (wideValue == 0) {
11446 Jim_SetResultString(interp, "Division by zero", -1);
11447 return JIM_ERR;
11449 res /= wideValue;
11452 Jim_SetResultInt(interp, res);
11453 return JIM_OK;
11454 trydouble:
11455 for (; i < argc; i++) {
11456 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11457 return JIM_ERR;
11458 if (op == JIM_EXPROP_SUB)
11459 doubleRes -= doubleValue;
11460 else
11461 doubleRes /= doubleValue;
11463 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11464 return JIM_OK;
11468 /* [+] */
11469 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11471 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11474 /* [*] */
11475 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11477 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11480 /* [-] */
11481 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11483 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11486 /* [/] */
11487 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11489 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11492 /* [set] */
11493 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11495 if (argc != 2 && argc != 3) {
11496 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11497 return JIM_ERR;
11499 if (argc == 2) {
11500 Jim_Obj *objPtr;
11502 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11503 if (!objPtr)
11504 return JIM_ERR;
11505 Jim_SetResult(interp, objPtr);
11506 return JIM_OK;
11508 /* argc == 3 case. */
11509 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11510 return JIM_ERR;
11511 Jim_SetResult(interp, argv[2]);
11512 return JIM_OK;
11515 /* [unset]
11517 * unset ?-nocomplain? ?--? ?varName ...?
11519 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11521 int i = 1;
11522 int complain = 1;
11524 while (i < argc) {
11525 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11526 i++;
11527 break;
11529 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11530 complain = 0;
11531 i++;
11532 continue;
11534 break;
11537 while (i < argc) {
11538 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11539 && complain) {
11540 return JIM_ERR;
11542 i++;
11544 return JIM_OK;
11547 /* [while] */
11548 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11550 if (argc != 3) {
11551 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11552 return JIM_ERR;
11555 /* The general purpose implementation of while starts here */
11556 while (1) {
11557 int boolean, retval;
11559 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11560 return retval;
11561 if (!boolean)
11562 break;
11564 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11565 switch (retval) {
11566 case JIM_BREAK:
11567 goto out;
11568 break;
11569 case JIM_CONTINUE:
11570 continue;
11571 break;
11572 default:
11573 return retval;
11577 out:
11578 Jim_SetEmptyResult(interp);
11579 return JIM_OK;
11582 /* [for] */
11583 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11585 int retval;
11586 int boolean = 1;
11587 Jim_Obj *varNamePtr = NULL;
11588 Jim_Obj *stopVarNamePtr = NULL;
11590 if (argc != 5) {
11591 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11592 return JIM_ERR;
11595 /* Do the initialisation */
11596 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11597 return retval;
11600 /* And do the first test now. Better for optimisation
11601 * if we can do next/test at the bottom of the loop
11603 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11605 /* Ready to do the body as follows:
11606 * while (1) {
11607 * body // check retcode
11608 * next // check retcode
11609 * test // check retcode/test bool
11613 #ifdef JIM_OPTIMIZATION
11614 /* Check if the for is on the form:
11615 * for ... {$i < CONST} {incr i}
11616 * for ... {$i < $j} {incr i}
11618 if (retval == JIM_OK && boolean) {
11619 ScriptObj *incrScript;
11620 struct ExprTree *expr;
11621 jim_wide stop, currentVal;
11622 Jim_Obj *objPtr;
11623 int cmpOffset;
11625 /* Do it only if there aren't shared arguments */
11626 expr = JimGetExpression(interp, argv[2]);
11627 incrScript = JimGetScript(interp, argv[3]);
11629 /* Ensure proper lengths to start */
11630 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11631 goto evalstart;
11633 /* Ensure proper token types. */
11634 if (incrScript->token[1].type != JIM_TT_ESC) {
11635 goto evalstart;
11638 if (expr->expr->type == JIM_EXPROP_LT) {
11639 cmpOffset = 0;
11641 else if (expr->expr->type == JIM_EXPROP_LTE) {
11642 cmpOffset = 1;
11644 else {
11645 goto evalstart;
11648 if (expr->expr->left->type != JIM_TT_VAR) {
11649 goto evalstart;
11652 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11653 goto evalstart;
11656 /* Update command must be incr */
11657 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11658 goto evalstart;
11661 /* incr, expression must be about the same variable */
11662 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11663 goto evalstart;
11666 /* Get the stop condition (must be a variable or integer) */
11667 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11668 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11669 goto evalstart;
11672 else {
11673 stopVarNamePtr = expr->expr->right->objPtr;
11674 Jim_IncrRefCount(stopVarNamePtr);
11675 /* Keep the compiler happy */
11676 stop = 0;
11679 /* Initialization */
11680 varNamePtr = expr->expr->left->objPtr;
11681 Jim_IncrRefCount(varNamePtr);
11683 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11684 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11685 goto testcond;
11688 /* --- OPTIMIZED FOR --- */
11689 while (retval == JIM_OK) {
11690 /* === Check condition === */
11691 /* Note that currentVal is already set here */
11693 /* Immediate or Variable? get the 'stop' value if the latter. */
11694 if (stopVarNamePtr) {
11695 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11696 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11697 goto testcond;
11701 if (currentVal >= stop + cmpOffset) {
11702 break;
11705 /* Eval body */
11706 retval = Jim_EvalObj(interp, argv[4]);
11707 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11708 retval = JIM_OK;
11710 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11712 /* Increment */
11713 if (objPtr == NULL) {
11714 retval = JIM_ERR;
11715 goto out;
11717 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11718 currentVal = ++JimWideValue(objPtr);
11719 Jim_InvalidateStringRep(objPtr);
11721 else {
11722 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11723 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11724 ++currentVal)) != JIM_OK) {
11725 goto evalnext;
11730 goto out;
11732 evalstart:
11733 #endif
11735 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11736 /* Body */
11737 retval = Jim_EvalObj(interp, argv[4]);
11739 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11740 /* increment */
11741 JIM_IF_OPTIM(evalnext:)
11742 retval = Jim_EvalObj(interp, argv[3]);
11743 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11744 /* test */
11745 JIM_IF_OPTIM(testcond:)
11746 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11750 JIM_IF_OPTIM(out:)
11751 if (stopVarNamePtr) {
11752 Jim_DecrRefCount(interp, stopVarNamePtr);
11754 if (varNamePtr) {
11755 Jim_DecrRefCount(interp, varNamePtr);
11758 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11759 Jim_SetEmptyResult(interp);
11760 return JIM_OK;
11763 return retval;
11766 /* [loop] */
11767 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11769 int retval;
11770 jim_wide i;
11771 jim_wide limit;
11772 jim_wide incr = 1;
11773 Jim_Obj *bodyObjPtr;
11775 if (argc != 5 && argc != 6) {
11776 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11777 return JIM_ERR;
11780 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11781 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11782 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11783 return JIM_ERR;
11785 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11787 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11789 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11790 retval = Jim_EvalObj(interp, bodyObjPtr);
11791 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11792 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11794 retval = JIM_OK;
11796 /* Increment */
11797 i += incr;
11799 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11800 if (argv[1]->typePtr != &variableObjType) {
11801 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11802 return JIM_ERR;
11805 JimWideValue(objPtr) = i;
11806 Jim_InvalidateStringRep(objPtr);
11808 /* The following step is required in order to invalidate the
11809 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11810 if (argv[1]->typePtr != &variableObjType) {
11811 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11812 retval = JIM_ERR;
11813 break;
11817 else {
11818 objPtr = Jim_NewIntObj(interp, i);
11819 retval = Jim_SetVariable(interp, argv[1], objPtr);
11820 if (retval != JIM_OK) {
11821 Jim_FreeNewObj(interp, objPtr);
11827 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11828 Jim_SetEmptyResult(interp);
11829 return JIM_OK;
11831 return retval;
11834 /* List iterators make it easy to iterate over a list.
11835 * At some point iterators will be expanded to support generators.
11837 typedef struct {
11838 Jim_Obj *objPtr;
11839 int idx;
11840 } Jim_ListIter;
11843 * Initialise the iterator at the start of the list.
11845 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11847 iter->objPtr = objPtr;
11848 iter->idx = 0;
11852 * Returns the next object from the list, or NULL on end-of-list.
11854 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11856 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11857 return NULL;
11859 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11863 * Returns 1 if end-of-list has been reached.
11865 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11867 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11870 /* foreach + lmap implementation. */
11871 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11873 int result = JIM_OK;
11874 int i, numargs;
11875 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11876 Jim_ListIter *iters;
11877 Jim_Obj *script;
11878 Jim_Obj *resultObj;
11880 if (argc < 4 || argc % 2 != 0) {
11881 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11882 return JIM_ERR;
11884 script = argv[argc - 1]; /* Last argument is a script */
11885 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11887 if (numargs == 2) {
11888 iters = twoiters;
11890 else {
11891 iters = Jim_Alloc(numargs * sizeof(*iters));
11893 for (i = 0; i < numargs; i++) {
11894 JimListIterInit(&iters[i], argv[i + 1]);
11895 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11896 result = JIM_ERR;
11899 if (result != JIM_OK) {
11900 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11901 return result;
11904 if (doMap) {
11905 resultObj = Jim_NewListObj(interp, NULL, 0);
11907 else {
11908 resultObj = interp->emptyObj;
11910 Jim_IncrRefCount(resultObj);
11912 while (1) {
11913 /* Have we expired all lists? */
11914 for (i = 0; i < numargs; i += 2) {
11915 if (!JimListIterDone(interp, &iters[i + 1])) {
11916 break;
11919 if (i == numargs) {
11920 /* All done */
11921 break;
11924 /* For each list */
11925 for (i = 0; i < numargs; i += 2) {
11926 Jim_Obj *varName;
11928 /* foreach var */
11929 JimListIterInit(&iters[i], argv[i + 1]);
11930 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11931 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11932 if (!valObj) {
11933 /* Ran out, so store the empty string */
11934 valObj = interp->emptyObj;
11936 /* Avoid shimmering */
11937 Jim_IncrRefCount(valObj);
11938 result = Jim_SetVariable(interp, varName, valObj);
11939 Jim_DecrRefCount(interp, valObj);
11940 if (result != JIM_OK) {
11941 goto err;
11945 switch (result = Jim_EvalObj(interp, script)) {
11946 case JIM_OK:
11947 if (doMap) {
11948 Jim_ListAppendElement(interp, resultObj, interp->result);
11950 break;
11951 case JIM_CONTINUE:
11952 break;
11953 case JIM_BREAK:
11954 goto out;
11955 default:
11956 goto err;
11959 out:
11960 result = JIM_OK;
11961 Jim_SetResult(interp, resultObj);
11962 err:
11963 Jim_DecrRefCount(interp, resultObj);
11964 if (numargs > 2) {
11965 Jim_Free(iters);
11967 return result;
11970 /* [foreach] */
11971 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11973 return JimForeachMapHelper(interp, argc, argv, 0);
11976 /* [lmap] */
11977 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11979 return JimForeachMapHelper(interp, argc, argv, 1);
11982 /* [lassign] */
11983 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11985 int result = JIM_ERR;
11986 int i;
11987 Jim_ListIter iter;
11988 Jim_Obj *resultObj;
11990 if (argc < 2) {
11991 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11992 return JIM_ERR;
11995 JimListIterInit(&iter, argv[1]);
11997 for (i = 2; i < argc; i++) {
11998 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11999 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12000 if (result != JIM_OK) {
12001 return result;
12005 resultObj = Jim_NewListObj(interp, NULL, 0);
12006 while (!JimListIterDone(interp, &iter)) {
12007 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12010 Jim_SetResult(interp, resultObj);
12012 return JIM_OK;
12015 /* [if] */
12016 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12018 int boolean, retval, current = 1, falsebody = 0;
12020 if (argc >= 3) {
12021 while (1) {
12022 /* Far not enough arguments given! */
12023 if (current >= argc)
12024 goto err;
12025 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12026 != JIM_OK)
12027 return retval;
12028 /* There lacks something, isn't it? */
12029 if (current >= argc)
12030 goto err;
12031 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12032 current++;
12033 /* Tsk tsk, no then-clause? */
12034 if (current >= argc)
12035 goto err;
12036 if (boolean)
12037 return Jim_EvalObj(interp, argv[current]);
12038 /* Ok: no else-clause follows */
12039 if (++current >= argc) {
12040 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12041 return JIM_OK;
12043 falsebody = current++;
12044 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12045 /* IIICKS - else-clause isn't last cmd? */
12046 if (current != argc - 1)
12047 goto err;
12048 return Jim_EvalObj(interp, argv[current]);
12050 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12051 /* Ok: elseif follows meaning all the stuff
12052 * again (how boring...) */
12053 continue;
12054 /* OOPS - else-clause is not last cmd? */
12055 else if (falsebody != argc - 1)
12056 goto err;
12057 return Jim_EvalObj(interp, argv[falsebody]);
12059 return JIM_OK;
12061 err:
12062 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12063 return JIM_ERR;
12067 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12068 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12069 Jim_Obj *stringObj, int nocase)
12071 Jim_Obj *parms[4];
12072 int argc = 0;
12073 long eq;
12074 int rc;
12076 parms[argc++] = commandObj;
12077 if (nocase) {
12078 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12080 parms[argc++] = patternObj;
12081 parms[argc++] = stringObj;
12083 rc = Jim_EvalObjVector(interp, argc, parms);
12085 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12086 eq = -rc;
12089 return eq;
12092 enum
12093 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12095 /* [switch] */
12096 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12098 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12099 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12100 Jim_Obj *script = 0;
12102 if (argc < 3) {
12103 wrongnumargs:
12104 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12105 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12106 return JIM_ERR;
12108 for (opt = 1; opt < argc; ++opt) {
12109 const char *option = Jim_String(argv[opt]);
12111 if (*option != '-')
12112 break;
12113 else if (strncmp(option, "--", 2) == 0) {
12114 ++opt;
12115 break;
12117 else if (strncmp(option, "-exact", 2) == 0)
12118 matchOpt = SWITCH_EXACT;
12119 else if (strncmp(option, "-glob", 2) == 0)
12120 matchOpt = SWITCH_GLOB;
12121 else if (strncmp(option, "-regexp", 2) == 0)
12122 matchOpt = SWITCH_RE;
12123 else if (strncmp(option, "-command", 2) == 0) {
12124 matchOpt = SWITCH_CMD;
12125 if ((argc - opt) < 2)
12126 goto wrongnumargs;
12127 command = argv[++opt];
12129 else {
12130 Jim_SetResultFormatted(interp,
12131 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12132 argv[opt]);
12133 return JIM_ERR;
12135 if ((argc - opt) < 2)
12136 goto wrongnumargs;
12138 strObj = argv[opt++];
12139 patCount = argc - opt;
12140 if (patCount == 1) {
12141 Jim_Obj **vector;
12143 JimListGetElements(interp, argv[opt], &patCount, &vector);
12144 caseList = vector;
12146 else
12147 caseList = &argv[opt];
12148 if (patCount == 0 || patCount % 2 != 0)
12149 goto wrongnumargs;
12150 for (i = 0; script == 0 && i < patCount; i += 2) {
12151 Jim_Obj *patObj = caseList[i];
12153 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12154 || i < (patCount - 2)) {
12155 switch (matchOpt) {
12156 case SWITCH_EXACT:
12157 if (Jim_StringEqObj(strObj, patObj))
12158 script = caseList[i + 1];
12159 break;
12160 case SWITCH_GLOB:
12161 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12162 script = caseList[i + 1];
12163 break;
12164 case SWITCH_RE:
12165 command = Jim_NewStringObj(interp, "regexp", -1);
12166 /* Fall thru intentionally */
12167 case SWITCH_CMD:{
12168 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12170 /* After the execution of a command we need to
12171 * make sure to reconvert the object into a list
12172 * again. Only for the single-list style [switch]. */
12173 if (argc - opt == 1) {
12174 Jim_Obj **vector;
12176 JimListGetElements(interp, argv[opt], &patCount, &vector);
12177 caseList = vector;
12179 /* command is here already decref'd */
12180 if (rc < 0) {
12181 return -rc;
12183 if (rc)
12184 script = caseList[i + 1];
12185 break;
12189 else {
12190 script = caseList[i + 1];
12193 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12194 script = caseList[i + 1];
12195 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12196 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12197 return JIM_ERR;
12199 Jim_SetEmptyResult(interp);
12200 if (script) {
12201 return Jim_EvalObj(interp, script);
12203 return JIM_OK;
12206 /* [list] */
12207 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12209 Jim_Obj *listObjPtr;
12211 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12212 Jim_SetResult(interp, listObjPtr);
12213 return JIM_OK;
12216 /* [lindex] */
12217 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12219 Jim_Obj *objPtr, *listObjPtr;
12220 int i;
12221 int idx;
12223 if (argc < 2) {
12224 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12225 return JIM_ERR;
12227 objPtr = argv[1];
12228 Jim_IncrRefCount(objPtr);
12229 for (i = 2; i < argc; i++) {
12230 listObjPtr = objPtr;
12231 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12232 Jim_DecrRefCount(interp, listObjPtr);
12233 return JIM_ERR;
12235 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12236 /* Returns an empty object if the index
12237 * is out of range. */
12238 Jim_DecrRefCount(interp, listObjPtr);
12239 Jim_SetEmptyResult(interp);
12240 return JIM_OK;
12242 Jim_IncrRefCount(objPtr);
12243 Jim_DecrRefCount(interp, listObjPtr);
12245 Jim_SetResult(interp, objPtr);
12246 Jim_DecrRefCount(interp, objPtr);
12247 return JIM_OK;
12250 /* [llength] */
12251 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12253 if (argc != 2) {
12254 Jim_WrongNumArgs(interp, 1, argv, "list");
12255 return JIM_ERR;
12257 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12258 return JIM_OK;
12261 /* [lsearch] */
12262 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12264 static const char * const options[] = {
12265 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12266 NULL
12268 enum
12269 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12270 OPT_COMMAND };
12271 int i;
12272 int opt_bool = 0;
12273 int opt_not = 0;
12274 int opt_nocase = 0;
12275 int opt_all = 0;
12276 int opt_inline = 0;
12277 int opt_match = OPT_EXACT;
12278 int listlen;
12279 int rc = JIM_OK;
12280 Jim_Obj *listObjPtr = NULL;
12281 Jim_Obj *commandObj = NULL;
12283 if (argc < 3) {
12284 wrongargs:
12285 Jim_WrongNumArgs(interp, 1, argv,
12286 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12287 return JIM_ERR;
12290 for (i = 1; i < argc - 2; i++) {
12291 int option;
12293 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12294 return JIM_ERR;
12296 switch (option) {
12297 case OPT_BOOL:
12298 opt_bool = 1;
12299 opt_inline = 0;
12300 break;
12301 case OPT_NOT:
12302 opt_not = 1;
12303 break;
12304 case OPT_NOCASE:
12305 opt_nocase = 1;
12306 break;
12307 case OPT_INLINE:
12308 opt_inline = 1;
12309 opt_bool = 0;
12310 break;
12311 case OPT_ALL:
12312 opt_all = 1;
12313 break;
12314 case OPT_COMMAND:
12315 if (i >= argc - 2) {
12316 goto wrongargs;
12318 commandObj = argv[++i];
12319 /* fallthru */
12320 case OPT_EXACT:
12321 case OPT_GLOB:
12322 case OPT_REGEXP:
12323 opt_match = option;
12324 break;
12328 argv += i;
12330 if (opt_all) {
12331 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12333 if (opt_match == OPT_REGEXP) {
12334 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12336 if (commandObj) {
12337 Jim_IncrRefCount(commandObj);
12340 listlen = Jim_ListLength(interp, argv[0]);
12341 for (i = 0; i < listlen; i++) {
12342 int eq = 0;
12343 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12345 switch (opt_match) {
12346 case OPT_EXACT:
12347 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12348 break;
12350 case OPT_GLOB:
12351 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12352 break;
12354 case OPT_REGEXP:
12355 case OPT_COMMAND:
12356 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12357 if (eq < 0) {
12358 if (listObjPtr) {
12359 Jim_FreeNewObj(interp, listObjPtr);
12361 rc = JIM_ERR;
12362 goto done;
12364 break;
12367 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12368 if (!eq && opt_bool && opt_not && !opt_all) {
12369 continue;
12372 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12373 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12374 Jim_Obj *resultObj;
12376 if (opt_bool) {
12377 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12379 else if (!opt_inline) {
12380 resultObj = Jim_NewIntObj(interp, i);
12382 else {
12383 resultObj = objPtr;
12386 if (opt_all) {
12387 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12389 else {
12390 Jim_SetResult(interp, resultObj);
12391 goto done;
12396 if (opt_all) {
12397 Jim_SetResult(interp, listObjPtr);
12399 else {
12400 /* No match */
12401 if (opt_bool) {
12402 Jim_SetResultBool(interp, opt_not);
12404 else if (!opt_inline) {
12405 Jim_SetResultInt(interp, -1);
12409 done:
12410 if (commandObj) {
12411 Jim_DecrRefCount(interp, commandObj);
12413 return rc;
12416 /* [lappend] */
12417 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12419 Jim_Obj *listObjPtr;
12420 int new_obj = 0;
12421 int i;
12423 if (argc < 2) {
12424 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12425 return JIM_ERR;
12427 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12428 if (!listObjPtr) {
12429 /* Create the list if it does not exist */
12430 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12431 new_obj = 1;
12433 else if (Jim_IsShared(listObjPtr)) {
12434 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12435 new_obj = 1;
12437 for (i = 2; i < argc; i++)
12438 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12439 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12440 if (new_obj)
12441 Jim_FreeNewObj(interp, listObjPtr);
12442 return JIM_ERR;
12444 Jim_SetResult(interp, listObjPtr);
12445 return JIM_OK;
12448 /* [linsert] */
12449 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12451 int idx, len;
12452 Jim_Obj *listPtr;
12454 if (argc < 3) {
12455 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12456 return JIM_ERR;
12458 listPtr = argv[1];
12459 if (Jim_IsShared(listPtr))
12460 listPtr = Jim_DuplicateObj(interp, listPtr);
12461 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12462 goto err;
12463 len = Jim_ListLength(interp, listPtr);
12464 if (idx >= len)
12465 idx = len;
12466 else if (idx < 0)
12467 idx = len + idx + 1;
12468 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12469 Jim_SetResult(interp, listPtr);
12470 return JIM_OK;
12471 err:
12472 if (listPtr != argv[1]) {
12473 Jim_FreeNewObj(interp, listPtr);
12475 return JIM_ERR;
12478 /* [lreplace] */
12479 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12481 int first, last, len, rangeLen;
12482 Jim_Obj *listObj;
12483 Jim_Obj *newListObj;
12485 if (argc < 4) {
12486 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12487 return JIM_ERR;
12489 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12490 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12491 return JIM_ERR;
12494 listObj = argv[1];
12495 len = Jim_ListLength(interp, listObj);
12497 first = JimRelToAbsIndex(len, first);
12498 last = JimRelToAbsIndex(len, last);
12499 JimRelToAbsRange(len, &first, &last, &rangeLen);
12501 /* Now construct a new list which consists of:
12502 * <elements before first> <supplied elements> <elements after last>
12505 /* Check to see if trying to replace past the end of the list */
12506 if (first < len) {
12507 /* OK. Not past the end */
12509 else if (len == 0) {
12510 /* Special for empty list, adjust first to 0 */
12511 first = 0;
12513 else {
12514 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12515 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12516 return JIM_ERR;
12519 /* Add the first set of elements */
12520 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12522 /* Add supplied elements */
12523 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12525 /* Add the remaining elements */
12526 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12528 Jim_SetResult(interp, newListObj);
12529 return JIM_OK;
12532 /* [lset] */
12533 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12535 if (argc < 3) {
12536 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12537 return JIM_ERR;
12539 else if (argc == 3) {
12540 /* With no indexes, simply implements [set] */
12541 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12542 return JIM_ERR;
12543 Jim_SetResult(interp, argv[2]);
12544 return JIM_OK;
12546 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12549 /* [lsort] */
12550 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12552 static const char * const options[] = {
12553 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12555 enum
12556 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12557 Jim_Obj *resObj;
12558 int i;
12559 int retCode;
12560 int shared;
12562 struct lsort_info info;
12564 if (argc < 2) {
12565 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12566 return JIM_ERR;
12569 info.type = JIM_LSORT_ASCII;
12570 info.order = 1;
12571 info.indexed = 0;
12572 info.unique = 0;
12573 info.command = NULL;
12574 info.interp = interp;
12576 for (i = 1; i < (argc - 1); i++) {
12577 int option;
12579 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12580 != JIM_OK)
12581 return JIM_ERR;
12582 switch (option) {
12583 case OPT_ASCII:
12584 info.type = JIM_LSORT_ASCII;
12585 break;
12586 case OPT_NOCASE:
12587 info.type = JIM_LSORT_NOCASE;
12588 break;
12589 case OPT_INTEGER:
12590 info.type = JIM_LSORT_INTEGER;
12591 break;
12592 case OPT_REAL:
12593 info.type = JIM_LSORT_REAL;
12594 break;
12595 case OPT_INCREASING:
12596 info.order = 1;
12597 break;
12598 case OPT_DECREASING:
12599 info.order = -1;
12600 break;
12601 case OPT_UNIQUE:
12602 info.unique = 1;
12603 break;
12604 case OPT_COMMAND:
12605 if (i >= (argc - 2)) {
12606 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12607 return JIM_ERR;
12609 info.type = JIM_LSORT_COMMAND;
12610 info.command = argv[i + 1];
12611 i++;
12612 break;
12613 case OPT_INDEX:
12614 if (i >= (argc - 2)) {
12615 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12616 return JIM_ERR;
12618 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12619 return JIM_ERR;
12621 info.indexed = 1;
12622 i++;
12623 break;
12626 resObj = argv[argc - 1];
12627 if ((shared = Jim_IsShared(resObj)))
12628 resObj = Jim_DuplicateObj(interp, resObj);
12629 retCode = ListSortElements(interp, resObj, &info);
12630 if (retCode == JIM_OK) {
12631 Jim_SetResult(interp, resObj);
12633 else if (shared) {
12634 Jim_FreeNewObj(interp, resObj);
12636 return retCode;
12639 /* [append] */
12640 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12642 Jim_Obj *stringObjPtr;
12643 int i;
12645 if (argc < 2) {
12646 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12647 return JIM_ERR;
12649 if (argc == 2) {
12650 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12651 if (!stringObjPtr)
12652 return JIM_ERR;
12654 else {
12655 int new_obj = 0;
12656 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12657 if (!stringObjPtr) {
12658 /* Create the string if it doesn't exist */
12659 stringObjPtr = Jim_NewEmptyStringObj(interp);
12660 new_obj = 1;
12662 else if (Jim_IsShared(stringObjPtr)) {
12663 new_obj = 1;
12664 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12666 for (i = 2; i < argc; i++) {
12667 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12669 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12670 if (new_obj) {
12671 Jim_FreeNewObj(interp, stringObjPtr);
12673 return JIM_ERR;
12676 Jim_SetResult(interp, stringObjPtr);
12677 return JIM_OK;
12680 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12682 * Returns a zero-refcount list describing the expression at 'node'
12684 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12686 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12688 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12689 if (TOKEN_IS_EXPR_OP(node->type)) {
12690 if (node->left) {
12691 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12693 if (node->right) {
12694 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12696 if (node->ternary) {
12697 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12700 else {
12701 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12703 return listObjPtr;
12705 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12707 /* [debug] */
12708 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12710 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12711 static const char * const options[] = {
12712 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12713 "exprbc", "show",
12714 NULL
12716 enum
12718 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12719 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12721 int option;
12723 if (argc < 2) {
12724 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12725 return JIM_ERR;
12727 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12728 return Jim_CheckShowCommands(interp, argv[1], options);
12729 if (option == OPT_REFCOUNT) {
12730 if (argc != 3) {
12731 Jim_WrongNumArgs(interp, 2, argv, "object");
12732 return JIM_ERR;
12734 Jim_SetResultInt(interp, argv[2]->refCount);
12735 return JIM_OK;
12737 else if (option == OPT_OBJCOUNT) {
12738 int freeobj = 0, liveobj = 0;
12739 char buf[256];
12740 Jim_Obj *objPtr;
12742 if (argc != 2) {
12743 Jim_WrongNumArgs(interp, 2, argv, "");
12744 return JIM_ERR;
12746 /* Count the number of free objects. */
12747 objPtr = interp->freeList;
12748 while (objPtr) {
12749 freeobj++;
12750 objPtr = objPtr->nextObjPtr;
12752 /* Count the number of live objects. */
12753 objPtr = interp->liveList;
12754 while (objPtr) {
12755 liveobj++;
12756 objPtr = objPtr->nextObjPtr;
12758 /* Set the result string and return. */
12759 sprintf(buf, "free %d used %d", freeobj, liveobj);
12760 Jim_SetResultString(interp, buf, -1);
12761 return JIM_OK;
12763 else if (option == OPT_OBJECTS) {
12764 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12766 /* Count the number of live objects. */
12767 objPtr = interp->liveList;
12768 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12769 while (objPtr) {
12770 char buf[128];
12771 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12773 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12774 sprintf(buf, "%p", objPtr);
12775 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12776 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12777 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12778 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12779 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12780 objPtr = objPtr->nextObjPtr;
12782 Jim_SetResult(interp, listObjPtr);
12783 return JIM_OK;
12785 else if (option == OPT_INVSTR) {
12786 Jim_Obj *objPtr;
12788 if (argc != 3) {
12789 Jim_WrongNumArgs(interp, 2, argv, "object");
12790 return JIM_ERR;
12792 objPtr = argv[2];
12793 if (objPtr->typePtr != NULL)
12794 Jim_InvalidateStringRep(objPtr);
12795 Jim_SetEmptyResult(interp);
12796 return JIM_OK;
12798 else if (option == OPT_SHOW) {
12799 const char *s;
12800 int len, charlen;
12802 if (argc != 3) {
12803 Jim_WrongNumArgs(interp, 2, argv, "object");
12804 return JIM_ERR;
12806 s = Jim_GetString(argv[2], &len);
12807 #ifdef JIM_UTF8
12808 charlen = utf8_strlen(s, len);
12809 #else
12810 charlen = len;
12811 #endif
12812 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12813 printf("chars (%d): <<%s>>\n", charlen, s);
12814 printf("bytes (%d):", len);
12815 while (len--) {
12816 printf(" %02x", (unsigned char)*s++);
12818 printf("\n");
12819 return JIM_OK;
12821 else if (option == OPT_SCRIPTLEN) {
12822 ScriptObj *script;
12824 if (argc != 3) {
12825 Jim_WrongNumArgs(interp, 2, argv, "script");
12826 return JIM_ERR;
12828 script = JimGetScript(interp, argv[2]);
12829 if (script == NULL)
12830 return JIM_ERR;
12831 Jim_SetResultInt(interp, script->len);
12832 return JIM_OK;
12834 else if (option == OPT_EXPRLEN) {
12835 struct ExprTree *expr;
12837 if (argc != 3) {
12838 Jim_WrongNumArgs(interp, 2, argv, "expression");
12839 return JIM_ERR;
12841 expr = JimGetExpression(interp, argv[2]);
12842 if (expr == NULL)
12843 return JIM_ERR;
12844 Jim_SetResultInt(interp, expr->len);
12845 return JIM_OK;
12847 else if (option == OPT_EXPRBC) {
12848 struct ExprTree *expr;
12850 if (argc != 3) {
12851 Jim_WrongNumArgs(interp, 2, argv, "expression");
12852 return JIM_ERR;
12854 expr = JimGetExpression(interp, argv[2]);
12855 if (expr == NULL)
12856 return JIM_ERR;
12857 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12858 return JIM_OK;
12860 else {
12861 Jim_SetResultString(interp,
12862 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12863 return JIM_ERR;
12865 /* unreached */
12866 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12867 #if !defined(JIM_DEBUG_COMMAND)
12868 Jim_SetResultString(interp, "unsupported", -1);
12869 return JIM_ERR;
12870 #endif
12873 /* [eval] */
12874 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12876 int rc;
12878 if (argc < 2) {
12879 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12880 return JIM_ERR;
12883 if (argc == 2) {
12884 rc = Jim_EvalObj(interp, argv[1]);
12886 else {
12887 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12890 if (rc == JIM_ERR) {
12891 /* eval is "interesting", so add a stack frame here */
12892 interp->addStackTrace++;
12894 return rc;
12897 /* [uplevel] */
12898 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12900 if (argc >= 2) {
12901 int retcode;
12902 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12903 const char *str;
12905 /* Save the old callframe pointer */
12906 savedCallFrame = interp->framePtr;
12908 /* Lookup the target frame pointer */
12909 str = Jim_String(argv[1]);
12910 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12911 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12912 argc--;
12913 argv++;
12915 else {
12916 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12918 if (targetCallFrame == NULL) {
12919 return JIM_ERR;
12921 if (argc < 2) {
12922 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12923 return JIM_ERR;
12925 /* Eval the code in the target callframe. */
12926 interp->framePtr = targetCallFrame;
12927 if (argc == 2) {
12928 retcode = Jim_EvalObj(interp, argv[1]);
12930 else {
12931 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12933 interp->framePtr = savedCallFrame;
12934 return retcode;
12936 else {
12937 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12938 return JIM_ERR;
12942 /* [expr] */
12943 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12945 int retcode;
12947 if (argc == 2) {
12948 retcode = Jim_EvalExpression(interp, argv[1]);
12950 else if (argc > 2) {
12951 Jim_Obj *objPtr;
12953 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12954 Jim_IncrRefCount(objPtr);
12955 retcode = Jim_EvalExpression(interp, objPtr);
12956 Jim_DecrRefCount(interp, objPtr);
12958 else {
12959 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12960 return JIM_ERR;
12962 if (retcode != JIM_OK)
12963 return retcode;
12964 return JIM_OK;
12967 /* [break] */
12968 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12970 if (argc != 1) {
12971 Jim_WrongNumArgs(interp, 1, argv, "");
12972 return JIM_ERR;
12974 return JIM_BREAK;
12977 /* [continue] */
12978 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12980 if (argc != 1) {
12981 Jim_WrongNumArgs(interp, 1, argv, "");
12982 return JIM_ERR;
12984 return JIM_CONTINUE;
12987 /* [return] */
12988 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12990 int i;
12991 Jim_Obj *stackTraceObj = NULL;
12992 Jim_Obj *errorCodeObj = NULL;
12993 int returnCode = JIM_OK;
12994 long level = 1;
12996 for (i = 1; i < argc - 1; i += 2) {
12997 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12998 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12999 return JIM_ERR;
13002 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13003 stackTraceObj = argv[i + 1];
13005 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13006 errorCodeObj = argv[i + 1];
13008 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13009 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13010 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13011 return JIM_ERR;
13014 else {
13015 break;
13019 if (i != argc - 1 && i != argc) {
13020 Jim_WrongNumArgs(interp, 1, argv,
13021 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13024 /* If a stack trace is supplied and code is error, set the stack trace */
13025 if (stackTraceObj && returnCode == JIM_ERR) {
13026 JimSetStackTrace(interp, stackTraceObj);
13028 /* If an error code list is supplied, set the global $errorCode */
13029 if (errorCodeObj && returnCode == JIM_ERR) {
13030 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13032 interp->returnCode = returnCode;
13033 interp->returnLevel = level;
13035 if (i == argc - 1) {
13036 Jim_SetResult(interp, argv[i]);
13038 return JIM_RETURN;
13041 /* [tailcall] */
13042 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13044 if (interp->framePtr->level == 0) {
13045 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13046 return JIM_ERR;
13048 else if (argc >= 2) {
13049 /* Need to resolve the tailcall command in the current context */
13050 Jim_CallFrame *cf = interp->framePtr->parent;
13052 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13053 if (cmdPtr == NULL) {
13054 return JIM_ERR;
13057 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13059 /* And stash this pre-resolved command */
13060 JimIncrCmdRefCount(cmdPtr);
13061 cf->tailcallCmd = cmdPtr;
13063 /* And stash the command list */
13064 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13066 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13067 Jim_IncrRefCount(cf->tailcallObj);
13069 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13070 return JIM_EVAL;
13072 return JIM_OK;
13075 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13077 Jim_Obj *cmdList;
13078 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13080 /* prefixListObj is a list to which the args need to be appended */
13081 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13082 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13084 return JimEvalObjList(interp, cmdList);
13087 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13089 Jim_Obj *prefixListObj = privData;
13090 Jim_DecrRefCount(interp, prefixListObj);
13093 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13095 Jim_Obj *prefixListObj;
13096 const char *newname;
13098 if (argc < 3) {
13099 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13100 return JIM_ERR;
13103 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13104 Jim_IncrRefCount(prefixListObj);
13105 newname = Jim_String(argv[1]);
13106 if (newname[0] == ':' && newname[1] == ':') {
13107 while (*++newname == ':') {
13111 Jim_SetResult(interp, argv[1]);
13113 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13116 /* [proc] */
13117 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13119 Jim_Cmd *cmd;
13121 if (argc != 4 && argc != 5) {
13122 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13123 return JIM_ERR;
13126 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13127 return JIM_ERR;
13130 if (argc == 4) {
13131 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13133 else {
13134 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13137 if (cmd) {
13138 /* Add the new command */
13139 Jim_Obj *qualifiedCmdNameObj;
13140 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13142 JimCreateCommand(interp, cmdname, cmd);
13144 /* Calculate and set the namespace for this proc */
13145 JimUpdateProcNamespace(interp, cmd, cmdname);
13147 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13149 /* Unlike Tcl, set the name of the proc as the result */
13150 Jim_SetResult(interp, argv[1]);
13151 return JIM_OK;
13153 return JIM_ERR;
13156 /* [local] */
13157 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13159 int retcode;
13161 if (argc < 2) {
13162 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13163 return JIM_ERR;
13166 /* Evaluate the arguments with 'local' in force */
13167 interp->local++;
13168 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13169 interp->local--;
13172 /* If OK, and the result is a proc, add it to the list of local procs */
13173 if (retcode == 0) {
13174 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13176 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13177 return JIM_ERR;
13179 if (interp->framePtr->localCommands == NULL) {
13180 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13181 Jim_InitStack(interp->framePtr->localCommands);
13183 Jim_IncrRefCount(cmdNameObj);
13184 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13187 return retcode;
13190 /* [upcall] */
13191 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13193 if (argc < 2) {
13194 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13195 return JIM_ERR;
13197 else {
13198 int retcode;
13200 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13201 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13202 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13203 return JIM_ERR;
13205 /* OK. Mark this command as being in an upcall */
13206 cmdPtr->u.proc.upcall++;
13207 JimIncrCmdRefCount(cmdPtr);
13209 /* Invoke the command as normal */
13210 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13212 /* No longer in an upcall */
13213 cmdPtr->u.proc.upcall--;
13214 JimDecrCmdRefCount(interp, cmdPtr);
13216 return retcode;
13220 /* [apply] */
13221 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13223 if (argc < 2) {
13224 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13225 return JIM_ERR;
13227 else {
13228 int ret;
13229 Jim_Cmd *cmd;
13230 Jim_Obj *argListObjPtr;
13231 Jim_Obj *bodyObjPtr;
13232 Jim_Obj *nsObj = NULL;
13233 Jim_Obj **nargv;
13235 int len = Jim_ListLength(interp, argv[1]);
13236 if (len != 2 && len != 3) {
13237 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13238 return JIM_ERR;
13241 if (len == 3) {
13242 #ifdef jim_ext_namespace
13243 /* Need to canonicalise the given namespace. */
13244 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13245 #else
13246 Jim_SetResultString(interp, "namespaces not enabled", -1);
13247 return JIM_ERR;
13248 #endif
13250 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13251 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13253 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13255 if (cmd) {
13256 /* Create a new argv array with a dummy argv[0], for error messages */
13257 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13258 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13259 Jim_IncrRefCount(nargv[0]);
13260 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13261 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13262 Jim_DecrRefCount(interp, nargv[0]);
13263 Jim_Free(nargv);
13265 JimDecrCmdRefCount(interp, cmd);
13266 return ret;
13268 return JIM_ERR;
13273 /* [concat] */
13274 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13276 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13277 return JIM_OK;
13280 /* [upvar] */
13281 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13283 int i;
13284 Jim_CallFrame *targetCallFrame;
13286 /* Lookup the target frame pointer */
13287 if (argc > 3 && (argc % 2 == 0)) {
13288 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13289 argc--;
13290 argv++;
13292 else {
13293 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13295 if (targetCallFrame == NULL) {
13296 return JIM_ERR;
13299 /* Check for arity */
13300 if (argc < 3) {
13301 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13302 return JIM_ERR;
13305 /* Now... for every other/local couple: */
13306 for (i = 1; i < argc; i += 2) {
13307 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13308 return JIM_ERR;
13310 return JIM_OK;
13313 /* [global] */
13314 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13316 int i;
13318 if (argc < 2) {
13319 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13320 return JIM_ERR;
13322 /* Link every var to the toplevel having the same name */
13323 if (interp->framePtr->level == 0)
13324 return JIM_OK; /* global at toplevel... */
13325 for (i = 1; i < argc; i++) {
13326 /* global ::blah does nothing */
13327 const char *name = Jim_String(argv[i]);
13328 if (name[0] != ':' || name[1] != ':') {
13329 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13330 return JIM_ERR;
13333 return JIM_OK;
13336 /* does the [string map] operation. On error NULL is returned,
13337 * otherwise a new string object with the result, having refcount = 0,
13338 * is returned. */
13339 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13340 Jim_Obj *objPtr, int nocase)
13342 int numMaps;
13343 const char *str, *noMatchStart = NULL;
13344 int strLen, i;
13345 Jim_Obj *resultObjPtr;
13347 numMaps = Jim_ListLength(interp, mapListObjPtr);
13348 if (numMaps % 2) {
13349 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13350 return NULL;
13353 str = Jim_String(objPtr);
13354 strLen = Jim_Utf8Length(interp, objPtr);
13356 /* Map it */
13357 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13358 while (strLen) {
13359 for (i = 0; i < numMaps; i += 2) {
13360 Jim_Obj *eachObjPtr;
13361 const char *k;
13362 int kl;
13364 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13365 k = Jim_String(eachObjPtr);
13366 kl = Jim_Utf8Length(interp, eachObjPtr);
13368 if (strLen >= kl && kl) {
13369 int rc;
13370 rc = JimStringCompareLen(str, k, kl, nocase);
13371 if (rc == 0) {
13372 if (noMatchStart) {
13373 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13374 noMatchStart = NULL;
13376 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13377 str += utf8_index(str, kl);
13378 strLen -= kl;
13379 break;
13383 if (i == numMaps) { /* no match */
13384 int c;
13385 if (noMatchStart == NULL)
13386 noMatchStart = str;
13387 str += utf8_tounicode(str, &c);
13388 strLen--;
13391 if (noMatchStart) {
13392 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13394 return resultObjPtr;
13397 /* [string] */
13398 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13400 int len;
13401 int opt_case = 1;
13402 int option;
13403 static const char * const options[] = {
13404 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13405 "map", "repeat", "reverse", "index", "first", "last", "cat",
13406 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13408 enum
13410 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13411 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13412 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13414 static const char * const nocase_options[] = {
13415 "-nocase", NULL
13417 static const char * const nocase_length_options[] = {
13418 "-nocase", "-length", NULL
13421 if (argc < 2) {
13422 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13423 return JIM_ERR;
13425 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13426 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13427 return Jim_CheckShowCommands(interp, argv[1], options);
13429 switch (option) {
13430 case OPT_LENGTH:
13431 case OPT_BYTELENGTH:
13432 if (argc != 3) {
13433 Jim_WrongNumArgs(interp, 2, argv, "string");
13434 return JIM_ERR;
13436 if (option == OPT_LENGTH) {
13437 len = Jim_Utf8Length(interp, argv[2]);
13439 else {
13440 len = Jim_Length(argv[2]);
13442 Jim_SetResultInt(interp, len);
13443 return JIM_OK;
13445 case OPT_CAT:{
13446 Jim_Obj *objPtr;
13447 if (argc == 3) {
13448 /* optimise the one-arg case */
13449 objPtr = argv[2];
13451 else {
13452 int i;
13454 objPtr = Jim_NewStringObj(interp, "", 0);
13456 for (i = 2; i < argc; i++) {
13457 Jim_AppendObj(interp, objPtr, argv[i]);
13460 Jim_SetResult(interp, objPtr);
13461 return JIM_OK;
13464 case OPT_COMPARE:
13465 case OPT_EQUAL:
13467 /* n is the number of remaining option args */
13468 long opt_length = -1;
13469 int n = argc - 4;
13470 int i = 2;
13471 while (n > 0) {
13472 int subopt;
13473 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13474 JIM_ENUM_ABBREV) != JIM_OK) {
13475 badcompareargs:
13476 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13477 return JIM_ERR;
13479 if (subopt == 0) {
13480 /* -nocase */
13481 opt_case = 0;
13482 n--;
13484 else {
13485 /* -length */
13486 if (n < 2) {
13487 goto badcompareargs;
13489 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13490 return JIM_ERR;
13492 n -= 2;
13495 if (n) {
13496 goto badcompareargs;
13498 argv += argc - 2;
13499 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13500 /* Fast version - [string equal], case sensitive, no length */
13501 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13503 else {
13504 if (opt_length >= 0) {
13505 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13507 else {
13508 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13510 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13512 return JIM_OK;
13515 case OPT_MATCH:
13516 if (argc != 4 &&
13517 (argc != 5 ||
13518 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13519 JIM_ENUM_ABBREV) != JIM_OK)) {
13520 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13521 return JIM_ERR;
13523 if (opt_case == 0) {
13524 argv++;
13526 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13527 return JIM_OK;
13529 case OPT_MAP:{
13530 Jim_Obj *objPtr;
13532 if (argc != 4 &&
13533 (argc != 5 ||
13534 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13535 JIM_ENUM_ABBREV) != JIM_OK)) {
13536 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13537 return JIM_ERR;
13540 if (opt_case == 0) {
13541 argv++;
13543 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13544 if (objPtr == NULL) {
13545 return JIM_ERR;
13547 Jim_SetResult(interp, objPtr);
13548 return JIM_OK;
13551 case OPT_RANGE:
13552 case OPT_BYTERANGE:{
13553 Jim_Obj *objPtr;
13555 if (argc != 5) {
13556 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13557 return JIM_ERR;
13559 if (option == OPT_RANGE) {
13560 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13562 else
13564 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13567 if (objPtr == NULL) {
13568 return JIM_ERR;
13570 Jim_SetResult(interp, objPtr);
13571 return JIM_OK;
13574 case OPT_REPLACE:{
13575 Jim_Obj *objPtr;
13577 if (argc != 5 && argc != 6) {
13578 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13579 return JIM_ERR;
13581 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13582 if (objPtr == NULL) {
13583 return JIM_ERR;
13585 Jim_SetResult(interp, objPtr);
13586 return JIM_OK;
13590 case OPT_REPEAT:{
13591 Jim_Obj *objPtr;
13592 jim_wide count;
13594 if (argc != 4) {
13595 Jim_WrongNumArgs(interp, 2, argv, "string count");
13596 return JIM_ERR;
13598 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13599 return JIM_ERR;
13601 objPtr = Jim_NewStringObj(interp, "", 0);
13602 if (count > 0) {
13603 while (count--) {
13604 Jim_AppendObj(interp, objPtr, argv[2]);
13607 Jim_SetResult(interp, objPtr);
13608 return JIM_OK;
13611 case OPT_REVERSE:{
13612 char *buf, *p;
13613 const char *str;
13614 int i;
13616 if (argc != 3) {
13617 Jim_WrongNumArgs(interp, 2, argv, "string");
13618 return JIM_ERR;
13621 str = Jim_GetString(argv[2], &len);
13622 buf = Jim_Alloc(len + 1);
13623 p = buf + len;
13624 *p = 0;
13625 for (i = 0; i < len; ) {
13626 int c;
13627 int l = utf8_tounicode(str, &c);
13628 memcpy(p - l, str, l);
13629 p -= l;
13630 i += l;
13631 str += l;
13633 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13634 return JIM_OK;
13637 case OPT_INDEX:{
13638 int idx;
13639 const char *str;
13641 if (argc != 4) {
13642 Jim_WrongNumArgs(interp, 2, argv, "string index");
13643 return JIM_ERR;
13645 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13646 return JIM_ERR;
13648 str = Jim_String(argv[2]);
13649 len = Jim_Utf8Length(interp, argv[2]);
13650 if (idx != INT_MIN && idx != INT_MAX) {
13651 idx = JimRelToAbsIndex(len, idx);
13653 if (idx < 0 || idx >= len || str == NULL) {
13654 Jim_SetResultString(interp, "", 0);
13656 else if (len == Jim_Length(argv[2])) {
13657 /* ASCII optimisation */
13658 Jim_SetResultString(interp, str + idx, 1);
13660 else {
13661 int c;
13662 int i = utf8_index(str, idx);
13663 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13665 return JIM_OK;
13668 case OPT_FIRST:
13669 case OPT_LAST:{
13670 int idx = 0, l1, l2;
13671 const char *s1, *s2;
13673 if (argc != 4 && argc != 5) {
13674 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13675 return JIM_ERR;
13677 s1 = Jim_String(argv[2]);
13678 s2 = Jim_String(argv[3]);
13679 l1 = Jim_Utf8Length(interp, argv[2]);
13680 l2 = Jim_Utf8Length(interp, argv[3]);
13681 if (argc == 5) {
13682 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13683 return JIM_ERR;
13685 idx = JimRelToAbsIndex(l2, idx);
13687 else if (option == OPT_LAST) {
13688 idx = l2;
13690 if (option == OPT_FIRST) {
13691 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13693 else {
13694 #ifdef JIM_UTF8
13695 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13696 #else
13697 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13698 #endif
13700 return JIM_OK;
13703 case OPT_TRIM:
13704 case OPT_TRIMLEFT:
13705 case OPT_TRIMRIGHT:{
13706 Jim_Obj *trimchars;
13708 if (argc != 3 && argc != 4) {
13709 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13710 return JIM_ERR;
13712 trimchars = (argc == 4 ? argv[3] : NULL);
13713 if (option == OPT_TRIM) {
13714 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13716 else if (option == OPT_TRIMLEFT) {
13717 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13719 else if (option == OPT_TRIMRIGHT) {
13720 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13722 return JIM_OK;
13725 case OPT_TOLOWER:
13726 case OPT_TOUPPER:
13727 case OPT_TOTITLE:
13728 if (argc != 3) {
13729 Jim_WrongNumArgs(interp, 2, argv, "string");
13730 return JIM_ERR;
13732 if (option == OPT_TOLOWER) {
13733 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13735 else if (option == OPT_TOUPPER) {
13736 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13738 else {
13739 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13741 return JIM_OK;
13743 case OPT_IS:
13744 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13745 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13747 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13748 return JIM_ERR;
13750 return JIM_OK;
13753 /* [time] */
13754 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13756 long i, count = 1;
13757 jim_wide start, elapsed;
13758 char buf[60];
13759 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13761 if (argc < 2) {
13762 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13763 return JIM_ERR;
13765 if (argc == 3) {
13766 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13767 return JIM_ERR;
13769 if (count < 0)
13770 return JIM_OK;
13771 i = count;
13772 start = JimClock();
13773 while (i-- > 0) {
13774 int retval;
13776 retval = Jim_EvalObj(interp, argv[1]);
13777 if (retval != JIM_OK) {
13778 return retval;
13781 elapsed = JimClock() - start;
13782 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13783 Jim_SetResultString(interp, buf, -1);
13784 return JIM_OK;
13787 /* [exit] */
13788 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13790 long exitCode = 0;
13792 if (argc > 2) {
13793 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13794 return JIM_ERR;
13796 if (argc == 2) {
13797 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13798 return JIM_ERR;
13800 interp->exitCode = exitCode;
13801 return JIM_EXIT;
13804 /* [catch] */
13805 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13807 int exitCode = 0;
13808 int i;
13809 int sig = 0;
13811 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13812 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13813 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13815 /* Reset the error code before catch.
13816 * Note that this is not strictly correct.
13818 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13820 for (i = 1; i < argc - 1; i++) {
13821 const char *arg = Jim_String(argv[i]);
13822 jim_wide option;
13823 int ignore;
13825 /* It's a pity we can't use Jim_GetEnum here :-( */
13826 if (strcmp(arg, "--") == 0) {
13827 i++;
13828 break;
13830 if (*arg != '-') {
13831 break;
13834 if (strncmp(arg, "-no", 3) == 0) {
13835 arg += 3;
13836 ignore = 1;
13838 else {
13839 arg++;
13840 ignore = 0;
13843 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13844 option = -1;
13846 if (option < 0) {
13847 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13849 if (option < 0) {
13850 goto wrongargs;
13853 if (ignore) {
13854 ignore_mask |= ((jim_wide)1 << option);
13856 else {
13857 ignore_mask &= (~((jim_wide)1 << option));
13861 argc -= i;
13862 if (argc < 1 || argc > 3) {
13863 wrongargs:
13864 Jim_WrongNumArgs(interp, 1, argv,
13865 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13866 return JIM_ERR;
13868 argv += i;
13870 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13871 sig++;
13874 interp->signal_level += sig;
13875 if (Jim_CheckSignal(interp)) {
13876 /* If a signal is set, don't even try to execute the body */
13877 exitCode = JIM_SIGNAL;
13879 else {
13880 exitCode = Jim_EvalObj(interp, argv[0]);
13881 /* Don't want any caught error included in a later stack trace */
13882 interp->errorFlag = 0;
13884 interp->signal_level -= sig;
13886 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13887 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13888 /* Not caught, pass it up */
13889 return exitCode;
13892 if (sig && exitCode == JIM_SIGNAL) {
13893 /* Catch the signal at this level */
13894 if (interp->signal_set_result) {
13895 interp->signal_set_result(interp, interp->sigmask);
13897 else {
13898 Jim_SetResultInt(interp, interp->sigmask);
13900 interp->sigmask = 0;
13903 if (argc >= 2) {
13904 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13905 return JIM_ERR;
13907 if (argc == 3) {
13908 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13910 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13911 Jim_ListAppendElement(interp, optListObj,
13912 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13913 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13914 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13915 if (exitCode == JIM_ERR) {
13916 Jim_Obj *errorCode;
13917 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13918 -1));
13919 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13921 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13922 if (errorCode) {
13923 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13924 Jim_ListAppendElement(interp, optListObj, errorCode);
13927 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13928 return JIM_ERR;
13932 Jim_SetResultInt(interp, exitCode);
13933 return JIM_OK;
13936 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13938 /* [ref] */
13939 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13941 if (argc != 3 && argc != 4) {
13942 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13943 return JIM_ERR;
13945 if (argc == 3) {
13946 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13948 else {
13949 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13951 return JIM_OK;
13954 /* [getref] */
13955 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13957 Jim_Reference *refPtr;
13959 if (argc != 2) {
13960 Jim_WrongNumArgs(interp, 1, argv, "reference");
13961 return JIM_ERR;
13963 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13964 return JIM_ERR;
13965 Jim_SetResult(interp, refPtr->objPtr);
13966 return JIM_OK;
13969 /* [setref] */
13970 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13972 Jim_Reference *refPtr;
13974 if (argc != 3) {
13975 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13976 return JIM_ERR;
13978 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13979 return JIM_ERR;
13980 Jim_IncrRefCount(argv[2]);
13981 Jim_DecrRefCount(interp, refPtr->objPtr);
13982 refPtr->objPtr = argv[2];
13983 Jim_SetResult(interp, argv[2]);
13984 return JIM_OK;
13987 /* [collect] */
13988 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13990 if (argc != 1) {
13991 Jim_WrongNumArgs(interp, 1, argv, "");
13992 return JIM_ERR;
13994 Jim_SetResultInt(interp, Jim_Collect(interp));
13996 /* Free all the freed objects. */
13997 while (interp->freeList) {
13998 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13999 Jim_Free(interp->freeList);
14000 interp->freeList = nextObjPtr;
14003 return JIM_OK;
14006 /* [finalize] reference ?newValue? */
14007 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14009 if (argc != 2 && argc != 3) {
14010 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14011 return JIM_ERR;
14013 if (argc == 2) {
14014 Jim_Obj *cmdNamePtr;
14016 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14017 return JIM_ERR;
14018 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14019 Jim_SetResult(interp, cmdNamePtr);
14021 else {
14022 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14023 return JIM_ERR;
14024 Jim_SetResult(interp, argv[2]);
14026 return JIM_OK;
14029 /* [info references] */
14030 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14032 Jim_Obj *listObjPtr;
14033 Jim_HashTableIterator htiter;
14034 Jim_HashEntry *he;
14036 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14038 JimInitHashTableIterator(&interp->references, &htiter);
14039 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14040 char buf[JIM_REFERENCE_SPACE + 1];
14041 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14042 const unsigned long *refId = he->key;
14044 JimFormatReference(buf, refPtr, *refId);
14045 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14047 Jim_SetResult(interp, listObjPtr);
14048 return JIM_OK;
14050 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14052 /* [rename] */
14053 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14055 if (argc != 3) {
14056 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14057 return JIM_ERR;
14060 if (JimValidName(interp, "new procedure", argv[2])) {
14061 return JIM_ERR;
14064 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14067 #define JIM_DICTMATCH_KEYS 0x0001
14068 #define JIM_DICTMATCH_VALUES 0x002
14071 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14072 * return_types should be either or both
14074 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14076 Jim_HashEntry *he;
14077 Jim_Obj *listObjPtr;
14078 Jim_HashTableIterator htiter;
14080 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14081 return JIM_ERR;
14084 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14086 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14087 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14088 if (patternObj) {
14089 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14090 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14091 /* no match */
14092 continue;
14095 if (return_types & JIM_DICTMATCH_KEYS) {
14096 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14098 if (return_types & JIM_DICTMATCH_VALUES) {
14099 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14103 Jim_SetResult(interp, listObjPtr);
14104 return JIM_OK;
14107 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14109 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14110 return -1;
14112 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14116 * Must be called with at least one object.
14117 * Returns the new dictionary, or NULL on error.
14119 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14121 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14122 int i;
14124 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14126 /* Note that we don't optimise the trivial case of a single argument */
14128 for (i = 0; i < objc; i++) {
14129 Jim_HashTable *ht;
14130 Jim_HashTableIterator htiter;
14131 Jim_HashEntry *he;
14133 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14134 Jim_FreeNewObj(interp, objPtr);
14135 return NULL;
14137 ht = objv[i]->internalRep.ptr;
14138 JimInitHashTableIterator(ht, &htiter);
14139 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14140 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14143 return objPtr;
14146 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14148 Jim_HashTable *ht;
14149 unsigned int i;
14150 char buffer[100];
14151 int sum = 0;
14152 int nonzero_count = 0;
14153 Jim_Obj *output;
14154 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14156 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14157 return JIM_ERR;
14160 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14162 /* Note that this uses internal knowledge of the hash table */
14163 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14164 output = Jim_NewStringObj(interp, buffer, -1);
14166 for (i = 0; i < ht->size; i++) {
14167 Jim_HashEntry *he = ht->table[i];
14168 int entries = 0;
14169 while (he) {
14170 entries++;
14171 he = he->next;
14173 if (entries > 9) {
14174 bucket_counts[10]++;
14176 else {
14177 bucket_counts[entries]++;
14179 if (entries) {
14180 sum += entries;
14181 nonzero_count++;
14184 for (i = 0; i < 10; i++) {
14185 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14186 Jim_AppendString(interp, output, buffer, -1);
14188 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14189 Jim_AppendString(interp, output, buffer, -1);
14190 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14191 Jim_AppendString(interp, output, buffer, -1);
14192 Jim_SetResult(interp, output);
14193 return JIM_OK;
14196 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14198 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14200 Jim_AppendString(interp, prefixObj, " ", 1);
14201 Jim_AppendString(interp, prefixObj, subcmd, -1);
14203 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14207 * Implements the [dict with] command
14209 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14211 int i;
14212 Jim_Obj *objPtr;
14213 Jim_Obj *dictObj;
14214 Jim_Obj **dictValues;
14215 int len;
14216 int ret = JIM_OK;
14218 /* Open up the appropriate level of the dictionary */
14219 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14220 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14221 return JIM_ERR;
14223 /* Set the local variables */
14224 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14225 return JIM_ERR;
14227 for (i = 0; i < len; i += 2) {
14228 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14229 Jim_Free(dictValues);
14230 return JIM_ERR;
14234 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14235 if (Jim_Length(scriptObj)) {
14236 ret = Jim_EvalObj(interp, scriptObj);
14238 /* Now if the dictionary still exists, update it based on the local variables */
14239 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14240 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14241 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14242 for (i = 0; i < keyc; i++) {
14243 newkeyv[i] = keyv[i];
14246 for (i = 0; i < len; i += 2) {
14247 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14248 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14249 newkeyv[keyc] = dictValues[i];
14250 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14252 Jim_Free(newkeyv);
14256 Jim_Free(dictValues);
14258 return ret;
14261 /* [dict] */
14262 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14264 Jim_Obj *objPtr;
14265 int types = JIM_DICTMATCH_KEYS;
14266 int option;
14267 static const char * const options[] = {
14268 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14269 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14270 "replace", "update", NULL
14272 enum
14274 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14275 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14276 OPT_REPLACE, OPT_UPDATE,
14279 if (argc < 2) {
14280 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14281 return JIM_ERR;
14284 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14285 return Jim_CheckShowCommands(interp, argv[1], options);
14288 switch (option) {
14289 case OPT_GET:
14290 if (argc < 3) {
14291 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14292 return JIM_ERR;
14294 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14295 JIM_ERRMSG) != JIM_OK) {
14296 return JIM_ERR;
14298 Jim_SetResult(interp, objPtr);
14299 return JIM_OK;
14301 case OPT_SET:
14302 if (argc < 5) {
14303 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14304 return JIM_ERR;
14306 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14308 case OPT_EXISTS:
14309 if (argc < 4) {
14310 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14311 return JIM_ERR;
14313 else {
14314 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14315 if (rc < 0) {
14316 return JIM_ERR;
14318 Jim_SetResultBool(interp, rc == JIM_OK);
14319 return JIM_OK;
14322 case OPT_UNSET:
14323 if (argc < 4) {
14324 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14325 return JIM_ERR;
14327 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14328 return JIM_ERR;
14330 return JIM_OK;
14332 case OPT_VALUES:
14333 types = JIM_DICTMATCH_VALUES;
14334 /* fallthru */
14335 case OPT_KEYS:
14336 if (argc != 3 && argc != 4) {
14337 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14338 return JIM_ERR;
14340 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14342 case OPT_SIZE:
14343 if (argc != 3) {
14344 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14345 return JIM_ERR;
14347 else if (Jim_DictSize(interp, argv[2]) < 0) {
14348 return JIM_ERR;
14350 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14351 return JIM_OK;
14353 case OPT_MERGE:
14354 if (argc == 2) {
14355 return JIM_OK;
14357 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14358 if (objPtr == NULL) {
14359 return JIM_ERR;
14361 Jim_SetResult(interp, objPtr);
14362 return JIM_OK;
14364 case OPT_UPDATE:
14365 if (argc < 6 || argc % 2) {
14366 /* Better error message */
14367 argc = 2;
14369 break;
14371 case OPT_CREATE:
14372 if (argc % 2) {
14373 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14374 return JIM_ERR;
14376 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14377 Jim_SetResult(interp, objPtr);
14378 return JIM_OK;
14380 case OPT_INFO:
14381 if (argc != 3) {
14382 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14383 return JIM_ERR;
14385 return Jim_DictInfo(interp, argv[2]);
14387 case OPT_WITH:
14388 if (argc < 4) {
14389 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14390 return JIM_ERR;
14392 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14394 /* Handle command as an ensemble */
14395 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14398 /* [subst] */
14399 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14401 static const char * const options[] = {
14402 "-nobackslashes", "-nocommands", "-novariables", NULL
14404 enum
14405 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14406 int i;
14407 int flags = JIM_SUBST_FLAG;
14408 Jim_Obj *objPtr;
14410 if (argc < 2) {
14411 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14412 return JIM_ERR;
14414 for (i = 1; i < (argc - 1); i++) {
14415 int option;
14417 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14418 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14419 return JIM_ERR;
14421 switch (option) {
14422 case OPT_NOBACKSLASHES:
14423 flags |= JIM_SUBST_NOESC;
14424 break;
14425 case OPT_NOCOMMANDS:
14426 flags |= JIM_SUBST_NOCMD;
14427 break;
14428 case OPT_NOVARIABLES:
14429 flags |= JIM_SUBST_NOVAR;
14430 break;
14433 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14434 return JIM_ERR;
14436 Jim_SetResult(interp, objPtr);
14437 return JIM_OK;
14440 /* [info] */
14441 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14443 int cmd;
14444 Jim_Obj *objPtr;
14445 int mode = 0;
14447 static const char * const commands[] = {
14448 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14449 "vars", "version", "patchlevel", "complete", "args", "hostname",
14450 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14451 "references", "alias", NULL
14453 enum
14454 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14455 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14456 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14457 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14460 #ifdef jim_ext_namespace
14461 int nons = 0;
14463 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14464 /* This is for internal use only */
14465 argc--;
14466 argv++;
14467 nons = 1;
14469 #endif
14471 if (argc < 2) {
14472 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14473 return JIM_ERR;
14475 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14476 return Jim_CheckShowCommands(interp, argv[1], commands);
14479 /* Test for the most common commands first, just in case it makes a difference */
14480 switch (cmd) {
14481 case INFO_EXISTS:
14482 if (argc != 3) {
14483 Jim_WrongNumArgs(interp, 2, argv, "varName");
14484 return JIM_ERR;
14486 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14487 break;
14489 case INFO_ALIAS:{
14490 Jim_Cmd *cmdPtr;
14492 if (argc != 3) {
14493 Jim_WrongNumArgs(interp, 2, argv, "command");
14494 return JIM_ERR;
14496 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14497 return JIM_ERR;
14499 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14500 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14501 return JIM_ERR;
14503 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14504 return JIM_OK;
14507 case INFO_CHANNELS:
14508 mode++; /* JIM_CMDLIST_CHANNELS */
14509 #ifndef jim_ext_aio
14510 Jim_SetResultString(interp, "aio not enabled", -1);
14511 return JIM_ERR;
14512 #endif
14513 /* fall through */
14514 case INFO_PROCS:
14515 mode++; /* JIM_CMDLIST_PROCS */
14516 /* fall through */
14517 case INFO_COMMANDS:
14518 /* mode 0 => JIM_CMDLIST_COMMANDS */
14519 if (argc != 2 && argc != 3) {
14520 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14521 return JIM_ERR;
14523 #ifdef jim_ext_namespace
14524 if (!nons) {
14525 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14526 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14529 #endif
14530 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14531 break;
14533 case INFO_VARS:
14534 mode++; /* JIM_VARLIST_VARS */
14535 /* fall through */
14536 case INFO_LOCALS:
14537 mode++; /* JIM_VARLIST_LOCALS */
14538 /* fall through */
14539 case INFO_GLOBALS:
14540 /* mode 0 => JIM_VARLIST_GLOBALS */
14541 if (argc != 2 && argc != 3) {
14542 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14543 return JIM_ERR;
14545 #ifdef jim_ext_namespace
14546 if (!nons) {
14547 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14548 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14551 #endif
14552 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14553 break;
14555 case INFO_SCRIPT:
14556 if (argc != 2) {
14557 Jim_WrongNumArgs(interp, 2, argv, "");
14558 return JIM_ERR;
14560 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14561 break;
14563 case INFO_SOURCE:{
14564 jim_wide line;
14565 Jim_Obj *resObjPtr;
14566 Jim_Obj *fileNameObj;
14568 if (argc != 3 && argc != 5) {
14569 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14570 return JIM_ERR;
14572 if (argc == 5) {
14573 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14574 return JIM_ERR;
14576 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14577 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14579 else {
14580 if (argv[2]->typePtr == &sourceObjType) {
14581 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14582 line = argv[2]->internalRep.sourceValue.lineNumber;
14584 else if (argv[2]->typePtr == &scriptObjType) {
14585 ScriptObj *script = JimGetScript(interp, argv[2]);
14586 fileNameObj = script->fileNameObj;
14587 line = script->firstline;
14589 else {
14590 fileNameObj = interp->emptyObj;
14591 line = 1;
14593 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14594 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14595 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14597 Jim_SetResult(interp, resObjPtr);
14598 break;
14601 case INFO_STACKTRACE:
14602 Jim_SetResult(interp, interp->stackTrace);
14603 break;
14605 case INFO_LEVEL:
14606 case INFO_FRAME:
14607 switch (argc) {
14608 case 2:
14609 Jim_SetResultInt(interp, interp->framePtr->level);
14610 break;
14612 case 3:
14613 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14614 return JIM_ERR;
14616 Jim_SetResult(interp, objPtr);
14617 break;
14619 default:
14620 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14621 return JIM_ERR;
14623 break;
14625 case INFO_BODY:
14626 case INFO_STATICS:
14627 case INFO_ARGS:{
14628 Jim_Cmd *cmdPtr;
14630 if (argc != 3) {
14631 Jim_WrongNumArgs(interp, 2, argv, "procname");
14632 return JIM_ERR;
14634 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14635 return JIM_ERR;
14637 if (!cmdPtr->isproc) {
14638 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14639 return JIM_ERR;
14641 switch (cmd) {
14642 case INFO_BODY:
14643 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14644 break;
14645 case INFO_ARGS:
14646 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14647 break;
14648 case INFO_STATICS:
14649 if (cmdPtr->u.proc.staticVars) {
14650 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14651 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14653 break;
14655 break;
14658 case INFO_VERSION:
14659 case INFO_PATCHLEVEL:{
14660 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14662 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14663 Jim_SetResultString(interp, buf, -1);
14664 break;
14667 case INFO_COMPLETE:
14668 if (argc != 3 && argc != 4) {
14669 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14670 return JIM_ERR;
14672 else {
14673 char missing;
14675 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14676 if (missing != ' ' && argc == 4) {
14677 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14680 break;
14682 case INFO_HOSTNAME:
14683 /* Redirect to os.gethostname if it exists */
14684 return Jim_Eval(interp, "os.gethostname");
14686 case INFO_NAMEOFEXECUTABLE:
14687 /* Redirect to Tcl proc */
14688 return Jim_Eval(interp, "{info nameofexecutable}");
14690 case INFO_RETURNCODES:
14691 if (argc == 2) {
14692 int i;
14693 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14695 for (i = 0; jimReturnCodes[i]; i++) {
14696 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14697 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14698 jimReturnCodes[i], -1));
14701 Jim_SetResult(interp, listObjPtr);
14703 else if (argc == 3) {
14704 long code;
14705 const char *name;
14707 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14708 return JIM_ERR;
14710 name = Jim_ReturnCode(code);
14711 if (*name == '?') {
14712 Jim_SetResultInt(interp, code);
14714 else {
14715 Jim_SetResultString(interp, name, -1);
14718 else {
14719 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14720 return JIM_ERR;
14722 break;
14723 case INFO_REFERENCES:
14724 #ifdef JIM_REFERENCES
14725 return JimInfoReferences(interp, argc, argv);
14726 #else
14727 Jim_SetResultString(interp, "not supported", -1);
14728 return JIM_ERR;
14729 #endif
14731 return JIM_OK;
14734 /* [exists] */
14735 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14737 Jim_Obj *objPtr;
14738 int result = 0;
14740 static const char * const options[] = {
14741 "-command", "-proc", "-alias", "-var", NULL
14743 enum
14745 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14747 int option;
14749 if (argc == 2) {
14750 option = OPT_VAR;
14751 objPtr = argv[1];
14753 else if (argc == 3) {
14754 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14755 return JIM_ERR;
14757 objPtr = argv[2];
14759 else {
14760 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14761 return JIM_ERR;
14764 if (option == OPT_VAR) {
14765 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14767 else {
14768 /* Now different kinds of commands */
14769 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14771 if (cmd) {
14772 switch (option) {
14773 case OPT_COMMAND:
14774 result = 1;
14775 break;
14777 case OPT_ALIAS:
14778 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14779 break;
14781 case OPT_PROC:
14782 result = cmd->isproc;
14783 break;
14787 Jim_SetResultBool(interp, result);
14788 return JIM_OK;
14791 /* [split] */
14792 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14794 const char *str, *splitChars, *noMatchStart;
14795 int splitLen, strLen;
14796 Jim_Obj *resObjPtr;
14797 int c;
14798 int len;
14800 if (argc != 2 && argc != 3) {
14801 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14802 return JIM_ERR;
14805 str = Jim_GetString(argv[1], &len);
14806 if (len == 0) {
14807 return JIM_OK;
14809 strLen = Jim_Utf8Length(interp, argv[1]);
14811 /* Init */
14812 if (argc == 2) {
14813 splitChars = " \n\t\r";
14814 splitLen = 4;
14816 else {
14817 splitChars = Jim_String(argv[2]);
14818 splitLen = Jim_Utf8Length(interp, argv[2]);
14821 noMatchStart = str;
14822 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14824 /* Split */
14825 if (splitLen) {
14826 Jim_Obj *objPtr;
14827 while (strLen--) {
14828 const char *sc = splitChars;
14829 int scLen = splitLen;
14830 int sl = utf8_tounicode(str, &c);
14831 while (scLen--) {
14832 int pc;
14833 sc += utf8_tounicode(sc, &pc);
14834 if (c == pc) {
14835 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14836 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14837 noMatchStart = str + sl;
14838 break;
14841 str += sl;
14843 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14844 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14846 else {
14847 /* This handles the special case of splitchars eq {}
14848 * Optimise by sharing common (ASCII) characters
14850 Jim_Obj **commonObj = NULL;
14851 #define NUM_COMMON (128 - 9)
14852 while (strLen--) {
14853 int n = utf8_tounicode(str, &c);
14854 #ifdef JIM_OPTIMIZATION
14855 if (c >= 9 && c < 128) {
14856 /* Common ASCII char. Note that 9 is the tab character */
14857 c -= 9;
14858 if (!commonObj) {
14859 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14860 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14862 if (!commonObj[c]) {
14863 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14865 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14866 str++;
14867 continue;
14869 #endif
14870 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14871 str += n;
14873 Jim_Free(commonObj);
14876 Jim_SetResult(interp, resObjPtr);
14877 return JIM_OK;
14880 /* [join] */
14881 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14883 const char *joinStr;
14884 int joinStrLen;
14886 if (argc != 2 && argc != 3) {
14887 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14888 return JIM_ERR;
14890 /* Init */
14891 if (argc == 2) {
14892 joinStr = " ";
14893 joinStrLen = 1;
14895 else {
14896 joinStr = Jim_GetString(argv[2], &joinStrLen);
14898 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14899 return JIM_OK;
14902 /* [format] */
14903 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14905 Jim_Obj *objPtr;
14907 if (argc < 2) {
14908 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14909 return JIM_ERR;
14911 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14912 if (objPtr == NULL)
14913 return JIM_ERR;
14914 Jim_SetResult(interp, objPtr);
14915 return JIM_OK;
14918 /* [scan] */
14919 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14921 Jim_Obj *listPtr, **outVec;
14922 int outc, i;
14924 if (argc < 3) {
14925 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14926 return JIM_ERR;
14928 if (argv[2]->typePtr != &scanFmtStringObjType)
14929 SetScanFmtFromAny(interp, argv[2]);
14930 if (FormatGetError(argv[2]) != 0) {
14931 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14932 return JIM_ERR;
14934 if (argc > 3) {
14935 int maxPos = FormatGetMaxPos(argv[2]);
14936 int count = FormatGetCnvCount(argv[2]);
14938 if (maxPos > argc - 3) {
14939 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14940 return JIM_ERR;
14942 else if (count > argc - 3) {
14943 Jim_SetResultString(interp, "different numbers of variable names and "
14944 "field specifiers", -1);
14945 return JIM_ERR;
14947 else if (count < argc - 3) {
14948 Jim_SetResultString(interp, "variable is not assigned by any "
14949 "conversion specifiers", -1);
14950 return JIM_ERR;
14953 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14954 if (listPtr == 0)
14955 return JIM_ERR;
14956 if (argc > 3) {
14957 int rc = JIM_OK;
14958 int count = 0;
14960 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14961 int len = Jim_ListLength(interp, listPtr);
14963 if (len != 0) {
14964 JimListGetElements(interp, listPtr, &outc, &outVec);
14965 for (i = 0; i < outc; ++i) {
14966 if (Jim_Length(outVec[i]) > 0) {
14967 ++count;
14968 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14969 rc = JIM_ERR;
14974 Jim_FreeNewObj(interp, listPtr);
14976 else {
14977 count = -1;
14979 if (rc == JIM_OK) {
14980 Jim_SetResultInt(interp, count);
14982 return rc;
14984 else {
14985 if (listPtr == (Jim_Obj *)EOF) {
14986 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14987 return JIM_OK;
14989 Jim_SetResult(interp, listPtr);
14991 return JIM_OK;
14994 /* [error] */
14995 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14997 if (argc != 2 && argc != 3) {
14998 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14999 return JIM_ERR;
15001 Jim_SetResult(interp, argv[1]);
15002 if (argc == 3) {
15003 JimSetStackTrace(interp, argv[2]);
15004 return JIM_ERR;
15006 interp->addStackTrace++;
15007 return JIM_ERR;
15010 /* [lrange] */
15011 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15013 Jim_Obj *objPtr;
15015 if (argc != 4) {
15016 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15017 return JIM_ERR;
15019 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15020 return JIM_ERR;
15021 Jim_SetResult(interp, objPtr);
15022 return JIM_OK;
15025 /* [lrepeat] */
15026 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15028 Jim_Obj *objPtr;
15029 long count;
15031 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15032 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15033 return JIM_ERR;
15036 if (count == 0 || argc == 2) {
15037 return JIM_OK;
15040 argc -= 2;
15041 argv += 2;
15043 objPtr = Jim_NewListObj(interp, argv, argc);
15044 while (--count) {
15045 ListInsertElements(objPtr, -1, argc, argv);
15048 Jim_SetResult(interp, objPtr);
15049 return JIM_OK;
15052 char **Jim_GetEnviron(void)
15054 #if defined(HAVE__NSGETENVIRON)
15055 return *_NSGetEnviron();
15056 #else
15057 #if !defined(NO_ENVIRON_EXTERN)
15058 extern char **environ;
15059 #endif
15061 return environ;
15062 #endif
15065 void Jim_SetEnviron(char **env)
15067 #if defined(HAVE__NSGETENVIRON)
15068 *_NSGetEnviron() = env;
15069 #else
15070 #if !defined(NO_ENVIRON_EXTERN)
15071 extern char **environ;
15072 #endif
15074 environ = env;
15075 #endif
15078 /* [env] */
15079 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15081 const char *key;
15082 const char *val;
15084 if (argc == 1) {
15085 char **e = Jim_GetEnviron();
15087 int i;
15088 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15090 for (i = 0; e[i]; i++) {
15091 const char *equals = strchr(e[i], '=');
15093 if (equals) {
15094 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15095 equals - e[i]));
15096 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15100 Jim_SetResult(interp, listObjPtr);
15101 return JIM_OK;
15104 if (argc < 2) {
15105 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15106 return JIM_ERR;
15108 key = Jim_String(argv[1]);
15109 val = getenv(key);
15110 if (val == NULL) {
15111 if (argc < 3) {
15112 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15113 return JIM_ERR;
15115 val = Jim_String(argv[2]);
15117 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15118 return JIM_OK;
15121 /* [source] */
15122 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15124 int retval;
15126 if (argc != 2) {
15127 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15128 return JIM_ERR;
15130 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15131 if (retval == JIM_RETURN)
15132 return JIM_OK;
15133 return retval;
15136 /* [lreverse] */
15137 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15139 Jim_Obj *revObjPtr, **ele;
15140 int len;
15142 if (argc != 2) {
15143 Jim_WrongNumArgs(interp, 1, argv, "list");
15144 return JIM_ERR;
15146 JimListGetElements(interp, argv[1], &len, &ele);
15147 len--;
15148 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15149 while (len >= 0)
15150 ListAppendElement(revObjPtr, ele[len--]);
15151 Jim_SetResult(interp, revObjPtr);
15152 return JIM_OK;
15155 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15157 jim_wide len;
15159 if (step == 0)
15160 return -1;
15161 if (start == end)
15162 return 0;
15163 else if (step > 0 && start > end)
15164 return -1;
15165 else if (step < 0 && end > start)
15166 return -1;
15167 len = end - start;
15168 if (len < 0)
15169 len = -len; /* abs(len) */
15170 if (step < 0)
15171 step = -step; /* abs(step) */
15172 len = 1 + ((len - 1) / step);
15173 /* We can truncate safely to INT_MAX, the range command
15174 * will always return an error for a such long range
15175 * because Tcl lists can't be so long. */
15176 if (len > INT_MAX)
15177 len = INT_MAX;
15178 return (int)((len < 0) ? -1 : len);
15181 /* [range] */
15182 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15184 jim_wide start = 0, end, step = 1;
15185 int len, i;
15186 Jim_Obj *objPtr;
15188 if (argc < 2 || argc > 4) {
15189 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15190 return JIM_ERR;
15192 if (argc == 2) {
15193 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15194 return JIM_ERR;
15196 else {
15197 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15198 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15199 return JIM_ERR;
15200 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15201 return JIM_ERR;
15203 if ((len = JimRangeLen(start, end, step)) == -1) {
15204 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15205 return JIM_ERR;
15207 objPtr = Jim_NewListObj(interp, NULL, 0);
15208 for (i = 0; i < len; i++)
15209 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15210 Jim_SetResult(interp, objPtr);
15211 return JIM_OK;
15214 /* [rand] */
15215 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15217 jim_wide min = 0, max = 0, len, maxMul;
15219 if (argc < 1 || argc > 3) {
15220 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15221 return JIM_ERR;
15223 if (argc == 1) {
15224 max = JIM_WIDE_MAX;
15225 } else if (argc == 2) {
15226 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15227 return JIM_ERR;
15228 } else if (argc == 3) {
15229 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15230 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15231 return JIM_ERR;
15233 len = max-min;
15234 if (len < 0) {
15235 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15236 return JIM_ERR;
15238 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15239 while (1) {
15240 jim_wide r;
15242 JimRandomBytes(interp, &r, sizeof(jim_wide));
15243 if (r < 0 || r >= maxMul) continue;
15244 r = (len == 0) ? 0 : r%len;
15245 Jim_SetResultInt(interp, min+r);
15246 return JIM_OK;
15250 static const struct {
15251 const char *name;
15252 Jim_CmdProc *cmdProc;
15253 } Jim_CoreCommandsTable[] = {
15254 {"alias", Jim_AliasCoreCommand},
15255 {"set", Jim_SetCoreCommand},
15256 {"unset", Jim_UnsetCoreCommand},
15257 {"puts", Jim_PutsCoreCommand},
15258 {"+", Jim_AddCoreCommand},
15259 {"*", Jim_MulCoreCommand},
15260 {"-", Jim_SubCoreCommand},
15261 {"/", Jim_DivCoreCommand},
15262 {"incr", Jim_IncrCoreCommand},
15263 {"while", Jim_WhileCoreCommand},
15264 {"loop", Jim_LoopCoreCommand},
15265 {"for", Jim_ForCoreCommand},
15266 {"foreach", Jim_ForeachCoreCommand},
15267 {"lmap", Jim_LmapCoreCommand},
15268 {"lassign", Jim_LassignCoreCommand},
15269 {"if", Jim_IfCoreCommand},
15270 {"switch", Jim_SwitchCoreCommand},
15271 {"list", Jim_ListCoreCommand},
15272 {"lindex", Jim_LindexCoreCommand},
15273 {"lset", Jim_LsetCoreCommand},
15274 {"lsearch", Jim_LsearchCoreCommand},
15275 {"llength", Jim_LlengthCoreCommand},
15276 {"lappend", Jim_LappendCoreCommand},
15277 {"linsert", Jim_LinsertCoreCommand},
15278 {"lreplace", Jim_LreplaceCoreCommand},
15279 {"lsort", Jim_LsortCoreCommand},
15280 {"append", Jim_AppendCoreCommand},
15281 {"debug", Jim_DebugCoreCommand},
15282 {"eval", Jim_EvalCoreCommand},
15283 {"uplevel", Jim_UplevelCoreCommand},
15284 {"expr", Jim_ExprCoreCommand},
15285 {"break", Jim_BreakCoreCommand},
15286 {"continue", Jim_ContinueCoreCommand},
15287 {"proc", Jim_ProcCoreCommand},
15288 {"concat", Jim_ConcatCoreCommand},
15289 {"return", Jim_ReturnCoreCommand},
15290 {"upvar", Jim_UpvarCoreCommand},
15291 {"global", Jim_GlobalCoreCommand},
15292 {"string", Jim_StringCoreCommand},
15293 {"time", Jim_TimeCoreCommand},
15294 {"exit", Jim_ExitCoreCommand},
15295 {"catch", Jim_CatchCoreCommand},
15296 #ifdef JIM_REFERENCES
15297 {"ref", Jim_RefCoreCommand},
15298 {"getref", Jim_GetrefCoreCommand},
15299 {"setref", Jim_SetrefCoreCommand},
15300 {"finalize", Jim_FinalizeCoreCommand},
15301 {"collect", Jim_CollectCoreCommand},
15302 #endif
15303 {"rename", Jim_RenameCoreCommand},
15304 {"dict", Jim_DictCoreCommand},
15305 {"subst", Jim_SubstCoreCommand},
15306 {"info", Jim_InfoCoreCommand},
15307 {"exists", Jim_ExistsCoreCommand},
15308 {"split", Jim_SplitCoreCommand},
15309 {"join", Jim_JoinCoreCommand},
15310 {"format", Jim_FormatCoreCommand},
15311 {"scan", Jim_ScanCoreCommand},
15312 {"error", Jim_ErrorCoreCommand},
15313 {"lrange", Jim_LrangeCoreCommand},
15314 {"lrepeat", Jim_LrepeatCoreCommand},
15315 {"env", Jim_EnvCoreCommand},
15316 {"source", Jim_SourceCoreCommand},
15317 {"lreverse", Jim_LreverseCoreCommand},
15318 {"range", Jim_RangeCoreCommand},
15319 {"rand", Jim_RandCoreCommand},
15320 {"tailcall", Jim_TailcallCoreCommand},
15321 {"local", Jim_LocalCoreCommand},
15322 {"upcall", Jim_UpcallCoreCommand},
15323 {"apply", Jim_ApplyCoreCommand},
15324 {NULL, NULL},
15327 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15329 int i = 0;
15331 while (Jim_CoreCommandsTable[i].name != NULL) {
15332 Jim_CreateCommand(interp,
15333 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15334 i++;
15338 /* -----------------------------------------------------------------------------
15339 * Interactive prompt
15340 * ---------------------------------------------------------------------------*/
15341 void Jim_MakeErrorMessage(Jim_Interp *interp)
15343 Jim_Obj *argv[2];
15345 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15346 argv[1] = interp->result;
15348 Jim_EvalObjVector(interp, 2, argv);
15352 * Given a null terminated array of strings, returns an allocated, sorted
15353 * copy of the array.
15355 static char **JimSortStringTable(const char *const *tablePtr)
15357 int count;
15358 char **tablePtrSorted;
15360 /* Find the size of the table */
15361 for (count = 0; tablePtr[count]; count++) {
15364 /* Allocate one extra for the terminating NULL pointer */
15365 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15366 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15367 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15368 tablePtrSorted[count] = NULL;
15370 return tablePtrSorted;
15373 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15374 const char *prefix, const char *const *tablePtr, const char *name)
15376 char **tablePtrSorted;
15377 int i;
15379 if (name == NULL) {
15380 name = "option";
15383 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15384 tablePtrSorted = JimSortStringTable(tablePtr);
15385 for (i = 0; tablePtrSorted[i]; i++) {
15386 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15387 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15389 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15390 if (tablePtrSorted[i + 1]) {
15391 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15394 Jim_Free(tablePtrSorted);
15399 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15400 * and returns JIM_OK.
15402 * Otherwise returns JIM_ERR.
15404 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15406 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15407 int i;
15408 char **tablePtrSorted = JimSortStringTable(tablePtr);
15409 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15410 for (i = 0; tablePtrSorted[i]; i++) {
15411 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15413 Jim_Free(tablePtrSorted);
15414 return JIM_OK;
15416 return JIM_ERR;
15419 /* internal rep is stored in ptrIntvalue
15420 * ptr = tablePtr
15421 * int1 = flags
15422 * int2 = index
15424 static const Jim_ObjType getEnumObjType = {
15425 "get-enum",
15426 NULL,
15427 NULL,
15428 NULL,
15429 JIM_TYPE_REFERENCES
15432 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15433 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15435 const char *bad = "bad ";
15436 const char *const *entryPtr = NULL;
15437 int i;
15438 int match = -1;
15439 int arglen;
15440 const char *arg;
15442 if (objPtr->typePtr == &getEnumObjType) {
15443 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15444 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15445 return JIM_OK;
15449 arg = Jim_GetString(objPtr, &arglen);
15451 *indexPtr = -1;
15453 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15454 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15455 /* Found an exact match */
15456 match = i;
15457 goto found;
15459 if (flags & JIM_ENUM_ABBREV) {
15460 /* Accept an unambiguous abbreviation.
15461 * Note that '-' doesnt' consitute a valid abbreviation
15463 if (strncmp(arg, *entryPtr, arglen) == 0) {
15464 if (*arg == '-' && arglen == 1) {
15465 break;
15467 if (match >= 0) {
15468 bad = "ambiguous ";
15469 goto ambiguous;
15471 match = i;
15476 /* If we had an unambiguous partial match */
15477 if (match >= 0) {
15478 found:
15479 /* Record the match in the object */
15480 Jim_FreeIntRep(interp, objPtr);
15481 objPtr->typePtr = &getEnumObjType;
15482 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15483 objPtr->internalRep.ptrIntValue.int1 = flags;
15484 objPtr->internalRep.ptrIntValue.int2 = match;
15485 /* Return the result */
15486 *indexPtr = match;
15487 return JIM_OK;
15490 ambiguous:
15491 if (flags & JIM_ERRMSG) {
15492 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15494 return JIM_ERR;
15497 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15499 int i;
15501 for (i = 0; i < (int)len; i++) {
15502 if (array[i] && strcmp(array[i], name) == 0) {
15503 return i;
15506 return -1;
15509 int Jim_IsDict(Jim_Obj *objPtr)
15511 return objPtr->typePtr == &dictObjType;
15514 int Jim_IsList(Jim_Obj *objPtr)
15516 return objPtr->typePtr == &listObjType;
15520 * Very simple printf-like formatting, designed for error messages.
15522 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15523 * The resulting string is created and set as the result.
15525 * Each '%s' should correspond to a regular string parameter.
15526 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15527 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15529 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15531 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15533 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15535 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15537 /* Initial space needed */
15538 int len = strlen(format);
15539 int extra = 0;
15540 int n = 0;
15541 const char *params[5];
15542 int nobjparam = 0;
15543 Jim_Obj *objparam[5];
15544 char *buf;
15545 va_list args;
15546 int i;
15548 va_start(args, format);
15550 for (i = 0; i < len && n < 5; i++) {
15551 int l;
15553 if (strncmp(format + i, "%s", 2) == 0) {
15554 params[n] = va_arg(args, char *);
15556 l = strlen(params[n]);
15558 else if (strncmp(format + i, "%#s", 3) == 0) {
15559 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15561 params[n] = Jim_GetString(objPtr, &l);
15562 objparam[nobjparam++] = objPtr;
15563 Jim_IncrRefCount(objPtr);
15565 else {
15566 if (format[i] == '%') {
15567 i++;
15569 continue;
15571 n++;
15572 extra += l;
15575 len += extra;
15576 buf = Jim_Alloc(len + 1);
15577 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15579 va_end(args);
15581 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15583 for (i = 0; i < nobjparam; i++) {
15584 Jim_DecrRefCount(interp, objparam[i]);
15588 /* stubs */
15589 #ifndef jim_ext_package
15590 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15592 return JIM_OK;
15594 #endif
15595 #ifndef jim_ext_aio
15596 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15598 Jim_SetResultString(interp, "aio not enabled", -1);
15599 return NULL;
15601 #endif
15605 * Local Variables: ***
15606 * c-basic-offset: 4 ***
15607 * tab-width: 4 ***
15608 * End: ***