build: improve build for shared objects
[jimtcl.git] / jim.c
blobab67141aba386631dbf85a7515f7db42bb515f51
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44 #ifndef _GNU_SOURCE
45 #define _GNU_SOURCE /* Mostly just for environ */
46 #endif
48 #include <stdio.h>
49 #include <stdlib.h>
51 #include <string.h>
52 #include <stdarg.h>
53 #include <ctype.h>
54 #include <limits.h>
55 #include <assert.h>
56 #include <errno.h>
57 #include <time.h>
58 #include <setjmp.h>
60 #include "jim.h"
61 #include "jimautoconf.h"
62 #include "utf8.h"
64 #ifdef HAVE_SYS_TIME_H
65 #include <sys/time.h>
66 #endif
67 #ifdef HAVE_BACKTRACE
68 #include <execinfo.h>
69 #endif
70 #ifdef HAVE_CRT_EXTERNS_H
71 #include <crt_externs.h>
72 #endif
74 /* For INFINITY, even if math functions are not enabled */
75 #include <math.h>
77 /* We may decide to switch to using $[...] after all, so leave it as an option */
78 /*#define EXPRSUGAR_BRACKET*/
80 /* For the no-autoconf case */
81 #ifndef TCL_LIBRARY
82 #define TCL_LIBRARY "."
83 #endif
84 #ifndef TCL_PLATFORM_OS
85 #define TCL_PLATFORM_OS "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PLATFORM
88 #define TCL_PLATFORM_PLATFORM "unknown"
89 #endif
90 #ifndef TCL_PLATFORM_PATH_SEPARATOR
91 #define TCL_PLATFORM_PATH_SEPARATOR ":"
92 #endif
94 /*#define DEBUG_SHOW_SCRIPT*/
95 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
96 /*#define DEBUG_SHOW_SUBST*/
97 /*#define DEBUG_SHOW_EXPR*/
98 /*#define DEBUG_SHOW_EXPR_TOKENS*/
99 /*#define JIM_DEBUG_GC*/
100 #ifdef JIM_MAINTAINER
101 #define JIM_DEBUG_COMMAND
102 #define JIM_DEBUG_PANIC
103 #endif
104 /* Enable this (in conjunction with valgrind) to help debug
105 * reference counting issues
107 /*#define JIM_DISABLE_OBJECT_POOL*/
109 /* Maximum size of an integer */
110 #define JIM_INTEGER_SPACE 24
112 const char *jim_tt_name(int type);
114 #ifdef JIM_DEBUG_PANIC
115 static void JimPanicDump(int fail_condition, const char *fmt, ...);
116 #define JimPanic(X) JimPanicDump X
117 #else
118 #define JimPanic(X)
119 #endif
121 #ifdef JIM_OPTIMIZATION
122 #define JIM_IF_OPTIM(X) X
123 #else
124 #define JIM_IF_OPTIM(X)
125 #endif
127 /* -----------------------------------------------------------------------------
128 * Global variables
129 * ---------------------------------------------------------------------------*/
131 /* A shared empty string for the objects string representation.
132 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
133 static char JimEmptyStringRep[] = "";
135 /* -----------------------------------------------------------------------------
136 * Required prototypes of not exported functions
137 * ---------------------------------------------------------------------------*/
138 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
139 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
140 int flags);
141 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
142 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
143 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
144 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
145 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
146 const char *prefix, const char *const *tablePtr, const char *name);
147 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
148 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
149 static int JimSign(jim_wide w);
150 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
151 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
152 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
155 /* Fast access to the int (wide) value of an object which is known to be of int type */
156 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
158 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
160 static int utf8_tounicode_case(const char *s, int *uc, int upper)
162 int l = utf8_tounicode(s, uc);
163 if (upper) {
164 *uc = utf8_upper(*uc);
166 return l;
169 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
170 #define JIM_CHARSET_SCAN 2
171 #define JIM_CHARSET_GLOB 0
174 * pattern points to a string like "[^a-z\ub5]"
176 * The pattern may contain trailing chars, which are ignored.
178 * The pattern is matched against unicode char 'c'.
180 * If (flags & JIM_NOCASE), case is ignored when matching.
181 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
182 * of the charset, per scan, rather than glob/string match.
184 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
185 * or the null character if the ']' is missing.
187 * Returns NULL on no match.
189 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
191 int not = 0;
192 int pchar;
193 int match = 0;
194 int nocase = 0;
196 if (flags & JIM_NOCASE) {
197 nocase++;
198 c = utf8_upper(c);
201 if (flags & JIM_CHARSET_SCAN) {
202 if (*pattern == '^') {
203 not++;
204 pattern++;
207 /* Special case. If the first char is ']', it is part of the set */
208 if (*pattern == ']') {
209 goto first;
213 while (*pattern && *pattern != ']') {
214 /* Exact match */
215 if (pattern[0] == '\\') {
216 first:
217 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
219 else {
220 /* Is this a range? a-z */
221 int start;
222 int end;
224 pattern += utf8_tounicode_case(pattern, &start, nocase);
225 if (pattern[0] == '-' && pattern[1]) {
226 /* skip '-' */
227 pattern++;
228 pattern += utf8_tounicode_case(pattern, &end, nocase);
230 /* Handle reversed range too */
231 if ((c >= start && c <= end) || (c >= end && c <= start)) {
232 match = 1;
234 continue;
236 pchar = start;
239 if (pchar == c) {
240 match = 1;
243 if (not) {
244 match = !match;
247 return match ? pattern : NULL;
250 /* Glob-style pattern matching. */
252 /* Note: string *must* be valid UTF-8 sequences
254 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
256 int c;
257 int pchar;
258 while (*pattern) {
259 switch (pattern[0]) {
260 case '*':
261 while (pattern[1] == '*') {
262 pattern++;
264 pattern++;
265 if (!pattern[0]) {
266 return 1; /* match */
268 while (*string) {
269 /* Recursive call - Does the remaining pattern match anywhere? */
270 if (JimGlobMatch(pattern, string, nocase))
271 return 1; /* match */
272 string += utf8_tounicode(string, &c);
274 return 0; /* no match */
276 case '?':
277 string += utf8_tounicode(string, &c);
278 break;
280 case '[': {
281 string += utf8_tounicode(string, &c);
282 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
283 if (!pattern) {
284 return 0;
286 if (!*pattern) {
287 /* Ran out of pattern (no ']') */
288 continue;
290 break;
292 case '\\':
293 if (pattern[1]) {
294 pattern++;
296 /* fall through */
297 default:
298 string += utf8_tounicode_case(string, &c, nocase);
299 utf8_tounicode_case(pattern, &pchar, nocase);
300 if (pchar != c) {
301 return 0;
303 break;
305 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
306 if (!*string) {
307 while (*pattern == '*') {
308 pattern++;
310 break;
313 if (!*pattern && !*string) {
314 return 1;
316 return 0;
320 * string comparison. Works on binary data.
322 * Returns -1, 0 or 1
324 * Note that the lengths are byte lengths, not char lengths.
326 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
328 if (l1 < l2) {
329 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
331 else if (l2 < l1) {
332 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
334 else {
335 return JimSign(memcmp(s1, s2, l1));
340 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
341 * (or end of string if 'maxchars' is -1).
343 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
345 * Note: does not support embedded nulls.
347 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
349 while (*s1 && *s2 && maxchars) {
350 int c1, c2;
351 s1 += utf8_tounicode_case(s1, &c1, nocase);
352 s2 += utf8_tounicode_case(s2, &c2, nocase);
353 if (c1 != c2) {
354 return JimSign(c1 - c2);
356 maxchars--;
358 if (!maxchars) {
359 return 0;
361 /* One string or both terminated */
362 if (*s1) {
363 return 1;
365 if (*s2) {
366 return -1;
368 return 0;
371 /* Search for 's1' inside 's2', starting to search from char 'index' of 's2'.
372 * The index of the first occurrence of s1 in s2 is returned.
373 * If s1 is not found inside s2, -1 is returned.
375 * Note: Lengths and return value are in bytes, not chars.
377 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
379 int i;
380 int l1bytelen;
382 if (!l1 || !l2 || l1 > l2) {
383 return -1;
385 if (idx < 0)
386 idx = 0;
387 s2 += utf8_index(s2, idx);
389 l1bytelen = utf8_index(s1, l1);
391 for (i = idx; i <= l2 - l1; i++) {
392 int c;
393 if (memcmp(s2, s1, l1bytelen) == 0) {
394 return i;
396 s2 += utf8_tounicode(s2, &c);
398 return -1;
401 /* Search for the last occurrence 's1' inside 's2', starting to search from char 'index' of 's2'.
402 * The index of the last occurrence of s1 in s2 is returned.
403 * If s1 is not found inside s2, -1 is returned.
405 * Note: Lengths and return value are in bytes, not chars.
407 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
409 const char *p;
411 if (!l1 || !l2 || l1 > l2)
412 return -1;
414 /* Now search for the needle */
415 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
416 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
417 return p - s2;
420 return -1;
423 #ifdef JIM_UTF8
425 * Per JimStringLast but lengths and return value are in chars, not bytes.
427 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
429 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
430 if (n > 0) {
431 n = utf8_strlen(s2, n);
433 return n;
435 #endif
438 * After an strtol()/strtod()-like conversion,
439 * check whether something was converted and that
440 * the only thing left is white space.
442 * Returns JIM_OK or JIM_ERR.
444 static int JimCheckConversion(const char *str, const char *endptr)
446 if (str[0] == '\0' || str == endptr) {
447 return JIM_ERR;
450 if (endptr[0] != '\0') {
451 while (*endptr) {
452 if (!isspace(UCHAR(*endptr))) {
453 return JIM_ERR;
455 endptr++;
458 return JIM_OK;
461 /* Parses the front of a number to determine its sign and base.
462 * Returns the index to start parsing according to the given base
464 static int JimNumberBase(const char *str, int *base, int *sign)
466 int i = 0;
468 *base = 10;
470 while (isspace(UCHAR(str[i]))) {
471 i++;
474 if (str[i] == '-') {
475 *sign = -1;
476 i++;
478 else {
479 if (str[i] == '+') {
480 i++;
482 *sign = 1;
485 if (str[i] != '0') {
486 /* base 10 */
487 return 0;
490 /* We have 0<x>, so see if we can convert it */
491 switch (str[i + 1]) {
492 case 'x': case 'X': *base = 16; break;
493 case 'o': case 'O': *base = 8; break;
494 case 'b': case 'B': *base = 2; break;
495 default: return 0;
497 i += 2;
498 /* Ensure that (e.g.) 0x-5 fails to parse */
499 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
500 /* Parse according to this base */
501 return i;
503 /* Parse as base 10 */
504 *base = 10;
505 return 0;
508 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
509 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
511 static long jim_strtol(const char *str, char **endptr)
513 int sign;
514 int base;
515 int i = JimNumberBase(str, &base, &sign);
517 if (base != 10) {
518 long value = strtol(str + i, endptr, base);
519 if (endptr == NULL || *endptr != str + i) {
520 return value * sign;
524 /* Can just do a regular base-10 conversion */
525 return strtol(str, endptr, 10);
529 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
530 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
532 static jim_wide jim_strtoull(const char *str, char **endptr)
534 #ifdef HAVE_LONG_LONG
535 int sign;
536 int base;
537 int i = JimNumberBase(str, &base, &sign);
539 if (base != 10) {
540 jim_wide value = strtoull(str + i, endptr, base);
541 if (endptr == NULL || *endptr != str + i) {
542 return value * sign;
546 /* Can just do a regular base-10 conversion */
547 return strtoull(str, endptr, 10);
548 #else
549 return (unsigned long)jim_strtol(str, endptr);
550 #endif
553 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
555 char *endptr;
557 if (base) {
558 *widePtr = strtoull(str, &endptr, base);
560 else {
561 *widePtr = jim_strtoull(str, &endptr);
564 return JimCheckConversion(str, endptr);
567 int Jim_StringToDouble(const char *str, double *doublePtr)
569 char *endptr;
571 /* Callers can check for underflow via ERANGE */
572 errno = 0;
574 *doublePtr = strtod(str, &endptr);
576 return JimCheckConversion(str, endptr);
579 static jim_wide JimPowWide(jim_wide b, jim_wide e)
581 jim_wide res = 1;
583 /* Special cases */
584 if (b == 1) {
585 /* 1 ^ any = 1 */
586 return 1;
588 if (e < 0) {
589 if (b != -1) {
590 return 0;
592 /* Only special case is -1 ^ -n
593 * -1^-1 = -1
594 * -1^-2 = 1
595 * i.e. same as +ve n
597 e = -e;
599 while (e)
601 if (e & 1) {
602 res *= b;
604 e >>= 1;
605 b *= b;
607 return res;
610 /* -----------------------------------------------------------------------------
611 * Special functions
612 * ---------------------------------------------------------------------------*/
613 #ifdef JIM_DEBUG_PANIC
614 static void JimPanicDump(int condition, const char *fmt, ...)
616 va_list ap;
618 if (!condition) {
619 return;
622 va_start(ap, fmt);
624 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
625 vfprintf(stderr, fmt, ap);
626 fprintf(stderr, "\n\n");
627 va_end(ap);
629 #ifdef HAVE_BACKTRACE
631 void *array[40];
632 int size, i;
633 char **strings;
635 size = backtrace(array, 40);
636 strings = backtrace_symbols(array, size);
637 for (i = 0; i < size; i++)
638 fprintf(stderr, "[backtrace] %s\n", strings[i]);
639 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
640 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
642 #endif
644 exit(1);
646 #endif
648 /* -----------------------------------------------------------------------------
649 * Memory allocation
650 * ---------------------------------------------------------------------------*/
652 void *Jim_Alloc(int size)
654 return size ? malloc(size) : NULL;
657 void Jim_Free(void *ptr)
659 free(ptr);
662 void *Jim_Realloc(void *ptr, int size)
664 return realloc(ptr, size);
667 char *Jim_StrDup(const char *s)
669 return strdup(s);
672 char *Jim_StrDupLen(const char *s, int l)
674 char *copy = Jim_Alloc(l + 1);
676 memcpy(copy, s, l + 1);
677 copy[l] = 0; /* Just to be sure, original could be substring */
678 return copy;
681 /* -----------------------------------------------------------------------------
682 * Time related functions
683 * ---------------------------------------------------------------------------*/
685 /* Returns current time in microseconds */
686 static jim_wide JimClock(void)
688 struct timeval tv;
690 gettimeofday(&tv, NULL);
691 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
694 /* -----------------------------------------------------------------------------
695 * Hash Tables
696 * ---------------------------------------------------------------------------*/
698 /* -------------------------- private prototypes ---------------------------- */
699 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
700 static unsigned int JimHashTableNextPower(unsigned int size);
701 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
703 /* -------------------------- hash functions -------------------------------- */
705 /* Thomas Wang's 32 bit Mix Function */
706 unsigned int Jim_IntHashFunction(unsigned int key)
708 key += ~(key << 15);
709 key ^= (key >> 10);
710 key += (key << 3);
711 key ^= (key >> 6);
712 key += ~(key << 11);
713 key ^= (key >> 16);
714 return key;
717 /* Generic hash function (we are using to multiply by 9 and add the byte
718 * as Tcl) */
719 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
721 unsigned int h = 0;
723 while (len--)
724 h += (h << 3) + *buf++;
725 return h;
728 /* ----------------------------- API implementation ------------------------- */
730 /* reset a hashtable already initialized */
731 static void JimResetHashTable(Jim_HashTable *ht)
733 ht->table = NULL;
734 ht->size = 0;
735 ht->sizemask = 0;
736 ht->used = 0;
737 ht->collisions = 0;
738 #ifdef JIM_RANDOMISE_HASH
739 /* This is initialised to a random value to avoid a hash collision attack.
740 * See: n.runs-SA-2011.004
742 ht->uniq = (rand() ^ time(NULL) ^ clock());
743 #else
744 ht->uniq = 0;
745 #endif
748 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
750 iter->ht = ht;
751 iter->index = -1;
752 iter->entry = NULL;
753 iter->nextEntry = NULL;
756 /* Initialize the hash table */
757 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
759 JimResetHashTable(ht);
760 ht->type = type;
761 ht->privdata = privDataPtr;
762 return JIM_OK;
765 /* Expand or create the hashtable */
766 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
768 Jim_HashTable n; /* the new hashtable */
769 unsigned int realsize = JimHashTableNextPower(size), i;
771 /* the size is invalid if it is smaller than the number of
772 * elements already inside the hashtable */
773 if (size <= ht->used)
774 return;
776 Jim_InitHashTable(&n, ht->type, ht->privdata);
777 n.size = realsize;
778 n.sizemask = realsize - 1;
779 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
780 /* Keep the same 'uniq' as the original */
781 n.uniq = ht->uniq;
783 /* Initialize all the pointers to NULL */
784 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
786 /* Copy all the elements from the old to the new table:
787 * note that if the old hash table is empty ht->used is zero,
788 * so Jim_ExpandHashTable just creates an empty hash table. */
789 n.used = ht->used;
790 for (i = 0; ht->used > 0; i++) {
791 Jim_HashEntry *he, *nextHe;
793 if (ht->table[i] == NULL)
794 continue;
796 /* For each hash entry on this slot... */
797 he = ht->table[i];
798 while (he) {
799 unsigned int h;
801 nextHe = he->next;
802 /* Get the new element index */
803 h = Jim_HashKey(ht, he->key) & n.sizemask;
804 he->next = n.table[h];
805 n.table[h] = he;
806 ht->used--;
807 /* Pass to the next element */
808 he = nextHe;
811 assert(ht->used == 0);
812 Jim_Free(ht->table);
814 /* Remap the new hashtable in the old */
815 *ht = n;
818 /* Add an element to the target hash table */
819 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
821 Jim_HashEntry *entry;
823 /* Get the index of the new element, or -1 if
824 * the element already exists. */
825 entry = JimInsertHashEntry(ht, key, 0);
826 if (entry == NULL)
827 return JIM_ERR;
829 /* Set the hash entry fields. */
830 Jim_SetHashKey(ht, entry, key);
831 Jim_SetHashVal(ht, entry, val);
832 return JIM_OK;
835 /* Add an element, discarding the old if the key already exists */
836 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
838 int existed;
839 Jim_HashEntry *entry;
841 /* Get the index of the new element, or -1 if
842 * the element already exists. */
843 entry = JimInsertHashEntry(ht, key, 1);
844 if (entry->key) {
845 /* It already exists, so only replace the value.
846 * Note if both a destructor and a duplicate function exist,
847 * need to dup before destroy. perhaps they are the same
848 * reference counted object
850 if (ht->type->valDestructor && ht->type->valDup) {
851 void *newval = ht->type->valDup(ht->privdata, val);
852 ht->type->valDestructor(ht->privdata, entry->u.val);
853 entry->u.val = newval;
855 else {
856 Jim_FreeEntryVal(ht, entry);
857 Jim_SetHashVal(ht, entry, val);
859 existed = 1;
861 else {
862 /* Doesn't exist, so set the key */
863 Jim_SetHashKey(ht, entry, key);
864 Jim_SetHashVal(ht, entry, val);
865 existed = 0;
868 return existed;
871 /* Search and remove an element */
872 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
874 unsigned int h;
875 Jim_HashEntry *he, *prevHe;
877 if (ht->used == 0)
878 return JIM_ERR;
879 h = Jim_HashKey(ht, key) & ht->sizemask;
880 he = ht->table[h];
882 prevHe = NULL;
883 while (he) {
884 if (Jim_CompareHashKeys(ht, key, he->key)) {
885 /* Unlink the element from the list */
886 if (prevHe)
887 prevHe->next = he->next;
888 else
889 ht->table[h] = he->next;
890 Jim_FreeEntryKey(ht, he);
891 Jim_FreeEntryVal(ht, he);
892 Jim_Free(he);
893 ht->used--;
894 return JIM_OK;
896 prevHe = he;
897 he = he->next;
899 return JIM_ERR; /* not found */
902 /* Destroy an entire hash table and leave it ready for reuse */
903 int Jim_FreeHashTable(Jim_HashTable *ht)
905 unsigned int i;
907 /* Free all the elements */
908 for (i = 0; ht->used > 0; i++) {
909 Jim_HashEntry *he, *nextHe;
911 if ((he = ht->table[i]) == NULL)
912 continue;
913 while (he) {
914 nextHe = he->next;
915 Jim_FreeEntryKey(ht, he);
916 Jim_FreeEntryVal(ht, he);
917 Jim_Free(he);
918 ht->used--;
919 he = nextHe;
922 /* Free the table and the allocated cache structure */
923 Jim_Free(ht->table);
924 /* Re-initialize the table */
925 JimResetHashTable(ht);
926 return JIM_OK; /* never fails */
929 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
931 Jim_HashEntry *he;
932 unsigned int h;
934 if (ht->used == 0)
935 return NULL;
936 h = Jim_HashKey(ht, key) & ht->sizemask;
937 he = ht->table[h];
938 while (he) {
939 if (Jim_CompareHashKeys(ht, key, he->key))
940 return he;
941 he = he->next;
943 return NULL;
946 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
948 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
949 JimInitHashTableIterator(ht, iter);
950 return iter;
953 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
955 while (1) {
956 if (iter->entry == NULL) {
957 iter->index++;
958 if (iter->index >= (signed)iter->ht->size)
959 break;
960 iter->entry = iter->ht->table[iter->index];
962 else {
963 iter->entry = iter->nextEntry;
965 if (iter->entry) {
966 /* We need to save the 'next' here, the iterator user
967 * may delete the entry we are returning. */
968 iter->nextEntry = iter->entry->next;
969 return iter->entry;
972 return NULL;
975 /* ------------------------- private functions ------------------------------ */
977 /* Expand the hash table if needed */
978 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
980 /* If the hash table is empty expand it to the intial size,
981 * if the table is "full" double its size. */
982 if (ht->size == 0)
983 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
984 if (ht->size == ht->used)
985 Jim_ExpandHashTable(ht, ht->size * 2);
988 /* Our hash table capability is a power of two */
989 static unsigned int JimHashTableNextPower(unsigned int size)
991 unsigned int i = JIM_HT_INITIAL_SIZE;
993 if (size >= 2147483648U)
994 return 2147483648U;
995 while (1) {
996 if (i >= size)
997 return i;
998 i *= 2;
1002 /* Returns the index of a free slot that can be populated with
1003 * a hash entry for the given 'key'.
1004 * If the key already exists, -1 is returned. */
1005 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1007 unsigned int h;
1008 Jim_HashEntry *he;
1010 /* Expand the hashtable if needed */
1011 JimExpandHashTableIfNeeded(ht);
1013 /* Compute the key hash value */
1014 h = Jim_HashKey(ht, key) & ht->sizemask;
1015 /* Search if this slot does not already contain the given key */
1016 he = ht->table[h];
1017 while (he) {
1018 if (Jim_CompareHashKeys(ht, key, he->key))
1019 return replace ? he : NULL;
1020 he = he->next;
1023 /* Allocates the memory and stores key */
1024 he = Jim_Alloc(sizeof(*he));
1025 he->next = ht->table[h];
1026 ht->table[h] = he;
1027 ht->used++;
1028 he->key = NULL;
1030 return he;
1033 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1035 static unsigned int JimStringCopyHTHashFunction(const void *key)
1037 return Jim_GenHashFunction(key, strlen(key));
1040 static void *JimStringCopyHTDup(void *privdata, const void *key)
1042 return Jim_StrDup(key);
1045 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1047 return strcmp(key1, key2) == 0;
1050 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1052 Jim_Free(key);
1055 static const Jim_HashTableType JimPackageHashTableType = {
1056 JimStringCopyHTHashFunction, /* hash function */
1057 JimStringCopyHTDup, /* key dup */
1058 NULL, /* val dup */
1059 JimStringCopyHTKeyCompare, /* key compare */
1060 JimStringCopyHTKeyDestructor, /* key destructor */
1061 NULL /* val destructor */
1064 typedef struct AssocDataValue
1066 Jim_InterpDeleteProc *delProc;
1067 void *data;
1068 } AssocDataValue;
1070 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1072 AssocDataValue *assocPtr = (AssocDataValue *) data;
1074 if (assocPtr->delProc != NULL)
1075 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1076 Jim_Free(data);
1079 static const Jim_HashTableType JimAssocDataHashTableType = {
1080 JimStringCopyHTHashFunction, /* hash function */
1081 JimStringCopyHTDup, /* key dup */
1082 NULL, /* val dup */
1083 JimStringCopyHTKeyCompare, /* key compare */
1084 JimStringCopyHTKeyDestructor, /* key destructor */
1085 JimAssocDataHashTableValueDestructor /* val destructor */
1088 /* -----------------------------------------------------------------------------
1089 * Stack - This is a simple generic stack implementation. It is used for
1090 * example in the 'expr' expression compiler.
1091 * ---------------------------------------------------------------------------*/
1092 void Jim_InitStack(Jim_Stack *stack)
1094 stack->len = 0;
1095 stack->maxlen = 0;
1096 stack->vector = NULL;
1099 void Jim_FreeStack(Jim_Stack *stack)
1101 Jim_Free(stack->vector);
1104 int Jim_StackLen(Jim_Stack *stack)
1106 return stack->len;
1109 void Jim_StackPush(Jim_Stack *stack, void *element)
1111 int neededLen = stack->len + 1;
1113 if (neededLen > stack->maxlen) {
1114 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1115 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1117 stack->vector[stack->len] = element;
1118 stack->len++;
1121 void *Jim_StackPop(Jim_Stack *stack)
1123 if (stack->len == 0)
1124 return NULL;
1125 stack->len--;
1126 return stack->vector[stack->len];
1129 void *Jim_StackPeek(Jim_Stack *stack)
1131 if (stack->len == 0)
1132 return NULL;
1133 return stack->vector[stack->len - 1];
1136 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1138 int i;
1140 for (i = 0; i < stack->len; i++)
1141 freeFunc(stack->vector[i]);
1144 /* -----------------------------------------------------------------------------
1145 * Tcl Parser
1146 * ---------------------------------------------------------------------------*/
1148 /* Token types */
1149 #define JIM_TT_NONE 0 /* No token returned */
1150 #define JIM_TT_STR 1 /* simple string */
1151 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1152 #define JIM_TT_VAR 3 /* var substitution */
1153 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1154 #define JIM_TT_CMD 5 /* command substitution */
1155 /* Note: Keep these three together for TOKEN_IS_SEP() */
1156 #define JIM_TT_SEP 6 /* word separator (white space) */
1157 #define JIM_TT_EOL 7 /* line separator */
1158 #define JIM_TT_EOF 8 /* end of script */
1160 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1161 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1163 /* Additional token types needed for expressions */
1164 #define JIM_TT_SUBEXPR_START 11
1165 #define JIM_TT_SUBEXPR_END 12
1166 #define JIM_TT_SUBEXPR_COMMA 13
1167 #define JIM_TT_EXPR_INT 14
1168 #define JIM_TT_EXPR_DOUBLE 15
1169 #define JIM_TT_EXPR_BOOLEAN 16
1171 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1173 /* Operator token types start here */
1174 #define JIM_TT_EXPR_OP 20
1176 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1177 /* Can this token start an expression? */
1178 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1179 /* Is this token an expression operator? */
1180 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1183 * Results of missing quotes, braces, etc. from parsing.
1185 struct JimParseMissing {
1186 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\', '}' if incomplete */
1187 int line; /* Line number starting the missing token */
1190 /* Parser context structure. The same context is used to parse
1191 * Tcl scripts, expressions and lists. */
1192 struct JimParserCtx
1194 const char *p; /* Pointer to the point of the program we are parsing */
1195 int len; /* Remaining length */
1196 int linenr; /* Current line number */
1197 const char *tstart;
1198 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1199 int tline; /* Line number of the returned token */
1200 int tt; /* Token type */
1201 int eof; /* Non zero if EOF condition is true. */
1202 int inquote; /* Parsing a quoted string */
1203 int comment; /* Non zero if the next chars may be a comment. */
1204 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1207 static int JimParseScript(struct JimParserCtx *pc);
1208 static int JimParseSep(struct JimParserCtx *pc);
1209 static int JimParseEol(struct JimParserCtx *pc);
1210 static int JimParseCmd(struct JimParserCtx *pc);
1211 static int JimParseQuote(struct JimParserCtx *pc);
1212 static int JimParseVar(struct JimParserCtx *pc);
1213 static int JimParseBrace(struct JimParserCtx *pc);
1214 static int JimParseStr(struct JimParserCtx *pc);
1215 static int JimParseComment(struct JimParserCtx *pc);
1216 static void JimParseSubCmd(struct JimParserCtx *pc);
1217 static int JimParseSubQuote(struct JimParserCtx *pc);
1218 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1220 /* Initialize a parser context.
1221 * 'prg' is a pointer to the program text, linenr is the line
1222 * number of the first line contained in the program. */
1223 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1225 pc->p = prg;
1226 pc->len = len;
1227 pc->tstart = NULL;
1228 pc->tend = NULL;
1229 pc->tline = 0;
1230 pc->tt = JIM_TT_NONE;
1231 pc->eof = 0;
1232 pc->inquote = 0;
1233 pc->linenr = linenr;
1234 pc->comment = 1;
1235 pc->missing.ch = ' ';
1236 pc->missing.line = linenr;
1239 static int JimParseScript(struct JimParserCtx *pc)
1241 while (1) { /* the while is used to reiterate with continue if needed */
1242 if (!pc->len) {
1243 pc->tstart = pc->p;
1244 pc->tend = pc->p - 1;
1245 pc->tline = pc->linenr;
1246 pc->tt = JIM_TT_EOL;
1247 pc->eof = 1;
1248 return JIM_OK;
1250 switch (*(pc->p)) {
1251 case '\\':
1252 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1253 return JimParseSep(pc);
1255 pc->comment = 0;
1256 return JimParseStr(pc);
1257 case ' ':
1258 case '\t':
1259 case '\r':
1260 case '\f':
1261 if (!pc->inquote)
1262 return JimParseSep(pc);
1263 pc->comment = 0;
1264 return JimParseStr(pc);
1265 case '\n':
1266 case ';':
1267 pc->comment = 1;
1268 if (!pc->inquote)
1269 return JimParseEol(pc);
1270 return JimParseStr(pc);
1271 case '[':
1272 pc->comment = 0;
1273 return JimParseCmd(pc);
1274 case '$':
1275 pc->comment = 0;
1276 if (JimParseVar(pc) == JIM_ERR) {
1277 /* An orphan $. Create as a separate token */
1278 pc->tstart = pc->tend = pc->p++;
1279 pc->len--;
1280 pc->tt = JIM_TT_ESC;
1282 return JIM_OK;
1283 case '#':
1284 if (pc->comment) {
1285 JimParseComment(pc);
1286 continue;
1288 return JimParseStr(pc);
1289 default:
1290 pc->comment = 0;
1291 return JimParseStr(pc);
1293 return JIM_OK;
1297 static int JimParseSep(struct JimParserCtx *pc)
1299 pc->tstart = pc->p;
1300 pc->tline = pc->linenr;
1301 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1302 if (*pc->p == '\n') {
1303 break;
1305 if (*pc->p == '\\') {
1306 pc->p++;
1307 pc->len--;
1308 pc->linenr++;
1310 pc->p++;
1311 pc->len--;
1313 pc->tend = pc->p - 1;
1314 pc->tt = JIM_TT_SEP;
1315 return JIM_OK;
1318 static int JimParseEol(struct JimParserCtx *pc)
1320 pc->tstart = pc->p;
1321 pc->tline = pc->linenr;
1322 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1323 if (*pc->p == '\n')
1324 pc->linenr++;
1325 pc->p++;
1326 pc->len--;
1328 pc->tend = pc->p - 1;
1329 pc->tt = JIM_TT_EOL;
1330 return JIM_OK;
1334 ** Here are the rules for parsing:
1335 ** {braced expression}
1336 ** - Count open and closing braces
1337 ** - Backslash escapes meaning of braces but doesn't remove the backslash
1339 ** "quoted expression"
1340 ** - Unescaped double quote terminates the expression
1341 ** - Backslash escapes next char
1342 ** - [commands brackets] are counted/nested
1343 ** - command rules apply within [brackets], not quoting rules (i.e. brackets have their own rules)
1345 ** [command expression]
1346 ** - Count open and closing brackets
1347 ** - Backslash escapes next char
1348 ** - [commands brackets] are counted/nested
1349 ** - "quoted expressions" are parsed according to quoting rules
1350 ** - {braced expressions} are parsed according to brace rules
1352 ** For everything, backslash escapes the next char, newline increments current line
1356 * Parses a braced expression starting at pc->p.
1358 * Positions the parser at the end of the braced expression,
1359 * sets pc->tend and possibly pc->missing.
1361 static void JimParseSubBrace(struct JimParserCtx *pc)
1363 int level = 1;
1365 /* Skip the brace */
1366 pc->p++;
1367 pc->len--;
1368 while (pc->len) {
1369 switch (*pc->p) {
1370 case '\\':
1371 if (pc->len > 1) {
1372 if (*++pc->p == '\n') {
1373 pc->linenr++;
1375 pc->len--;
1377 break;
1379 case '{':
1380 level++;
1381 break;
1383 case '}':
1384 if (--level == 0) {
1385 pc->tend = pc->p - 1;
1386 pc->p++;
1387 pc->len--;
1388 return;
1390 break;
1392 case '\n':
1393 pc->linenr++;
1394 break;
1396 pc->p++;
1397 pc->len--;
1399 pc->missing.ch = '{';
1400 pc->missing.line = pc->tline;
1401 pc->tend = pc->p - 1;
1405 * Parses a quoted expression starting at pc->p.
1407 * Positions the parser at the end of the quoted expression,
1408 * sets pc->tend and possibly pc->missing.
1410 * Returns the type of the token of the string,
1411 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1412 * or JIM_TT_STR.
1414 static int JimParseSubQuote(struct JimParserCtx *pc)
1416 int tt = JIM_TT_STR;
1417 int line = pc->tline;
1419 /* Skip the quote */
1420 pc->p++;
1421 pc->len--;
1422 while (pc->len) {
1423 switch (*pc->p) {
1424 case '\\':
1425 if (pc->len > 1) {
1426 if (*++pc->p == '\n') {
1427 pc->linenr++;
1429 pc->len--;
1430 tt = JIM_TT_ESC;
1432 break;
1434 case '"':
1435 pc->tend = pc->p - 1;
1436 pc->p++;
1437 pc->len--;
1438 return tt;
1440 case '[':
1441 JimParseSubCmd(pc);
1442 tt = JIM_TT_ESC;
1443 continue;
1445 case '\n':
1446 pc->linenr++;
1447 break;
1449 case '$':
1450 tt = JIM_TT_ESC;
1451 break;
1453 pc->p++;
1454 pc->len--;
1456 pc->missing.ch = '"';
1457 pc->missing.line = line;
1458 pc->tend = pc->p - 1;
1459 return tt;
1463 * Parses a [command] expression starting at pc->p.
1465 * Positions the parser at the end of the command expression,
1466 * sets pc->tend and possibly pc->missing.
1468 static void JimParseSubCmd(struct JimParserCtx *pc)
1470 int level = 1;
1471 int startofword = 1;
1472 int line = pc->tline;
1474 /* Skip the bracket */
1475 pc->p++;
1476 pc->len--;
1477 while (pc->len) {
1478 switch (*pc->p) {
1479 case '\\':
1480 if (pc->len > 1) {
1481 if (*++pc->p == '\n') {
1482 pc->linenr++;
1484 pc->len--;
1486 break;
1488 case '[':
1489 level++;
1490 break;
1492 case ']':
1493 if (--level == 0) {
1494 pc->tend = pc->p - 1;
1495 pc->p++;
1496 pc->len--;
1497 return;
1499 break;
1501 case '"':
1502 if (startofword) {
1503 JimParseSubQuote(pc);
1504 continue;
1506 break;
1508 case '{':
1509 JimParseSubBrace(pc);
1510 startofword = 0;
1511 continue;
1513 case '\n':
1514 pc->linenr++;
1515 break;
1517 startofword = isspace(UCHAR(*pc->p));
1518 pc->p++;
1519 pc->len--;
1521 pc->missing.ch = '[';
1522 pc->missing.line = line;
1523 pc->tend = pc->p - 1;
1526 static int JimParseBrace(struct JimParserCtx *pc)
1528 pc->tstart = pc->p + 1;
1529 pc->tline = pc->linenr;
1530 pc->tt = JIM_TT_STR;
1531 JimParseSubBrace(pc);
1532 return JIM_OK;
1535 static int JimParseCmd(struct JimParserCtx *pc)
1537 pc->tstart = pc->p + 1;
1538 pc->tline = pc->linenr;
1539 pc->tt = JIM_TT_CMD;
1540 JimParseSubCmd(pc);
1541 return JIM_OK;
1544 static int JimParseQuote(struct JimParserCtx *pc)
1546 pc->tstart = pc->p + 1;
1547 pc->tline = pc->linenr;
1548 pc->tt = JimParseSubQuote(pc);
1549 return JIM_OK;
1552 static int JimParseVar(struct JimParserCtx *pc)
1554 /* skip the $ */
1555 pc->p++;
1556 pc->len--;
1558 #ifdef EXPRSUGAR_BRACKET
1559 if (*pc->p == '[') {
1560 /* Parse $[...] expr shorthand syntax */
1561 JimParseCmd(pc);
1562 pc->tt = JIM_TT_EXPRSUGAR;
1563 return JIM_OK;
1565 #endif
1567 pc->tstart = pc->p;
1568 pc->tt = JIM_TT_VAR;
1569 pc->tline = pc->linenr;
1571 if (*pc->p == '{') {
1572 pc->tstart = ++pc->p;
1573 pc->len--;
1575 while (pc->len && *pc->p != '}') {
1576 if (*pc->p == '\n') {
1577 pc->linenr++;
1579 pc->p++;
1580 pc->len--;
1582 pc->tend = pc->p - 1;
1583 if (pc->len) {
1584 pc->p++;
1585 pc->len--;
1588 else {
1589 while (1) {
1590 /* Skip double colon, but not single colon! */
1591 if (pc->p[0] == ':' && pc->p[1] == ':') {
1592 while (*pc->p == ':') {
1593 pc->p++;
1594 pc->len--;
1596 continue;
1598 /* Note that any char >= 0x80 must be part of a utf-8 char.
1599 * We consider all unicode points outside of ASCII as letters
1601 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1602 pc->p++;
1603 pc->len--;
1604 continue;
1606 break;
1608 /* Parse [dict get] syntax sugar. */
1609 if (*pc->p == '(') {
1610 int count = 1;
1611 const char *paren = NULL;
1613 pc->tt = JIM_TT_DICTSUGAR;
1615 while (count && pc->len) {
1616 pc->p++;
1617 pc->len--;
1618 if (*pc->p == '\\' && pc->len >= 1) {
1619 pc->p++;
1620 pc->len--;
1622 else if (*pc->p == '(') {
1623 count++;
1625 else if (*pc->p == ')') {
1626 paren = pc->p;
1627 count--;
1630 if (count == 0) {
1631 pc->p++;
1632 pc->len--;
1634 else if (paren) {
1635 /* Did not find a matching paren. Back up */
1636 paren++;
1637 pc->len += (pc->p - paren);
1638 pc->p = paren;
1640 #ifndef EXPRSUGAR_BRACKET
1641 if (*pc->tstart == '(') {
1642 pc->tt = JIM_TT_EXPRSUGAR;
1644 #endif
1646 pc->tend = pc->p - 1;
1648 /* Check if we parsed just the '$' character.
1649 * That's not a variable so an error is returned
1650 * to tell the state machine to consider this '$' just
1651 * a string. */
1652 if (pc->tstart == pc->p) {
1653 pc->p--;
1654 pc->len++;
1655 return JIM_ERR;
1657 return JIM_OK;
1660 static int JimParseStr(struct JimParserCtx *pc)
1662 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1663 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1664 /* Starting a new word */
1665 if (*pc->p == '{') {
1666 return JimParseBrace(pc);
1668 if (*pc->p == '"') {
1669 pc->inquote = 1;
1670 pc->p++;
1671 pc->len--;
1672 /* In case the end quote is missing */
1673 pc->missing.line = pc->tline;
1676 pc->tstart = pc->p;
1677 pc->tline = pc->linenr;
1678 while (1) {
1679 if (pc->len == 0) {
1680 if (pc->inquote) {
1681 pc->missing.ch = '"';
1683 pc->tend = pc->p - 1;
1684 pc->tt = JIM_TT_ESC;
1685 return JIM_OK;
1687 switch (*pc->p) {
1688 case '\\':
1689 if (!pc->inquote && *(pc->p + 1) == '\n') {
1690 pc->tend = pc->p - 1;
1691 pc->tt = JIM_TT_ESC;
1692 return JIM_OK;
1694 if (pc->len >= 2) {
1695 if (*(pc->p + 1) == '\n') {
1696 pc->linenr++;
1698 pc->p++;
1699 pc->len--;
1701 else if (pc->len == 1) {
1702 /* End of script with trailing backslash */
1703 pc->missing.ch = '\\';
1705 break;
1706 case '(':
1707 /* If the following token is not '$' just keep going */
1708 if (pc->len > 1 && pc->p[1] != '$') {
1709 break;
1711 /* fall through */
1712 case ')':
1713 /* Only need a separate ')' token if the previous was a var */
1714 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1715 if (pc->p == pc->tstart) {
1716 /* At the start of the token, so just return this char */
1717 pc->p++;
1718 pc->len--;
1720 pc->tend = pc->p - 1;
1721 pc->tt = JIM_TT_ESC;
1722 return JIM_OK;
1724 break;
1726 case '$':
1727 case '[':
1728 pc->tend = pc->p - 1;
1729 pc->tt = JIM_TT_ESC;
1730 return JIM_OK;
1731 case ' ':
1732 case '\t':
1733 case '\n':
1734 case '\r':
1735 case '\f':
1736 case ';':
1737 if (!pc->inquote) {
1738 pc->tend = pc->p - 1;
1739 pc->tt = JIM_TT_ESC;
1740 return JIM_OK;
1742 else if (*pc->p == '\n') {
1743 pc->linenr++;
1745 break;
1746 case '"':
1747 if (pc->inquote) {
1748 pc->tend = pc->p - 1;
1749 pc->tt = JIM_TT_ESC;
1750 pc->p++;
1751 pc->len--;
1752 pc->inquote = 0;
1753 return JIM_OK;
1755 break;
1757 pc->p++;
1758 pc->len--;
1760 return JIM_OK; /* unreached */
1763 static int JimParseComment(struct JimParserCtx *pc)
1765 while (*pc->p) {
1766 if (*pc->p == '\\') {
1767 pc->p++;
1768 pc->len--;
1769 if (pc->len == 0) {
1770 pc->missing.ch = '\\';
1771 return JIM_OK;
1773 if (*pc->p == '\n') {
1774 pc->linenr++;
1777 else if (*pc->p == '\n') {
1778 pc->p++;
1779 pc->len--;
1780 pc->linenr++;
1781 break;
1783 pc->p++;
1784 pc->len--;
1786 return JIM_OK;
1789 /* xdigitval and odigitval are helper functions for JimEscape() */
1790 static int xdigitval(int c)
1792 if (c >= '0' && c <= '9')
1793 return c - '0';
1794 if (c >= 'a' && c <= 'f')
1795 return c - 'a' + 10;
1796 if (c >= 'A' && c <= 'F')
1797 return c - 'A' + 10;
1798 return -1;
1801 static int odigitval(int c)
1803 if (c >= '0' && c <= '7')
1804 return c - '0';
1805 return -1;
1808 /* Perform Tcl escape substitution of 's', storing the result
1809 * string into 'dest'. The escaped string is guaranteed to
1810 * be the same length or shorter than the source string.
1811 * slen is the length of the string at 's'.
1813 * The function returns the length of the resulting string. */
1814 static int JimEscape(char *dest, const char *s, int slen)
1816 char *p = dest;
1817 int i, len;
1819 for (i = 0; i < slen; i++) {
1820 switch (s[i]) {
1821 case '\\':
1822 switch (s[i + 1]) {
1823 case 'a':
1824 *p++ = 0x7;
1825 i++;
1826 break;
1827 case 'b':
1828 *p++ = 0x8;
1829 i++;
1830 break;
1831 case 'f':
1832 *p++ = 0xc;
1833 i++;
1834 break;
1835 case 'n':
1836 *p++ = 0xa;
1837 i++;
1838 break;
1839 case 'r':
1840 *p++ = 0xd;
1841 i++;
1842 break;
1843 case 't':
1844 *p++ = 0x9;
1845 i++;
1846 break;
1847 case 'u':
1848 case 'U':
1849 case 'x':
1850 /* A unicode or hex sequence.
1851 * \x Expect 1-2 hex chars and convert to hex.
1852 * \u Expect 1-4 hex chars and convert to utf-8.
1853 * \U Expect 1-8 hex chars and convert to utf-8.
1854 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1855 * An invalid sequence means simply the escaped char.
1858 unsigned val = 0;
1859 int k;
1860 int maxchars = 2;
1862 i++;
1864 if (s[i] == 'U') {
1865 maxchars = 8;
1867 else if (s[i] == 'u') {
1868 if (s[i + 1] == '{') {
1869 maxchars = 6;
1870 i++;
1872 else {
1873 maxchars = 4;
1877 for (k = 0; k < maxchars; k++) {
1878 int c = xdigitval(s[i + k + 1]);
1879 if (c == -1) {
1880 break;
1882 val = (val << 4) | c;
1884 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1885 if (s[i] == '{') {
1886 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1887 /* Back up */
1888 i--;
1889 k = 0;
1891 else {
1892 /* Skip the closing brace */
1893 k++;
1896 if (k) {
1897 /* Got a valid sequence, so convert */
1898 if (s[i] == 'x') {
1899 *p++ = val;
1901 else {
1902 p += utf8_fromunicode(p, val);
1904 i += k;
1905 break;
1907 /* Not a valid codepoint, just an escaped char */
1908 *p++ = s[i];
1910 break;
1911 case 'v':
1912 *p++ = 0xb;
1913 i++;
1914 break;
1915 case '\0':
1916 *p++ = '\\';
1917 i++;
1918 break;
1919 case '\n':
1920 /* Replace all spaces and tabs after backslash newline with a single space*/
1921 *p++ = ' ';
1922 do {
1923 i++;
1924 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1925 break;
1926 case '0':
1927 case '1':
1928 case '2':
1929 case '3':
1930 case '4':
1931 case '5':
1932 case '6':
1933 case '7':
1934 /* octal escape */
1936 int val = 0;
1937 int c = odigitval(s[i + 1]);
1939 val = c;
1940 c = odigitval(s[i + 2]);
1941 if (c == -1) {
1942 *p++ = val;
1943 i++;
1944 break;
1946 val = (val * 8) + c;
1947 c = odigitval(s[i + 3]);
1948 if (c == -1) {
1949 *p++ = val;
1950 i += 2;
1951 break;
1953 val = (val * 8) + c;
1954 *p++ = val;
1955 i += 3;
1957 break;
1958 default:
1959 *p++ = s[i + 1];
1960 i++;
1961 break;
1963 break;
1964 default:
1965 *p++ = s[i];
1966 break;
1969 len = p - dest;
1970 *p = '\0';
1971 return len;
1974 /* Returns a dynamically allocated copy of the current token in the
1975 * parser context. The function performs conversion of escapes if
1976 * the token is of type JIM_TT_ESC.
1978 * Note that after the conversion, tokens that are grouped with
1979 * braces in the source code, are always recognizable from the
1980 * identical string obtained in a different way from the type.
1982 * For example the string:
1984 * {*}$a
1986 * will return as first token "*", of type JIM_TT_STR
1988 * While the string:
1990 * *$a
1992 * will return as first token "*", of type JIM_TT_ESC
1994 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1996 const char *start, *end;
1997 char *token;
1998 int len;
2000 start = pc->tstart;
2001 end = pc->tend;
2002 len = (end - start) + 1;
2003 if (len < 0) {
2004 len = 0;
2006 token = Jim_Alloc(len + 1);
2007 if (pc->tt != JIM_TT_ESC) {
2008 /* No escape conversion needed? Just copy it. */
2009 memcpy(token, start, len);
2010 token[len] = '\0';
2012 else {
2013 /* Else convert the escape chars. */
2014 len = JimEscape(token, start, len);
2017 return Jim_NewStringObjNoAlloc(interp, token, len);
2020 /* -----------------------------------------------------------------------------
2021 * Tcl Lists parsing
2022 * ---------------------------------------------------------------------------*/
2023 static int JimParseListSep(struct JimParserCtx *pc);
2024 static int JimParseListStr(struct JimParserCtx *pc);
2025 static int JimParseListQuote(struct JimParserCtx *pc);
2027 static int JimParseList(struct JimParserCtx *pc)
2029 if (isspace(UCHAR(*pc->p))) {
2030 return JimParseListSep(pc);
2032 switch (*pc->p) {
2033 case '"':
2034 return JimParseListQuote(pc);
2036 case '{':
2037 return JimParseBrace(pc);
2039 default:
2040 if (pc->len) {
2041 return JimParseListStr(pc);
2043 break;
2046 pc->tstart = pc->tend = pc->p;
2047 pc->tline = pc->linenr;
2048 pc->tt = JIM_TT_EOL;
2049 pc->eof = 1;
2050 return JIM_OK;
2053 static int JimParseListSep(struct JimParserCtx *pc)
2055 pc->tstart = pc->p;
2056 pc->tline = pc->linenr;
2057 while (isspace(UCHAR(*pc->p))) {
2058 if (*pc->p == '\n') {
2059 pc->linenr++;
2061 pc->p++;
2062 pc->len--;
2064 pc->tend = pc->p - 1;
2065 pc->tt = JIM_TT_SEP;
2066 return JIM_OK;
2069 static int JimParseListQuote(struct JimParserCtx *pc)
2071 pc->p++;
2072 pc->len--;
2074 pc->tstart = pc->p;
2075 pc->tline = pc->linenr;
2076 pc->tt = JIM_TT_STR;
2078 while (pc->len) {
2079 switch (*pc->p) {
2080 case '\\':
2081 pc->tt = JIM_TT_ESC;
2082 if (--pc->len == 0) {
2083 /* Trailing backslash */
2084 pc->tend = pc->p;
2085 return JIM_OK;
2087 pc->p++;
2088 break;
2089 case '\n':
2090 pc->linenr++;
2091 break;
2092 case '"':
2093 pc->tend = pc->p - 1;
2094 pc->p++;
2095 pc->len--;
2096 return JIM_OK;
2098 pc->p++;
2099 pc->len--;
2102 pc->tend = pc->p - 1;
2103 return JIM_OK;
2106 static int JimParseListStr(struct JimParserCtx *pc)
2108 pc->tstart = pc->p;
2109 pc->tline = pc->linenr;
2110 pc->tt = JIM_TT_STR;
2112 while (pc->len) {
2113 if (isspace(UCHAR(*pc->p))) {
2114 pc->tend = pc->p - 1;
2115 return JIM_OK;
2117 if (*pc->p == '\\') {
2118 if (--pc->len == 0) {
2119 /* Trailing backslash */
2120 pc->tend = pc->p;
2121 return JIM_OK;
2123 pc->tt = JIM_TT_ESC;
2124 pc->p++;
2126 pc->p++;
2127 pc->len--;
2129 pc->tend = pc->p - 1;
2130 return JIM_OK;
2133 /* -----------------------------------------------------------------------------
2134 * Jim_Obj related functions
2135 * ---------------------------------------------------------------------------*/
2137 /* Return a new initialized object. */
2138 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2140 Jim_Obj *objPtr;
2142 /* -- Check if there are objects in the free list -- */
2143 if (interp->freeList != NULL) {
2144 /* -- Unlink the object from the free list -- */
2145 objPtr = interp->freeList;
2146 interp->freeList = objPtr->nextObjPtr;
2148 else {
2149 /* -- No ready to use objects: allocate a new one -- */
2150 objPtr = Jim_Alloc(sizeof(*objPtr));
2153 /* Object is returned with refCount of 0. Every
2154 * kind of GC implemented should take care to avoid
2155 * scanning objects with refCount == 0. */
2156 objPtr->refCount = 0;
2157 /* All the other fields are left uninitialized to save time.
2158 * The caller will probably want to set them to the right
2159 * value anyway. */
2161 /* -- Put the object into the live list -- */
2162 objPtr->prevObjPtr = NULL;
2163 objPtr->nextObjPtr = interp->liveList;
2164 if (interp->liveList)
2165 interp->liveList->prevObjPtr = objPtr;
2166 interp->liveList = objPtr;
2168 return objPtr;
2171 /* Free an object. Actually objects are never freed, but
2172 * just moved to the free objects list, where they will be
2173 * reused by Jim_NewObj(). */
2174 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2176 /* Check if the object was already freed, panic. */
2177 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2178 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2180 /* Free the internal representation */
2181 Jim_FreeIntRep(interp, objPtr);
2182 /* Free the string representation */
2183 if (objPtr->bytes != NULL) {
2184 if (objPtr->bytes != JimEmptyStringRep)
2185 Jim_Free(objPtr->bytes);
2187 /* Unlink the object from the live objects list */
2188 if (objPtr->prevObjPtr)
2189 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2190 if (objPtr->nextObjPtr)
2191 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2192 if (interp->liveList == objPtr)
2193 interp->liveList = objPtr->nextObjPtr;
2194 #ifdef JIM_DISABLE_OBJECT_POOL
2195 Jim_Free(objPtr);
2196 #else
2197 /* Link the object into the free objects list */
2198 objPtr->prevObjPtr = NULL;
2199 objPtr->nextObjPtr = interp->freeList;
2200 if (interp->freeList)
2201 interp->freeList->prevObjPtr = objPtr;
2202 interp->freeList = objPtr;
2203 objPtr->refCount = -1;
2204 #endif
2207 /* Invalidate the string representation of an object. */
2208 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2210 if (objPtr->bytes != NULL) {
2211 if (objPtr->bytes != JimEmptyStringRep)
2212 Jim_Free(objPtr->bytes);
2214 objPtr->bytes = NULL;
2217 /* Duplicate an object. The returned object has refcount = 0. */
2218 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2220 Jim_Obj *dupPtr;
2222 dupPtr = Jim_NewObj(interp);
2223 if (objPtr->bytes == NULL) {
2224 /* Object does not have a valid string representation. */
2225 dupPtr->bytes = NULL;
2227 else if (objPtr->length == 0) {
2228 /* Zero length, so don't even bother with the type-specific dup,
2229 * since all zero length objects look the same
2231 dupPtr->bytes = JimEmptyStringRep;
2232 dupPtr->length = 0;
2233 dupPtr->typePtr = NULL;
2234 return dupPtr;
2236 else {
2237 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2238 dupPtr->length = objPtr->length;
2239 /* Copy the null byte too */
2240 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2243 /* By default, the new object has the same type as the old object */
2244 dupPtr->typePtr = objPtr->typePtr;
2245 if (objPtr->typePtr != NULL) {
2246 if (objPtr->typePtr->dupIntRepProc == NULL) {
2247 dupPtr->internalRep = objPtr->internalRep;
2249 else {
2250 /* The dup proc may set a different type, e.g. NULL */
2251 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2254 return dupPtr;
2257 /* Return the string representation for objPtr. If the object's
2258 * string representation is invalid, calls the updateStringProc method to create
2259 * a new one from the internal representation of the object.
2261 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2263 if (objPtr->bytes == NULL) {
2264 /* Invalid string repr. Generate it. */
2265 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2266 objPtr->typePtr->updateStringProc(objPtr);
2268 if (lenPtr)
2269 *lenPtr = objPtr->length;
2270 return objPtr->bytes;
2273 /* Just returns the length (in bytes) of the object's string rep */
2274 int Jim_Length(Jim_Obj *objPtr)
2276 if (objPtr->bytes == NULL) {
2277 /* Invalid string repr. Generate it. */
2278 Jim_GetString(objPtr, NULL);
2280 return objPtr->length;
2283 /* Just returns object's string rep */
2284 const char *Jim_String(Jim_Obj *objPtr)
2286 if (objPtr->bytes == NULL) {
2287 /* Invalid string repr. Generate it. */
2288 Jim_GetString(objPtr, NULL);
2290 return objPtr->bytes;
2293 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2295 objPtr->bytes = Jim_StrDup(str);
2296 objPtr->length = strlen(str);
2299 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2300 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2302 static const Jim_ObjType dictSubstObjType = {
2303 "dict-substitution",
2304 FreeDictSubstInternalRep,
2305 DupDictSubstInternalRep,
2306 NULL,
2307 JIM_TYPE_NONE,
2310 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2311 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2313 static const Jim_ObjType interpolatedObjType = {
2314 "interpolated",
2315 FreeInterpolatedInternalRep,
2316 DupInterpolatedInternalRep,
2317 NULL,
2318 JIM_TYPE_NONE,
2321 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2323 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2326 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2328 /* Copy the interal rep */
2329 dupPtr->internalRep = srcPtr->internalRep;
2330 /* Need to increment the key ref count */
2331 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2334 /* -----------------------------------------------------------------------------
2335 * String Object
2336 * ---------------------------------------------------------------------------*/
2337 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2338 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2340 static const Jim_ObjType stringObjType = {
2341 "string",
2342 NULL,
2343 DupStringInternalRep,
2344 NULL,
2345 JIM_TYPE_REFERENCES,
2348 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2350 JIM_NOTUSED(interp);
2352 /* This is a bit subtle: the only caller of this function
2353 * should be Jim_DuplicateObj(), that will copy the
2354 * string representaion. After the copy, the duplicated
2355 * object will not have more room in the buffer than
2356 * srcPtr->length bytes. So we just set it to length. */
2357 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2358 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2361 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2363 if (objPtr->typePtr != &stringObjType) {
2364 /* Get a fresh string representation. */
2365 if (objPtr->bytes == NULL) {
2366 /* Invalid string repr. Generate it. */
2367 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2368 objPtr->typePtr->updateStringProc(objPtr);
2370 /* Free any other internal representation. */
2371 Jim_FreeIntRep(interp, objPtr);
2372 /* Set it as string, i.e. just set the maxLength field. */
2373 objPtr->typePtr = &stringObjType;
2374 objPtr->internalRep.strValue.maxLength = objPtr->length;
2375 /* Don't know the utf-8 length yet */
2376 objPtr->internalRep.strValue.charLength = -1;
2378 return JIM_OK;
2382 * Returns the length of the object string in chars, not bytes.
2384 * These may be different for a utf-8 string.
2386 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2388 #ifdef JIM_UTF8
2389 SetStringFromAny(interp, objPtr);
2391 if (objPtr->internalRep.strValue.charLength < 0) {
2392 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2394 return objPtr->internalRep.strValue.charLength;
2395 #else
2396 return Jim_Length(objPtr);
2397 #endif
2400 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2401 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2403 Jim_Obj *objPtr = Jim_NewObj(interp);
2405 /* Need to find out how many bytes the string requires */
2406 if (len == -1)
2407 len = strlen(s);
2408 /* Alloc/Set the string rep. */
2409 if (len == 0) {
2410 objPtr->bytes = JimEmptyStringRep;
2412 else {
2413 objPtr->bytes = Jim_StrDupLen(s, len);
2415 objPtr->length = len;
2417 /* No typePtr field for the vanilla string object. */
2418 objPtr->typePtr = NULL;
2419 return objPtr;
2422 /* charlen is in characters -- see also Jim_NewStringObj() */
2423 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2425 #ifdef JIM_UTF8
2426 /* Need to find out how many bytes the string requires */
2427 int bytelen = utf8_index(s, charlen);
2429 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2431 /* Remember the utf8 length, so set the type */
2432 objPtr->typePtr = &stringObjType;
2433 objPtr->internalRep.strValue.maxLength = bytelen;
2434 objPtr->internalRep.strValue.charLength = charlen;
2436 return objPtr;
2437 #else
2438 return Jim_NewStringObj(interp, s, charlen);
2439 #endif
2442 /* This version does not try to duplicate the 's' pointer, but
2443 * use it directly. */
2444 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2446 Jim_Obj *objPtr = Jim_NewObj(interp);
2448 objPtr->bytes = s;
2449 objPtr->length = (len == -1) ? strlen(s) : len;
2450 objPtr->typePtr = NULL;
2451 return objPtr;
2454 /* Low-level string append. Use it only against unshared objects
2455 * of type "string". */
2456 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2458 int needlen;
2460 if (len == -1)
2461 len = strlen(str);
2462 needlen = objPtr->length + len;
2463 if (objPtr->internalRep.strValue.maxLength < needlen ||
2464 objPtr->internalRep.strValue.maxLength == 0) {
2465 needlen *= 2;
2466 /* Inefficient to malloc() for less than 8 bytes */
2467 if (needlen < 7) {
2468 needlen = 7;
2470 if (objPtr->bytes == JimEmptyStringRep) {
2471 objPtr->bytes = Jim_Alloc(needlen + 1);
2473 else {
2474 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2476 objPtr->internalRep.strValue.maxLength = needlen;
2478 memcpy(objPtr->bytes + objPtr->length, str, len);
2479 objPtr->bytes[objPtr->length + len] = '\0';
2481 if (objPtr->internalRep.strValue.charLength >= 0) {
2482 /* Update the utf-8 char length */
2483 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2485 objPtr->length += len;
2488 /* Higher level API to append strings to objects.
2489 * Object must not be unshared for each of these.
2491 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2493 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2494 SetStringFromAny(interp, objPtr);
2495 StringAppendString(objPtr, str, len);
2498 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2500 int len;
2501 const char *str = Jim_GetString(appendObjPtr, &len);
2502 Jim_AppendString(interp, objPtr, str, len);
2505 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2507 va_list ap;
2509 SetStringFromAny(interp, objPtr);
2510 va_start(ap, objPtr);
2511 while (1) {
2512 const char *s = va_arg(ap, const char *);
2514 if (s == NULL)
2515 break;
2516 Jim_AppendString(interp, objPtr, s, -1);
2518 va_end(ap);
2521 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2523 if (aObjPtr == bObjPtr) {
2524 return 1;
2526 else {
2527 int Alen, Blen;
2528 const char *sA = Jim_GetString(aObjPtr, &Alen);
2529 const char *sB = Jim_GetString(bObjPtr, &Blen);
2531 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2536 * Note. Does not support embedded nulls in either the pattern or the object.
2538 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2540 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2544 * Note: does not support embedded nulls for the nocase option.
2546 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2548 int l1, l2;
2549 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2550 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2552 if (nocase) {
2553 /* Do a character compare for nocase */
2554 return JimStringCompareLen(s1, s2, -1, nocase);
2556 return JimStringCompare(s1, l1, s2, l2);
2560 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2562 * Note: does not support embedded nulls
2564 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2566 const char *s1 = Jim_String(firstObjPtr);
2567 const char *s2 = Jim_String(secondObjPtr);
2569 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2572 /* Convert a range, as returned by Jim_GetRange(), into
2573 * an absolute index into an object of the specified length.
2574 * This function may return negative values, or values
2575 * greater than or equal to the length of the list if the index
2576 * is out of range. */
2577 static int JimRelToAbsIndex(int len, int idx)
2579 if (idx < 0)
2580 return len + idx;
2581 return idx;
2584 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2585 * into a form suitable for implementation of commands like [string range] and [lrange].
2587 * The resulting range is guaranteed to address valid elements of
2588 * the structure.
2590 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2592 int rangeLen;
2594 if (*firstPtr > *lastPtr) {
2595 rangeLen = 0;
2597 else {
2598 rangeLen = *lastPtr - *firstPtr + 1;
2599 if (rangeLen) {
2600 if (*firstPtr < 0) {
2601 rangeLen += *firstPtr;
2602 *firstPtr = 0;
2604 if (*lastPtr >= len) {
2605 rangeLen -= (*lastPtr - (len - 1));
2606 *lastPtr = len - 1;
2610 if (rangeLen < 0)
2611 rangeLen = 0;
2613 *rangeLenPtr = rangeLen;
2616 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2617 int len, int *first, int *last, int *range)
2619 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2620 return JIM_ERR;
2622 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2623 return JIM_ERR;
2625 *first = JimRelToAbsIndex(len, *first);
2626 *last = JimRelToAbsIndex(len, *last);
2627 JimRelToAbsRange(len, first, last, range);
2628 return JIM_OK;
2631 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2632 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2634 int first, last;
2635 const char *str;
2636 int rangeLen;
2637 int bytelen;
2639 str = Jim_GetString(strObjPtr, &bytelen);
2641 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2642 return NULL;
2645 if (first == 0 && rangeLen == bytelen) {
2646 return strObjPtr;
2648 return Jim_NewStringObj(interp, str + first, rangeLen);
2651 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2652 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2654 #ifdef JIM_UTF8
2655 int first, last;
2656 const char *str;
2657 int len, rangeLen;
2658 int bytelen;
2660 str = Jim_GetString(strObjPtr, &bytelen);
2661 len = Jim_Utf8Length(interp, strObjPtr);
2663 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2664 return NULL;
2667 if (first == 0 && rangeLen == len) {
2668 return strObjPtr;
2670 if (len == bytelen) {
2671 /* ASCII optimisation */
2672 return Jim_NewStringObj(interp, str + first, rangeLen);
2674 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2675 #else
2676 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2677 #endif
2680 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2681 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2683 int first, last;
2684 const char *str;
2685 int len, rangeLen;
2686 Jim_Obj *objPtr;
2688 len = Jim_Utf8Length(interp, strObjPtr);
2690 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2691 return NULL;
2694 if (last < first) {
2695 return strObjPtr;
2698 str = Jim_String(strObjPtr);
2700 /* Before part */
2701 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2703 /* Replacement */
2704 if (newStrObj) {
2705 Jim_AppendObj(interp, objPtr, newStrObj);
2708 /* After part */
2709 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2711 return objPtr;
2715 * Note: does not support embedded nulls.
2717 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2719 while (*str) {
2720 int c;
2721 str += utf8_tounicode(str, &c);
2722 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2724 *dest = 0;
2728 * Note: does not support embedded nulls.
2730 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2732 char *buf;
2733 int len;
2734 const char *str;
2736 str = Jim_GetString(strObjPtr, &len);
2738 #ifdef JIM_UTF8
2739 /* Case mapping can change the utf-8 length of the string.
2740 * But at worst it will be by one extra byte per char
2742 len *= 2;
2743 #endif
2744 buf = Jim_Alloc(len + 1);
2745 JimStrCopyUpperLower(buf, str, 0);
2746 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2750 * Note: does not support embedded nulls.
2752 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2754 char *buf;
2755 const char *str;
2756 int len;
2758 str = Jim_GetString(strObjPtr, &len);
2760 #ifdef JIM_UTF8
2761 /* Case mapping can change the utf-8 length of the string.
2762 * But at worst it will be by one extra byte per char
2764 len *= 2;
2765 #endif
2766 buf = Jim_Alloc(len + 1);
2767 JimStrCopyUpperLower(buf, str, 1);
2768 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2772 * Note: does not support embedded nulls.
2774 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2776 char *buf, *p;
2777 int len;
2778 int c;
2779 const char *str;
2781 str = Jim_GetString(strObjPtr, &len);
2783 #ifdef JIM_UTF8
2784 /* Case mapping can change the utf-8 length of the string.
2785 * But at worst it will be by one extra byte per char
2787 len *= 2;
2788 #endif
2789 buf = p = Jim_Alloc(len + 1);
2791 str += utf8_tounicode(str, &c);
2792 p += utf8_getchars(p, utf8_title(c));
2794 JimStrCopyUpperLower(p, str, 0);
2796 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2799 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2800 * for unicode character 'c'.
2801 * Returns the position if found or NULL if not
2803 static const char *utf8_memchr(const char *str, int len, int c)
2805 #ifdef JIM_UTF8
2806 while (len) {
2807 int sc;
2808 int n = utf8_tounicode(str, &sc);
2809 if (sc == c) {
2810 return str;
2812 str += n;
2813 len -= n;
2815 return NULL;
2816 #else
2817 return memchr(str, c, len);
2818 #endif
2822 * Searches for the first non-trim char in string (str, len)
2824 * If none is found, returns just past the last char.
2826 * Lengths are in bytes.
2828 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2830 while (len) {
2831 int c;
2832 int n = utf8_tounicode(str, &c);
2834 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2835 /* Not a trim char, so stop */
2836 break;
2838 str += n;
2839 len -= n;
2841 return str;
2845 * Searches backwards for a non-trim char in string (str, len).
2847 * Returns a pointer to just after the non-trim char, or NULL if not found.
2849 * Lengths are in bytes.
2851 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2853 str += len;
2855 while (len) {
2856 int c;
2857 int n = utf8_prev_len(str, len);
2859 len -= n;
2860 str -= n;
2862 n = utf8_tounicode(str, &c);
2864 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2865 return str + n;
2869 return NULL;
2872 static const char default_trim_chars[] = " \t\n\r";
2873 /* sizeof() here includes the null byte */
2874 static int default_trim_chars_len = sizeof(default_trim_chars);
2876 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2878 int len;
2879 const char *str = Jim_GetString(strObjPtr, &len);
2880 const char *trimchars = default_trim_chars;
2881 int trimcharslen = default_trim_chars_len;
2882 const char *newstr;
2884 if (trimcharsObjPtr) {
2885 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2888 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2889 if (newstr == str) {
2890 return strObjPtr;
2893 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2896 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2898 int len;
2899 const char *trimchars = default_trim_chars;
2900 int trimcharslen = default_trim_chars_len;
2901 const char *nontrim;
2903 if (trimcharsObjPtr) {
2904 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2907 SetStringFromAny(interp, strObjPtr);
2909 len = Jim_Length(strObjPtr);
2910 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2912 if (nontrim == NULL) {
2913 /* All trim, so return a zero-length string */
2914 return Jim_NewEmptyStringObj(interp);
2916 if (nontrim == strObjPtr->bytes + len) {
2917 /* All non-trim, so return the original object */
2918 return strObjPtr;
2921 if (Jim_IsShared(strObjPtr)) {
2922 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2924 else {
2925 /* Can modify this string in place */
2926 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2927 strObjPtr->length = (nontrim - strObjPtr->bytes);
2930 return strObjPtr;
2933 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2935 /* First trim left. */
2936 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2938 /* Now trim right */
2939 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2941 /* Note: refCount check is needed since objPtr may be emptyObj */
2942 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2943 /* We don't want this object to be leaked */
2944 Jim_FreeNewObj(interp, objPtr);
2947 return strObjPtr;
2950 /* Some platforms don't have isascii - need a non-macro version */
2951 #ifdef HAVE_ISASCII
2952 #define jim_isascii isascii
2953 #else
2954 static int jim_isascii(int c)
2956 return !(c & ~0x7f);
2958 #endif
2960 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2962 static const char * const strclassnames[] = {
2963 "integer", "alpha", "alnum", "ascii", "digit",
2964 "double", "lower", "upper", "space", "xdigit",
2965 "control", "print", "graph", "punct", "boolean",
2966 NULL
2968 enum {
2969 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2970 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2971 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2973 int strclass;
2974 int len;
2975 int i;
2976 const char *str;
2977 int (*isclassfunc)(int c) = NULL;
2979 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2980 return JIM_ERR;
2983 str = Jim_GetString(strObjPtr, &len);
2984 if (len == 0) {
2985 Jim_SetResultBool(interp, !strict);
2986 return JIM_OK;
2989 switch (strclass) {
2990 case STR_IS_INTEGER:
2992 jim_wide w;
2993 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2994 return JIM_OK;
2997 case STR_IS_DOUBLE:
2999 double d;
3000 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3001 return JIM_OK;
3004 case STR_IS_BOOLEAN:
3006 int b;
3007 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3008 return JIM_OK;
3011 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3012 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3013 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3014 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3015 case STR_IS_LOWER: isclassfunc = islower; break;
3016 case STR_IS_UPPER: isclassfunc = isupper; break;
3017 case STR_IS_SPACE: isclassfunc = isspace; break;
3018 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3019 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3020 case STR_IS_PRINT: isclassfunc = isprint; break;
3021 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3022 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3023 default:
3024 return JIM_ERR;
3027 for (i = 0; i < len; i++) {
3028 if (!isclassfunc(UCHAR(str[i]))) {
3029 Jim_SetResultBool(interp, 0);
3030 return JIM_OK;
3033 Jim_SetResultBool(interp, 1);
3034 return JIM_OK;
3037 /* -----------------------------------------------------------------------------
3038 * Compared String Object
3039 * ---------------------------------------------------------------------------*/
3041 /* This is strange object that allows comparison of a C literal string
3042 * with a Jim object in a very short time if the same comparison is done
3043 * multiple times. For example every time the [if] command is executed,
3044 * Jim has to check if a given argument is "else".
3045 * If the code has no errors, this comparison is true most of the time,
3046 * so we can cache the pointer of the string of the last matching
3047 * comparison inside the object. Because most C compilers perform literal sharing,
3048 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3049 * this works pretty well even if comparisons are at different places
3050 * inside the C code. */
3052 static const Jim_ObjType comparedStringObjType = {
3053 "compared-string",
3054 NULL,
3055 NULL,
3056 NULL,
3057 JIM_TYPE_REFERENCES,
3060 /* The only way this object is exposed to the API is via the following
3061 * function. Returns true if the string and the object string repr.
3062 * are the same, otherwise zero is returned.
3064 * Note: this isn't binary safe, but it hardly needs to be.*/
3065 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3067 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3068 return 1;
3070 else {
3071 if (strcmp(str, Jim_String(objPtr)) != 0)
3072 return 0;
3074 if (objPtr->typePtr != &comparedStringObjType) {
3075 Jim_FreeIntRep(interp, objPtr);
3076 objPtr->typePtr = &comparedStringObjType;
3078 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3079 return 1;
3083 static int qsortCompareStringPointers(const void *a, const void *b)
3085 char *const *sa = (char *const *)a;
3086 char *const *sb = (char *const *)b;
3088 return strcmp(*sa, *sb);
3092 /* -----------------------------------------------------------------------------
3093 * Source Object
3095 * This object is just a string from the language point of view, but
3096 * the internal representation contains the filename and line number
3097 * where this token was read. This information is used by
3098 * Jim_EvalObj() if the object passed happens to be of type "source".
3100 * This allows propagation of the information about line numbers and file
3101 * names and gives error messages with absolute line numbers.
3103 * Note that this object uses the internal representation of the Jim_Object,
3104 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3106 * Also the object will be converted to something else if the given
3107 * token it represents in the source file is not something to be
3108 * evaluated (not a script), and will be specialized in some other way,
3109 * so the time overhead is also almost zero.
3110 * ---------------------------------------------------------------------------*/
3112 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3113 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3115 static const Jim_ObjType sourceObjType = {
3116 "source",
3117 FreeSourceInternalRep,
3118 DupSourceInternalRep,
3119 NULL,
3120 JIM_TYPE_REFERENCES,
3123 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3125 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3128 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3130 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3131 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3134 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3135 Jim_Obj *fileNameObj, int lineNumber)
3137 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3138 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3139 Jim_IncrRefCount(fileNameObj);
3140 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3141 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3142 objPtr->typePtr = &sourceObjType;
3145 /* -----------------------------------------------------------------------------
3146 * ScriptLine Object
3148 * This object is used only in the Script internal represenation.
3149 * For each line of the script, it holds the number of tokens on the line
3150 * and the source line number.
3152 static const Jim_ObjType scriptLineObjType = {
3153 "scriptline",
3154 NULL,
3155 NULL,
3156 NULL,
3157 JIM_NONE,
3160 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3162 Jim_Obj *objPtr;
3164 #ifdef DEBUG_SHOW_SCRIPT
3165 char buf[100];
3166 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3167 objPtr = Jim_NewStringObj(interp, buf, -1);
3168 #else
3169 objPtr = Jim_NewEmptyStringObj(interp);
3170 #endif
3171 objPtr->typePtr = &scriptLineObjType;
3172 objPtr->internalRep.scriptLineValue.argc = argc;
3173 objPtr->internalRep.scriptLineValue.line = line;
3175 return objPtr;
3178 /* -----------------------------------------------------------------------------
3179 * Script Object
3181 * This object holds the parsed internal representation of a script.
3182 * This representation is help within an allocated ScriptObj (see below)
3184 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3185 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3187 static const Jim_ObjType scriptObjType = {
3188 "script",
3189 FreeScriptInternalRep,
3190 DupScriptInternalRep,
3191 NULL,
3192 JIM_TYPE_REFERENCES,
3195 /* Each token of a script is represented by a ScriptToken.
3196 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3197 * can be specialized by commands operating on it.
3199 typedef struct ScriptToken
3201 Jim_Obj *objPtr;
3202 int type;
3203 } ScriptToken;
3205 /* This is the script object internal representation. An array of
3206 * ScriptToken structures, including a pre-computed representation of the
3207 * command length and arguments.
3209 * For example the script:
3211 * puts hello
3212 * set $i $x$y [foo]BAR
3214 * will produce a ScriptObj with the following ScriptToken's:
3216 * LIN 2
3217 * ESC puts
3218 * ESC hello
3219 * LIN 4
3220 * ESC set
3221 * VAR i
3222 * WRD 2
3223 * VAR x
3224 * VAR y
3225 * WRD 2
3226 * CMD foo
3227 * ESC BAR
3229 * "puts hello" has two args (LIN 2), composed of single tokens.
3230 * (Note that the WRD token is omitted for the common case of a single token.)
3232 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3233 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3235 * The precomputation of the command structure makes Jim_Eval() faster,
3236 * and simpler because there aren't dynamic lengths / allocations.
3238 * -- {expand}/{*} handling --
3240 * Expand is handled in a special way.
3242 * If a "word" begins with {*}, the word token count is -ve.
3244 * For example the command:
3246 * list {*}{a b}
3248 * Will produce the following cmdstruct array:
3250 * LIN 2
3251 * ESC list
3252 * WRD -1
3253 * STR a b
3255 * Note that the 'LIN' token also contains the source information for the
3256 * first word of the line for error reporting purposes
3258 * -- the substFlags field of the structure --
3260 * The scriptObj structure is used to represent both "script" objects
3261 * and "subst" objects. In the second case, there are no LIN and WRD
3262 * tokens. Instead SEP and EOL tokens are added as-is.
3263 * In addition, the field 'substFlags' is used to represent the flags used to turn
3264 * the string into the internal representation.
3265 * If these flags do not match what the application requires,
3266 * the scriptObj is created again. For example the script:
3268 * subst -nocommands $string
3269 * subst -novariables $string
3271 * Will (re)create the internal representation of the $string object
3272 * two times.
3274 typedef struct ScriptObj
3276 ScriptToken *token; /* Tokens array. */
3277 Jim_Obj *fileNameObj; /* Filename */
3278 int len; /* Length of token[] */
3279 int substFlags; /* flags used for the compilation of "subst" objects */
3280 int inUse; /* Used to share a ScriptObj. Currently
3281 only used by Jim_EvalObj() as protection against
3282 shimmering of the currently evaluated object. */
3283 int firstline; /* Line number of the first line */
3284 int linenr; /* Error line number, if any */
3285 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3286 } ScriptObj;
3288 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3289 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3290 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3292 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3294 int i;
3295 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3297 if (--script->inUse != 0)
3298 return;
3299 for (i = 0; i < script->len; i++) {
3300 Jim_DecrRefCount(interp, script->token[i].objPtr);
3302 Jim_Free(script->token);
3303 Jim_DecrRefCount(interp, script->fileNameObj);
3304 Jim_Free(script);
3307 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3309 JIM_NOTUSED(interp);
3310 JIM_NOTUSED(srcPtr);
3312 /* Just return a simple string. We don't try to preserve the source info
3313 * since in practice scripts are never duplicated
3315 dupPtr->typePtr = NULL;
3318 /* A simple parse token.
3319 * As the script is parsed, the created tokens point into the script string rep.
3321 typedef struct
3323 const char *token; /* Pointer to the start of the token */
3324 int len; /* Length of this token */
3325 int type; /* Token type */
3326 int line; /* Line number */
3327 } ParseToken;
3329 /* A list of parsed tokens representing a script.
3330 * Tokens are added to this list as the script is parsed.
3331 * It grows as needed.
3333 typedef struct
3335 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3336 ParseToken *list; /* Array of tokens */
3337 int size; /* Current size of the list */
3338 int count; /* Number of entries used */
3339 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3340 } ParseTokenList;
3342 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3344 tokenlist->list = tokenlist->static_list;
3345 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3346 tokenlist->count = 0;
3349 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3351 if (tokenlist->list != tokenlist->static_list) {
3352 Jim_Free(tokenlist->list);
3357 * Adds the new token to the tokenlist.
3358 * The token has the given length, type and line number.
3359 * The token list is resized as necessary.
3361 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3362 int line)
3364 ParseToken *t;
3366 if (tokenlist->count == tokenlist->size) {
3367 /* Resize the list */
3368 tokenlist->size *= 2;
3369 if (tokenlist->list != tokenlist->static_list) {
3370 tokenlist->list =
3371 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3373 else {
3374 /* The list needs to become allocated */
3375 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3376 memcpy(tokenlist->list, tokenlist->static_list,
3377 tokenlist->count * sizeof(*tokenlist->list));
3380 t = &tokenlist->list[tokenlist->count++];
3381 t->token = token;
3382 t->len = len;
3383 t->type = type;
3384 t->line = line;
3387 /* Counts the number of adjoining non-separator tokens.
3389 * Returns -ve if the first token is the expansion
3390 * operator (in which case the count doesn't include
3391 * that token).
3393 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3395 int expand = 1;
3396 int count = 0;
3398 /* Is the first word {*} or {expand}? */
3399 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3400 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3401 /* Create an expand token */
3402 expand = -1;
3403 t++;
3405 else {
3406 if (script->missing == ' ') {
3407 /* This is a "extra characters after close-brace" error. Report the first error */
3408 script->missing = '}';
3409 script->linenr = t[1].line;
3414 /* Now count non-separator words */
3415 while (!TOKEN_IS_SEP(t->type)) {
3416 t++;
3417 count++;
3420 return count * expand;
3424 * Create a script/subst object from the given token.
3426 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3428 Jim_Obj *objPtr;
3430 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3431 /* Convert backlash escapes. The result will never be longer than the original */
3432 int len = t->len;
3433 char *str = Jim_Alloc(len + 1);
3434 len = JimEscape(str, t->token, len);
3435 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3437 else {
3438 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3439 * with a single space.
3441 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3443 return objPtr;
3447 * Takes a tokenlist and creates the allocated list of script tokens
3448 * in script->token, of length script->len.
3450 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3451 * as required.
3453 * Also sets script->line to the line number of the first token
3455 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3456 ParseTokenList *tokenlist)
3458 int i;
3459 struct ScriptToken *token;
3460 /* Number of tokens so far for the current command */
3461 int lineargs = 0;
3462 /* This is the first token for the current command */
3463 ScriptToken *linefirst;
3464 int count;
3465 int linenr;
3467 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3468 printf("==== Tokens ====\n");
3469 for (i = 0; i < tokenlist->count; i++) {
3470 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3471 tokenlist->list[i].len, tokenlist->list[i].token);
3473 #endif
3475 /* May need up to one extra script token for each EOL in the worst case */
3476 count = tokenlist->count;
3477 for (i = 0; i < tokenlist->count; i++) {
3478 if (tokenlist->list[i].type == JIM_TT_EOL) {
3479 count++;
3482 linenr = script->firstline = tokenlist->list[0].line;
3484 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3486 /* This is the first token for the current command */
3487 linefirst = token++;
3489 for (i = 0; i < tokenlist->count; ) {
3490 /* Look ahead to find out how many tokens make up the next word */
3491 int wordtokens;
3493 /* Skip any leading separators */
3494 while (tokenlist->list[i].type == JIM_TT_SEP) {
3495 i++;
3498 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3500 if (wordtokens == 0) {
3501 /* None, so at end of line */
3502 if (lineargs) {
3503 linefirst->type = JIM_TT_LINE;
3504 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3505 Jim_IncrRefCount(linefirst->objPtr);
3507 /* Reset for new line */
3508 lineargs = 0;
3509 linefirst = token++;
3511 i++;
3512 continue;
3514 else if (wordtokens != 1) {
3515 /* More than 1, or {*}, so insert a WORD token */
3516 token->type = JIM_TT_WORD;
3517 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3518 Jim_IncrRefCount(token->objPtr);
3519 token++;
3520 if (wordtokens < 0) {
3521 /* Skip the expand token */
3522 i++;
3523 wordtokens = -wordtokens - 1;
3524 lineargs--;
3528 if (lineargs == 0) {
3529 /* First real token on the line, so record the line number */
3530 linenr = tokenlist->list[i].line;
3532 lineargs++;
3534 /* Add each non-separator word token to the line */
3535 while (wordtokens--) {
3536 const ParseToken *t = &tokenlist->list[i++];
3538 token->type = t->type;
3539 token->objPtr = JimMakeScriptObj(interp, t);
3540 Jim_IncrRefCount(token->objPtr);
3542 /* Every object is initially a string of type 'source', but the
3543 * internal type may be specialized during execution of the
3544 * script. */
3545 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3546 token++;
3550 if (lineargs == 0) {
3551 token--;
3554 script->len = token - script->token;
3556 JimPanic((script->len >= count, "allocated script array is too short"));
3558 #ifdef DEBUG_SHOW_SCRIPT
3559 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3560 for (i = 0; i < script->len; i++) {
3561 const ScriptToken *t = &script->token[i];
3562 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3564 #endif
3568 /* Parses the given string object to determine if it represents a complete script.
3570 * This is useful for interactive shells implementation, for [info complete].
3572 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3573 * '{' on scripts incomplete missing one or more '}' to be balanced.
3574 * '[' on scripts incomplete missing one or more ']' to be balanced.
3575 * '"' on scripts incomplete missing a '"' char.
3576 * '\\' on scripts with a trailing backslash.
3578 * If the script is complete, 1 is returned, otherwise 0.
3580 * If the script has extra characters after a close brace, this still returns 1,
3581 * but sets *stateCharPtr to '}'
3582 * Evaluating the script will give the error "extra characters after close-brace".
3584 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3586 ScriptObj *script = JimGetScript(interp, scriptObj);
3587 if (stateCharPtr) {
3588 *stateCharPtr = script->missing;
3590 return script->missing == ' ' || script->missing == '}';
3594 * Sets an appropriate error message for a missing script/expression terminator.
3596 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3598 * Note that a trailing backslash is not considered to be an error.
3600 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3602 const char *msg;
3604 switch (ch) {
3605 case '\\':
3606 case ' ':
3607 return JIM_OK;
3609 case '[':
3610 msg = "unmatched \"[\"";
3611 break;
3612 case '{':
3613 msg = "missing close-brace";
3614 break;
3615 case '}':
3616 msg = "extra characters after close-brace";
3617 break;
3618 case '"':
3619 default:
3620 msg = "missing quote";
3621 break;
3624 Jim_SetResultString(interp, msg, -1);
3625 return JIM_ERR;
3629 * Similar to ScriptObjAddTokens(), but for subst objects.
3631 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3632 ParseTokenList *tokenlist)
3634 int i;
3635 struct ScriptToken *token;
3637 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3639 for (i = 0; i < tokenlist->count; i++) {
3640 const ParseToken *t = &tokenlist->list[i];
3642 /* Create a token for 't' */
3643 token->type = t->type;
3644 token->objPtr = JimMakeScriptObj(interp, t);
3645 Jim_IncrRefCount(token->objPtr);
3646 token++;
3649 script->len = i;
3652 /* This method takes the string representation of an object
3653 * as a Tcl script, and generates the pre-parsed internal representation
3654 * of the script.
3656 * On parse error, sets an error message and returns JIM_ERR
3657 * (Note: the object is still converted to a script, even if an error occurs)
3659 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3661 int scriptTextLen;
3662 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3663 struct JimParserCtx parser;
3664 struct ScriptObj *script;
3665 ParseTokenList tokenlist;
3666 int line = 1;
3668 /* Try to get information about filename / line number */
3669 if (objPtr->typePtr == &sourceObjType) {
3670 line = objPtr->internalRep.sourceValue.lineNumber;
3673 /* Initially parse the script into tokens (in tokenlist) */
3674 ScriptTokenListInit(&tokenlist);
3676 JimParserInit(&parser, scriptText, scriptTextLen, line);
3677 while (!parser.eof) {
3678 JimParseScript(&parser);
3679 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3680 parser.tline);
3683 /* Add a final EOF token */
3684 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3686 /* Create the "real" script tokens from the parsed tokens */
3687 script = Jim_Alloc(sizeof(*script));
3688 memset(script, 0, sizeof(*script));
3689 script->inUse = 1;
3690 if (objPtr->typePtr == &sourceObjType) {
3691 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3693 else {
3694 script->fileNameObj = interp->emptyObj;
3696 Jim_IncrRefCount(script->fileNameObj);
3697 script->missing = parser.missing.ch;
3698 script->linenr = parser.missing.line;
3700 ScriptObjAddTokens(interp, script, &tokenlist);
3702 /* No longer need the token list */
3703 ScriptTokenListFree(&tokenlist);
3705 /* Free the old internal rep and set the new one. */
3706 Jim_FreeIntRep(interp, objPtr);
3707 Jim_SetIntRepPtr(objPtr, script);
3708 objPtr->typePtr = &scriptObjType;
3711 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3714 * Returns the parsed script.
3715 * Note that if there is any possibility that the script is not valid,
3716 * call JimScriptValid() to check
3718 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3720 if (objPtr == interp->emptyObj) {
3721 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3722 objPtr = interp->nullScriptObj;
3725 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3726 JimSetScriptFromAny(interp, objPtr);
3729 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3733 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3734 * and leaves an error message in the interp result.
3737 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3739 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3740 JimAddErrorToStack(interp, script);
3741 return 0;
3743 return 1;
3747 /* -----------------------------------------------------------------------------
3748 * Commands
3749 * ---------------------------------------------------------------------------*/
3750 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3752 cmdPtr->inUse++;
3755 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3757 if (--cmdPtr->inUse == 0) {
3758 if (cmdPtr->isproc) {
3759 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3760 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3761 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3762 if (cmdPtr->u.proc.staticVars) {
3763 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3764 Jim_Free(cmdPtr->u.proc.staticVars);
3767 else {
3768 /* native (C) */
3769 if (cmdPtr->u.native.delProc) {
3770 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3773 if (cmdPtr->prevCmd) {
3774 /* Delete any pushed command too */
3775 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3777 Jim_Free(cmdPtr);
3781 /* Variables HashTable Type.
3783 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3785 static void JimVariablesHTValDestructor(void *interp, void *val)
3787 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3788 Jim_Free(val);
3791 static const Jim_HashTableType JimVariablesHashTableType = {
3792 JimStringCopyHTHashFunction, /* hash function */
3793 JimStringCopyHTDup, /* key dup */
3794 NULL, /* val dup */
3795 JimStringCopyHTKeyCompare, /* key compare */
3796 JimStringCopyHTKeyDestructor, /* key destructor */
3797 JimVariablesHTValDestructor /* val destructor */
3800 /* Commands HashTable Type.
3802 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3804 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3806 JimDecrCmdRefCount(interp, val);
3809 static const Jim_HashTableType JimCommandsHashTableType = {
3810 JimStringCopyHTHashFunction, /* hash function */
3811 JimStringCopyHTDup, /* key dup */
3812 NULL, /* val dup */
3813 JimStringCopyHTKeyCompare, /* key compare */
3814 JimStringCopyHTKeyDestructor, /* key destructor */
3815 JimCommandsHT_ValDestructor /* val destructor */
3818 /* ------------------------- Commands related functions --------------------- */
3820 #ifdef jim_ext_namespace
3822 * Returns the "unscoped" version of the given namespace.
3823 * That is, the fully qualified name without the leading ::
3824 * The returned value is either nsObj, or an object with a zero ref count.
3826 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3828 const char *name = Jim_String(nsObj);
3829 if (name[0] == ':' && name[1] == ':') {
3830 /* This command is being defined in the global namespace */
3831 while (*++name == ':') {
3833 nsObj = Jim_NewStringObj(interp, name, -1);
3835 else if (Jim_Length(interp->framePtr->nsObj)) {
3836 /* This command is being defined in a non-global namespace */
3837 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3838 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3840 return nsObj;
3844 * If nameObjPtr starts with "::", returns it.
3845 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3846 * In this case, decrements the ref count of nameObjPtr.
3848 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3850 Jim_Obj *resultObj;
3852 const char *name = Jim_String(nameObjPtr);
3853 if (name[0] == ':' && name[1] == ':') {
3854 return nameObjPtr;
3856 Jim_IncrRefCount(nameObjPtr);
3857 resultObj = Jim_NewStringObj(interp, "::", -1);
3858 Jim_AppendObj(interp, resultObj, nameObjPtr);
3859 Jim_DecrRefCount(interp, nameObjPtr);
3861 return resultObj;
3865 * An efficient version of JimQualifyNameObj() where the name is
3866 * available (and needed) as a 'const char *'.
3867 * Avoids creating an object if not necessary.
3868 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3870 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3872 Jim_Obj *objPtr = interp->emptyObj;
3874 if (name[0] == ':' && name[1] == ':') {
3875 /* This command is being defined in the global namespace */
3876 while (*++name == ':') {
3879 else if (Jim_Length(interp->framePtr->nsObj)) {
3880 /* This command is being defined in a non-global namespace */
3881 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3882 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3883 name = Jim_String(objPtr);
3885 Jim_IncrRefCount(objPtr);
3886 *objPtrPtr = objPtr;
3887 return name;
3890 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3892 #else
3893 /* We can be more efficient in the no-namespace case */
3894 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3895 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3897 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3899 return nameObjPtr;
3901 #endif
3903 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3905 /* It may already exist, so we try to delete the old one.
3906 * Note that reference count means that it won't be deleted yet if
3907 * it exists in the call stack.
3909 * BUT, if 'local' is in force, instead of deleting the existing
3910 * proc, we stash a reference to the old proc here.
3912 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3913 if (he) {
3914 /* There was an old cmd with the same name,
3915 * so this requires a 'proc epoch' update. */
3917 /* If a procedure with the same name didn't exist there is no need
3918 * to increment the 'proc epoch' because creation of a new procedure
3919 * can never affect existing cached commands. We don't do
3920 * negative caching. */
3921 Jim_InterpIncrProcEpoch(interp);
3924 if (he && interp->local) {
3925 /* Push this command over the top of the previous one */
3926 cmd->prevCmd = Jim_GetHashEntryVal(he);
3927 Jim_SetHashVal(&interp->commands, he, cmd);
3929 else {
3930 if (he) {
3931 /* Replace the existing command */
3932 Jim_DeleteHashEntry(&interp->commands, name);
3935 Jim_AddHashEntry(&interp->commands, name, cmd);
3937 return JIM_OK;
3941 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3942 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3944 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3946 /* Store the new details for this command */
3947 memset(cmdPtr, 0, sizeof(*cmdPtr));
3948 cmdPtr->inUse = 1;
3949 cmdPtr->u.native.delProc = delProc;
3950 cmdPtr->u.native.cmdProc = cmdProc;
3951 cmdPtr->u.native.privData = privData;
3953 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3955 return JIM_OK;
3958 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3960 int len, i;
3962 len = Jim_ListLength(interp, staticsListObjPtr);
3963 if (len == 0) {
3964 return JIM_OK;
3967 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3968 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3969 for (i = 0; i < len; i++) {
3970 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3971 Jim_Var *varPtr;
3972 int subLen;
3974 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3975 /* Check if it's composed of two elements. */
3976 subLen = Jim_ListLength(interp, objPtr);
3977 if (subLen == 1 || subLen == 2) {
3978 /* Try to get the variable value from the current
3979 * environment. */
3980 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3981 if (subLen == 1) {
3982 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3983 if (initObjPtr == NULL) {
3984 Jim_SetResultFormatted(interp,
3985 "variable for initialization of static \"%#s\" not found in the local context",
3986 nameObjPtr);
3987 return JIM_ERR;
3990 else {
3991 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3993 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3994 return JIM_ERR;
3997 varPtr = Jim_Alloc(sizeof(*varPtr));
3998 varPtr->objPtr = initObjPtr;
3999 Jim_IncrRefCount(initObjPtr);
4000 varPtr->linkFramePtr = NULL;
4001 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
4002 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
4003 Jim_SetResultFormatted(interp,
4004 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4005 Jim_DecrRefCount(interp, initObjPtr);
4006 Jim_Free(varPtr);
4007 return JIM_ERR;
4010 else {
4011 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4012 objPtr);
4013 return JIM_ERR;
4016 return JIM_OK;
4020 * If the command is a proc, sets/updates the cached namespace (nsObj)
4021 * based on the command name.
4023 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4025 #ifdef jim_ext_namespace
4026 if (cmdPtr->isproc) {
4027 /* XXX: Really need JimNamespaceSplit() */
4028 const char *pt = strrchr(cmdname, ':');
4029 if (pt && pt != cmdname && pt[-1] == ':') {
4030 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4031 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4032 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4034 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4035 /* This command shadows a global command, so a proc epoch update is required */
4036 Jim_InterpIncrProcEpoch(interp);
4040 #endif
4043 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4044 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4046 Jim_Cmd *cmdPtr;
4047 int argListLen;
4048 int i;
4050 argListLen = Jim_ListLength(interp, argListObjPtr);
4052 /* Allocate space for both the command pointer and the arg list */
4053 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4054 memset(cmdPtr, 0, sizeof(*cmdPtr));
4055 cmdPtr->inUse = 1;
4056 cmdPtr->isproc = 1;
4057 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4058 cmdPtr->u.proc.argListLen = argListLen;
4059 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4060 cmdPtr->u.proc.argsPos = -1;
4061 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4062 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4063 Jim_IncrRefCount(argListObjPtr);
4064 Jim_IncrRefCount(bodyObjPtr);
4065 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4067 /* Create the statics hash table. */
4068 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4069 goto err;
4072 /* Parse the args out into arglist, validating as we go */
4073 /* Examine the argument list for default parameters and 'args' */
4074 for (i = 0; i < argListLen; i++) {
4075 Jim_Obj *argPtr;
4076 Jim_Obj *nameObjPtr;
4077 Jim_Obj *defaultObjPtr;
4078 int len;
4080 /* Examine a parameter */
4081 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4082 len = Jim_ListLength(interp, argPtr);
4083 if (len == 0) {
4084 Jim_SetResultString(interp, "argument with no name", -1);
4085 err:
4086 JimDecrCmdRefCount(interp, cmdPtr);
4087 return NULL;
4089 if (len > 2) {
4090 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4091 goto err;
4094 if (len == 2) {
4095 /* Optional parameter */
4096 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4097 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4099 else {
4100 /* Required parameter */
4101 nameObjPtr = argPtr;
4102 defaultObjPtr = NULL;
4106 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4107 if (cmdPtr->u.proc.argsPos >= 0) {
4108 Jim_SetResultString(interp, "'args' specified more than once", -1);
4109 goto err;
4111 cmdPtr->u.proc.argsPos = i;
4113 else {
4114 if (len == 2) {
4115 cmdPtr->u.proc.optArity++;
4117 else {
4118 cmdPtr->u.proc.reqArity++;
4122 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4123 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4126 return cmdPtr;
4129 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4131 int ret = JIM_OK;
4132 Jim_Obj *qualifiedNameObj;
4133 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4135 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4136 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4137 ret = JIM_ERR;
4139 else {
4140 Jim_InterpIncrProcEpoch(interp);
4143 JimFreeQualifiedName(interp, qualifiedNameObj);
4145 return ret;
4148 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4150 int ret = JIM_ERR;
4151 Jim_HashEntry *he;
4152 Jim_Cmd *cmdPtr;
4153 Jim_Obj *qualifiedOldNameObj;
4154 Jim_Obj *qualifiedNewNameObj;
4155 const char *fqold;
4156 const char *fqnew;
4158 if (newName[0] == 0) {
4159 return Jim_DeleteCommand(interp, oldName);
4162 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4163 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4165 /* Does it exist? */
4166 he = Jim_FindHashEntry(&interp->commands, fqold);
4167 if (he == NULL) {
4168 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4170 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4171 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4173 else {
4174 /* Add the new name first */
4175 cmdPtr = Jim_GetHashEntryVal(he);
4176 JimIncrCmdRefCount(cmdPtr);
4177 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4178 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4180 /* Now remove the old name */
4181 Jim_DeleteHashEntry(&interp->commands, fqold);
4183 /* Increment the epoch */
4184 Jim_InterpIncrProcEpoch(interp);
4186 ret = JIM_OK;
4189 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4190 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4192 return ret;
4195 /* -----------------------------------------------------------------------------
4196 * Command object
4197 * ---------------------------------------------------------------------------*/
4199 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4201 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4204 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4206 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4207 dupPtr->typePtr = srcPtr->typePtr;
4208 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4211 static const Jim_ObjType commandObjType = {
4212 "command",
4213 FreeCommandInternalRep,
4214 DupCommandInternalRep,
4215 NULL,
4216 JIM_TYPE_REFERENCES,
4219 /* This function returns the command structure for the command name
4220 * stored in objPtr. It specializes the objPtr to contain
4221 * cached info instead of performing the lookup into the hash table
4222 * every time. The information cached may not be up-to-date, in this
4223 * case the lookup is performed and the cache updated.
4225 * Respects the 'upcall' setting.
4227 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4229 Jim_Cmd *cmd;
4231 /* In order to be valid, the proc epoch must match and
4232 * the lookup must have occurred in the same namespace
4234 if (objPtr->typePtr != &commandObjType ||
4235 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4236 #ifdef jim_ext_namespace
4237 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4238 #endif
4240 /* Not cached or out of date, so lookup */
4242 /* Do we need to try the local namespace? */
4243 const char *name = Jim_String(objPtr);
4244 Jim_HashEntry *he;
4246 if (name[0] == ':' && name[1] == ':') {
4247 while (*++name == ':') {
4250 #ifdef jim_ext_namespace
4251 else if (Jim_Length(interp->framePtr->nsObj)) {
4252 /* This command is being defined in a non-global namespace */
4253 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4254 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4255 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4256 Jim_FreeNewObj(interp, nameObj);
4257 if (he) {
4258 goto found;
4261 #endif
4263 /* Lookup in the global namespace */
4264 he = Jim_FindHashEntry(&interp->commands, name);
4265 if (he == NULL) {
4266 if (flags & JIM_ERRMSG) {
4267 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4269 return NULL;
4271 #ifdef jim_ext_namespace
4272 found:
4273 #endif
4274 cmd = Jim_GetHashEntryVal(he);
4276 /* Free the old internal rep and set the new one. */
4277 Jim_FreeIntRep(interp, objPtr);
4278 objPtr->typePtr = &commandObjType;
4279 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4280 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4281 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4282 Jim_IncrRefCount(interp->framePtr->nsObj);
4284 else {
4285 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4287 while (cmd->u.proc.upcall) {
4288 cmd = cmd->prevCmd;
4290 return cmd;
4293 /* -----------------------------------------------------------------------------
4294 * Variables
4295 * ---------------------------------------------------------------------------*/
4297 /* -----------------------------------------------------------------------------
4298 * Variable object
4299 * ---------------------------------------------------------------------------*/
4301 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4303 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4305 static const Jim_ObjType variableObjType = {
4306 "variable",
4307 NULL,
4308 NULL,
4309 NULL,
4310 JIM_TYPE_REFERENCES,
4314 * Check that the name does not contain embedded nulls.
4316 * Variable and procedure names are manipulated as null terminated strings, so
4317 * don't allow names with embedded nulls.
4319 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4321 /* Variable names and proc names can't contain embedded nulls */
4322 if (nameObjPtr->typePtr != &variableObjType) {
4323 int len;
4324 const char *str = Jim_GetString(nameObjPtr, &len);
4325 if (memchr(str, '\0', len)) {
4326 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4327 return JIM_ERR;
4330 return JIM_OK;
4333 /* This method should be called only by the variable API.
4334 * It returns JIM_OK on success (variable already exists),
4335 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4336 * a variable name, but syntax glue for [dict] i.e. the last
4337 * character is ')' */
4338 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4340 const char *varName;
4341 Jim_CallFrame *framePtr;
4342 Jim_HashEntry *he;
4343 int global;
4344 int len;
4346 /* Check if the object is already an uptodate variable */
4347 if (objPtr->typePtr == &variableObjType) {
4348 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4349 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4350 /* nothing to do */
4351 return JIM_OK;
4353 /* Need to re-resolve the variable in the updated callframe */
4355 else if (objPtr->typePtr == &dictSubstObjType) {
4356 return JIM_DICT_SUGAR;
4358 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4359 return JIM_ERR;
4363 varName = Jim_GetString(objPtr, &len);
4365 /* Make sure it's not syntax glue to get/set dict. */
4366 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4367 return JIM_DICT_SUGAR;
4370 if (varName[0] == ':' && varName[1] == ':') {
4371 while (*++varName == ':') {
4373 global = 1;
4374 framePtr = interp->topFramePtr;
4376 else {
4377 global = 0;
4378 framePtr = interp->framePtr;
4381 /* Resolve this name in the variables hash table */
4382 he = Jim_FindHashEntry(&framePtr->vars, varName);
4383 if (he == NULL) {
4384 if (!global && framePtr->staticVars) {
4385 /* Try with static vars. */
4386 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4388 if (he == NULL) {
4389 return JIM_ERR;
4393 /* Free the old internal repr and set the new one. */
4394 Jim_FreeIntRep(interp, objPtr);
4395 objPtr->typePtr = &variableObjType;
4396 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4397 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4398 objPtr->internalRep.varValue.global = global;
4399 return JIM_OK;
4402 /* -------------------- Variables related functions ------------------------- */
4403 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4404 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4406 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4408 const char *name;
4409 Jim_CallFrame *framePtr;
4410 int global;
4412 /* New variable to create */
4413 Jim_Var *var = Jim_Alloc(sizeof(*var));
4415 var->objPtr = valObjPtr;
4416 Jim_IncrRefCount(valObjPtr);
4417 var->linkFramePtr = NULL;
4419 name = Jim_String(nameObjPtr);
4420 if (name[0] == ':' && name[1] == ':') {
4421 while (*++name == ':') {
4423 framePtr = interp->topFramePtr;
4424 global = 1;
4426 else {
4427 framePtr = interp->framePtr;
4428 global = 0;
4431 /* Insert the new variable */
4432 Jim_AddHashEntry(&framePtr->vars, name, var);
4434 /* Make the object int rep a variable */
4435 Jim_FreeIntRep(interp, nameObjPtr);
4436 nameObjPtr->typePtr = &variableObjType;
4437 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4438 nameObjPtr->internalRep.varValue.varPtr = var;
4439 nameObjPtr->internalRep.varValue.global = global;
4441 return var;
4444 /* For now that's dummy. Variables lookup should be optimized
4445 * in many ways, with caching of lookups, and possibly with
4446 * a table of pre-allocated vars in every CallFrame for local vars.
4447 * All the caching should also have an 'epoch' mechanism similar
4448 * to the one used by Tcl for procedures lookup caching. */
4451 * Set the variable nameObjPtr to value valObjptr.
4453 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4455 int err;
4456 Jim_Var *var;
4458 switch (SetVariableFromAny(interp, nameObjPtr)) {
4459 case JIM_DICT_SUGAR:
4460 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4462 case JIM_ERR:
4463 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4464 return JIM_ERR;
4466 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4467 break;
4469 case JIM_OK:
4470 var = nameObjPtr->internalRep.varValue.varPtr;
4471 if (var->linkFramePtr == NULL) {
4472 Jim_IncrRefCount(valObjPtr);
4473 Jim_DecrRefCount(interp, var->objPtr);
4474 var->objPtr = valObjPtr;
4476 else { /* Else handle the link */
4477 Jim_CallFrame *savedCallFrame;
4479 savedCallFrame = interp->framePtr;
4480 interp->framePtr = var->linkFramePtr;
4481 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4482 interp->framePtr = savedCallFrame;
4483 if (err != JIM_OK)
4484 return err;
4487 return JIM_OK;
4490 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4492 Jim_Obj *nameObjPtr;
4493 int result;
4495 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4496 Jim_IncrRefCount(nameObjPtr);
4497 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4498 Jim_DecrRefCount(interp, nameObjPtr);
4499 return result;
4502 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4504 Jim_CallFrame *savedFramePtr;
4505 int result;
4507 savedFramePtr = interp->framePtr;
4508 interp->framePtr = interp->topFramePtr;
4509 result = Jim_SetVariableStr(interp, name, objPtr);
4510 interp->framePtr = savedFramePtr;
4511 return result;
4514 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4516 Jim_Obj *valObjPtr;
4517 int result;
4519 valObjPtr = Jim_NewStringObj(interp, val, -1);
4520 Jim_IncrRefCount(valObjPtr);
4521 result = Jim_SetVariableStr(interp, name, valObjPtr);
4522 Jim_DecrRefCount(interp, valObjPtr);
4523 return result;
4526 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4527 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4529 const char *varName;
4530 const char *targetName;
4531 Jim_CallFrame *framePtr;
4532 Jim_Var *varPtr;
4534 /* Check for an existing variable or link */
4535 switch (SetVariableFromAny(interp, nameObjPtr)) {
4536 case JIM_DICT_SUGAR:
4537 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4538 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4539 return JIM_ERR;
4541 case JIM_OK:
4542 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4544 if (varPtr->linkFramePtr == NULL) {
4545 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4546 return JIM_ERR;
4549 /* It exists, but is a link, so first delete the link */
4550 varPtr->linkFramePtr = NULL;
4551 break;
4554 /* Resolve the call frames for both variables */
4555 /* XXX: SetVariableFromAny() already did this! */
4556 varName = Jim_String(nameObjPtr);
4558 if (varName[0] == ':' && varName[1] == ':') {
4559 while (*++varName == ':') {
4561 /* Linking a global var does nothing */
4562 framePtr = interp->topFramePtr;
4564 else {
4565 framePtr = interp->framePtr;
4568 targetName = Jim_String(targetNameObjPtr);
4569 if (targetName[0] == ':' && targetName[1] == ':') {
4570 while (*++targetName == ':') {
4572 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4573 targetCallFrame = interp->topFramePtr;
4575 Jim_IncrRefCount(targetNameObjPtr);
4577 if (framePtr->level < targetCallFrame->level) {
4578 Jim_SetResultFormatted(interp,
4579 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4580 nameObjPtr);
4581 Jim_DecrRefCount(interp, targetNameObjPtr);
4582 return JIM_ERR;
4585 /* Check for cycles. */
4586 if (framePtr == targetCallFrame) {
4587 Jim_Obj *objPtr = targetNameObjPtr;
4589 /* Cycles are only possible with 'uplevel 0' */
4590 while (1) {
4591 if (strcmp(Jim_String(objPtr), varName) == 0) {
4592 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4593 Jim_DecrRefCount(interp, targetNameObjPtr);
4594 return JIM_ERR;
4596 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4597 break;
4598 varPtr = objPtr->internalRep.varValue.varPtr;
4599 if (varPtr->linkFramePtr != targetCallFrame)
4600 break;
4601 objPtr = varPtr->objPtr;
4605 /* Perform the binding */
4606 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4607 /* We are now sure 'nameObjPtr' type is variableObjType */
4608 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4609 Jim_DecrRefCount(interp, targetNameObjPtr);
4610 return JIM_OK;
4613 /* Return the Jim_Obj pointer associated with a variable name,
4614 * or NULL if the variable was not found in the current context.
4615 * The same optimization discussed in the comment to the
4616 * 'SetVariable' function should apply here.
4618 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4619 * in a dictionary which is shared, the array variable value is duplicated first.
4620 * This allows the array element to be updated (e.g. append, lappend) without
4621 * affecting other references to the dictionary.
4623 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4625 switch (SetVariableFromAny(interp, nameObjPtr)) {
4626 case JIM_OK:{
4627 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4629 if (varPtr->linkFramePtr == NULL) {
4630 return varPtr->objPtr;
4632 else {
4633 Jim_Obj *objPtr;
4635 /* The variable is a link? Resolve it. */
4636 Jim_CallFrame *savedCallFrame = interp->framePtr;
4638 interp->framePtr = varPtr->linkFramePtr;
4639 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4640 interp->framePtr = savedCallFrame;
4641 if (objPtr) {
4642 return objPtr;
4644 /* Error, so fall through to the error message */
4647 break;
4649 case JIM_DICT_SUGAR:
4650 /* [dict] syntax sugar. */
4651 return JimDictSugarGet(interp, nameObjPtr, flags);
4653 if (flags & JIM_ERRMSG) {
4654 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4656 return NULL;
4659 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4661 Jim_CallFrame *savedFramePtr;
4662 Jim_Obj *objPtr;
4664 savedFramePtr = interp->framePtr;
4665 interp->framePtr = interp->topFramePtr;
4666 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4667 interp->framePtr = savedFramePtr;
4669 return objPtr;
4672 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4674 Jim_Obj *nameObjPtr, *varObjPtr;
4676 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4677 Jim_IncrRefCount(nameObjPtr);
4678 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4679 Jim_DecrRefCount(interp, nameObjPtr);
4680 return varObjPtr;
4683 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4685 Jim_CallFrame *savedFramePtr;
4686 Jim_Obj *objPtr;
4688 savedFramePtr = interp->framePtr;
4689 interp->framePtr = interp->topFramePtr;
4690 objPtr = Jim_GetVariableStr(interp, name, flags);
4691 interp->framePtr = savedFramePtr;
4693 return objPtr;
4696 /* Unset a variable.
4697 * Note: On success unset invalidates all the (cached) variable objects
4698 * by incrementing callFrameEpoch
4700 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4702 Jim_Var *varPtr;
4703 int retval;
4704 Jim_CallFrame *framePtr;
4706 retval = SetVariableFromAny(interp, nameObjPtr);
4707 if (retval == JIM_DICT_SUGAR) {
4708 /* [dict] syntax sugar. */
4709 return JimDictSugarSet(interp, nameObjPtr, NULL);
4711 else if (retval == JIM_OK) {
4712 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4714 /* If it's a link call UnsetVariable recursively */
4715 if (varPtr->linkFramePtr) {
4716 framePtr = interp->framePtr;
4717 interp->framePtr = varPtr->linkFramePtr;
4718 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4719 interp->framePtr = framePtr;
4721 else {
4722 const char *name = Jim_String(nameObjPtr);
4723 if (nameObjPtr->internalRep.varValue.global) {
4724 name += 2;
4725 framePtr = interp->topFramePtr;
4727 else {
4728 framePtr = interp->framePtr;
4731 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4732 if (retval == JIM_OK) {
4733 /* Change the callframe id, invalidating var lookup caching */
4734 framePtr->id = interp->callFrameEpoch++;
4738 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4739 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4741 return retval;
4744 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4746 /* Given a variable name for [dict] operation syntax sugar,
4747 * this function returns two objects, the first with the name
4748 * of the variable to set, and the second with the respective key.
4749 * For example "foo(bar)" will return objects with string repr. of
4750 * "foo" and "bar".
4752 * The returned objects have refcount = 1. The function can't fail. */
4753 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4754 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4756 const char *str, *p;
4757 int len, keyLen;
4758 Jim_Obj *varObjPtr, *keyObjPtr;
4760 str = Jim_GetString(objPtr, &len);
4762 p = strchr(str, '(');
4763 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4765 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4767 p++;
4768 keyLen = (str + len) - p;
4769 if (str[len - 1] == ')') {
4770 keyLen--;
4773 /* Create the objects with the variable name and key. */
4774 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4776 Jim_IncrRefCount(varObjPtr);
4777 Jim_IncrRefCount(keyObjPtr);
4778 *varPtrPtr = varObjPtr;
4779 *keyPtrPtr = keyObjPtr;
4782 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4783 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4784 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4786 int err;
4788 SetDictSubstFromAny(interp, objPtr);
4790 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4791 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4793 if (err == JIM_OK) {
4794 /* Don't keep an extra ref to the result */
4795 Jim_SetEmptyResult(interp);
4797 else {
4798 if (!valObjPtr) {
4799 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4800 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4801 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4802 objPtr);
4803 return err;
4806 /* Make the error more informative and Tcl-compatible */
4807 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4808 (valObjPtr ? "set" : "unset"), objPtr);
4810 return err;
4814 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4816 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4817 * and stored back to the variable before expansion.
4819 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4820 Jim_Obj *keyObjPtr, int flags)
4822 Jim_Obj *dictObjPtr;
4823 Jim_Obj *resObjPtr = NULL;
4824 int ret;
4826 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4827 if (!dictObjPtr) {
4828 return NULL;
4831 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4832 if (ret != JIM_OK) {
4833 Jim_SetResultFormatted(interp,
4834 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4835 ret < 0 ? "variable isn't" : "no such element in");
4837 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4838 /* Update the variable to have an unshared copy */
4839 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4842 return resObjPtr;
4845 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4846 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4848 SetDictSubstFromAny(interp, objPtr);
4850 return JimDictExpandArrayVariable(interp,
4851 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4852 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4855 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4857 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4859 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4860 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4863 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4865 /* Copy the internal rep */
4866 dupPtr->internalRep = srcPtr->internalRep;
4867 /* Need to increment the ref counts */
4868 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4869 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4872 /* Note: The object *must* be in dict-sugar format */
4873 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4875 if (objPtr->typePtr != &dictSubstObjType) {
4876 Jim_Obj *varObjPtr, *keyObjPtr;
4878 if (objPtr->typePtr == &interpolatedObjType) {
4879 /* An interpolated object in dict-sugar form */
4881 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4882 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4884 Jim_IncrRefCount(varObjPtr);
4885 Jim_IncrRefCount(keyObjPtr);
4887 else {
4888 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4891 Jim_FreeIntRep(interp, objPtr);
4892 objPtr->typePtr = &dictSubstObjType;
4893 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4894 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4898 /* This function is used to expand [dict get] sugar in the form
4899 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4900 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4901 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4902 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4903 * the [dict]ionary contained in variable VARNAME. */
4904 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4906 Jim_Obj *resObjPtr = NULL;
4907 Jim_Obj *substKeyObjPtr = NULL;
4909 SetDictSubstFromAny(interp, objPtr);
4911 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4912 &substKeyObjPtr, JIM_NONE)
4913 != JIM_OK) {
4914 return NULL;
4916 Jim_IncrRefCount(substKeyObjPtr);
4917 resObjPtr =
4918 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4919 substKeyObjPtr, 0);
4920 Jim_DecrRefCount(interp, substKeyObjPtr);
4922 return resObjPtr;
4925 /* -----------------------------------------------------------------------------
4926 * CallFrame
4927 * ---------------------------------------------------------------------------*/
4929 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4931 Jim_CallFrame *cf;
4933 if (interp->freeFramesList) {
4934 cf = interp->freeFramesList;
4935 interp->freeFramesList = cf->next;
4937 cf->argv = NULL;
4938 cf->argc = 0;
4939 cf->procArgsObjPtr = NULL;
4940 cf->procBodyObjPtr = NULL;
4941 cf->next = NULL;
4942 cf->staticVars = NULL;
4943 cf->localCommands = NULL;
4944 cf->tailcallObj = NULL;
4945 cf->tailcallCmd = NULL;
4947 else {
4948 cf = Jim_Alloc(sizeof(*cf));
4949 memset(cf, 0, sizeof(*cf));
4951 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4954 cf->id = interp->callFrameEpoch++;
4955 cf->parent = parent;
4956 cf->level = parent ? parent->level + 1 : 0;
4957 cf->nsObj = nsObj;
4958 Jim_IncrRefCount(nsObj);
4960 return cf;
4963 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4965 /* Delete any local procs */
4966 if (localCommands) {
4967 Jim_Obj *cmdNameObj;
4969 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4970 Jim_HashEntry *he;
4971 Jim_Obj *fqObjName;
4972 Jim_HashTable *ht = &interp->commands;
4974 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4976 he = Jim_FindHashEntry(ht, fqname);
4978 if (he) {
4979 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4980 if (cmd->prevCmd) {
4981 Jim_Cmd *prevCmd = cmd->prevCmd;
4982 cmd->prevCmd = NULL;
4984 /* Delete the old command */
4985 JimDecrCmdRefCount(interp, cmd);
4987 /* And restore the original */
4988 Jim_SetHashVal(ht, he, prevCmd);
4990 else {
4991 Jim_DeleteHashEntry(ht, fqname);
4993 Jim_InterpIncrProcEpoch(interp);
4995 Jim_DecrRefCount(interp, cmdNameObj);
4996 JimFreeQualifiedName(interp, fqObjName);
4998 Jim_FreeStack(localCommands);
4999 Jim_Free(localCommands);
5001 return JIM_OK;
5005 * Run any $jim::defer scripts for the current call frame.
5007 * retcode is the return code from the current proc.
5009 * Returns the new return code.
5011 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
5013 Jim_Obj *objPtr;
5015 /* Fast check for the likely case that the variable doesn't exist */
5016 if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
5017 return retcode;
5020 objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
5022 if (objPtr) {
5023 int ret = JIM_OK;
5024 int i;
5025 int listLen = Jim_ListLength(interp, objPtr);
5026 Jim_Obj *resultObjPtr;
5028 Jim_IncrRefCount(objPtr);
5030 /* Need to save away the current interp result and
5031 * restore it if appropriate
5033 resultObjPtr = Jim_GetResult(interp);
5034 Jim_IncrRefCount(resultObjPtr);
5035 Jim_SetEmptyResult(interp);
5037 /* Invoke in reverse order */
5038 for (i = listLen; i > 0; i--) {
5039 /* If a defer script returns an error, don't evaluate remaining scripts */
5040 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5041 ret = Jim_EvalObj(interp, scriptObjPtr);
5042 if (ret != JIM_OK) {
5043 break;
5047 if (ret == JIM_OK || retcode == JIM_ERR) {
5048 /* defer script had no error, or proc had an error so restore proc result */
5049 Jim_SetResult(interp, resultObjPtr);
5051 else {
5052 retcode = ret;
5055 Jim_DecrRefCount(interp, resultObjPtr);
5056 Jim_DecrRefCount(interp, objPtr);
5058 return retcode;
5061 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5062 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5063 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5065 JimDeleteLocalProcs(interp, cf->localCommands);
5067 if (cf->procArgsObjPtr)
5068 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5069 if (cf->procBodyObjPtr)
5070 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5071 Jim_DecrRefCount(interp, cf->nsObj);
5072 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5073 Jim_FreeHashTable(&cf->vars);
5074 else {
5075 int i;
5076 Jim_HashEntry **table = cf->vars.table, *he;
5078 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5079 he = table[i];
5080 while (he != NULL) {
5081 Jim_HashEntry *nextEntry = he->next;
5082 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5084 Jim_DecrRefCount(interp, varPtr->objPtr);
5085 Jim_Free(Jim_GetHashEntryKey(he));
5086 Jim_Free(varPtr);
5087 Jim_Free(he);
5088 table[i] = NULL;
5089 he = nextEntry;
5092 cf->vars.used = 0;
5094 cf->next = interp->freeFramesList;
5095 interp->freeFramesList = cf;
5099 /* -----------------------------------------------------------------------------
5100 * References
5101 * ---------------------------------------------------------------------------*/
5102 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5104 /* References HashTable Type.
5106 * Keys are unsigned long integers, dynamically allocated for now but in the
5107 * future it's worth to cache this 4 bytes objects. Values are pointers
5108 * to Jim_References. */
5109 static void JimReferencesHTValDestructor(void *interp, void *val)
5111 Jim_Reference *refPtr = (void *)val;
5113 Jim_DecrRefCount(interp, refPtr->objPtr);
5114 if (refPtr->finalizerCmdNamePtr != NULL) {
5115 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5117 Jim_Free(val);
5120 static unsigned int JimReferencesHTHashFunction(const void *key)
5122 /* Only the least significant bits are used. */
5123 const unsigned long *widePtr = key;
5124 unsigned int intValue = (unsigned int)*widePtr;
5126 return Jim_IntHashFunction(intValue);
5129 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5131 void *copy = Jim_Alloc(sizeof(unsigned long));
5133 JIM_NOTUSED(privdata);
5135 memcpy(copy, key, sizeof(unsigned long));
5136 return copy;
5139 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5141 JIM_NOTUSED(privdata);
5143 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5146 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5148 JIM_NOTUSED(privdata);
5150 Jim_Free(key);
5153 static const Jim_HashTableType JimReferencesHashTableType = {
5154 JimReferencesHTHashFunction, /* hash function */
5155 JimReferencesHTKeyDup, /* key dup */
5156 NULL, /* val dup */
5157 JimReferencesHTKeyCompare, /* key compare */
5158 JimReferencesHTKeyDestructor, /* key destructor */
5159 JimReferencesHTValDestructor /* val destructor */
5162 /* -----------------------------------------------------------------------------
5163 * Reference object type and References API
5164 * ---------------------------------------------------------------------------*/
5166 /* The string representation of references has two features in order
5167 * to make the GC faster. The first is that every reference starts
5168 * with a non common character '<', in order to make the string matching
5169 * faster. The second is that the reference string rep is 42 characters
5170 * in length, this means that it is not necessary to check any object with a string
5171 * repr < 42, and usually there aren't many of these objects. */
5173 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5175 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5177 const char *fmt = "<reference.<%s>.%020lu>";
5179 sprintf(buf, fmt, refPtr->tag, id);
5180 return JIM_REFERENCE_SPACE;
5183 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5185 static const Jim_ObjType referenceObjType = {
5186 "reference",
5187 NULL,
5188 NULL,
5189 UpdateStringOfReference,
5190 JIM_TYPE_REFERENCES,
5193 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5195 char buf[JIM_REFERENCE_SPACE + 1];
5197 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5198 JimSetStringBytes(objPtr, buf);
5201 /* returns true if 'c' is a valid reference tag character.
5202 * i.e. inside the range [_a-zA-Z0-9] */
5203 static int isrefchar(int c)
5205 return (c == '_' || isalnum(c));
5208 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5210 unsigned long value;
5211 int i, len;
5212 const char *str, *start, *end;
5213 char refId[21];
5214 Jim_Reference *refPtr;
5215 Jim_HashEntry *he;
5216 char *endptr;
5218 /* Get the string representation */
5219 str = Jim_GetString(objPtr, &len);
5220 /* Check if it looks like a reference */
5221 if (len < JIM_REFERENCE_SPACE)
5222 goto badformat;
5223 /* Trim spaces */
5224 start = str;
5225 end = str + len - 1;
5226 while (*start == ' ')
5227 start++;
5228 while (*end == ' ' && end > start)
5229 end--;
5230 if (end - start + 1 != JIM_REFERENCE_SPACE)
5231 goto badformat;
5232 /* <reference.<1234567>.%020> */
5233 if (memcmp(start, "<reference.<", 12) != 0)
5234 goto badformat;
5235 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5236 goto badformat;
5237 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5238 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5239 if (!isrefchar(start[12 + i]))
5240 goto badformat;
5242 /* Extract info from the reference. */
5243 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5244 refId[20] = '\0';
5245 /* Try to convert the ID into an unsigned long */
5246 value = strtoul(refId, &endptr, 10);
5247 if (JimCheckConversion(refId, endptr) != JIM_OK)
5248 goto badformat;
5249 /* Check if the reference really exists! */
5250 he = Jim_FindHashEntry(&interp->references, &value);
5251 if (he == NULL) {
5252 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5253 return JIM_ERR;
5255 refPtr = Jim_GetHashEntryVal(he);
5256 /* Free the old internal repr and set the new one. */
5257 Jim_FreeIntRep(interp, objPtr);
5258 objPtr->typePtr = &referenceObjType;
5259 objPtr->internalRep.refValue.id = value;
5260 objPtr->internalRep.refValue.refPtr = refPtr;
5261 return JIM_OK;
5263 badformat:
5264 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5265 return JIM_ERR;
5268 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5269 * as finalizer command (or NULL if there is no finalizer).
5270 * The returned reference object has refcount = 0. */
5271 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5273 struct Jim_Reference *refPtr;
5274 unsigned long id;
5275 Jim_Obj *refObjPtr;
5276 const char *tag;
5277 int tagLen, i;
5279 /* Perform the Garbage Collection if needed. */
5280 Jim_CollectIfNeeded(interp);
5282 refPtr = Jim_Alloc(sizeof(*refPtr));
5283 refPtr->objPtr = objPtr;
5284 Jim_IncrRefCount(objPtr);
5285 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5286 if (cmdNamePtr)
5287 Jim_IncrRefCount(cmdNamePtr);
5288 id = interp->referenceNextId++;
5289 Jim_AddHashEntry(&interp->references, &id, refPtr);
5290 refObjPtr = Jim_NewObj(interp);
5291 refObjPtr->typePtr = &referenceObjType;
5292 refObjPtr->bytes = NULL;
5293 refObjPtr->internalRep.refValue.id = id;
5294 refObjPtr->internalRep.refValue.refPtr = refPtr;
5295 interp->referenceNextId++;
5296 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5297 * that does not pass the 'isrefchar' test is replaced with '_' */
5298 tag = Jim_GetString(tagPtr, &tagLen);
5299 if (tagLen > JIM_REFERENCE_TAGLEN)
5300 tagLen = JIM_REFERENCE_TAGLEN;
5301 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5302 if (i < tagLen && isrefchar(tag[i]))
5303 refPtr->tag[i] = tag[i];
5304 else
5305 refPtr->tag[i] = '_';
5307 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5308 return refObjPtr;
5311 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5313 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5314 return NULL;
5315 return objPtr->internalRep.refValue.refPtr;
5318 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5320 Jim_Reference *refPtr;
5322 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5323 return JIM_ERR;
5324 Jim_IncrRefCount(cmdNamePtr);
5325 if (refPtr->finalizerCmdNamePtr)
5326 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5327 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5328 return JIM_OK;
5331 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5333 Jim_Reference *refPtr;
5335 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5336 return JIM_ERR;
5337 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5338 return JIM_OK;
5341 /* -----------------------------------------------------------------------------
5342 * References Garbage Collection
5343 * ---------------------------------------------------------------------------*/
5345 /* This the hash table type for the "MARK" phase of the GC */
5346 static const Jim_HashTableType JimRefMarkHashTableType = {
5347 JimReferencesHTHashFunction, /* hash function */
5348 JimReferencesHTKeyDup, /* key dup */
5349 NULL, /* val dup */
5350 JimReferencesHTKeyCompare, /* key compare */
5351 JimReferencesHTKeyDestructor, /* key destructor */
5352 NULL /* val destructor */
5355 /* Performs the garbage collection. */
5356 int Jim_Collect(Jim_Interp *interp)
5358 int collected = 0;
5359 Jim_HashTable marks;
5360 Jim_HashTableIterator htiter;
5361 Jim_HashEntry *he;
5362 Jim_Obj *objPtr;
5364 /* Avoid recursive calls */
5365 if (interp->lastCollectId == (unsigned long)~0) {
5366 /* Jim_Collect() already running. Return just now. */
5367 return 0;
5369 interp->lastCollectId = ~0;
5371 /* Mark all the references found into the 'mark' hash table.
5372 * The references are searched in every live object that
5373 * is of a type that can contain references. */
5374 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5375 objPtr = interp->liveList;
5376 while (objPtr) {
5377 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5378 const char *str, *p;
5379 int len;
5381 /* If the object is of type reference, to get the
5382 * Id is simple... */
5383 if (objPtr->typePtr == &referenceObjType) {
5384 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5385 #ifdef JIM_DEBUG_GC
5386 printf("MARK (reference): %d refcount: %d\n",
5387 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5388 #endif
5389 objPtr = objPtr->nextObjPtr;
5390 continue;
5392 /* Get the string repr of the object we want
5393 * to scan for references. */
5394 p = str = Jim_GetString(objPtr, &len);
5395 /* Skip objects too little to contain references. */
5396 if (len < JIM_REFERENCE_SPACE) {
5397 objPtr = objPtr->nextObjPtr;
5398 continue;
5400 /* Extract references from the object string repr. */
5401 while (1) {
5402 int i;
5403 unsigned long id;
5405 if ((p = strstr(p, "<reference.<")) == NULL)
5406 break;
5407 /* Check if it's a valid reference. */
5408 if (len - (p - str) < JIM_REFERENCE_SPACE)
5409 break;
5410 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5411 break;
5412 for (i = 21; i <= 40; i++)
5413 if (!isdigit(UCHAR(p[i])))
5414 break;
5415 /* Get the ID */
5416 id = strtoul(p + 21, NULL, 10);
5418 /* Ok, a reference for the given ID
5419 * was found. Mark it. */
5420 Jim_AddHashEntry(&marks, &id, NULL);
5421 #ifdef JIM_DEBUG_GC
5422 printf("MARK: %d\n", (int)id);
5423 #endif
5424 p += JIM_REFERENCE_SPACE;
5427 objPtr = objPtr->nextObjPtr;
5430 /* Run the references hash table to destroy every reference that
5431 * is not referenced outside (not present in the mark HT). */
5432 JimInitHashTableIterator(&interp->references, &htiter);
5433 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5434 const unsigned long *refId;
5435 Jim_Reference *refPtr;
5437 refId = he->key;
5438 /* Check if in the mark phase we encountered
5439 * this reference. */
5440 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5441 #ifdef JIM_DEBUG_GC
5442 printf("COLLECTING %d\n", (int)*refId);
5443 #endif
5444 collected++;
5445 /* Drop the reference, but call the
5446 * finalizer first if registered. */
5447 refPtr = Jim_GetHashEntryVal(he);
5448 if (refPtr->finalizerCmdNamePtr) {
5449 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5450 Jim_Obj *objv[3], *oldResult;
5452 JimFormatReference(refstr, refPtr, *refId);
5454 objv[0] = refPtr->finalizerCmdNamePtr;
5455 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5456 objv[2] = refPtr->objPtr;
5458 /* Drop the reference itself */
5459 /* Avoid the finaliser being freed here */
5460 Jim_IncrRefCount(objv[0]);
5461 /* Don't remove the reference from the hash table just yet
5462 * since that will free refPtr, and hence refPtr->objPtr
5465 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5466 oldResult = interp->result;
5467 Jim_IncrRefCount(oldResult);
5468 Jim_EvalObjVector(interp, 3, objv);
5469 Jim_SetResult(interp, oldResult);
5470 Jim_DecrRefCount(interp, oldResult);
5472 Jim_DecrRefCount(interp, objv[0]);
5474 Jim_DeleteHashEntry(&interp->references, refId);
5477 Jim_FreeHashTable(&marks);
5478 interp->lastCollectId = interp->referenceNextId;
5479 interp->lastCollectTime = time(NULL);
5480 return collected;
5483 #define JIM_COLLECT_ID_PERIOD 5000
5484 #define JIM_COLLECT_TIME_PERIOD 300
5486 void Jim_CollectIfNeeded(Jim_Interp *interp)
5488 unsigned long elapsedId;
5489 int elapsedTime;
5491 elapsedId = interp->referenceNextId - interp->lastCollectId;
5492 elapsedTime = time(NULL) - interp->lastCollectTime;
5495 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5496 Jim_Collect(interp);
5499 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5501 int Jim_IsBigEndian(void)
5503 union {
5504 unsigned short s;
5505 unsigned char c[2];
5506 } uval = {0x0102};
5508 return uval.c[0] == 1;
5511 /* -----------------------------------------------------------------------------
5512 * Interpreter related functions
5513 * ---------------------------------------------------------------------------*/
5515 Jim_Interp *Jim_CreateInterp(void)
5517 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5519 memset(i, 0, sizeof(*i));
5521 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5522 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5523 i->lastCollectTime = time(NULL);
5525 /* Note that we can create objects only after the
5526 * interpreter liveList and freeList pointers are
5527 * initialized to NULL. */
5528 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5529 #ifdef JIM_REFERENCES
5530 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5531 #endif
5532 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5533 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5534 i->emptyObj = Jim_NewEmptyStringObj(i);
5535 i->trueObj = Jim_NewIntObj(i, 1);
5536 i->falseObj = Jim_NewIntObj(i, 0);
5537 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5538 i->errorFileNameObj = i->emptyObj;
5539 i->result = i->emptyObj;
5540 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5541 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5542 i->errorProc = i->emptyObj;
5543 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5544 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5545 Jim_IncrRefCount(i->emptyObj);
5546 Jim_IncrRefCount(i->errorFileNameObj);
5547 Jim_IncrRefCount(i->result);
5548 Jim_IncrRefCount(i->stackTrace);
5549 Jim_IncrRefCount(i->unknown);
5550 Jim_IncrRefCount(i->currentScriptObj);
5551 Jim_IncrRefCount(i->nullScriptObj);
5552 Jim_IncrRefCount(i->errorProc);
5553 Jim_IncrRefCount(i->trueObj);
5554 Jim_IncrRefCount(i->falseObj);
5556 /* Initialize key variables every interpreter should contain */
5557 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5558 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5560 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5561 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5562 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5563 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5564 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5565 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5566 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5567 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5569 return i;
5572 void Jim_FreeInterp(Jim_Interp *i)
5574 Jim_CallFrame *cf, *cfx;
5576 Jim_Obj *objPtr, *nextObjPtr;
5578 /* Free the active call frames list - must be done before i->commands is destroyed */
5579 for (cf = i->framePtr; cf; cf = cfx) {
5580 /* Note that we ignore any errors */
5581 JimInvokeDefer(i, JIM_OK);
5582 cfx = cf->parent;
5583 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5586 Jim_DecrRefCount(i, i->emptyObj);
5587 Jim_DecrRefCount(i, i->trueObj);
5588 Jim_DecrRefCount(i, i->falseObj);
5589 Jim_DecrRefCount(i, i->result);
5590 Jim_DecrRefCount(i, i->stackTrace);
5591 Jim_DecrRefCount(i, i->errorProc);
5592 Jim_DecrRefCount(i, i->unknown);
5593 Jim_DecrRefCount(i, i->errorFileNameObj);
5594 Jim_DecrRefCount(i, i->currentScriptObj);
5595 Jim_DecrRefCount(i, i->nullScriptObj);
5596 Jim_FreeHashTable(&i->commands);
5597 #ifdef JIM_REFERENCES
5598 Jim_FreeHashTable(&i->references);
5599 #endif
5600 Jim_FreeHashTable(&i->packages);
5601 Jim_Free(i->prngState);
5602 Jim_FreeHashTable(&i->assocData);
5604 /* Check that the live object list is empty, otherwise
5605 * there is a memory leak. */
5606 #ifdef JIM_MAINTAINER
5607 if (i->liveList != NULL) {
5608 objPtr = i->liveList;
5610 printf("\n-------------------------------------\n");
5611 printf("Objects still in the free list:\n");
5612 while (objPtr) {
5613 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5614 Jim_String(objPtr);
5616 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5617 printf("%p (%d) %-10s: '%.20s...'\n",
5618 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5620 else {
5621 printf("%p (%d) %-10s: '%s'\n",
5622 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5624 if (objPtr->typePtr == &sourceObjType) {
5625 printf("FILE %s LINE %d\n",
5626 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5627 objPtr->internalRep.sourceValue.lineNumber);
5629 objPtr = objPtr->nextObjPtr;
5631 printf("-------------------------------------\n\n");
5632 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5634 #endif
5636 /* Free all the freed objects. */
5637 objPtr = i->freeList;
5638 while (objPtr) {
5639 nextObjPtr = objPtr->nextObjPtr;
5640 Jim_Free(objPtr);
5641 objPtr = nextObjPtr;
5644 /* Free the free call frames list */
5645 for (cf = i->freeFramesList; cf; cf = cfx) {
5646 cfx = cf->next;
5647 if (cf->vars.table)
5648 Jim_FreeHashTable(&cf->vars);
5649 Jim_Free(cf);
5652 /* Free the interpreter structure. */
5653 Jim_Free(i);
5656 /* Returns the call frame relative to the level represented by
5657 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5659 * This function accepts the 'level' argument in the form
5660 * of the commands [uplevel] and [upvar].
5662 * Returns NULL on error.
5664 * Note: for a function accepting a relative integer as level suitable
5665 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5667 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5669 long level;
5670 const char *str;
5671 Jim_CallFrame *framePtr;
5673 if (levelObjPtr) {
5674 str = Jim_String(levelObjPtr);
5675 if (str[0] == '#') {
5676 char *endptr;
5678 level = jim_strtol(str + 1, &endptr);
5679 if (str[1] == '\0' || endptr[0] != '\0') {
5680 level = -1;
5683 else {
5684 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5685 level = -1;
5687 else {
5688 /* Convert from a relative to an absolute level */
5689 level = interp->framePtr->level - level;
5693 else {
5694 str = "1"; /* Needed to format the error message. */
5695 level = interp->framePtr->level - 1;
5698 if (level == 0) {
5699 return interp->topFramePtr;
5701 if (level > 0) {
5702 /* Lookup */
5703 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5704 if (framePtr->level == level) {
5705 return framePtr;
5710 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5711 return NULL;
5714 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5715 * as a relative integer like in the [info level ?level?] command.
5717 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5719 long level;
5720 Jim_CallFrame *framePtr;
5722 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5723 if (level <= 0) {
5724 /* Convert from a relative to an absolute level */
5725 level = interp->framePtr->level + level;
5728 if (level == 0) {
5729 return interp->topFramePtr;
5732 /* Lookup */
5733 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5734 if (framePtr->level == level) {
5735 return framePtr;
5740 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5741 return NULL;
5744 static void JimResetStackTrace(Jim_Interp *interp)
5746 Jim_DecrRefCount(interp, interp->stackTrace);
5747 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5748 Jim_IncrRefCount(interp->stackTrace);
5751 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5753 int len;
5755 /* Increment reference first in case these are the same object */
5756 Jim_IncrRefCount(stackTraceObj);
5757 Jim_DecrRefCount(interp, interp->stackTrace);
5758 interp->stackTrace = stackTraceObj;
5759 interp->errorFlag = 1;
5761 /* This is a bit ugly.
5762 * If the filename of the last entry of the stack trace is empty,
5763 * the next stack level should be added.
5765 len = Jim_ListLength(interp, interp->stackTrace);
5766 if (len >= 3) {
5767 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5768 interp->addStackTrace = 1;
5773 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5774 Jim_Obj *fileNameObj, int linenr)
5776 if (strcmp(procname, "unknown") == 0) {
5777 procname = "";
5779 if (!*procname && !Jim_Length(fileNameObj)) {
5780 /* No useful info here */
5781 return;
5784 if (Jim_IsShared(interp->stackTrace)) {
5785 Jim_DecrRefCount(interp, interp->stackTrace);
5786 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5787 Jim_IncrRefCount(interp->stackTrace);
5790 /* If we have no procname but the previous element did, merge with that frame */
5791 if (!*procname && Jim_Length(fileNameObj)) {
5792 /* Just a filename. Check the previous entry */
5793 int len = Jim_ListLength(interp, interp->stackTrace);
5795 if (len >= 3) {
5796 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5797 if (Jim_Length(objPtr)) {
5798 /* Yes, the previous level had procname */
5799 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5800 if (Jim_Length(objPtr) == 0) {
5801 /* But no filename, so merge the new info with that frame */
5802 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5803 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5804 return;
5810 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5811 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5812 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5815 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5816 void *data)
5818 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5820 assocEntryPtr->delProc = delProc;
5821 assocEntryPtr->data = data;
5822 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5825 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5827 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5829 if (entryPtr != NULL) {
5830 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5831 return assocEntryPtr->data;
5833 return NULL;
5836 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5838 return Jim_DeleteHashEntry(&interp->assocData, key);
5841 int Jim_GetExitCode(Jim_Interp *interp)
5843 return interp->exitCode;
5846 /* -----------------------------------------------------------------------------
5847 * Integer object
5848 * ---------------------------------------------------------------------------*/
5849 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5850 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5852 static const Jim_ObjType intObjType = {
5853 "int",
5854 NULL,
5855 NULL,
5856 UpdateStringOfInt,
5857 JIM_TYPE_NONE,
5860 /* A coerced double is closer to an int than a double.
5861 * It is an int value temporarily masquerading as a double value.
5862 * i.e. it has the same string value as an int and Jim_GetWide()
5863 * succeeds, but also Jim_GetDouble() returns the value directly.
5865 static const Jim_ObjType coercedDoubleObjType = {
5866 "coerced-double",
5867 NULL,
5868 NULL,
5869 UpdateStringOfInt,
5870 JIM_TYPE_NONE,
5874 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5876 char buf[JIM_INTEGER_SPACE + 1];
5877 jim_wide wideValue = JimWideValue(objPtr);
5878 int pos = 0;
5880 if (wideValue == 0) {
5881 buf[pos++] = '0';
5883 else {
5884 char tmp[JIM_INTEGER_SPACE];
5885 int num = 0;
5886 int i;
5888 if (wideValue < 0) {
5889 buf[pos++] = '-';
5890 i = wideValue % 10;
5891 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5892 * whereas C99 is always -6
5893 * coverity[dead_error_line]
5895 tmp[num++] = (i > 0) ? (10 - i) : -i;
5896 wideValue /= -10;
5899 while (wideValue) {
5900 tmp[num++] = wideValue % 10;
5901 wideValue /= 10;
5904 for (i = 0; i < num; i++) {
5905 buf[pos++] = '0' + tmp[num - i - 1];
5908 buf[pos] = 0;
5910 JimSetStringBytes(objPtr, buf);
5913 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5915 jim_wide wideValue;
5916 const char *str;
5918 if (objPtr->typePtr == &coercedDoubleObjType) {
5919 /* Simple switch */
5920 objPtr->typePtr = &intObjType;
5921 return JIM_OK;
5924 /* Get the string representation */
5925 str = Jim_String(objPtr);
5926 /* Try to convert into a jim_wide */
5927 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5928 if (flags & JIM_ERRMSG) {
5929 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5931 return JIM_ERR;
5933 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5934 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5935 return JIM_ERR;
5937 /* Free the old internal repr and set the new one. */
5938 Jim_FreeIntRep(interp, objPtr);
5939 objPtr->typePtr = &intObjType;
5940 objPtr->internalRep.wideValue = wideValue;
5941 return JIM_OK;
5944 #ifdef JIM_OPTIMIZATION
5945 static int JimIsWide(Jim_Obj *objPtr)
5947 return objPtr->typePtr == &intObjType;
5949 #endif
5951 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5953 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5954 return JIM_ERR;
5955 *widePtr = JimWideValue(objPtr);
5956 return JIM_OK;
5959 /* Get a wide but does not set an error if the format is bad. */
5960 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5962 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5963 return JIM_ERR;
5964 *widePtr = JimWideValue(objPtr);
5965 return JIM_OK;
5968 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5970 jim_wide wideValue;
5971 int retval;
5973 retval = Jim_GetWide(interp, objPtr, &wideValue);
5974 if (retval == JIM_OK) {
5975 *longPtr = (long)wideValue;
5976 return JIM_OK;
5978 return JIM_ERR;
5981 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5983 Jim_Obj *objPtr;
5985 objPtr = Jim_NewObj(interp);
5986 objPtr->typePtr = &intObjType;
5987 objPtr->bytes = NULL;
5988 objPtr->internalRep.wideValue = wideValue;
5989 return objPtr;
5992 /* -----------------------------------------------------------------------------
5993 * Double object
5994 * ---------------------------------------------------------------------------*/
5995 #define JIM_DOUBLE_SPACE 30
5997 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5998 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6000 static const Jim_ObjType doubleObjType = {
6001 "double",
6002 NULL,
6003 NULL,
6004 UpdateStringOfDouble,
6005 JIM_TYPE_NONE,
6008 #ifndef HAVE_ISNAN
6009 #undef isnan
6010 #define isnan(X) ((X) != (X))
6011 #endif
6012 #ifndef HAVE_ISINF
6013 #undef isinf
6014 #define isinf(X) (1.0 / (X) == 0.0)
6015 #endif
6017 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
6019 double value = objPtr->internalRep.doubleValue;
6021 if (isnan(value)) {
6022 JimSetStringBytes(objPtr, "NaN");
6023 return;
6025 if (isinf(value)) {
6026 if (value < 0) {
6027 JimSetStringBytes(objPtr, "-Inf");
6029 else {
6030 JimSetStringBytes(objPtr, "Inf");
6032 return;
6035 char buf[JIM_DOUBLE_SPACE + 1];
6036 int i;
6037 int len = sprintf(buf, "%.12g", value);
6039 /* Add a final ".0" if necessary */
6040 for (i = 0; i < len; i++) {
6041 if (buf[i] == '.' || buf[i] == 'e') {
6042 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6043 /* If 'buf' ends in e-0nn or e+0nn, remove
6044 * the 0 after the + or - and reduce the length by 1
6046 char *e = strchr(buf, 'e');
6047 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6048 /* Move it up */
6049 e += 2;
6050 memmove(e, e + 1, len - (e - buf));
6052 #endif
6053 break;
6056 if (buf[i] == '\0') {
6057 buf[i++] = '.';
6058 buf[i++] = '0';
6059 buf[i] = '\0';
6061 JimSetStringBytes(objPtr, buf);
6065 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6067 double doubleValue;
6068 jim_wide wideValue;
6069 const char *str;
6071 #ifdef HAVE_LONG_LONG
6072 /* Assume a 53 bit mantissa */
6073 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6074 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6076 if (objPtr->typePtr == &intObjType
6077 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6078 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6080 /* Direct conversion to coerced double */
6081 objPtr->typePtr = &coercedDoubleObjType;
6082 return JIM_OK;
6084 #endif
6085 /* Preserve the string representation.
6086 * Needed so we can convert back to int without loss
6088 str = Jim_String(objPtr);
6090 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6091 /* Managed to convert to an int, so we can use this as a cooerced double */
6092 Jim_FreeIntRep(interp, objPtr);
6093 objPtr->typePtr = &coercedDoubleObjType;
6094 objPtr->internalRep.wideValue = wideValue;
6095 return JIM_OK;
6097 else {
6098 /* Try to convert into a double */
6099 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6100 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6101 return JIM_ERR;
6103 /* Free the old internal repr and set the new one. */
6104 Jim_FreeIntRep(interp, objPtr);
6106 objPtr->typePtr = &doubleObjType;
6107 objPtr->internalRep.doubleValue = doubleValue;
6108 return JIM_OK;
6111 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6113 if (objPtr->typePtr == &coercedDoubleObjType) {
6114 *doublePtr = JimWideValue(objPtr);
6115 return JIM_OK;
6117 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6118 return JIM_ERR;
6120 if (objPtr->typePtr == &coercedDoubleObjType) {
6121 *doublePtr = JimWideValue(objPtr);
6123 else {
6124 *doublePtr = objPtr->internalRep.doubleValue;
6126 return JIM_OK;
6129 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6131 Jim_Obj *objPtr;
6133 objPtr = Jim_NewObj(interp);
6134 objPtr->typePtr = &doubleObjType;
6135 objPtr->bytes = NULL;
6136 objPtr->internalRep.doubleValue = doubleValue;
6137 return objPtr;
6140 /* -----------------------------------------------------------------------------
6141 * Boolean conversion
6142 * ---------------------------------------------------------------------------*/
6143 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6145 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6147 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6148 return JIM_ERR;
6149 *booleanPtr = (int) JimWideValue(objPtr);
6150 return JIM_OK;
6153 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6155 static const char * const falses[] = {
6156 "0", "false", "no", "off", NULL
6158 static const char * const trues[] = {
6159 "1", "true", "yes", "on", NULL
6162 int boolean;
6164 int index;
6165 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6166 boolean = 0;
6167 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6168 boolean = 1;
6169 } else {
6170 if (flags & JIM_ERRMSG) {
6171 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6173 return JIM_ERR;
6176 /* Free the old internal repr and set the new one. */
6177 Jim_FreeIntRep(interp, objPtr);
6178 objPtr->typePtr = &intObjType;
6179 objPtr->internalRep.wideValue = boolean;
6180 return JIM_OK;
6183 /* -----------------------------------------------------------------------------
6184 * List object
6185 * ---------------------------------------------------------------------------*/
6186 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6187 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6188 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6189 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6190 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6191 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6193 /* Note that while the elements of the list may contain references,
6194 * the list object itself can't. This basically means that the
6195 * list object string representation as a whole can't contain references
6196 * that are not presents in the single elements. */
6197 static const Jim_ObjType listObjType = {
6198 "list",
6199 FreeListInternalRep,
6200 DupListInternalRep,
6201 UpdateStringOfList,
6202 JIM_TYPE_NONE,
6205 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6207 int i;
6209 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6210 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6212 Jim_Free(objPtr->internalRep.listValue.ele);
6215 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6217 int i;
6219 JIM_NOTUSED(interp);
6221 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6222 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6223 dupPtr->internalRep.listValue.ele =
6224 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6225 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6226 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6227 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6228 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6230 dupPtr->typePtr = &listObjType;
6233 /* The following function checks if a given string can be encoded
6234 * into a list element without any kind of quoting, surrounded by braces,
6235 * or using escapes to quote. */
6236 #define JIM_ELESTR_SIMPLE 0
6237 #define JIM_ELESTR_BRACE 1
6238 #define JIM_ELESTR_QUOTE 2
6239 static unsigned char ListElementQuotingType(const char *s, int len)
6241 int i, level, blevel, trySimple = 1;
6243 /* Try with the SIMPLE case */
6244 if (len == 0)
6245 return JIM_ELESTR_BRACE;
6246 if (s[0] == '"' || s[0] == '{') {
6247 trySimple = 0;
6248 goto testbrace;
6250 for (i = 0; i < len; i++) {
6251 switch (s[i]) {
6252 case ' ':
6253 case '$':
6254 case '"':
6255 case '[':
6256 case ']':
6257 case ';':
6258 case '\\':
6259 case '\r':
6260 case '\n':
6261 case '\t':
6262 case '\f':
6263 case '\v':
6264 trySimple = 0;
6265 /* fall through */
6266 case '{':
6267 case '}':
6268 goto testbrace;
6271 return JIM_ELESTR_SIMPLE;
6273 testbrace:
6274 /* Test if it's possible to do with braces */
6275 if (s[len - 1] == '\\')
6276 return JIM_ELESTR_QUOTE;
6277 level = 0;
6278 blevel = 0;
6279 for (i = 0; i < len; i++) {
6280 switch (s[i]) {
6281 case '{':
6282 level++;
6283 break;
6284 case '}':
6285 level--;
6286 if (level < 0)
6287 return JIM_ELESTR_QUOTE;
6288 break;
6289 case '[':
6290 blevel++;
6291 break;
6292 case ']':
6293 blevel--;
6294 break;
6295 case '\\':
6296 if (s[i + 1] == '\n')
6297 return JIM_ELESTR_QUOTE;
6298 else if (s[i + 1] != '\0')
6299 i++;
6300 break;
6303 if (blevel < 0) {
6304 return JIM_ELESTR_QUOTE;
6307 if (level == 0) {
6308 if (!trySimple)
6309 return JIM_ELESTR_BRACE;
6310 for (i = 0; i < len; i++) {
6311 switch (s[i]) {
6312 case ' ':
6313 case '$':
6314 case '"':
6315 case '[':
6316 case ']':
6317 case ';':
6318 case '\\':
6319 case '\r':
6320 case '\n':
6321 case '\t':
6322 case '\f':
6323 case '\v':
6324 return JIM_ELESTR_BRACE;
6325 break;
6328 return JIM_ELESTR_SIMPLE;
6330 return JIM_ELESTR_QUOTE;
6333 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6334 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6335 * scenario.
6336 * Returns the length of the result.
6338 static int BackslashQuoteString(const char *s, int len, char *q)
6340 char *p = q;
6342 while (len--) {
6343 switch (*s) {
6344 case ' ':
6345 case '$':
6346 case '"':
6347 case '[':
6348 case ']':
6349 case '{':
6350 case '}':
6351 case ';':
6352 case '\\':
6353 *p++ = '\\';
6354 *p++ = *s++;
6355 break;
6356 case '\n':
6357 *p++ = '\\';
6358 *p++ = 'n';
6359 s++;
6360 break;
6361 case '\r':
6362 *p++ = '\\';
6363 *p++ = 'r';
6364 s++;
6365 break;
6366 case '\t':
6367 *p++ = '\\';
6368 *p++ = 't';
6369 s++;
6370 break;
6371 case '\f':
6372 *p++ = '\\';
6373 *p++ = 'f';
6374 s++;
6375 break;
6376 case '\v':
6377 *p++ = '\\';
6378 *p++ = 'v';
6379 s++;
6380 break;
6381 default:
6382 *p++ = *s++;
6383 break;
6386 *p = '\0';
6388 return p - q;
6391 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6393 #define STATIC_QUOTING_LEN 32
6394 int i, bufLen, realLength;
6395 const char *strRep;
6396 char *p;
6397 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6399 /* Estimate the space needed. */
6400 if (objc > STATIC_QUOTING_LEN) {
6401 quotingType = Jim_Alloc(objc);
6403 else {
6404 quotingType = staticQuoting;
6406 bufLen = 0;
6407 for (i = 0; i < objc; i++) {
6408 int len;
6410 strRep = Jim_GetString(objv[i], &len);
6411 quotingType[i] = ListElementQuotingType(strRep, len);
6412 switch (quotingType[i]) {
6413 case JIM_ELESTR_SIMPLE:
6414 if (i != 0 || strRep[0] != '#') {
6415 bufLen += len;
6416 break;
6418 /* Special case '#' on first element needs braces */
6419 quotingType[i] = JIM_ELESTR_BRACE;
6420 /* fall through */
6421 case JIM_ELESTR_BRACE:
6422 bufLen += len + 2;
6423 break;
6424 case JIM_ELESTR_QUOTE:
6425 bufLen += len * 2;
6426 break;
6428 bufLen++; /* elements separator. */
6430 bufLen++;
6432 /* Generate the string rep. */
6433 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6434 realLength = 0;
6435 for (i = 0; i < objc; i++) {
6436 int len, qlen;
6438 strRep = Jim_GetString(objv[i], &len);
6440 switch (quotingType[i]) {
6441 case JIM_ELESTR_SIMPLE:
6442 memcpy(p, strRep, len);
6443 p += len;
6444 realLength += len;
6445 break;
6446 case JIM_ELESTR_BRACE:
6447 *p++ = '{';
6448 memcpy(p, strRep, len);
6449 p += len;
6450 *p++ = '}';
6451 realLength += len + 2;
6452 break;
6453 case JIM_ELESTR_QUOTE:
6454 if (i == 0 && strRep[0] == '#') {
6455 *p++ = '\\';
6456 realLength++;
6458 qlen = BackslashQuoteString(strRep, len, p);
6459 p += qlen;
6460 realLength += qlen;
6461 break;
6463 /* Add a separating space */
6464 if (i + 1 != objc) {
6465 *p++ = ' ';
6466 realLength++;
6469 *p = '\0'; /* nul term. */
6470 objPtr->length = realLength;
6472 if (quotingType != staticQuoting) {
6473 Jim_Free(quotingType);
6477 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6479 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6482 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6484 struct JimParserCtx parser;
6485 const char *str;
6486 int strLen;
6487 Jim_Obj *fileNameObj;
6488 int linenr;
6490 if (objPtr->typePtr == &listObjType) {
6491 return JIM_OK;
6494 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6495 * it also preserves any source location of the dict elements
6496 * which can be very useful
6498 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6499 Jim_Obj **listObjPtrPtr;
6500 int len;
6501 int i;
6503 listObjPtrPtr = JimDictPairs(objPtr, &len);
6504 for (i = 0; i < len; i++) {
6505 Jim_IncrRefCount(listObjPtrPtr[i]);
6508 /* Now just switch the internal rep */
6509 Jim_FreeIntRep(interp, objPtr);
6510 objPtr->typePtr = &listObjType;
6511 objPtr->internalRep.listValue.len = len;
6512 objPtr->internalRep.listValue.maxLen = len;
6513 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6515 return JIM_OK;
6518 /* Try to preserve information about filename / line number */
6519 if (objPtr->typePtr == &sourceObjType) {
6520 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6521 linenr = objPtr->internalRep.sourceValue.lineNumber;
6523 else {
6524 fileNameObj = interp->emptyObj;
6525 linenr = 1;
6527 Jim_IncrRefCount(fileNameObj);
6529 /* Get the string representation */
6530 str = Jim_GetString(objPtr, &strLen);
6532 /* Free the old internal repr just now and initialize the
6533 * new one just now. The string->list conversion can't fail. */
6534 Jim_FreeIntRep(interp, objPtr);
6535 objPtr->typePtr = &listObjType;
6536 objPtr->internalRep.listValue.len = 0;
6537 objPtr->internalRep.listValue.maxLen = 0;
6538 objPtr->internalRep.listValue.ele = NULL;
6540 /* Convert into a list */
6541 if (strLen) {
6542 JimParserInit(&parser, str, strLen, linenr);
6543 while (!parser.eof) {
6544 Jim_Obj *elementPtr;
6546 JimParseList(&parser);
6547 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6548 continue;
6549 elementPtr = JimParserGetTokenObj(interp, &parser);
6550 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6551 ListAppendElement(objPtr, elementPtr);
6554 Jim_DecrRefCount(interp, fileNameObj);
6555 return JIM_OK;
6558 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6560 Jim_Obj *objPtr;
6562 objPtr = Jim_NewObj(interp);
6563 objPtr->typePtr = &listObjType;
6564 objPtr->bytes = NULL;
6565 objPtr->internalRep.listValue.ele = NULL;
6566 objPtr->internalRep.listValue.len = 0;
6567 objPtr->internalRep.listValue.maxLen = 0;
6569 if (len) {
6570 ListInsertElements(objPtr, 0, len, elements);
6573 return objPtr;
6576 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6577 * length of the vector. Note that the user of this function should make
6578 * sure that the list object can't shimmer while the vector returned
6579 * is in use, this vector is the one stored inside the internal representation
6580 * of the list object. This function is not exported, extensions should
6581 * always access to the List object elements using Jim_ListIndex(). */
6582 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6583 Jim_Obj ***listVec)
6585 *listLen = Jim_ListLength(interp, listObj);
6586 *listVec = listObj->internalRep.listValue.ele;
6589 /* Sorting uses ints, but commands may return wide */
6590 static int JimSign(jim_wide w)
6592 if (w == 0) {
6593 return 0;
6595 else if (w < 0) {
6596 return -1;
6598 return 1;
6601 /* ListSortElements type values */
6602 struct lsort_info {
6603 jmp_buf jmpbuf;
6604 Jim_Obj *command;
6605 Jim_Interp *interp;
6606 enum {
6607 JIM_LSORT_ASCII,
6608 JIM_LSORT_NOCASE,
6609 JIM_LSORT_INTEGER,
6610 JIM_LSORT_REAL,
6611 JIM_LSORT_COMMAND
6612 } type;
6613 int order;
6614 int index;
6615 int indexed;
6616 int unique;
6617 int (*subfn)(Jim_Obj **, Jim_Obj **);
6620 static struct lsort_info *sort_info;
6622 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6624 Jim_Obj *lObj, *rObj;
6626 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6627 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6628 longjmp(sort_info->jmpbuf, JIM_ERR);
6630 return sort_info->subfn(&lObj, &rObj);
6633 /* Sort the internal rep of a list. */
6634 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6636 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6639 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6641 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6644 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6646 jim_wide lhs = 0, rhs = 0;
6648 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6649 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6650 longjmp(sort_info->jmpbuf, JIM_ERR);
6653 return JimSign(lhs - rhs) * sort_info->order;
6656 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6658 double lhs = 0, rhs = 0;
6660 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6661 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6662 longjmp(sort_info->jmpbuf, JIM_ERR);
6664 if (lhs == rhs) {
6665 return 0;
6667 if (lhs > rhs) {
6668 return sort_info->order;
6670 return -sort_info->order;
6673 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6675 Jim_Obj *compare_script;
6676 int rc;
6678 jim_wide ret = 0;
6680 /* This must be a valid list */
6681 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6682 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6683 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6685 rc = Jim_EvalObj(sort_info->interp, compare_script);
6687 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6688 longjmp(sort_info->jmpbuf, rc);
6691 return JimSign(ret) * sort_info->order;
6694 /* Remove duplicate elements from the (sorted) list in-place, according to the
6695 * comparison function, comp.
6697 * Note that the last unique value is kept, not the first
6699 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6701 int src;
6702 int dst = 0;
6703 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6705 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6706 if (comp(&ele[dst], &ele[src]) == 0) {
6707 /* Match, so replace the dest with the current source */
6708 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6710 else {
6711 /* No match, so keep the current source and move to the next destination */
6712 dst++;
6714 ele[dst] = ele[src];
6717 /* At end of list, keep the final element unless all elements were kept */
6718 dst++;
6719 if (dst < listObjPtr->internalRep.listValue.len) {
6720 ele[dst] = ele[src];
6723 /* Set the new length */
6724 listObjPtr->internalRep.listValue.len = dst;
6727 /* Sort a list *in place*. MUST be called with a non-shared list. */
6728 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6730 struct lsort_info *prev_info;
6732 typedef int (qsort_comparator) (const void *, const void *);
6733 int (*fn) (Jim_Obj **, Jim_Obj **);
6734 Jim_Obj **vector;
6735 int len;
6736 int rc;
6738 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6739 SetListFromAny(interp, listObjPtr);
6741 /* Allow lsort to be called reentrantly */
6742 prev_info = sort_info;
6743 sort_info = info;
6745 vector = listObjPtr->internalRep.listValue.ele;
6746 len = listObjPtr->internalRep.listValue.len;
6747 switch (info->type) {
6748 case JIM_LSORT_ASCII:
6749 fn = ListSortString;
6750 break;
6751 case JIM_LSORT_NOCASE:
6752 fn = ListSortStringNoCase;
6753 break;
6754 case JIM_LSORT_INTEGER:
6755 fn = ListSortInteger;
6756 break;
6757 case JIM_LSORT_REAL:
6758 fn = ListSortReal;
6759 break;
6760 case JIM_LSORT_COMMAND:
6761 fn = ListSortCommand;
6762 break;
6763 default:
6764 fn = NULL; /* avoid warning */
6765 JimPanic((1, "ListSort called with invalid sort type"));
6766 return -1; /* Should not be run but keeps static analysers happy */
6769 if (info->indexed) {
6770 /* Need to interpose a "list index" function */
6771 info->subfn = fn;
6772 fn = ListSortIndexHelper;
6775 if ((rc = setjmp(info->jmpbuf)) == 0) {
6776 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6778 if (info->unique && len > 1) {
6779 ListRemoveDuplicates(listObjPtr, fn);
6782 Jim_InvalidateStringRep(listObjPtr);
6784 sort_info = prev_info;
6786 return rc;
6789 /* This is the low-level function to insert elements into a list.
6790 * The higher-level Jim_ListInsertElements() performs shared object
6791 * check and invalidates the string repr. This version is used
6792 * in the internals of the List Object and is not exported.
6794 * NOTE: this function can be called only against objects
6795 * with internal type of List.
6797 * An insertion point (idx) of -1 means end-of-list.
6799 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6801 int currentLen = listPtr->internalRep.listValue.len;
6802 int requiredLen = currentLen + elemc;
6803 int i;
6804 Jim_Obj **point;
6806 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6807 if (requiredLen < 2) {
6808 /* Don't do allocations of under 4 pointers. */
6809 requiredLen = 4;
6811 else {
6812 requiredLen *= 2;
6815 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6816 sizeof(Jim_Obj *) * requiredLen);
6818 listPtr->internalRep.listValue.maxLen = requiredLen;
6820 if (idx < 0) {
6821 idx = currentLen;
6823 point = listPtr->internalRep.listValue.ele + idx;
6824 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6825 for (i = 0; i < elemc; ++i) {
6826 point[i] = elemVec[i];
6827 Jim_IncrRefCount(point[i]);
6829 listPtr->internalRep.listValue.len += elemc;
6832 /* Convenience call to ListInsertElements() to append a single element.
6834 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6836 ListInsertElements(listPtr, -1, 1, &objPtr);
6839 /* Appends every element of appendListPtr into listPtr.
6840 * Both have to be of the list type.
6841 * Convenience call to ListInsertElements()
6843 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6845 ListInsertElements(listPtr, -1,
6846 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6849 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6851 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6852 SetListFromAny(interp, listPtr);
6853 Jim_InvalidateStringRep(listPtr);
6854 ListAppendElement(listPtr, objPtr);
6857 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6859 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6860 SetListFromAny(interp, listPtr);
6861 SetListFromAny(interp, appendListPtr);
6862 Jim_InvalidateStringRep(listPtr);
6863 ListAppendList(listPtr, appendListPtr);
6866 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6868 SetListFromAny(interp, objPtr);
6869 return objPtr->internalRep.listValue.len;
6872 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6873 int objc, Jim_Obj *const *objVec)
6875 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6876 SetListFromAny(interp, listPtr);
6877 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6878 idx = listPtr->internalRep.listValue.len;
6879 else if (idx < 0)
6880 idx = 0;
6881 Jim_InvalidateStringRep(listPtr);
6882 ListInsertElements(listPtr, idx, objc, objVec);
6885 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6887 SetListFromAny(interp, listPtr);
6888 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6889 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6890 return NULL;
6892 if (idx < 0)
6893 idx = listPtr->internalRep.listValue.len + idx;
6894 return listPtr->internalRep.listValue.ele[idx];
6897 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6899 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6900 if (*objPtrPtr == NULL) {
6901 if (flags & JIM_ERRMSG) {
6902 Jim_SetResultString(interp, "list index out of range", -1);
6904 return JIM_ERR;
6906 return JIM_OK;
6909 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6910 Jim_Obj *newObjPtr, int flags)
6912 SetListFromAny(interp, listPtr);
6913 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6914 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6915 if (flags & JIM_ERRMSG) {
6916 Jim_SetResultString(interp, "list index out of range", -1);
6918 return JIM_ERR;
6920 if (idx < 0)
6921 idx = listPtr->internalRep.listValue.len + idx;
6922 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6923 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6924 Jim_IncrRefCount(newObjPtr);
6925 return JIM_OK;
6928 /* Modify the list stored in the variable named 'varNamePtr'
6929 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6930 * with the new element 'newObjptr'. (implements the [lset] command) */
6931 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6932 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6934 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6935 int shared, i, idx;
6937 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6938 if (objPtr == NULL)
6939 return JIM_ERR;
6940 if ((shared = Jim_IsShared(objPtr)))
6941 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6942 for (i = 0; i < indexc - 1; i++) {
6943 listObjPtr = objPtr;
6944 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6945 goto err;
6946 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6947 goto err;
6949 if (Jim_IsShared(objPtr)) {
6950 objPtr = Jim_DuplicateObj(interp, objPtr);
6951 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6953 Jim_InvalidateStringRep(listObjPtr);
6955 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6956 goto err;
6957 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6958 goto err;
6959 Jim_InvalidateStringRep(objPtr);
6960 Jim_InvalidateStringRep(varObjPtr);
6961 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6962 goto err;
6963 Jim_SetResult(interp, varObjPtr);
6964 return JIM_OK;
6965 err:
6966 if (shared) {
6967 Jim_FreeNewObj(interp, varObjPtr);
6969 return JIM_ERR;
6972 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6974 int i;
6975 int listLen = Jim_ListLength(interp, listObjPtr);
6976 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6978 for (i = 0; i < listLen; ) {
6979 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6980 if (++i != listLen) {
6981 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6984 return resObjPtr;
6987 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6989 int i;
6991 /* If all the objects in objv are lists,
6992 * it's possible to return a list as result, that's the
6993 * concatenation of all the lists. */
6994 for (i = 0; i < objc; i++) {
6995 if (!Jim_IsList(objv[i]))
6996 break;
6998 if (i == objc) {
6999 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
7001 for (i = 0; i < objc; i++)
7002 ListAppendList(objPtr, objv[i]);
7003 return objPtr;
7005 else {
7006 /* Else... we have to glue strings together */
7007 int len = 0, objLen;
7008 char *bytes, *p;
7010 /* Compute the length */
7011 for (i = 0; i < objc; i++) {
7012 len += Jim_Length(objv[i]);
7014 if (objc)
7015 len += objc - 1;
7016 /* Create the string rep, and a string object holding it. */
7017 p = bytes = Jim_Alloc(len + 1);
7018 for (i = 0; i < objc; i++) {
7019 const char *s = Jim_GetString(objv[i], &objLen);
7021 /* Remove leading space */
7022 while (objLen && isspace(UCHAR(*s))) {
7023 s++;
7024 objLen--;
7025 len--;
7027 /* And trailing space */
7028 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
7029 /* Handle trailing backslash-space case */
7030 if (objLen > 1 && s[objLen - 2] == '\\') {
7031 break;
7033 objLen--;
7034 len--;
7036 memcpy(p, s, objLen);
7037 p += objLen;
7038 if (i + 1 != objc) {
7039 if (objLen)
7040 *p++ = ' ';
7041 else {
7042 /* Drop the space calculated for this
7043 * element that is instead null. */
7044 len--;
7048 *p = '\0';
7049 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7053 /* Returns a list composed of the elements in the specified range.
7054 * first and start are directly accepted as Jim_Objects and
7055 * processed for the end?-index? case. */
7056 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7057 Jim_Obj *lastObjPtr)
7059 int first, last;
7060 int len, rangeLen;
7062 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7063 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7064 return NULL;
7065 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7066 first = JimRelToAbsIndex(len, first);
7067 last = JimRelToAbsIndex(len, last);
7068 JimRelToAbsRange(len, &first, &last, &rangeLen);
7069 if (first == 0 && last == len) {
7070 return listObjPtr;
7072 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7075 /* -----------------------------------------------------------------------------
7076 * Dict object
7077 * ---------------------------------------------------------------------------*/
7078 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7079 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7080 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7081 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7083 /* Dict HashTable Type.
7085 * Keys and Values are Jim objects. */
7087 static unsigned int JimObjectHTHashFunction(const void *key)
7089 int len;
7090 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7091 return Jim_GenHashFunction((const unsigned char *)str, len);
7094 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7096 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7099 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7101 Jim_IncrRefCount((Jim_Obj *)val);
7102 return (void *)val;
7105 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7107 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7110 static const Jim_HashTableType JimDictHashTableType = {
7111 JimObjectHTHashFunction, /* hash function */
7112 JimObjectHTKeyValDup, /* key dup */
7113 JimObjectHTKeyValDup, /* val dup */
7114 JimObjectHTKeyCompare, /* key compare */
7115 JimObjectHTKeyValDestructor, /* key destructor */
7116 JimObjectHTKeyValDestructor /* val destructor */
7119 /* Note that while the elements of the dict may contain references,
7120 * the list object itself can't. This basically means that the
7121 * dict object string representation as a whole can't contain references
7122 * that are not presents in the single elements. */
7123 static const Jim_ObjType dictObjType = {
7124 "dict",
7125 FreeDictInternalRep,
7126 DupDictInternalRep,
7127 UpdateStringOfDict,
7128 JIM_TYPE_NONE,
7131 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7133 JIM_NOTUSED(interp);
7135 Jim_FreeHashTable(objPtr->internalRep.ptr);
7136 Jim_Free(objPtr->internalRep.ptr);
7139 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7141 Jim_HashTable *ht, *dupHt;
7142 Jim_HashTableIterator htiter;
7143 Jim_HashEntry *he;
7145 /* Create a new hash table */
7146 ht = srcPtr->internalRep.ptr;
7147 dupHt = Jim_Alloc(sizeof(*dupHt));
7148 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7149 if (ht->size != 0)
7150 Jim_ExpandHashTable(dupHt, ht->size);
7151 /* Copy every element from the source to the dup hash table */
7152 JimInitHashTableIterator(ht, &htiter);
7153 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7154 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7157 dupPtr->internalRep.ptr = dupHt;
7158 dupPtr->typePtr = &dictObjType;
7161 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7163 Jim_HashTable *ht;
7164 Jim_HashTableIterator htiter;
7165 Jim_HashEntry *he;
7166 Jim_Obj **objv;
7167 int i;
7169 ht = dictPtr->internalRep.ptr;
7171 /* Turn the hash table into a flat vector of Jim_Objects. */
7172 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7173 JimInitHashTableIterator(ht, &htiter);
7174 i = 0;
7175 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7176 objv[i++] = Jim_GetHashEntryKey(he);
7177 objv[i++] = Jim_GetHashEntryVal(he);
7179 *len = i;
7180 return objv;
7183 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7185 /* Turn the hash table into a flat vector of Jim_Objects. */
7186 int len;
7187 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7189 /* And now generate the string rep as a list */
7190 JimMakeListStringRep(objPtr, objv, len);
7192 Jim_Free(objv);
7195 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7197 int listlen;
7199 if (objPtr->typePtr == &dictObjType) {
7200 return JIM_OK;
7203 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7204 /* A shared list, so get the string representation now to avoid
7205 * changing the order in case of fast conversion to dict.
7207 Jim_String(objPtr);
7210 /* For simplicity, convert a non-list object to a list and then to a dict */
7211 listlen = Jim_ListLength(interp, objPtr);
7212 if (listlen % 2) {
7213 Jim_SetResultString(interp, "missing value to go with key", -1);
7214 return JIM_ERR;
7216 else {
7217 /* Converting from a list to a dict can't fail */
7218 Jim_HashTable *ht;
7219 int i;
7221 ht = Jim_Alloc(sizeof(*ht));
7222 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7224 for (i = 0; i < listlen; i += 2) {
7225 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7226 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7228 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7231 Jim_FreeIntRep(interp, objPtr);
7232 objPtr->typePtr = &dictObjType;
7233 objPtr->internalRep.ptr = ht;
7235 return JIM_OK;
7239 /* Dict object API */
7241 /* Add an element to a dict. objPtr must be of the "dict" type.
7242 * The higher-level exported function is Jim_DictAddElement().
7243 * If an element with the specified key already exists, the value
7244 * associated is replaced with the new one.
7246 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7247 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7248 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7250 Jim_HashTable *ht = objPtr->internalRep.ptr;
7252 if (valueObjPtr == NULL) { /* unset */
7253 return Jim_DeleteHashEntry(ht, keyObjPtr);
7255 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7256 return JIM_OK;
7259 /* Add an element, higher-level interface for DictAddElement().
7260 * If valueObjPtr == NULL, the key is removed if it exists. */
7261 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7262 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7264 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7265 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7266 return JIM_ERR;
7268 Jim_InvalidateStringRep(objPtr);
7269 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7272 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7274 Jim_Obj *objPtr;
7275 int i;
7277 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7279 objPtr = Jim_NewObj(interp);
7280 objPtr->typePtr = &dictObjType;
7281 objPtr->bytes = NULL;
7282 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7283 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7284 for (i = 0; i < len; i += 2)
7285 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7286 return objPtr;
7289 /* Return the value associated to the specified dict key
7290 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7292 * Sets *objPtrPtr to non-NULL only upon success.
7294 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7295 Jim_Obj **objPtrPtr, int flags)
7297 Jim_HashEntry *he;
7298 Jim_HashTable *ht;
7300 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7301 return -1;
7303 ht = dictPtr->internalRep.ptr;
7304 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7305 if (flags & JIM_ERRMSG) {
7306 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7308 return JIM_ERR;
7310 else {
7311 *objPtrPtr = Jim_GetHashEntryVal(he);
7312 return JIM_OK;
7316 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7317 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7319 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7320 return JIM_ERR;
7322 *objPtrPtr = JimDictPairs(dictPtr, len);
7324 return JIM_OK;
7328 /* Return the value associated to the specified dict keys */
7329 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7330 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7332 int i;
7334 if (keyc == 0) {
7335 *objPtrPtr = dictPtr;
7336 return JIM_OK;
7339 for (i = 0; i < keyc; i++) {
7340 Jim_Obj *objPtr;
7342 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7343 if (rc != JIM_OK) {
7344 return rc;
7346 dictPtr = objPtr;
7348 *objPtrPtr = dictPtr;
7349 return JIM_OK;
7352 /* Modify the dict stored into the variable named 'varNamePtr'
7353 * setting the element specified by the 'keyc' keys objects in 'keyv',
7354 * with the new value of the element 'newObjPtr'.
7356 * If newObjPtr == NULL the operation is to remove the given key
7357 * from the dictionary.
7359 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7360 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7362 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7363 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7365 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7366 int shared, i;
7368 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7369 if (objPtr == NULL) {
7370 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7371 /* Cannot remove a key from non existing var */
7372 return JIM_ERR;
7374 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7375 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7376 Jim_FreeNewObj(interp, varObjPtr);
7377 return JIM_ERR;
7380 if ((shared = Jim_IsShared(objPtr)))
7381 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7382 for (i = 0; i < keyc; i++) {
7383 dictObjPtr = objPtr;
7385 /* Check if it's a valid dictionary */
7386 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7387 goto err;
7390 if (i == keyc - 1) {
7391 /* Last key: Note that error on unset with missing last key is OK */
7392 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7393 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7394 goto err;
7397 break;
7400 /* Check if the given key exists. */
7401 Jim_InvalidateStringRep(dictObjPtr);
7402 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7403 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7404 /* This key exists at the current level.
7405 * Make sure it's not shared!. */
7406 if (Jim_IsShared(objPtr)) {
7407 objPtr = Jim_DuplicateObj(interp, objPtr);
7408 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7411 else {
7412 /* Key not found. If it's an [unset] operation
7413 * this is an error. Only the last key may not
7414 * exist. */
7415 if (newObjPtr == NULL) {
7416 goto err;
7418 /* Otherwise set an empty dictionary
7419 * as key's value. */
7420 objPtr = Jim_NewDictObj(interp, NULL, 0);
7421 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7424 /* XXX: Is this necessary? */
7425 Jim_InvalidateStringRep(objPtr);
7426 Jim_InvalidateStringRep(varObjPtr);
7427 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7428 goto err;
7430 Jim_SetResult(interp, varObjPtr);
7431 return JIM_OK;
7432 err:
7433 if (shared) {
7434 Jim_FreeNewObj(interp, varObjPtr);
7436 return JIM_ERR;
7439 /* -----------------------------------------------------------------------------
7440 * Index object
7441 * ---------------------------------------------------------------------------*/
7442 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7443 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7445 static const Jim_ObjType indexObjType = {
7446 "index",
7447 NULL,
7448 NULL,
7449 UpdateStringOfIndex,
7450 JIM_TYPE_NONE,
7453 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7455 if (objPtr->internalRep.intValue == -1) {
7456 JimSetStringBytes(objPtr, "end");
7458 else {
7459 char buf[JIM_INTEGER_SPACE + 1];
7460 if (objPtr->internalRep.intValue >= 0) {
7461 sprintf(buf, "%d", objPtr->internalRep.intValue);
7463 else {
7464 /* Must be <= -2 */
7465 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7467 JimSetStringBytes(objPtr, buf);
7471 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7473 int idx, end = 0;
7474 const char *str;
7475 char *endptr;
7477 /* Get the string representation */
7478 str = Jim_String(objPtr);
7480 /* Try to convert into an index */
7481 if (strncmp(str, "end", 3) == 0) {
7482 end = 1;
7483 str += 3;
7484 idx = 0;
7486 else {
7487 idx = jim_strtol(str, &endptr);
7489 if (endptr == str) {
7490 goto badindex;
7492 str = endptr;
7495 /* Now str may include or +<num> or -<num> */
7496 if (*str == '+' || *str == '-') {
7497 int sign = (*str == '+' ? 1 : -1);
7499 idx += sign * jim_strtol(++str, &endptr);
7500 if (str == endptr || *endptr) {
7501 goto badindex;
7503 str = endptr;
7505 /* The only thing left should be spaces */
7506 while (isspace(UCHAR(*str))) {
7507 str++;
7509 if (*str) {
7510 goto badindex;
7512 if (end) {
7513 if (idx > 0) {
7514 idx = INT_MAX;
7516 else {
7517 /* end-1 is repesented as -2 */
7518 idx--;
7521 else if (idx < 0) {
7522 idx = -INT_MAX;
7525 /* Free the old internal repr and set the new one. */
7526 Jim_FreeIntRep(interp, objPtr);
7527 objPtr->typePtr = &indexObjType;
7528 objPtr->internalRep.intValue = idx;
7529 return JIM_OK;
7531 badindex:
7532 Jim_SetResultFormatted(interp,
7533 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7534 return JIM_ERR;
7537 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7539 /* Avoid shimmering if the object is an integer. */
7540 if (objPtr->typePtr == &intObjType) {
7541 jim_wide val = JimWideValue(objPtr);
7543 if (val < 0)
7544 *indexPtr = -INT_MAX;
7545 else if (val > INT_MAX)
7546 *indexPtr = INT_MAX;
7547 else
7548 *indexPtr = (int)val;
7549 return JIM_OK;
7551 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7552 return JIM_ERR;
7553 *indexPtr = objPtr->internalRep.intValue;
7554 return JIM_OK;
7557 /* -----------------------------------------------------------------------------
7558 * Return Code Object.
7559 * ---------------------------------------------------------------------------*/
7561 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7562 static const char * const jimReturnCodes[] = {
7563 "ok",
7564 "error",
7565 "return",
7566 "break",
7567 "continue",
7568 "signal",
7569 "exit",
7570 "eval",
7571 NULL
7574 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7576 static const Jim_ObjType returnCodeObjType = {
7577 "return-code",
7578 NULL,
7579 NULL,
7580 NULL,
7581 JIM_TYPE_NONE,
7584 /* Converts a (standard) return code to a string. Returns "?" for
7585 * non-standard return codes.
7587 const char *Jim_ReturnCode(int code)
7589 if (code < 0 || code >= (int)jimReturnCodesSize) {
7590 return "?";
7592 else {
7593 return jimReturnCodes[code];
7597 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7599 int returnCode;
7600 jim_wide wideValue;
7602 /* Try to convert into an integer */
7603 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7604 returnCode = (int)wideValue;
7605 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7606 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7607 return JIM_ERR;
7609 /* Free the old internal repr and set the new one. */
7610 Jim_FreeIntRep(interp, objPtr);
7611 objPtr->typePtr = &returnCodeObjType;
7612 objPtr->internalRep.intValue = returnCode;
7613 return JIM_OK;
7616 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7618 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7619 return JIM_ERR;
7620 *intPtr = objPtr->internalRep.intValue;
7621 return JIM_OK;
7624 /* -----------------------------------------------------------------------------
7625 * Expression Parsing
7626 * ---------------------------------------------------------------------------*/
7627 static int JimParseExprOperator(struct JimParserCtx *pc);
7628 static int JimParseExprNumber(struct JimParserCtx *pc);
7629 static int JimParseExprIrrational(struct JimParserCtx *pc);
7630 static int JimParseExprBoolean(struct JimParserCtx *pc);
7632 /* expr operator opcodes. */
7633 enum
7635 /* Continues on from the JIM_TT_ space */
7637 /* Binary operators (numbers) */
7638 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7639 JIM_EXPROP_DIV,
7640 JIM_EXPROP_MOD,
7641 JIM_EXPROP_SUB,
7642 JIM_EXPROP_ADD,
7643 JIM_EXPROP_LSHIFT,
7644 JIM_EXPROP_RSHIFT,
7645 JIM_EXPROP_ROTL,
7646 JIM_EXPROP_ROTR,
7647 JIM_EXPROP_LT,
7648 JIM_EXPROP_GT,
7649 JIM_EXPROP_LTE,
7650 JIM_EXPROP_GTE,
7651 JIM_EXPROP_NUMEQ,
7652 JIM_EXPROP_NUMNE,
7653 JIM_EXPROP_BITAND, /* 35 */
7654 JIM_EXPROP_BITXOR,
7655 JIM_EXPROP_BITOR,
7656 JIM_EXPROP_LOGICAND, /* 38 */
7657 JIM_EXPROP_LOGICOR, /* 39 */
7658 JIM_EXPROP_TERNARY, /* 40 */
7659 JIM_EXPROP_COLON, /* 41 */
7660 JIM_EXPROP_POW, /* 42 */
7662 /* Binary operators (strings) */
7663 JIM_EXPROP_STREQ, /* 43 */
7664 JIM_EXPROP_STRNE,
7665 JIM_EXPROP_STRIN,
7666 JIM_EXPROP_STRNI,
7668 /* Unary operators (numbers) */
7669 JIM_EXPROP_NOT, /* 47 */
7670 JIM_EXPROP_BITNOT,
7671 JIM_EXPROP_UNARYMINUS,
7672 JIM_EXPROP_UNARYPLUS,
7674 /* Functions */
7675 JIM_EXPROP_FUNC_INT, /* 51 */
7676 JIM_EXPROP_FUNC_WIDE,
7677 JIM_EXPROP_FUNC_ABS,
7678 JIM_EXPROP_FUNC_DOUBLE,
7679 JIM_EXPROP_FUNC_ROUND,
7680 JIM_EXPROP_FUNC_RAND,
7681 JIM_EXPROP_FUNC_SRAND,
7683 /* math functions from libm */
7684 JIM_EXPROP_FUNC_SIN, /* 65 */
7685 JIM_EXPROP_FUNC_COS,
7686 JIM_EXPROP_FUNC_TAN,
7687 JIM_EXPROP_FUNC_ASIN,
7688 JIM_EXPROP_FUNC_ACOS,
7689 JIM_EXPROP_FUNC_ATAN,
7690 JIM_EXPROP_FUNC_ATAN2,
7691 JIM_EXPROP_FUNC_SINH,
7692 JIM_EXPROP_FUNC_COSH,
7693 JIM_EXPROP_FUNC_TANH,
7694 JIM_EXPROP_FUNC_CEIL,
7695 JIM_EXPROP_FUNC_FLOOR,
7696 JIM_EXPROP_FUNC_EXP,
7697 JIM_EXPROP_FUNC_LOG,
7698 JIM_EXPROP_FUNC_LOG10,
7699 JIM_EXPROP_FUNC_SQRT,
7700 JIM_EXPROP_FUNC_POW,
7701 JIM_EXPROP_FUNC_HYPOT,
7702 JIM_EXPROP_FUNC_FMOD,
7705 /* A expression node is either a term or an operator
7706 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7708 struct JimExprNode {
7709 int type; /* JIM_TT_xxx */
7710 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7712 struct JimExprNode *left; /* For all operators */
7713 struct JimExprNode *right; /* For binary operators */
7714 struct JimExprNode *ternary; /* For ternary operator only */
7717 /* Operators table */
7718 typedef struct Jim_ExprOperator
7720 const char *name;
7721 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7722 unsigned char precedence;
7723 unsigned char arity;
7724 unsigned char attr;
7725 unsigned char namelen;
7726 } Jim_ExprOperator;
7728 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7729 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7730 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7732 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7734 int intresult = 1;
7735 int rc;
7736 double dA, dC = 0;
7737 jim_wide wA, wC = 0;
7738 Jim_Obj *A;
7740 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7741 return rc;
7744 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7745 switch (node->type) {
7746 case JIM_EXPROP_FUNC_INT:
7747 case JIM_EXPROP_FUNC_WIDE:
7748 case JIM_EXPROP_FUNC_ROUND:
7749 case JIM_EXPROP_UNARYPLUS:
7750 wC = wA;
7751 break;
7752 case JIM_EXPROP_FUNC_DOUBLE:
7753 dC = wA;
7754 intresult = 0;
7755 break;
7756 case JIM_EXPROP_FUNC_ABS:
7757 wC = wA >= 0 ? wA : -wA;
7758 break;
7759 case JIM_EXPROP_UNARYMINUS:
7760 wC = -wA;
7761 break;
7762 case JIM_EXPROP_NOT:
7763 wC = !wA;
7764 break;
7765 default:
7766 abort();
7769 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7770 switch (node->type) {
7771 case JIM_EXPROP_FUNC_INT:
7772 case JIM_EXPROP_FUNC_WIDE:
7773 wC = dA;
7774 break;
7775 case JIM_EXPROP_FUNC_ROUND:
7776 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7777 break;
7778 case JIM_EXPROP_FUNC_DOUBLE:
7779 case JIM_EXPROP_UNARYPLUS:
7780 dC = dA;
7781 intresult = 0;
7782 break;
7783 case JIM_EXPROP_FUNC_ABS:
7784 #ifdef JIM_MATH_FUNCTIONS
7785 dC = fabs(dA);
7786 #else
7787 dC = dA >= 0 ? dA : -dA;
7788 #endif
7789 intresult = 0;
7790 break;
7791 case JIM_EXPROP_UNARYMINUS:
7792 dC = -dA;
7793 intresult = 0;
7794 break;
7795 case JIM_EXPROP_NOT:
7796 wC = !dA;
7797 break;
7798 default:
7799 abort();
7803 if (rc == JIM_OK) {
7804 if (intresult) {
7805 Jim_SetResultInt(interp, wC);
7807 else {
7808 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7812 Jim_DecrRefCount(interp, A);
7814 return rc;
7817 static double JimRandDouble(Jim_Interp *interp)
7819 unsigned long x;
7820 JimRandomBytes(interp, &x, sizeof(x));
7822 return (double)x / (unsigned long)~0;
7825 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7827 jim_wide wA;
7828 Jim_Obj *A;
7829 int rc;
7831 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7832 return rc;
7835 rc = Jim_GetWide(interp, A, &wA);
7836 if (rc == JIM_OK) {
7837 switch (node->type) {
7838 case JIM_EXPROP_BITNOT:
7839 Jim_SetResultInt(interp, ~wA);
7840 break;
7841 case JIM_EXPROP_FUNC_SRAND:
7842 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7843 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7844 break;
7845 default:
7846 abort();
7850 Jim_DecrRefCount(interp, A);
7852 return rc;
7855 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7857 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7859 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7861 return JIM_OK;
7864 #ifdef JIM_MATH_FUNCTIONS
7865 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7867 int rc;
7868 double dA, dC;
7869 Jim_Obj *A;
7871 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7872 return rc;
7875 rc = Jim_GetDouble(interp, A, &dA);
7876 if (rc == JIM_OK) {
7877 switch (node->type) {
7878 case JIM_EXPROP_FUNC_SIN:
7879 dC = sin(dA);
7880 break;
7881 case JIM_EXPROP_FUNC_COS:
7882 dC = cos(dA);
7883 break;
7884 case JIM_EXPROP_FUNC_TAN:
7885 dC = tan(dA);
7886 break;
7887 case JIM_EXPROP_FUNC_ASIN:
7888 dC = asin(dA);
7889 break;
7890 case JIM_EXPROP_FUNC_ACOS:
7891 dC = acos(dA);
7892 break;
7893 case JIM_EXPROP_FUNC_ATAN:
7894 dC = atan(dA);
7895 break;
7896 case JIM_EXPROP_FUNC_SINH:
7897 dC = sinh(dA);
7898 break;
7899 case JIM_EXPROP_FUNC_COSH:
7900 dC = cosh(dA);
7901 break;
7902 case JIM_EXPROP_FUNC_TANH:
7903 dC = tanh(dA);
7904 break;
7905 case JIM_EXPROP_FUNC_CEIL:
7906 dC = ceil(dA);
7907 break;
7908 case JIM_EXPROP_FUNC_FLOOR:
7909 dC = floor(dA);
7910 break;
7911 case JIM_EXPROP_FUNC_EXP:
7912 dC = exp(dA);
7913 break;
7914 case JIM_EXPROP_FUNC_LOG:
7915 dC = log(dA);
7916 break;
7917 case JIM_EXPROP_FUNC_LOG10:
7918 dC = log10(dA);
7919 break;
7920 case JIM_EXPROP_FUNC_SQRT:
7921 dC = sqrt(dA);
7922 break;
7923 default:
7924 abort();
7926 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7929 Jim_DecrRefCount(interp, A);
7931 return rc;
7933 #endif
7935 /* A binary operation on two ints */
7936 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7938 jim_wide wA, wB;
7939 int rc;
7940 Jim_Obj *A, *B;
7942 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7943 return rc;
7945 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7946 Jim_DecrRefCount(interp, A);
7947 return rc;
7950 rc = JIM_ERR;
7952 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7953 jim_wide wC;
7955 rc = JIM_OK;
7957 switch (node->type) {
7958 case JIM_EXPROP_LSHIFT:
7959 wC = wA << wB;
7960 break;
7961 case JIM_EXPROP_RSHIFT:
7962 wC = wA >> wB;
7963 break;
7964 case JIM_EXPROP_BITAND:
7965 wC = wA & wB;
7966 break;
7967 case JIM_EXPROP_BITXOR:
7968 wC = wA ^ wB;
7969 break;
7970 case JIM_EXPROP_BITOR:
7971 wC = wA | wB;
7972 break;
7973 case JIM_EXPROP_MOD:
7974 if (wB == 0) {
7975 wC = 0;
7976 Jim_SetResultString(interp, "Division by zero", -1);
7977 rc = JIM_ERR;
7979 else {
7981 * From Tcl 8.x
7983 * This code is tricky: C doesn't guarantee much
7984 * about the quotient or remainder, but Tcl does.
7985 * The remainder always has the same sign as the
7986 * divisor and a smaller absolute value.
7988 int negative = 0;
7990 if (wB < 0) {
7991 wB = -wB;
7992 wA = -wA;
7993 negative = 1;
7995 wC = wA % wB;
7996 if (wC < 0) {
7997 wC += wB;
7999 if (negative) {
8000 wC = -wC;
8003 break;
8004 case JIM_EXPROP_ROTL:
8005 case JIM_EXPROP_ROTR:{
8006 /* uint32_t would be better. But not everyone has inttypes.h? */
8007 unsigned long uA = (unsigned long)wA;
8008 unsigned long uB = (unsigned long)wB;
8009 const unsigned int S = sizeof(unsigned long) * 8;
8011 /* Shift left by the word size or more is undefined. */
8012 uB %= S;
8014 if (node->type == JIM_EXPROP_ROTR) {
8015 uB = S - uB;
8017 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
8018 break;
8020 default:
8021 abort();
8023 Jim_SetResultInt(interp, wC);
8026 Jim_DecrRefCount(interp, A);
8027 Jim_DecrRefCount(interp, B);
8029 return rc;
8033 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8034 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8036 int rc = JIM_OK;
8037 double dA, dB, dC = 0;
8038 jim_wide wA, wB, wC = 0;
8039 Jim_Obj *A, *B;
8041 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8042 return rc;
8044 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8045 Jim_DecrRefCount(interp, A);
8046 return rc;
8049 if ((A->typePtr != &doubleObjType || A->bytes) &&
8050 (B->typePtr != &doubleObjType || B->bytes) &&
8051 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8053 /* Both are ints */
8055 switch (node->type) {
8056 case JIM_EXPROP_POW:
8057 case JIM_EXPROP_FUNC_POW:
8058 if (wA == 0 && wB < 0) {
8059 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8060 rc = JIM_ERR;
8061 goto done;
8063 wC = JimPowWide(wA, wB);
8064 goto intresult;
8065 case JIM_EXPROP_ADD:
8066 wC = wA + wB;
8067 goto intresult;
8068 case JIM_EXPROP_SUB:
8069 wC = wA - wB;
8070 goto intresult;
8071 case JIM_EXPROP_MUL:
8072 wC = wA * wB;
8073 goto intresult;
8074 case JIM_EXPROP_DIV:
8075 if (wB == 0) {
8076 Jim_SetResultString(interp, "Division by zero", -1);
8077 rc = JIM_ERR;
8078 goto done;
8080 else {
8082 * From Tcl 8.x
8084 * This code is tricky: C doesn't guarantee much
8085 * about the quotient or remainder, but Tcl does.
8086 * The remainder always has the same sign as the
8087 * divisor and a smaller absolute value.
8089 if (wB < 0) {
8090 wB = -wB;
8091 wA = -wA;
8093 wC = wA / wB;
8094 if (wA % wB < 0) {
8095 wC--;
8097 goto intresult;
8099 case JIM_EXPROP_LT:
8100 wC = wA < wB;
8101 goto intresult;
8102 case JIM_EXPROP_GT:
8103 wC = wA > wB;
8104 goto intresult;
8105 case JIM_EXPROP_LTE:
8106 wC = wA <= wB;
8107 goto intresult;
8108 case JIM_EXPROP_GTE:
8109 wC = wA >= wB;
8110 goto intresult;
8111 case JIM_EXPROP_NUMEQ:
8112 wC = wA == wB;
8113 goto intresult;
8114 case JIM_EXPROP_NUMNE:
8115 wC = wA != wB;
8116 goto intresult;
8119 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8120 switch (node->type) {
8121 #ifndef JIM_MATH_FUNCTIONS
8122 case JIM_EXPROP_POW:
8123 case JIM_EXPROP_FUNC_POW:
8124 case JIM_EXPROP_FUNC_ATAN2:
8125 case JIM_EXPROP_FUNC_HYPOT:
8126 case JIM_EXPROP_FUNC_FMOD:
8127 Jim_SetResultString(interp, "unsupported", -1);
8128 rc = JIM_ERR;
8129 goto done;
8130 #else
8131 case JIM_EXPROP_POW:
8132 case JIM_EXPROP_FUNC_POW:
8133 dC = pow(dA, dB);
8134 goto doubleresult;
8135 case JIM_EXPROP_FUNC_ATAN2:
8136 dC = atan2(dA, dB);
8137 goto doubleresult;
8138 case JIM_EXPROP_FUNC_HYPOT:
8139 dC = hypot(dA, dB);
8140 goto doubleresult;
8141 case JIM_EXPROP_FUNC_FMOD:
8142 dC = fmod(dA, dB);
8143 goto doubleresult;
8144 #endif
8145 case JIM_EXPROP_ADD:
8146 dC = dA + dB;
8147 goto doubleresult;
8148 case JIM_EXPROP_SUB:
8149 dC = dA - dB;
8150 goto doubleresult;
8151 case JIM_EXPROP_MUL:
8152 dC = dA * dB;
8153 goto doubleresult;
8154 case JIM_EXPROP_DIV:
8155 if (dB == 0) {
8156 #ifdef INFINITY
8157 dC = dA < 0 ? -INFINITY : INFINITY;
8158 #else
8159 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8160 #endif
8162 else {
8163 dC = dA / dB;
8165 goto doubleresult;
8166 case JIM_EXPROP_LT:
8167 wC = dA < dB;
8168 goto intresult;
8169 case JIM_EXPROP_GT:
8170 wC = dA > dB;
8171 goto intresult;
8172 case JIM_EXPROP_LTE:
8173 wC = dA <= dB;
8174 goto intresult;
8175 case JIM_EXPROP_GTE:
8176 wC = dA >= dB;
8177 goto intresult;
8178 case JIM_EXPROP_NUMEQ:
8179 wC = dA == dB;
8180 goto intresult;
8181 case JIM_EXPROP_NUMNE:
8182 wC = dA != dB;
8183 goto intresult;
8186 else {
8187 /* Handle the string case */
8189 /* XXX: Could optimise the eq/ne case by checking lengths */
8190 int i = Jim_StringCompareObj(interp, A, B, 0);
8192 switch (node->type) {
8193 case JIM_EXPROP_LT:
8194 wC = i < 0;
8195 goto intresult;
8196 case JIM_EXPROP_GT:
8197 wC = i > 0;
8198 goto intresult;
8199 case JIM_EXPROP_LTE:
8200 wC = i <= 0;
8201 goto intresult;
8202 case JIM_EXPROP_GTE:
8203 wC = i >= 0;
8204 goto intresult;
8205 case JIM_EXPROP_NUMEQ:
8206 wC = i == 0;
8207 goto intresult;
8208 case JIM_EXPROP_NUMNE:
8209 wC = i != 0;
8210 goto intresult;
8213 /* If we get here, it is an error */
8214 rc = JIM_ERR;
8215 done:
8216 Jim_DecrRefCount(interp, A);
8217 Jim_DecrRefCount(interp, B);
8218 return rc;
8219 intresult:
8220 Jim_SetResultInt(interp, wC);
8221 goto done;
8222 doubleresult:
8223 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8224 goto done;
8227 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8229 int listlen;
8230 int i;
8232 listlen = Jim_ListLength(interp, listObjPtr);
8233 for (i = 0; i < listlen; i++) {
8234 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8235 return 1;
8238 return 0;
8243 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8245 Jim_Obj *A, *B;
8246 jim_wide wC;
8247 int rc;
8249 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8250 return rc;
8252 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8253 Jim_DecrRefCount(interp, A);
8254 return rc;
8257 switch (node->type) {
8258 case JIM_EXPROP_STREQ:
8259 case JIM_EXPROP_STRNE:
8260 wC = Jim_StringEqObj(A, B);
8261 if (node->type == JIM_EXPROP_STRNE) {
8262 wC = !wC;
8264 break;
8265 case JIM_EXPROP_STRIN:
8266 wC = JimSearchList(interp, B, A);
8267 break;
8268 case JIM_EXPROP_STRNI:
8269 wC = !JimSearchList(interp, B, A);
8270 break;
8271 default:
8272 abort();
8274 Jim_SetResultInt(interp, wC);
8276 Jim_DecrRefCount(interp, A);
8277 Jim_DecrRefCount(interp, B);
8279 return rc;
8282 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8284 long l;
8285 double d;
8286 int b;
8287 int ret = -1;
8289 /* In case the object is interp->result with refcount 1*/
8290 Jim_IncrRefCount(obj);
8292 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8293 ret = (l != 0);
8295 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8296 ret = (d != 0);
8298 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8299 ret = (b != 0);
8302 Jim_DecrRefCount(interp, obj);
8303 return ret;
8306 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8308 /* evaluate left */
8309 int result = JimExprGetTermBoolean(interp, node->left);
8311 if (result == 1) {
8312 /* true so evaluate right */
8313 result = JimExprGetTermBoolean(interp, node->right);
8315 if (result == -1) {
8316 return JIM_ERR;
8318 Jim_SetResultInt(interp, result);
8319 return JIM_OK;
8322 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8324 /* evaluate left */
8325 int result = JimExprGetTermBoolean(interp, node->left);
8327 if (result == 0) {
8328 /* false so evaluate right */
8329 result = JimExprGetTermBoolean(interp, node->right);
8331 if (result == -1) {
8332 return JIM_ERR;
8334 Jim_SetResultInt(interp, result);
8335 return JIM_OK;
8338 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8340 /* evaluate left */
8341 int result = JimExprGetTermBoolean(interp, node->left);
8343 if (result == 1) {
8344 /* true so select right */
8345 return JimExprEvalTermNode(interp, node->right);
8347 else if (result == 0) {
8348 /* false so select ternary */
8349 return JimExprEvalTermNode(interp, node->ternary);
8351 /* error */
8352 return JIM_ERR;
8355 enum
8357 OP_FUNC = 0x0001, /* function syntax */
8358 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8361 /* name - precedence - arity - opcode
8363 * This array *must* be kept in sync with the JIM_EXPROP enum.
8365 * The following macros pre-compute the string length at compile time.
8367 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8368 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8370 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8371 OPRINIT("*", 110, 2, JimExprOpBin),
8372 OPRINIT("/", 110, 2, JimExprOpBin),
8373 OPRINIT("%", 110, 2, JimExprOpIntBin),
8375 OPRINIT("-", 100, 2, JimExprOpBin),
8376 OPRINIT("+", 100, 2, JimExprOpBin),
8378 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8379 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8381 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8382 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8384 OPRINIT("<", 80, 2, JimExprOpBin),
8385 OPRINIT(">", 80, 2, JimExprOpBin),
8386 OPRINIT("<=", 80, 2, JimExprOpBin),
8387 OPRINIT(">=", 80, 2, JimExprOpBin),
8389 OPRINIT("==", 70, 2, JimExprOpBin),
8390 OPRINIT("!=", 70, 2, JimExprOpBin),
8392 OPRINIT("&", 50, 2, JimExprOpIntBin),
8393 OPRINIT("^", 49, 2, JimExprOpIntBin),
8394 OPRINIT("|", 48, 2, JimExprOpIntBin),
8396 OPRINIT("&&", 10, 2, JimExprOpAnd),
8397 OPRINIT("||", 9, 2, JimExprOpOr),
8398 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8399 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8401 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8402 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8404 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8405 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8407 OPRINIT("in", 55, 2, JimExprOpStrBin),
8408 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8410 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8411 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8412 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8413 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8417 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8418 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8419 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8420 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8421 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8422 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8423 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8425 #ifdef JIM_MATH_FUNCTIONS
8426 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8427 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8428 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8429 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8430 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8431 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8432 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8433 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8434 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8435 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8436 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8437 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8438 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8439 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8440 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8441 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8442 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8443 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8444 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8445 #endif
8447 #undef OPRINIT
8448 #undef OPRINIT_ATTR
8450 #define JIM_EXPR_OPERATORS_NUM \
8451 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8453 static int JimParseExpression(struct JimParserCtx *pc)
8455 /* Discard spaces and quoted newline */
8456 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8457 if (*pc->p == '\n') {
8458 pc->linenr++;
8460 pc->p++;
8461 pc->len--;
8464 /* Common case */
8465 pc->tline = pc->linenr;
8466 pc->tstart = pc->p;
8468 if (pc->len == 0) {
8469 pc->tend = pc->p;
8470 pc->tt = JIM_TT_EOL;
8471 pc->eof = 1;
8472 return JIM_OK;
8474 switch (*(pc->p)) {
8475 case '(':
8476 pc->tt = JIM_TT_SUBEXPR_START;
8477 goto singlechar;
8478 case ')':
8479 pc->tt = JIM_TT_SUBEXPR_END;
8480 goto singlechar;
8481 case ',':
8482 pc->tt = JIM_TT_SUBEXPR_COMMA;
8483 singlechar:
8484 pc->tend = pc->p;
8485 pc->p++;
8486 pc->len--;
8487 break;
8488 case '[':
8489 return JimParseCmd(pc);
8490 case '$':
8491 if (JimParseVar(pc) == JIM_ERR)
8492 return JimParseExprOperator(pc);
8493 else {
8494 /* Don't allow expr sugar in expressions */
8495 if (pc->tt == JIM_TT_EXPRSUGAR) {
8496 return JIM_ERR;
8498 return JIM_OK;
8500 break;
8501 case '0':
8502 case '1':
8503 case '2':
8504 case '3':
8505 case '4':
8506 case '5':
8507 case '6':
8508 case '7':
8509 case '8':
8510 case '9':
8511 case '.':
8512 return JimParseExprNumber(pc);
8513 case '"':
8514 return JimParseQuote(pc);
8515 case '{':
8516 return JimParseBrace(pc);
8518 case 'N':
8519 case 'I':
8520 case 'n':
8521 case 'i':
8522 if (JimParseExprIrrational(pc) == JIM_ERR)
8523 if (JimParseExprBoolean(pc) == JIM_ERR)
8524 return JimParseExprOperator(pc);
8525 break;
8526 case 't':
8527 case 'f':
8528 case 'o':
8529 case 'y':
8530 if (JimParseExprBoolean(pc) == JIM_ERR)
8531 return JimParseExprOperator(pc);
8532 break;
8533 default:
8534 return JimParseExprOperator(pc);
8535 break;
8537 return JIM_OK;
8540 static int JimParseExprNumber(struct JimParserCtx *pc)
8542 char *end;
8544 /* Assume an integer for now */
8545 pc->tt = JIM_TT_EXPR_INT;
8547 jim_strtoull(pc->p, (char **)&pc->p);
8548 /* Tried as an integer, but perhaps it parses as a double */
8549 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8550 /* Some stupid compilers insist they are cleverer that
8551 * we are. Even a (void) cast doesn't prevent this warning!
8553 if (strtod(pc->tstart, &end)) { /* nothing */ }
8554 if (end == pc->tstart)
8555 return JIM_ERR;
8556 if (end > pc->p) {
8557 /* Yes, double captured more chars */
8558 pc->tt = JIM_TT_EXPR_DOUBLE;
8559 pc->p = end;
8562 pc->tend = pc->p - 1;
8563 pc->len -= (pc->p - pc->tstart);
8564 return JIM_OK;
8567 static int JimParseExprIrrational(struct JimParserCtx *pc)
8569 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8570 int i;
8572 for (i = 0; irrationals[i]; i++) {
8573 const char *irr = irrationals[i];
8575 if (strncmp(irr, pc->p, 3) == 0) {
8576 pc->p += 3;
8577 pc->len -= 3;
8578 pc->tend = pc->p - 1;
8579 pc->tt = JIM_TT_EXPR_DOUBLE;
8580 return JIM_OK;
8583 return JIM_ERR;
8586 static int JimParseExprBoolean(struct JimParserCtx *pc)
8588 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8589 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8590 int i;
8592 for (i = 0; booleans[i]; i++) {
8593 const char *boolean = booleans[i];
8594 int length = lengths[i];
8596 if (strncmp(boolean, pc->p, length) == 0) {
8597 pc->p += length;
8598 pc->len -= length;
8599 pc->tend = pc->p - 1;
8600 pc->tt = JIM_TT_EXPR_BOOLEAN;
8601 return JIM_OK;
8604 return JIM_ERR;
8607 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8609 static Jim_ExprOperator dummy_op;
8610 if (opcode < JIM_TT_EXPR_OP) {
8611 return &dummy_op;
8613 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8616 static int JimParseExprOperator(struct JimParserCtx *pc)
8618 int i;
8619 const struct Jim_ExprOperator *bestOp = NULL;
8620 int bestLen = 0;
8622 /* Try to get the longest match. */
8623 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8624 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8626 if (op->name[0] != pc->p[0]) {
8627 continue;
8630 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8631 bestOp = op;
8632 bestLen = op->namelen;
8635 if (bestOp == NULL) {
8636 return JIM_ERR;
8639 /* Validate paretheses around function arguments */
8640 if (bestOp->attr & OP_FUNC) {
8641 const char *p = pc->p + bestLen;
8642 int len = pc->len - bestLen;
8644 while (len && isspace(UCHAR(*p))) {
8645 len--;
8646 p++;
8648 if (*p != '(') {
8649 return JIM_ERR;
8652 pc->tend = pc->p + bestLen - 1;
8653 pc->p += bestLen;
8654 pc->len -= bestLen;
8656 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8657 return JIM_OK;
8660 const char *jim_tt_name(int type)
8662 static const char * const tt_names[JIM_TT_EXPR_OP] =
8663 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8664 "DBL", "BOO", "$()" };
8665 if (type < JIM_TT_EXPR_OP) {
8666 return tt_names[type];
8668 else if (type == JIM_EXPROP_UNARYMINUS) {
8669 return "-VE";
8671 else if (type == JIM_EXPROP_UNARYPLUS) {
8672 return "+VE";
8674 else {
8675 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8676 static char buf[20];
8678 if (op->name) {
8679 return op->name;
8681 sprintf(buf, "(%d)", type);
8682 return buf;
8686 /* -----------------------------------------------------------------------------
8687 * Expression Object
8688 * ---------------------------------------------------------------------------*/
8689 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8690 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8691 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8693 static const Jim_ObjType exprObjType = {
8694 "expression",
8695 FreeExprInternalRep,
8696 DupExprInternalRep,
8697 NULL,
8698 JIM_TYPE_REFERENCES,
8701 /* expr tree structure */
8702 struct ExprTree
8704 struct JimExprNode *expr; /* The first operator or term */
8705 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8706 int len; /* Number of nodes in use */
8707 int inUse; /* Used for sharing. */
8710 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8712 int i;
8713 for (i = 0; i < num; i++) {
8714 if (nodes[i].objPtr) {
8715 Jim_DecrRefCount(interp, nodes[i].objPtr);
8718 Jim_Free(nodes);
8721 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8723 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8724 Jim_Free(expr);
8727 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8729 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8731 if (expr) {
8732 if (--expr->inUse != 0) {
8733 return;
8736 ExprTreeFree(interp, expr);
8740 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8742 JIM_NOTUSED(interp);
8743 JIM_NOTUSED(srcPtr);
8745 /* Just returns an simple string. */
8746 dupPtr->typePtr = NULL;
8749 struct ExprBuilder {
8750 int parencount; /* count of outstanding parentheses */
8751 int level; /* recursion depth */
8752 ParseToken *token; /* The current token */
8753 ParseToken *first_token; /* The first token */
8754 Jim_Stack stack; /* stack of pending terms */
8755 Jim_Obj *exprObjPtr; /* the original expression */
8756 Jim_Obj *fileNameObj; /* filename of the original expression */
8757 struct JimExprNode *nodes; /* storage for all nodes */
8758 struct JimExprNode *next; /* storage for the next node */
8761 #ifdef DEBUG_SHOW_EXPR
8762 static void JimShowExprNode(struct JimExprNode *node, int level)
8764 int i;
8765 for (i = 0; i < level; i++) {
8766 printf(" ");
8768 if (TOKEN_IS_EXPR_OP(node->type)) {
8769 printf("%s\n", jim_tt_name(node->type));
8770 if (node->left) {
8771 JimShowExprNode(node->left, level + 1);
8773 if (node->right) {
8774 JimShowExprNode(node->right, level + 1);
8776 if (node->ternary) {
8777 JimShowExprNode(node->ternary, level + 1);
8780 else {
8781 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8784 #endif
8786 #define EXPR_UNTIL_CLOSE 0x0001
8787 #define EXPR_FUNC_ARGS 0x0002
8788 #define EXPR_TERNARY 0x0004
8791 * Parse the subexpression at builder->token and return with the node on the stack.
8792 * builder->token is advanced to the next unconsumed token.
8793 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8795 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8796 * with an equal or lower precedence is reached (or strictly lower if right associative).
8798 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8799 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8800 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8802 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8804 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8806 int rc;
8807 struct JimExprNode *node;
8808 /* Calculate the stack length expected after pushing the number of expected terms */
8809 int exp_stacklen = builder->stack.len + exp_numterms;
8811 if (builder->level++ > 200) {
8812 Jim_SetResultString(interp, "Expression too complex", -1);
8813 return JIM_ERR;
8816 while (builder->token->type != JIM_TT_EOL) {
8817 ParseToken *t = builder->token++;
8818 int prevtt;
8820 if (t == builder->first_token) {
8821 prevtt = JIM_TT_NONE;
8823 else {
8824 prevtt = t[-1].type;
8827 if (t->type == JIM_TT_SUBEXPR_START) {
8828 if (builder->stack.len == exp_stacklen) {
8829 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8830 return JIM_ERR;
8832 builder->parencount++;
8833 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8834 if (rc != JIM_OK) {
8835 return rc;
8837 /* A complete subexpression is on the stack */
8839 else if (t->type == JIM_TT_SUBEXPR_END) {
8840 if (!(flags & EXPR_UNTIL_CLOSE)) {
8841 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8842 builder->token--;
8843 builder->level--;
8844 return JIM_OK;
8846 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8847 return JIM_ERR;
8849 builder->parencount--;
8850 if (builder->stack.len == exp_stacklen) {
8851 /* Return with the expected number of subexpressions on the stack */
8852 break;
8855 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8856 if (!(flags & EXPR_FUNC_ARGS)) {
8857 if (builder->stack.len == exp_stacklen) {
8858 /* handle the comma back at the parent level */
8859 builder->token--;
8860 builder->level--;
8861 return JIM_OK;
8863 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8864 return JIM_ERR;
8866 else {
8867 /* If we see more terms than expected, it is an error */
8868 if (builder->stack.len > exp_stacklen) {
8869 Jim_SetResultFormatted(interp, "too many arguments to math function");
8870 return JIM_ERR;
8873 /* just go onto the next arg */
8875 else if (t->type == JIM_EXPROP_COLON) {
8876 if (!(flags & EXPR_TERNARY)) {
8877 if (builder->level != 1) {
8878 /* handle the comma back at the parent level */
8879 builder->token--;
8880 builder->level--;
8881 return JIM_OK;
8883 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8884 return JIM_ERR;
8886 if (builder->stack.len == exp_stacklen) {
8887 /* handle the comma back at the parent level */
8888 builder->token--;
8889 builder->level--;
8890 return JIM_OK;
8892 /* just go onto the next term */
8894 else if (TOKEN_IS_EXPR_OP(t->type)) {
8895 const struct Jim_ExprOperator *op;
8897 /* Convert -/+ to unary minus or unary plus if necessary */
8898 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8899 if (t->type == JIM_EXPROP_SUB) {
8900 t->type = JIM_EXPROP_UNARYMINUS;
8902 else if (t->type == JIM_EXPROP_ADD) {
8903 t->type = JIM_EXPROP_UNARYPLUS;
8907 op = JimExprOperatorInfoByOpcode(t->type);
8909 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8910 /* next op is lower precedence, or equal and left associative, so done here */
8911 builder->token--;
8912 break;
8915 if (op->attr & OP_FUNC) {
8916 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8917 Jim_SetResultString(interp, "missing arguments for math function", -1);
8918 return JIM_ERR;
8920 builder->token++;
8921 if (op->arity == 0) {
8922 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8923 Jim_SetResultString(interp, "too many arguments for math function", -1);
8924 return JIM_ERR;
8926 builder->token++;
8927 goto noargs;
8929 builder->parencount++;
8931 /* This will push left and return right */
8932 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8934 else if (t->type == JIM_EXPROP_TERNARY) {
8935 /* Collect the two arguments to the ternary operator */
8936 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8938 else {
8939 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8940 * and push that on the term stack
8942 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8945 if (rc != JIM_OK) {
8946 return rc;
8949 noargs:
8950 node = builder->next++;
8951 node->type = t->type;
8953 if (op->arity >= 3) {
8954 node->ternary = Jim_StackPop(&builder->stack);
8955 if (node->ternary == NULL) {
8956 goto missingoperand;
8959 if (op->arity >= 2) {
8960 node->right = Jim_StackPop(&builder->stack);
8961 if (node->right == NULL) {
8962 goto missingoperand;
8965 if (op->arity >= 1) {
8966 node->left = Jim_StackPop(&builder->stack);
8967 if (node->left == NULL) {
8968 missingoperand:
8969 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8970 builder->next--;
8971 return JIM_ERR;
8976 /* Now push the node */
8977 Jim_StackPush(&builder->stack, node);
8979 else {
8980 Jim_Obj *objPtr = NULL;
8982 /* This is a simple non-operator term, so create and push the appropriate object */
8984 /* Two consecutive terms without an operator is invalid */
8985 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
8986 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
8987 return JIM_ERR;
8990 /* Immediately create a double or int object? */
8991 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
8992 char *endptr;
8993 if (t->type == JIM_TT_EXPR_INT) {
8994 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8996 else {
8997 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8999 if (endptr != t->token + t->len) {
9000 /* Conversion failed, so just store it as a string */
9001 Jim_FreeNewObj(interp, objPtr);
9002 objPtr = NULL;
9006 if (!objPtr) {
9007 /* Everything else is stored a simple string term */
9008 objPtr = Jim_NewStringObj(interp, t->token, t->len);
9009 if (t->type == JIM_TT_CMD) {
9010 /* Only commands need source info */
9011 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
9015 /* Now push a term node */
9016 node = builder->next++;
9017 node->objPtr = objPtr;
9018 Jim_IncrRefCount(node->objPtr);
9019 node->type = t->type;
9020 Jim_StackPush(&builder->stack, node);
9024 if (builder->stack.len == exp_stacklen) {
9025 builder->level--;
9026 return JIM_OK;
9029 if ((flags & EXPR_FUNC_ARGS)) {
9030 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9032 else {
9033 if (builder->stack.len < exp_stacklen) {
9034 if (builder->level == 0) {
9035 Jim_SetResultFormatted(interp, "empty expression");
9037 else {
9038 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9041 else {
9042 Jim_SetResultFormatted(interp, "extra terms after expression");
9046 return JIM_ERR;
9049 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9051 struct ExprTree *expr;
9052 struct ExprBuilder builder;
9053 int rc;
9054 struct JimExprNode *top = NULL;
9056 builder.parencount = 0;
9057 builder.level = 0;
9058 builder.token = builder.first_token = tokenlist->list;
9059 builder.exprObjPtr = exprObjPtr;
9060 builder.fileNameObj = fileNameObj;
9061 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9062 builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9063 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9064 builder.next = builder.nodes;
9065 Jim_InitStack(&builder.stack);
9067 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9069 if (rc == JIM_OK) {
9070 top = Jim_StackPop(&builder.stack);
9072 if (builder.parencount) {
9073 Jim_SetResultString(interp, "missing close parenthesis", -1);
9074 rc = JIM_ERR;
9078 /* Free the stack used for the compilation. */
9079 Jim_FreeStack(&builder.stack);
9081 if (rc != JIM_OK) {
9082 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9083 return NULL;
9086 expr = Jim_Alloc(sizeof(*expr));
9087 expr->inUse = 1;
9088 expr->expr = top;
9089 expr->nodes = builder.nodes;
9090 expr->len = builder.next - builder.nodes;
9092 assert(expr->len <= tokenlist->count - 1);
9094 return expr;
9097 /* This method takes the string representation of an expression
9098 * and generates a program for the expr engine */
9099 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9101 int exprTextLen;
9102 const char *exprText;
9103 struct JimParserCtx parser;
9104 struct ExprTree *expr;
9105 ParseTokenList tokenlist;
9106 int line;
9107 Jim_Obj *fileNameObj;
9108 int rc = JIM_ERR;
9110 /* Try to get information about filename / line number */
9111 if (objPtr->typePtr == &sourceObjType) {
9112 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9113 line = objPtr->internalRep.sourceValue.lineNumber;
9115 else {
9116 fileNameObj = interp->emptyObj;
9117 line = 1;
9119 Jim_IncrRefCount(fileNameObj);
9121 exprText = Jim_GetString(objPtr, &exprTextLen);
9123 /* Initially tokenise the expression into tokenlist */
9124 ScriptTokenListInit(&tokenlist);
9126 JimParserInit(&parser, exprText, exprTextLen, line);
9127 while (!parser.eof) {
9128 if (JimParseExpression(&parser) != JIM_OK) {
9129 ScriptTokenListFree(&tokenlist);
9130 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9131 expr = NULL;
9132 goto err;
9135 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9136 parser.tline);
9139 #ifdef DEBUG_SHOW_EXPR_TOKENS
9141 int i;
9142 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9143 for (i = 0; i < tokenlist.count; i++) {
9144 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9145 tokenlist.list[i].len, tokenlist.list[i].token);
9148 #endif
9150 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9151 ScriptTokenListFree(&tokenlist);
9152 Jim_DecrRefCount(interp, fileNameObj);
9153 return JIM_ERR;
9156 /* Now create the expression bytecode from the tokenlist */
9157 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9159 /* No longer need the token list */
9160 ScriptTokenListFree(&tokenlist);
9162 if (!expr) {
9163 goto err;
9166 #ifdef DEBUG_SHOW_EXPR
9167 printf("==== Expr ====\n");
9168 JimShowExprNode(expr->expr, 0);
9169 #endif
9171 rc = JIM_OK;
9173 err:
9174 /* Free the old internal rep and set the new one. */
9175 Jim_DecrRefCount(interp, fileNameObj);
9176 Jim_FreeIntRep(interp, objPtr);
9177 Jim_SetIntRepPtr(objPtr, expr);
9178 objPtr->typePtr = &exprObjType;
9179 return rc;
9182 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9184 if (objPtr->typePtr != &exprObjType) {
9185 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9186 return NULL;
9189 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9192 #ifdef JIM_OPTIMIZATION
9193 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9195 if (node->type == JIM_TT_EXPR_INT)
9196 return node->objPtr;
9197 else if (node->type == JIM_TT_VAR)
9198 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9199 else if (node->type == JIM_TT_DICTSUGAR)
9200 return JimExpandDictSugar(interp, node->objPtr);
9201 else
9202 return NULL;
9204 #endif
9206 /* -----------------------------------------------------------------------------
9207 * Expressions evaluation.
9208 * Jim uses a recursive evaluation engine for expressions,
9209 * that takes advantage of the fact that expr's operators
9210 * can't be redefined.
9212 * Jim_EvalExpression() uses the expression tree compiled by
9213 * SetExprFromAny() method of the "expression" object.
9215 * On success a Tcl Object containing the result of the evaluation
9216 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9217 * returned.
9218 * On error the function returns a retcode != to JIM_OK and set a suitable
9219 * error on the interp.
9220 * ---------------------------------------------------------------------------*/
9222 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9224 if (TOKEN_IS_EXPR_OP(node->type)) {
9225 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9226 return op->funcop(interp, node);
9228 else {
9229 Jim_Obj *objPtr;
9231 /* A term */
9232 switch (node->type) {
9233 case JIM_TT_EXPR_INT:
9234 case JIM_TT_EXPR_DOUBLE:
9235 case JIM_TT_EXPR_BOOLEAN:
9236 case JIM_TT_STR:
9237 Jim_SetResult(interp, node->objPtr);
9238 return JIM_OK;
9240 case JIM_TT_VAR:
9241 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9242 if (objPtr) {
9243 Jim_SetResult(interp, objPtr);
9244 return JIM_OK;
9246 return JIM_ERR;
9248 case JIM_TT_DICTSUGAR:
9249 objPtr = JimExpandDictSugar(interp, node->objPtr);
9250 if (objPtr) {
9251 Jim_SetResult(interp, objPtr);
9252 return JIM_OK;
9254 return JIM_ERR;
9256 case JIM_TT_ESC:
9257 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9258 Jim_SetResult(interp, objPtr);
9259 return JIM_OK;
9261 return JIM_ERR;
9263 case JIM_TT_CMD:
9264 return Jim_EvalObj(interp, node->objPtr);
9266 default:
9267 /* Should never get here */
9268 return JIM_ERR;
9273 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9275 int rc = JimExprEvalTermNode(interp, node);
9276 if (rc == JIM_OK) {
9277 *objPtrPtr = Jim_GetResult(interp);
9278 Jim_IncrRefCount(*objPtrPtr);
9280 return rc;
9283 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9285 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9286 return ExprBool(interp, Jim_GetResult(interp));
9288 return -1;
9291 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9293 struct ExprTree *expr;
9294 int retcode = JIM_OK;
9296 expr = JimGetExpression(interp, exprObjPtr);
9297 if (!expr) {
9298 return JIM_ERR; /* error in expression. */
9301 #ifdef JIM_OPTIMIZATION
9302 /* Check for one of the following common expressions used by while/for
9304 * CONST
9305 * $a
9306 * !$a
9307 * $a < CONST, $a < $b
9308 * $a <= CONST, $a <= $b
9309 * $a > CONST, $a > $b
9310 * $a >= CONST, $a >= $b
9311 * $a != CONST, $a != $b
9312 * $a == CONST, $a == $b
9315 Jim_Obj *objPtr;
9317 /* STEP 1 -- Check if there are the conditions to run the specialized
9318 * version of while */
9320 switch (expr->len) {
9321 case 1:
9322 objPtr = JimExprIntValOrVar(interp, expr->expr);
9323 if (objPtr) {
9324 Jim_SetResult(interp, objPtr);
9325 return JIM_OK;
9327 break;
9329 case 2:
9330 if (expr->expr->type == JIM_EXPROP_NOT) {
9331 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9333 if (objPtr && JimIsWide(objPtr)) {
9334 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9335 return JIM_OK;
9338 break;
9340 case 3:
9341 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9342 if (objPtr && JimIsWide(objPtr)) {
9343 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9344 if (objPtr2 && JimIsWide(objPtr2)) {
9345 jim_wide wideValueA = JimWideValue(objPtr);
9346 jim_wide wideValueB = JimWideValue(objPtr2);
9347 int cmpRes;
9348 switch (expr->expr->type) {
9349 case JIM_EXPROP_LT:
9350 cmpRes = wideValueA < wideValueB;
9351 break;
9352 case JIM_EXPROP_LTE:
9353 cmpRes = wideValueA <= wideValueB;
9354 break;
9355 case JIM_EXPROP_GT:
9356 cmpRes = wideValueA > wideValueB;
9357 break;
9358 case JIM_EXPROP_GTE:
9359 cmpRes = wideValueA >= wideValueB;
9360 break;
9361 case JIM_EXPROP_NUMEQ:
9362 cmpRes = wideValueA == wideValueB;
9363 break;
9364 case JIM_EXPROP_NUMNE:
9365 cmpRes = wideValueA != wideValueB;
9366 break;
9367 default:
9368 goto noopt;
9370 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9371 return JIM_OK;
9374 break;
9377 noopt:
9378 #endif
9380 /* In order to avoid the internal repr being freed due to
9381 * shimmering of the exprObjPtr's object, we make the internal rep
9382 * shared. */
9383 expr->inUse++;
9385 /* Evaluate with the recursive expr engine */
9386 retcode = JimExprEvalTermNode(interp, expr->expr);
9388 expr->inUse--;
9390 return retcode;
9393 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9395 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9397 if (retcode == JIM_OK) {
9398 switch (ExprBool(interp, Jim_GetResult(interp))) {
9399 case 0:
9400 *boolPtr = 0;
9401 break;
9403 case 1:
9404 *boolPtr = 1;
9405 break;
9407 case -1:
9408 retcode = JIM_ERR;
9409 break;
9412 return retcode;
9415 /* -----------------------------------------------------------------------------
9416 * ScanFormat String Object
9417 * ---------------------------------------------------------------------------*/
9419 /* This Jim_Obj will held a parsed representation of a format string passed to
9420 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9421 * to be parsed in its entirely first and then, if correct, can be used for
9422 * scanning. To avoid endless re-parsing, the parsed representation will be
9423 * stored in an internal representation and re-used for performance reason. */
9425 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9426 * scanformat string. This part will later be used to extract information
9427 * out from the string to be parsed by Jim_ScanString */
9429 typedef struct ScanFmtPartDescr
9431 const char *arg; /* Specification of a CHARSET conversion */
9432 const char *prefix; /* Prefix to be scanned literally before conversion */
9433 size_t width; /* Maximal width of input to be converted */
9434 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9435 char type; /* Type of conversion (e.g. c, d, f) */
9436 char modifier; /* Modify type (e.g. l - long, h - short */
9437 } ScanFmtPartDescr;
9439 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9440 * string parsed and separated in part descriptions. Furthermore it contains
9441 * the original string representation of the scanformat string to allow for
9442 * fast update of the Jim_Obj's string representation part.
9444 * As an add-on the internal object representation adds some scratch pad area
9445 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9446 * memory for purpose of string scanning.
9448 * The error member points to a static allocated string in case of a mal-
9449 * formed scanformat string or it contains '0' (NULL) in case of a valid
9450 * parse representation.
9452 * The whole memory of the internal representation is allocated as a single
9453 * area of memory that will be internally separated. So freeing and duplicating
9454 * of such an object is cheap */
9456 typedef struct ScanFmtStringObj
9458 jim_wide size; /* Size of internal repr in bytes */
9459 char *stringRep; /* Original string representation */
9460 size_t count; /* Number of ScanFmtPartDescr contained */
9461 size_t convCount; /* Number of conversions that will assign */
9462 size_t maxPos; /* Max position index if XPG3 is used */
9463 const char *error; /* Ptr to error text (NULL if no error */
9464 char *scratch; /* Some scratch pad used by Jim_ScanString */
9465 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9466 } ScanFmtStringObj;
9469 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9470 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9471 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9473 static const Jim_ObjType scanFmtStringObjType = {
9474 "scanformatstring",
9475 FreeScanFmtInternalRep,
9476 DupScanFmtInternalRep,
9477 UpdateStringOfScanFmt,
9478 JIM_TYPE_NONE,
9481 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9483 JIM_NOTUSED(interp);
9484 Jim_Free((char *)objPtr->internalRep.ptr);
9485 objPtr->internalRep.ptr = 0;
9488 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9490 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9491 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9493 JIM_NOTUSED(interp);
9494 memcpy(newVec, srcPtr->internalRep.ptr, size);
9495 dupPtr->internalRep.ptr = newVec;
9496 dupPtr->typePtr = &scanFmtStringObjType;
9499 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9501 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9504 /* SetScanFmtFromAny will parse a given string and create the internal
9505 * representation of the format specification. In case of an error
9506 * the error data member of the internal representation will be set
9507 * to an descriptive error text and the function will be left with
9508 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9509 * specification */
9511 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9513 ScanFmtStringObj *fmtObj;
9514 char *buffer;
9515 int maxCount, i, approxSize, lastPos = -1;
9516 const char *fmt = Jim_String(objPtr);
9517 int maxFmtLen = Jim_Length(objPtr);
9518 const char *fmtEnd = fmt + maxFmtLen;
9519 int curr;
9521 Jim_FreeIntRep(interp, objPtr);
9522 /* Count how many conversions could take place maximally */
9523 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9524 if (fmt[i] == '%')
9525 ++maxCount;
9526 /* Calculate an approximation of the memory necessary */
9527 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9528 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9529 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9530 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9531 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9532 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9533 +1; /* safety byte */
9534 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9535 memset(fmtObj, 0, approxSize);
9536 fmtObj->size = approxSize;
9537 fmtObj->maxPos = 0;
9538 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9539 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9540 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9541 buffer = fmtObj->stringRep + maxFmtLen + 1;
9542 objPtr->internalRep.ptr = fmtObj;
9543 objPtr->typePtr = &scanFmtStringObjType;
9544 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9545 int width = 0, skip;
9546 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9548 fmtObj->count++;
9549 descr->width = 0; /* Assume width unspecified */
9550 /* Overread and store any "literal" prefix */
9551 if (*fmt != '%' || fmt[1] == '%') {
9552 descr->type = 0;
9553 descr->prefix = &buffer[i];
9554 for (; fmt < fmtEnd; ++fmt) {
9555 if (*fmt == '%') {
9556 if (fmt[1] != '%')
9557 break;
9558 ++fmt;
9560 buffer[i++] = *fmt;
9562 buffer[i++] = 0;
9564 /* Skip the conversion introducing '%' sign */
9565 ++fmt;
9566 /* End reached due to non-conversion literal only? */
9567 if (fmt >= fmtEnd)
9568 goto done;
9569 descr->pos = 0; /* Assume "natural" positioning */
9570 if (*fmt == '*') {
9571 descr->pos = -1; /* Okay, conversion will not be assigned */
9572 ++fmt;
9574 else
9575 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9576 /* Check if next token is a number (could be width or pos */
9577 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9578 fmt += skip;
9579 /* Was the number a XPG3 position specifier? */
9580 if (descr->pos != -1 && *fmt == '$') {
9581 int prev;
9583 ++fmt;
9584 descr->pos = width;
9585 width = 0;
9586 /* Look if "natural" postioning and XPG3 one was mixed */
9587 if ((lastPos == 0 && descr->pos > 0)
9588 || (lastPos > 0 && descr->pos == 0)) {
9589 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9590 return JIM_ERR;
9592 /* Look if this position was already used */
9593 for (prev = 0; prev < curr; ++prev) {
9594 if (fmtObj->descr[prev].pos == -1)
9595 continue;
9596 if (fmtObj->descr[prev].pos == descr->pos) {
9597 fmtObj->error =
9598 "variable is assigned by multiple \"%n$\" conversion specifiers";
9599 return JIM_ERR;
9602 if (descr->pos < 0) {
9603 fmtObj->error =
9604 "\"%n$\" conversion specifier is negative";
9605 return JIM_ERR;
9607 /* Try to find a width after the XPG3 specifier */
9608 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9609 descr->width = width;
9610 fmt += skip;
9612 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9613 fmtObj->maxPos = descr->pos;
9615 else {
9616 /* Number was not a XPG3, so it has to be a width */
9617 descr->width = width;
9620 /* If positioning mode was undetermined yet, fix this */
9621 if (lastPos == -1)
9622 lastPos = descr->pos;
9623 /* Handle CHARSET conversion type ... */
9624 if (*fmt == '[') {
9625 int swapped = 1, beg = i, end, j;
9627 descr->type = '[';
9628 descr->arg = &buffer[i];
9629 ++fmt;
9630 if (*fmt == '^')
9631 buffer[i++] = *fmt++;
9632 if (*fmt == ']')
9633 buffer[i++] = *fmt++;
9634 while (*fmt && *fmt != ']')
9635 buffer[i++] = *fmt++;
9636 if (*fmt != ']') {
9637 fmtObj->error = "unmatched [ in format string";
9638 return JIM_ERR;
9640 end = i;
9641 buffer[i++] = 0;
9642 /* In case a range fence was given "backwards", swap it */
9643 while (swapped) {
9644 swapped = 0;
9645 for (j = beg + 1; j < end - 1; ++j) {
9646 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9647 char tmp = buffer[j - 1];
9649 buffer[j - 1] = buffer[j + 1];
9650 buffer[j + 1] = tmp;
9651 swapped = 1;
9656 else {
9657 /* Remember any valid modifier if given */
9658 if (fmt < fmtEnd && strchr("hlL", *fmt))
9659 descr->modifier = tolower((int)*fmt++);
9661 if (fmt >= fmtEnd) {
9662 fmtObj->error = "missing scan conversion character";
9663 return JIM_ERR;
9666 descr->type = *fmt;
9667 if (strchr("efgcsndoxui", *fmt) == 0) {
9668 fmtObj->error = "bad scan conversion character";
9669 return JIM_ERR;
9671 else if (*fmt == 'c' && descr->width != 0) {
9672 fmtObj->error = "field width may not be specified in %c " "conversion";
9673 return JIM_ERR;
9675 else if (*fmt == 'u' && descr->modifier == 'l') {
9676 fmtObj->error = "unsigned wide not supported";
9677 return JIM_ERR;
9680 curr++;
9682 done:
9683 return JIM_OK;
9686 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9688 #define FormatGetCnvCount(_fo_) \
9689 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9690 #define FormatGetMaxPos(_fo_) \
9691 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9692 #define FormatGetError(_fo_) \
9693 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9695 /* JimScanAString is used to scan an unspecified string that ends with
9696 * next WS, or a string that is specified via a charset.
9699 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9701 char *buffer = Jim_StrDup(str);
9702 char *p = buffer;
9704 while (*str) {
9705 int c;
9706 int n;
9708 if (!sdescr && isspace(UCHAR(*str)))
9709 break; /* EOS via WS if unspecified */
9711 n = utf8_tounicode(str, &c);
9712 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9713 break;
9714 while (n--)
9715 *p++ = *str++;
9717 *p = 0;
9718 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9721 /* ScanOneEntry will scan one entry out of the string passed as argument.
9722 * It use the sscanf() function for this task. After extracting and
9723 * converting of the value, the count of scanned characters will be
9724 * returned of -1 in case of no conversion tool place and string was
9725 * already scanned thru */
9727 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9728 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9730 const char *tok;
9731 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9732 size_t scanned = 0;
9733 size_t anchor = pos;
9734 int i;
9735 Jim_Obj *tmpObj = NULL;
9737 /* First pessimistically assume, we will not scan anything :-) */
9738 *valObjPtr = 0;
9739 if (descr->prefix) {
9740 /* There was a prefix given before the conversion, skip it and adjust
9741 * the string-to-be-parsed accordingly */
9742 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9743 /* If prefix require, skip WS */
9744 if (isspace(UCHAR(descr->prefix[i])))
9745 while (pos < strLen && isspace(UCHAR(str[pos])))
9746 ++pos;
9747 else if (descr->prefix[i] != str[pos])
9748 break; /* Prefix do not match here, leave the loop */
9749 else
9750 ++pos; /* Prefix matched so far, next round */
9752 if (pos >= strLen) {
9753 return -1; /* All of str consumed: EOF condition */
9755 else if (descr->prefix[i] != 0)
9756 return 0; /* Not whole prefix consumed, no conversion possible */
9758 /* For all but following conversion, skip leading WS */
9759 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9760 while (isspace(UCHAR(str[pos])))
9761 ++pos;
9762 /* Determine how much skipped/scanned so far */
9763 scanned = pos - anchor;
9765 /* %c is a special, simple case. no width */
9766 if (descr->type == 'n') {
9767 /* Return pseudo conversion means: how much scanned so far? */
9768 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9770 else if (pos >= strLen) {
9771 /* Cannot scan anything, as str is totally consumed */
9772 return -1;
9774 else if (descr->type == 'c') {
9775 int c;
9776 scanned += utf8_tounicode(&str[pos], &c);
9777 *valObjPtr = Jim_NewIntObj(interp, c);
9778 return scanned;
9780 else {
9781 /* Processing of conversions follows ... */
9782 if (descr->width > 0) {
9783 /* Do not try to scan as fas as possible but only the given width.
9784 * To ensure this, we copy the part that should be scanned. */
9785 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9786 size_t tLen = descr->width > sLen ? sLen : descr->width;
9788 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9789 tok = tmpObj->bytes;
9791 else {
9792 /* As no width was given, simply refer to the original string */
9793 tok = &str[pos];
9795 switch (descr->type) {
9796 case 'd':
9797 case 'o':
9798 case 'x':
9799 case 'u':
9800 case 'i':{
9801 char *endp; /* Position where the number finished */
9802 jim_wide w;
9804 int base = descr->type == 'o' ? 8
9805 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9807 /* Try to scan a number with the given base */
9808 if (base == 0) {
9809 w = jim_strtoull(tok, &endp);
9811 else {
9812 w = strtoull(tok, &endp, base);
9815 if (endp != tok) {
9816 /* There was some number sucessfully scanned! */
9817 *valObjPtr = Jim_NewIntObj(interp, w);
9819 /* Adjust the number-of-chars scanned so far */
9820 scanned += endp - tok;
9822 else {
9823 /* Nothing was scanned. We have to determine if this
9824 * happened due to e.g. prefix mismatch or input str
9825 * exhausted */
9826 scanned = *tok ? 0 : -1;
9828 break;
9830 case 's':
9831 case '[':{
9832 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9833 scanned += Jim_Length(*valObjPtr);
9834 break;
9836 case 'e':
9837 case 'f':
9838 case 'g':{
9839 char *endp;
9840 double value = strtod(tok, &endp);
9842 if (endp != tok) {
9843 /* There was some number sucessfully scanned! */
9844 *valObjPtr = Jim_NewDoubleObj(interp, value);
9845 /* Adjust the number-of-chars scanned so far */
9846 scanned += endp - tok;
9848 else {
9849 /* Nothing was scanned. We have to determine if this
9850 * happened due to e.g. prefix mismatch or input str
9851 * exhausted */
9852 scanned = *tok ? 0 : -1;
9854 break;
9857 /* If a substring was allocated (due to pre-defined width) do not
9858 * forget to free it */
9859 if (tmpObj) {
9860 Jim_FreeNewObj(interp, tmpObj);
9863 return scanned;
9866 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9867 * string and returns all converted (and not ignored) values in a list back
9868 * to the caller. If an error occured, a NULL pointer will be returned */
9870 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9872 size_t i, pos;
9873 int scanned = 1;
9874 const char *str = Jim_String(strObjPtr);
9875 int strLen = Jim_Utf8Length(interp, strObjPtr);
9876 Jim_Obj *resultList = 0;
9877 Jim_Obj **resultVec = 0;
9878 int resultc;
9879 Jim_Obj *emptyStr = 0;
9880 ScanFmtStringObj *fmtObj;
9882 /* This should never happen. The format object should already be of the correct type */
9883 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9885 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9886 /* Check if format specification was valid */
9887 if (fmtObj->error != 0) {
9888 if (flags & JIM_ERRMSG)
9889 Jim_SetResultString(interp, fmtObj->error, -1);
9890 return 0;
9892 /* Allocate a new "shared" empty string for all unassigned conversions */
9893 emptyStr = Jim_NewEmptyStringObj(interp);
9894 Jim_IncrRefCount(emptyStr);
9895 /* Create a list and fill it with empty strings up to max specified XPG3 */
9896 resultList = Jim_NewListObj(interp, NULL, 0);
9897 if (fmtObj->maxPos > 0) {
9898 for (i = 0; i < fmtObj->maxPos; ++i)
9899 Jim_ListAppendElement(interp, resultList, emptyStr);
9900 JimListGetElements(interp, resultList, &resultc, &resultVec);
9902 /* Now handle every partial format description */
9903 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9904 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9905 Jim_Obj *value = 0;
9907 /* Only last type may be "literal" w/o conversion - skip it! */
9908 if (descr->type == 0)
9909 continue;
9910 /* As long as any conversion could be done, we will proceed */
9911 if (scanned > 0)
9912 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9913 /* In case our first try results in EOF, we will leave */
9914 if (scanned == -1 && i == 0)
9915 goto eof;
9916 /* Advance next pos-to-be-scanned for the amount scanned already */
9917 pos += scanned;
9919 /* value == 0 means no conversion took place so take empty string */
9920 if (value == 0)
9921 value = Jim_NewEmptyStringObj(interp);
9922 /* If value is a non-assignable one, skip it */
9923 if (descr->pos == -1) {
9924 Jim_FreeNewObj(interp, value);
9926 else if (descr->pos == 0)
9927 /* Otherwise append it to the result list if no XPG3 was given */
9928 Jim_ListAppendElement(interp, resultList, value);
9929 else if (resultVec[descr->pos - 1] == emptyStr) {
9930 /* But due to given XPG3, put the value into the corr. slot */
9931 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9932 Jim_IncrRefCount(value);
9933 resultVec[descr->pos - 1] = value;
9935 else {
9936 /* Otherwise, the slot was already used - free obj and ERROR */
9937 Jim_FreeNewObj(interp, value);
9938 goto err;
9941 Jim_DecrRefCount(interp, emptyStr);
9942 return resultList;
9943 eof:
9944 Jim_DecrRefCount(interp, emptyStr);
9945 Jim_FreeNewObj(interp, resultList);
9946 return (Jim_Obj *)EOF;
9947 err:
9948 Jim_DecrRefCount(interp, emptyStr);
9949 Jim_FreeNewObj(interp, resultList);
9950 return 0;
9953 /* -----------------------------------------------------------------------------
9954 * Pseudo Random Number Generation
9955 * ---------------------------------------------------------------------------*/
9956 /* Initialize the sbox with the numbers from 0 to 255 */
9957 static void JimPrngInit(Jim_Interp *interp)
9959 #define PRNG_SEED_SIZE 256
9960 int i;
9961 unsigned int *seed;
9962 time_t t = time(NULL);
9964 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9966 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9967 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9968 seed[i] = (rand() ^ t ^ clock());
9970 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9971 Jim_Free(seed);
9974 /* Generates N bytes of random data */
9975 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9977 Jim_PrngState *prng;
9978 unsigned char *destByte = (unsigned char *)dest;
9979 unsigned int si, sj, x;
9981 /* initialization, only needed the first time */
9982 if (interp->prngState == NULL)
9983 JimPrngInit(interp);
9984 prng = interp->prngState;
9985 /* generates 'len' bytes of pseudo-random numbers */
9986 for (x = 0; x < len; x++) {
9987 prng->i = (prng->i + 1) & 0xff;
9988 si = prng->sbox[prng->i];
9989 prng->j = (prng->j + si) & 0xff;
9990 sj = prng->sbox[prng->j];
9991 prng->sbox[prng->i] = sj;
9992 prng->sbox[prng->j] = si;
9993 *destByte++ = prng->sbox[(si + sj) & 0xff];
9997 /* Re-seed the generator with user-provided bytes */
9998 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10000 int i;
10001 Jim_PrngState *prng;
10003 /* initialization, only needed the first time */
10004 if (interp->prngState == NULL)
10005 JimPrngInit(interp);
10006 prng = interp->prngState;
10008 /* Set the sbox[i] with i */
10009 for (i = 0; i < 256; i++)
10010 prng->sbox[i] = i;
10011 /* Now use the seed to perform a random permutation of the sbox */
10012 for (i = 0; i < seedLen; i++) {
10013 unsigned char t;
10015 t = prng->sbox[i & 0xFF];
10016 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10017 prng->sbox[seed[i]] = t;
10019 prng->i = prng->j = 0;
10021 /* discard at least the first 256 bytes of stream.
10022 * borrow the seed buffer for this
10024 for (i = 0; i < 256; i += seedLen) {
10025 JimRandomBytes(interp, seed, seedLen);
10029 /* [incr] */
10030 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10032 jim_wide wideValue, increment = 1;
10033 Jim_Obj *intObjPtr;
10035 if (argc != 2 && argc != 3) {
10036 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10037 return JIM_ERR;
10039 if (argc == 3) {
10040 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10041 return JIM_ERR;
10043 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10044 if (!intObjPtr) {
10045 /* Set missing variable to 0 */
10046 wideValue = 0;
10048 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10049 return JIM_ERR;
10051 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10052 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10053 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10054 Jim_FreeNewObj(interp, intObjPtr);
10055 return JIM_ERR;
10058 else {
10059 /* Can do it the quick way */
10060 Jim_InvalidateStringRep(intObjPtr);
10061 JimWideValue(intObjPtr) = wideValue + increment;
10063 /* The following step is required in order to invalidate the
10064 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10065 if (argv[1]->typePtr != &variableObjType) {
10066 /* Note that this can't fail since GetVariable already succeeded */
10067 Jim_SetVariable(interp, argv[1], intObjPtr);
10070 Jim_SetResult(interp, intObjPtr);
10071 return JIM_OK;
10075 /* -----------------------------------------------------------------------------
10076 * Eval
10077 * ---------------------------------------------------------------------------*/
10078 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10079 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10081 /* Handle calls to the [unknown] command */
10082 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10084 int retcode;
10086 /* If JimUnknown() is recursively called too many times...
10087 * done here
10089 if (interp->unknown_called > 50) {
10090 return JIM_ERR;
10093 /* The object interp->unknown just contains
10094 * the "unknown" string, it is used in order to
10095 * avoid to lookup the unknown command every time
10096 * but instead to cache the result. */
10098 /* If the [unknown] command does not exist ... */
10099 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10100 return JIM_ERR;
10102 interp->unknown_called++;
10103 /* XXX: Are we losing fileNameObj and linenr? */
10104 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10105 interp->unknown_called--;
10107 return retcode;
10110 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10112 int retcode;
10113 Jim_Cmd *cmdPtr;
10114 void *prevPrivData;
10116 #if 0
10117 printf("invoke");
10118 int j;
10119 for (j = 0; j < objc; j++) {
10120 printf(" '%s'", Jim_String(objv[j]));
10122 printf("\n");
10123 #endif
10125 if (interp->framePtr->tailcallCmd) {
10126 /* Special tailcall command was pre-resolved */
10127 cmdPtr = interp->framePtr->tailcallCmd;
10128 interp->framePtr->tailcallCmd = NULL;
10130 else {
10131 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10132 if (cmdPtr == NULL) {
10133 return JimUnknown(interp, objc, objv);
10135 JimIncrCmdRefCount(cmdPtr);
10138 if (interp->evalDepth == interp->maxEvalDepth) {
10139 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10140 retcode = JIM_ERR;
10141 goto out;
10143 interp->evalDepth++;
10144 prevPrivData = interp->cmdPrivData;
10146 /* Call it -- Make sure result is an empty object. */
10147 Jim_SetEmptyResult(interp);
10148 if (cmdPtr->isproc) {
10149 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10151 else {
10152 interp->cmdPrivData = cmdPtr->u.native.privData;
10153 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10155 interp->cmdPrivData = prevPrivData;
10156 interp->evalDepth--;
10158 out:
10159 JimDecrCmdRefCount(interp, cmdPtr);
10161 return retcode;
10164 /* Eval the object vector 'objv' composed of 'objc' elements.
10165 * Every element is used as single argument.
10166 * Jim_EvalObj() will call this function every time its object
10167 * argument is of "list" type, with no string representation.
10169 * This is possible because the string representation of a
10170 * list object generated by the UpdateStringOfList is made
10171 * in a way that ensures that every list element is a different
10172 * command argument. */
10173 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10175 int i, retcode;
10177 /* Incr refcount of arguments. */
10178 for (i = 0; i < objc; i++)
10179 Jim_IncrRefCount(objv[i]);
10181 retcode = JimInvokeCommand(interp, objc, objv);
10183 /* Decr refcount of arguments and return the retcode */
10184 for (i = 0; i < objc; i++)
10185 Jim_DecrRefCount(interp, objv[i]);
10187 return retcode;
10191 * Invokes 'prefix' as a command with the objv array as arguments.
10193 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10195 int ret;
10196 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10198 nargv[0] = prefix;
10199 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10200 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10201 Jim_Free(nargv);
10202 return ret;
10205 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10207 if (!interp->errorFlag) {
10208 /* This is the first error, so save the file/line information and reset the stack */
10209 interp->errorFlag = 1;
10210 Jim_IncrRefCount(script->fileNameObj);
10211 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10212 interp->errorFileNameObj = script->fileNameObj;
10213 interp->errorLine = script->linenr;
10215 JimResetStackTrace(interp);
10216 /* Always add a level where the error first occurs */
10217 interp->addStackTrace++;
10220 /* Now if this is an "interesting" level, add it to the stack trace */
10221 if (interp->addStackTrace > 0) {
10222 /* Add the stack info for the current level */
10224 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10226 /* Note: if we didn't have a filename for this level,
10227 * don't clear the addStackTrace flag
10228 * so we can pick it up at the next level
10230 if (Jim_Length(script->fileNameObj)) {
10231 interp->addStackTrace = 0;
10234 Jim_DecrRefCount(interp, interp->errorProc);
10235 interp->errorProc = interp->emptyObj;
10236 Jim_IncrRefCount(interp->errorProc);
10240 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10242 Jim_Obj *objPtr;
10243 int ret = JIM_ERR;
10245 switch (token->type) {
10246 case JIM_TT_STR:
10247 case JIM_TT_ESC:
10248 objPtr = token->objPtr;
10249 break;
10250 case JIM_TT_VAR:
10251 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10252 break;
10253 case JIM_TT_DICTSUGAR:
10254 objPtr = JimExpandDictSugar(interp, token->objPtr);
10255 break;
10256 case JIM_TT_EXPRSUGAR:
10257 ret = Jim_EvalExpression(interp, token->objPtr);
10258 if (ret == JIM_OK) {
10259 objPtr = Jim_GetResult(interp);
10261 else {
10262 objPtr = NULL;
10264 break;
10265 case JIM_TT_CMD:
10266 ret = Jim_EvalObj(interp, token->objPtr);
10267 if (ret == JIM_OK || ret == JIM_RETURN) {
10268 objPtr = interp->result;
10269 } else {
10270 /* includes JIM_BREAK, JIM_CONTINUE */
10271 objPtr = NULL;
10273 break;
10274 default:
10275 JimPanic((1,
10276 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10277 objPtr = NULL;
10278 break;
10280 if (objPtr) {
10281 *objPtrPtr = objPtr;
10282 return JIM_OK;
10284 return ret;
10287 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10288 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10289 * The returned object has refcount = 0.
10291 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10293 int totlen = 0, i;
10294 Jim_Obj **intv;
10295 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10296 Jim_Obj *objPtr;
10297 char *s;
10299 if (tokens <= JIM_EVAL_SINTV_LEN)
10300 intv = sintv;
10301 else
10302 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10304 /* Compute every token forming the argument
10305 * in the intv objects vector. */
10306 for (i = 0; i < tokens; i++) {
10307 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10308 case JIM_OK:
10309 case JIM_RETURN:
10310 break;
10311 case JIM_BREAK:
10312 if (flags & JIM_SUBST_FLAG) {
10313 /* Stop here */
10314 tokens = i;
10315 continue;
10317 /* XXX: Should probably set an error about break outside loop */
10318 /* fall through to error */
10319 case JIM_CONTINUE:
10320 if (flags & JIM_SUBST_FLAG) {
10321 intv[i] = NULL;
10322 continue;
10324 /* XXX: Ditto continue outside loop */
10325 /* fall through to error */
10326 default:
10327 while (i--) {
10328 Jim_DecrRefCount(interp, intv[i]);
10330 if (intv != sintv) {
10331 Jim_Free(intv);
10333 return NULL;
10335 Jim_IncrRefCount(intv[i]);
10336 Jim_String(intv[i]);
10337 totlen += intv[i]->length;
10340 /* Fast path return for a single token */
10341 if (tokens == 1 && intv[0] && intv == sintv) {
10342 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10343 intv[0]->refCount--;
10344 return intv[0];
10347 /* Concatenate every token in an unique
10348 * object. */
10349 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10351 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10352 && token[2].type == JIM_TT_VAR) {
10353 /* May be able to do fast interpolated object -> dictSubst */
10354 objPtr->typePtr = &interpolatedObjType;
10355 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10356 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10357 Jim_IncrRefCount(intv[2]);
10359 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10360 /* The first interpolated token is source, so preserve the source info */
10361 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10365 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10366 objPtr->length = totlen;
10367 for (i = 0; i < tokens; i++) {
10368 if (intv[i]) {
10369 memcpy(s, intv[i]->bytes, intv[i]->length);
10370 s += intv[i]->length;
10371 Jim_DecrRefCount(interp, intv[i]);
10374 objPtr->bytes[totlen] = '\0';
10375 /* Free the intv vector if not static. */
10376 if (intv != sintv) {
10377 Jim_Free(intv);
10380 return objPtr;
10384 /* listPtr *must* be a list.
10385 * The contents of the list is evaluated with the first element as the command and
10386 * the remaining elements as the arguments.
10388 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10390 int retcode = JIM_OK;
10392 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10394 if (listPtr->internalRep.listValue.len) {
10395 Jim_IncrRefCount(listPtr);
10396 retcode = JimInvokeCommand(interp,
10397 listPtr->internalRep.listValue.len,
10398 listPtr->internalRep.listValue.ele);
10399 Jim_DecrRefCount(interp, listPtr);
10401 return retcode;
10404 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10406 SetListFromAny(interp, listPtr);
10407 return JimEvalObjList(interp, listPtr);
10410 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10412 int i;
10413 ScriptObj *script;
10414 ScriptToken *token;
10415 int retcode = JIM_OK;
10416 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10417 Jim_Obj *prevScriptObj;
10419 /* If the object is of type "list", with no string rep we can call
10420 * a specialized version of Jim_EvalObj() */
10421 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10422 return JimEvalObjList(interp, scriptObjPtr);
10425 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10426 script = JimGetScript(interp, scriptObjPtr);
10427 if (!JimScriptValid(interp, script)) {
10428 Jim_DecrRefCount(interp, scriptObjPtr);
10429 return JIM_ERR;
10432 /* Reset the interpreter result. This is useful to
10433 * return the empty result in the case of empty program. */
10434 Jim_SetEmptyResult(interp);
10436 token = script->token;
10438 #ifdef JIM_OPTIMIZATION
10439 /* Check for one of the following common scripts used by for, while
10441 * {}
10442 * incr a
10444 if (script->len == 0) {
10445 Jim_DecrRefCount(interp, scriptObjPtr);
10446 return JIM_OK;
10448 if (script->len == 3
10449 && token[1].objPtr->typePtr == &commandObjType
10450 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10451 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10452 && token[2].objPtr->typePtr == &variableObjType) {
10454 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10456 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10457 JimWideValue(objPtr)++;
10458 Jim_InvalidateStringRep(objPtr);
10459 Jim_DecrRefCount(interp, scriptObjPtr);
10460 Jim_SetResult(interp, objPtr);
10461 return JIM_OK;
10464 #endif
10466 /* Now we have to make sure the internal repr will not be
10467 * freed on shimmering.
10469 * Think for example to this:
10471 * set x {llength $x; ... some more code ...}; eval $x
10473 * In order to preserve the internal rep, we increment the
10474 * inUse field of the script internal rep structure. */
10475 script->inUse++;
10477 /* Stash the current script */
10478 prevScriptObj = interp->currentScriptObj;
10479 interp->currentScriptObj = scriptObjPtr;
10481 interp->errorFlag = 0;
10482 argv = sargv;
10484 /* Execute every command sequentially until the end of the script
10485 * or an error occurs.
10487 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10488 int argc;
10489 int j;
10491 /* First token of the line is always JIM_TT_LINE */
10492 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10493 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10495 /* Allocate the arguments vector if required */
10496 if (argc > JIM_EVAL_SARGV_LEN)
10497 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10499 /* Skip the JIM_TT_LINE token */
10500 i++;
10502 /* Populate the arguments objects.
10503 * If an error occurs, retcode will be set and
10504 * 'j' will be set to the number of args expanded
10506 for (j = 0; j < argc; j++) {
10507 long wordtokens = 1;
10508 int expand = 0;
10509 Jim_Obj *wordObjPtr = NULL;
10511 if (token[i].type == JIM_TT_WORD) {
10512 wordtokens = JimWideValue(token[i++].objPtr);
10513 if (wordtokens < 0) {
10514 expand = 1;
10515 wordtokens = -wordtokens;
10519 if (wordtokens == 1) {
10520 /* Fast path if the token does not
10521 * need interpolation */
10523 switch (token[i].type) {
10524 case JIM_TT_ESC:
10525 case JIM_TT_STR:
10526 wordObjPtr = token[i].objPtr;
10527 break;
10528 case JIM_TT_VAR:
10529 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10530 break;
10531 case JIM_TT_EXPRSUGAR:
10532 retcode = Jim_EvalExpression(interp, token[i].objPtr);
10533 if (retcode == JIM_OK) {
10534 wordObjPtr = Jim_GetResult(interp);
10536 else {
10537 wordObjPtr = NULL;
10539 break;
10540 case JIM_TT_DICTSUGAR:
10541 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10542 break;
10543 case JIM_TT_CMD:
10544 retcode = Jim_EvalObj(interp, token[i].objPtr);
10545 if (retcode == JIM_OK) {
10546 wordObjPtr = Jim_GetResult(interp);
10548 break;
10549 default:
10550 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10553 else {
10554 /* For interpolation we call a helper
10555 * function to do the work for us. */
10556 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10559 if (!wordObjPtr) {
10560 if (retcode == JIM_OK) {
10561 retcode = JIM_ERR;
10563 break;
10566 Jim_IncrRefCount(wordObjPtr);
10567 i += wordtokens;
10569 if (!expand) {
10570 argv[j] = wordObjPtr;
10572 else {
10573 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10574 int len = Jim_ListLength(interp, wordObjPtr);
10575 int newargc = argc + len - 1;
10576 int k;
10578 if (len > 1) {
10579 if (argv == sargv) {
10580 if (newargc > JIM_EVAL_SARGV_LEN) {
10581 argv = Jim_Alloc(sizeof(*argv) * newargc);
10582 memcpy(argv, sargv, sizeof(*argv) * j);
10585 else {
10586 /* Need to realloc to make room for (len - 1) more entries */
10587 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10591 /* Now copy in the expanded version */
10592 for (k = 0; k < len; k++) {
10593 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10594 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10597 /* The original object reference is no longer needed,
10598 * after the expansion it is no longer present on
10599 * the argument vector, but the single elements are
10600 * in its place. */
10601 Jim_DecrRefCount(interp, wordObjPtr);
10603 /* And update the indexes */
10604 j--;
10605 argc += len - 1;
10609 if (retcode == JIM_OK && argc) {
10610 /* Invoke the command */
10611 retcode = JimInvokeCommand(interp, argc, argv);
10612 /* Check for a signal after each command */
10613 if (Jim_CheckSignal(interp)) {
10614 retcode = JIM_SIGNAL;
10618 /* Finished with the command, so decrement ref counts of each argument */
10619 while (j-- > 0) {
10620 Jim_DecrRefCount(interp, argv[j]);
10623 if (argv != sargv) {
10624 Jim_Free(argv);
10625 argv = sargv;
10629 /* Possibly add to the error stack trace */
10630 if (retcode == JIM_ERR) {
10631 JimAddErrorToStack(interp, script);
10633 /* Propagate the addStackTrace value through 'return -code error' */
10634 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10635 /* No need to add stack trace */
10636 interp->addStackTrace = 0;
10639 /* Restore the current script */
10640 interp->currentScriptObj = prevScriptObj;
10642 /* Note that we don't have to decrement inUse, because the
10643 * following code transfers our use of the reference again to
10644 * the script object. */
10645 Jim_FreeIntRep(interp, scriptObjPtr);
10646 scriptObjPtr->typePtr = &scriptObjType;
10647 Jim_SetIntRepPtr(scriptObjPtr, script);
10648 Jim_DecrRefCount(interp, scriptObjPtr);
10650 return retcode;
10653 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10655 int retcode;
10656 /* If argObjPtr begins with '&', do an automatic upvar */
10657 const char *varname = Jim_String(argNameObj);
10658 if (*varname == '&') {
10659 /* First check that the target variable exists */
10660 Jim_Obj *objPtr;
10661 Jim_CallFrame *savedCallFrame = interp->framePtr;
10663 interp->framePtr = interp->framePtr->parent;
10664 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10665 interp->framePtr = savedCallFrame;
10666 if (!objPtr) {
10667 return JIM_ERR;
10670 /* It exists, so perform the binding. */
10671 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10672 Jim_IncrRefCount(objPtr);
10673 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10674 Jim_DecrRefCount(interp, objPtr);
10676 else {
10677 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10679 return retcode;
10683 * Sets the interp result to be an error message indicating the required proc args.
10685 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10687 /* Create a nice error message, consistent with Tcl 8.5 */
10688 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10689 int i;
10691 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10692 Jim_AppendString(interp, argmsg, " ", 1);
10694 if (i == cmd->u.proc.argsPos) {
10695 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10696 /* Renamed args */
10697 Jim_AppendString(interp, argmsg, "?", 1);
10698 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10699 Jim_AppendString(interp, argmsg, " ...?", -1);
10701 else {
10702 /* We have plain args */
10703 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10706 else {
10707 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10708 Jim_AppendString(interp, argmsg, "?", 1);
10709 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10710 Jim_AppendString(interp, argmsg, "?", 1);
10712 else {
10713 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10714 if (*arg == '&') {
10715 arg++;
10717 Jim_AppendString(interp, argmsg, arg, -1);
10721 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10724 #ifdef jim_ext_namespace
10726 * [namespace eval]
10728 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10730 Jim_CallFrame *callFramePtr;
10731 int retcode;
10733 /* Create a new callframe */
10734 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10735 callFramePtr->argv = &interp->emptyObj;
10736 callFramePtr->argc = 0;
10737 callFramePtr->procArgsObjPtr = NULL;
10738 callFramePtr->procBodyObjPtr = scriptObj;
10739 callFramePtr->staticVars = NULL;
10740 callFramePtr->fileNameObj = interp->emptyObj;
10741 callFramePtr->line = 0;
10742 Jim_IncrRefCount(scriptObj);
10743 interp->framePtr = callFramePtr;
10745 /* Check if there are too nested calls */
10746 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10747 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10748 retcode = JIM_ERR;
10750 else {
10751 /* Eval the body */
10752 retcode = Jim_EvalObj(interp, scriptObj);
10755 /* Destroy the callframe */
10756 interp->framePtr = interp->framePtr->parent;
10757 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10759 return retcode;
10761 #endif
10763 /* Call a procedure implemented in Tcl.
10764 * It's possible to speed-up a lot this function, currently
10765 * the callframes are not cached, but allocated and
10766 * destroied every time. What is expecially costly is
10767 * to create/destroy the local vars hash table every time.
10769 * This can be fixed just implementing callframes caching
10770 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10771 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10773 Jim_CallFrame *callFramePtr;
10774 int i, d, retcode, optargs;
10775 ScriptObj *script;
10777 /* Check arity */
10778 if (argc - 1 < cmd->u.proc.reqArity ||
10779 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10780 JimSetProcWrongArgs(interp, argv[0], cmd);
10781 return JIM_ERR;
10784 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10785 /* Optimise for procedure with no body - useful for optional debugging */
10786 return JIM_OK;
10789 /* Check if there are too nested calls */
10790 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10791 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10792 return JIM_ERR;
10795 /* Create a new callframe */
10796 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10797 callFramePtr->argv = argv;
10798 callFramePtr->argc = argc;
10799 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10800 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10801 callFramePtr->staticVars = cmd->u.proc.staticVars;
10803 /* Remember where we were called from. */
10804 script = JimGetScript(interp, interp->currentScriptObj);
10805 callFramePtr->fileNameObj = script->fileNameObj;
10806 callFramePtr->line = script->linenr;
10808 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10809 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10810 interp->framePtr = callFramePtr;
10812 /* How many optional args are available */
10813 optargs = (argc - 1 - cmd->u.proc.reqArity);
10815 /* Step 'i' along the actual args, and step 'd' along the formal args */
10816 i = 1;
10817 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10818 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10819 if (d == cmd->u.proc.argsPos) {
10820 /* assign $args */
10821 Jim_Obj *listObjPtr;
10822 int argsLen = 0;
10823 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10824 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10826 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10828 /* It is possible to rename args. */
10829 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10830 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10832 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10833 if (retcode != JIM_OK) {
10834 goto badargset;
10837 i += argsLen;
10838 continue;
10841 /* Optional or required? */
10842 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10843 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10845 else {
10846 /* Ran out, so use the default */
10847 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10849 if (retcode != JIM_OK) {
10850 goto badargset;
10854 /* Eval the body */
10855 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10857 badargset:
10859 /* Invoke $jim::defer then destroy the callframe */
10860 retcode = JimInvokeDefer(interp, retcode);
10861 interp->framePtr = interp->framePtr->parent;
10862 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10864 /* Now chain any tailcalls in the parent frame */
10865 if (interp->framePtr->tailcallObj) {
10866 do {
10867 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10869 interp->framePtr->tailcallObj = NULL;
10871 if (retcode == JIM_EVAL) {
10872 retcode = Jim_EvalObjList(interp, tailcallObj);
10873 if (retcode == JIM_RETURN) {
10874 /* If the result of the tailcall is 'return', push
10875 * it up to the caller
10877 interp->returnLevel++;
10880 Jim_DecrRefCount(interp, tailcallObj);
10881 } while (interp->framePtr->tailcallObj);
10883 /* If the tailcall chain finished early, may need to manually discard the command */
10884 if (interp->framePtr->tailcallCmd) {
10885 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10886 interp->framePtr->tailcallCmd = NULL;
10890 /* Handle the JIM_RETURN return code */
10891 if (retcode == JIM_RETURN) {
10892 if (--interp->returnLevel <= 0) {
10893 retcode = interp->returnCode;
10894 interp->returnCode = JIM_OK;
10895 interp->returnLevel = 0;
10898 else if (retcode == JIM_ERR) {
10899 interp->addStackTrace++;
10900 Jim_DecrRefCount(interp, interp->errorProc);
10901 interp->errorProc = argv[0];
10902 Jim_IncrRefCount(interp->errorProc);
10905 return retcode;
10908 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10910 int retval;
10911 Jim_Obj *scriptObjPtr;
10913 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10914 Jim_IncrRefCount(scriptObjPtr);
10916 if (filename) {
10917 Jim_Obj *prevScriptObj;
10919 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10921 prevScriptObj = interp->currentScriptObj;
10922 interp->currentScriptObj = scriptObjPtr;
10924 retval = Jim_EvalObj(interp, scriptObjPtr);
10926 interp->currentScriptObj = prevScriptObj;
10928 else {
10929 retval = Jim_EvalObj(interp, scriptObjPtr);
10931 Jim_DecrRefCount(interp, scriptObjPtr);
10932 return retval;
10935 int Jim_Eval(Jim_Interp *interp, const char *script)
10937 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10940 /* Execute script in the scope of the global level */
10941 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10943 int retval;
10944 Jim_CallFrame *savedFramePtr = interp->framePtr;
10946 interp->framePtr = interp->topFramePtr;
10947 retval = Jim_Eval(interp, script);
10948 interp->framePtr = savedFramePtr;
10950 return retval;
10953 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10955 int retval;
10956 Jim_CallFrame *savedFramePtr = interp->framePtr;
10958 interp->framePtr = interp->topFramePtr;
10959 retval = Jim_EvalFile(interp, filename);
10960 interp->framePtr = savedFramePtr;
10962 return retval;
10965 #include <sys/stat.h>
10967 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10969 FILE *fp;
10970 char *buf;
10971 Jim_Obj *scriptObjPtr;
10972 Jim_Obj *prevScriptObj;
10973 struct stat sb;
10974 int retcode;
10975 int readlen;
10977 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10978 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10979 return JIM_ERR;
10981 if (sb.st_size == 0) {
10982 fclose(fp);
10983 return JIM_OK;
10986 buf = Jim_Alloc(sb.st_size + 1);
10987 readlen = fread(buf, 1, sb.st_size, fp);
10988 if (ferror(fp)) {
10989 fclose(fp);
10990 Jim_Free(buf);
10991 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10992 return JIM_ERR;
10994 fclose(fp);
10995 buf[readlen] = 0;
10997 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10998 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
10999 Jim_IncrRefCount(scriptObjPtr);
11001 prevScriptObj = interp->currentScriptObj;
11002 interp->currentScriptObj = scriptObjPtr;
11004 retcode = Jim_EvalObj(interp, scriptObjPtr);
11006 /* Handle the JIM_RETURN return code */
11007 if (retcode == JIM_RETURN) {
11008 if (--interp->returnLevel <= 0) {
11009 retcode = interp->returnCode;
11010 interp->returnCode = JIM_OK;
11011 interp->returnLevel = 0;
11014 if (retcode == JIM_ERR) {
11015 /* EvalFile changes context, so add a stack frame here */
11016 interp->addStackTrace++;
11019 interp->currentScriptObj = prevScriptObj;
11021 Jim_DecrRefCount(interp, scriptObjPtr);
11023 return retcode;
11026 /* -----------------------------------------------------------------------------
11027 * Subst
11028 * ---------------------------------------------------------------------------*/
11029 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11031 pc->tstart = pc->p;
11032 pc->tline = pc->linenr;
11034 if (pc->len == 0) {
11035 pc->tend = pc->p;
11036 pc->tt = JIM_TT_EOL;
11037 pc->eof = 1;
11038 return;
11040 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11041 JimParseCmd(pc);
11042 return;
11044 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11045 if (JimParseVar(pc) == JIM_OK) {
11046 return;
11048 /* Not a var, so treat as a string */
11049 pc->tstart = pc->p;
11050 flags |= JIM_SUBST_NOVAR;
11052 while (pc->len) {
11053 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11054 break;
11056 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11057 break;
11059 if (*pc->p == '\\' && pc->len > 1) {
11060 pc->p++;
11061 pc->len--;
11063 pc->p++;
11064 pc->len--;
11066 pc->tend = pc->p - 1;
11067 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11070 /* The subst object type reuses most of the data structures and functions
11071 * of the script object. Script's data structures are a bit more complex
11072 * for what is needed for [subst]itution tasks, but the reuse helps to
11073 * deal with a single data structure at the cost of some more memory
11074 * usage for substitutions. */
11076 /* This method takes the string representation of an object
11077 * as a Tcl string where to perform [subst]itution, and generates
11078 * the pre-parsed internal representation. */
11079 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11081 int scriptTextLen;
11082 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11083 struct JimParserCtx parser;
11084 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11085 ParseTokenList tokenlist;
11087 /* Initially parse the subst into tokens (in tokenlist) */
11088 ScriptTokenListInit(&tokenlist);
11090 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11091 while (1) {
11092 JimParseSubst(&parser, flags);
11093 if (parser.eof) {
11094 /* Note that subst doesn't need the EOL token */
11095 break;
11097 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11098 parser.tline);
11101 /* Create the "real" subst/script tokens from the initial token list */
11102 script->inUse = 1;
11103 script->substFlags = flags;
11104 script->fileNameObj = interp->emptyObj;
11105 Jim_IncrRefCount(script->fileNameObj);
11106 SubstObjAddTokens(interp, script, &tokenlist);
11108 /* No longer need the token list */
11109 ScriptTokenListFree(&tokenlist);
11111 #ifdef DEBUG_SHOW_SUBST
11113 int i;
11115 printf("==== Subst ====\n");
11116 for (i = 0; i < script->len; i++) {
11117 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11118 Jim_String(script->token[i].objPtr));
11121 #endif
11123 /* Free the old internal rep and set the new one. */
11124 Jim_FreeIntRep(interp, objPtr);
11125 Jim_SetIntRepPtr(objPtr, script);
11126 objPtr->typePtr = &scriptObjType;
11127 return JIM_OK;
11130 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11132 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11133 SetSubstFromAny(interp, objPtr, flags);
11134 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11137 /* Performs commands,variables,blackslashes substitution,
11138 * storing the result object (with refcount 0) into
11139 * resObjPtrPtr. */
11140 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11142 ScriptObj *script;
11144 JimPanic((substObjPtr->refCount == 0, "Jim_SubstObj() called with zero refcount object"));
11146 script = Jim_GetSubst(interp, substObjPtr, flags);
11148 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11149 /* In order to preserve the internal rep, we increment the
11150 * inUse field of the script internal rep structure. */
11151 script->inUse++;
11153 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11155 script->inUse--;
11156 Jim_DecrRefCount(interp, substObjPtr);
11157 if (*resObjPtrPtr == NULL) {
11158 return JIM_ERR;
11160 return JIM_OK;
11163 /* -----------------------------------------------------------------------------
11164 * Core commands utility functions
11165 * ---------------------------------------------------------------------------*/
11166 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11168 Jim_Obj *objPtr;
11169 Jim_Obj *listObjPtr;
11171 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11173 listObjPtr = Jim_NewListObj(interp, argv, argc);
11175 if (msg && *msg) {
11176 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11178 Jim_IncrRefCount(listObjPtr);
11179 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11180 Jim_DecrRefCount(interp, listObjPtr);
11182 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11186 * May add the key and/or value to the list.
11188 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11189 Jim_HashEntry *he, int type);
11191 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11194 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11195 * invoke the callback to add entries to a list.
11196 * Returns the list.
11198 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11199 JimHashtableIteratorCallbackType *callback, int type)
11201 Jim_HashEntry *he;
11202 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11204 /* Check for the non-pattern case. We can do this much more efficiently. */
11205 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11206 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11207 if (he) {
11208 callback(interp, listObjPtr, he, type);
11211 else {
11212 Jim_HashTableIterator htiter;
11213 JimInitHashTableIterator(ht, &htiter);
11214 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11215 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11216 callback(interp, listObjPtr, he, type);
11220 return listObjPtr;
11223 /* Keep these in order */
11224 #define JIM_CMDLIST_COMMANDS 0
11225 #define JIM_CMDLIST_PROCS 1
11226 #define JIM_CMDLIST_CHANNELS 2
11229 * Adds matching command names (procs, channels) to the list.
11231 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11232 Jim_HashEntry *he, int type)
11234 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11235 Jim_Obj *objPtr;
11237 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11238 /* not a proc */
11239 return;
11242 objPtr = Jim_NewStringObj(interp, he->key, -1);
11243 Jim_IncrRefCount(objPtr);
11245 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11246 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11248 Jim_DecrRefCount(interp, objPtr);
11251 /* type is JIM_CMDLIST_xxx */
11252 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11254 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11257 /* Keep these in order */
11258 #define JIM_VARLIST_GLOBALS 0
11259 #define JIM_VARLIST_LOCALS 1
11260 #define JIM_VARLIST_VARS 2
11262 #define JIM_VARLIST_VALUES 0x1000
11265 * Adds matching variable names to the list.
11267 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11268 Jim_HashEntry *he, int type)
11270 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11272 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11273 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11274 if (type & JIM_VARLIST_VALUES) {
11275 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11280 /* mode is JIM_VARLIST_xxx */
11281 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11283 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11284 /* For [info locals], if we are at top level an emtpy list
11285 * is returned. I don't agree, but we aim at compatibility (SS) */
11286 return interp->emptyObj;
11288 else {
11289 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11290 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11294 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11295 Jim_Obj **objPtrPtr, int info_level_cmd)
11297 Jim_CallFrame *targetCallFrame;
11299 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11300 if (targetCallFrame == NULL) {
11301 return JIM_ERR;
11303 /* No proc call at toplevel callframe */
11304 if (targetCallFrame == interp->topFramePtr) {
11305 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11306 return JIM_ERR;
11308 if (info_level_cmd) {
11309 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11311 else {
11312 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11314 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11315 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11316 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11317 *objPtrPtr = listObj;
11319 return JIM_OK;
11322 /* -----------------------------------------------------------------------------
11323 * Core commands
11324 * ---------------------------------------------------------------------------*/
11326 /* fake [puts] -- not the real puts, just for debugging. */
11327 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11329 if (argc != 2 && argc != 3) {
11330 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11331 return JIM_ERR;
11333 if (argc == 3) {
11334 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11335 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11336 return JIM_ERR;
11338 else {
11339 fputs(Jim_String(argv[2]), stdout);
11342 else {
11343 puts(Jim_String(argv[1]));
11345 return JIM_OK;
11348 /* Helper for [+] and [*] */
11349 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11351 jim_wide wideValue, res;
11352 double doubleValue, doubleRes;
11353 int i;
11355 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11357 for (i = 1; i < argc; i++) {
11358 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11359 goto trydouble;
11360 if (op == JIM_EXPROP_ADD)
11361 res += wideValue;
11362 else
11363 res *= wideValue;
11365 Jim_SetResultInt(interp, res);
11366 return JIM_OK;
11367 trydouble:
11368 doubleRes = (double)res;
11369 for (; i < argc; i++) {
11370 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11371 return JIM_ERR;
11372 if (op == JIM_EXPROP_ADD)
11373 doubleRes += doubleValue;
11374 else
11375 doubleRes *= doubleValue;
11377 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11378 return JIM_OK;
11381 /* Helper for [-] and [/] */
11382 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11384 jim_wide wideValue, res = 0;
11385 double doubleValue, doubleRes = 0;
11386 int i = 2;
11388 if (argc < 2) {
11389 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11390 return JIM_ERR;
11392 else if (argc == 2) {
11393 /* The arity = 2 case is different. For [- x] returns -x,
11394 * while [/ x] returns 1/x. */
11395 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11396 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11397 return JIM_ERR;
11399 else {
11400 if (op == JIM_EXPROP_SUB)
11401 doubleRes = -doubleValue;
11402 else
11403 doubleRes = 1.0 / doubleValue;
11404 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11405 return JIM_OK;
11408 if (op == JIM_EXPROP_SUB) {
11409 res = -wideValue;
11410 Jim_SetResultInt(interp, res);
11412 else {
11413 doubleRes = 1.0 / wideValue;
11414 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11416 return JIM_OK;
11418 else {
11419 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11420 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11421 != JIM_OK) {
11422 return JIM_ERR;
11424 else {
11425 goto trydouble;
11429 for (i = 2; i < argc; i++) {
11430 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11431 doubleRes = (double)res;
11432 goto trydouble;
11434 if (op == JIM_EXPROP_SUB)
11435 res -= wideValue;
11436 else {
11437 if (wideValue == 0) {
11438 Jim_SetResultString(interp, "Division by zero", -1);
11439 return JIM_ERR;
11441 res /= wideValue;
11444 Jim_SetResultInt(interp, res);
11445 return JIM_OK;
11446 trydouble:
11447 for (; i < argc; i++) {
11448 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11449 return JIM_ERR;
11450 if (op == JIM_EXPROP_SUB)
11451 doubleRes -= doubleValue;
11452 else
11453 doubleRes /= doubleValue;
11455 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11456 return JIM_OK;
11460 /* [+] */
11461 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11463 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11466 /* [*] */
11467 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11469 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11472 /* [-] */
11473 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11475 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11478 /* [/] */
11479 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11481 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11484 /* [set] */
11485 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11487 if (argc != 2 && argc != 3) {
11488 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11489 return JIM_ERR;
11491 if (argc == 2) {
11492 Jim_Obj *objPtr;
11494 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11495 if (!objPtr)
11496 return JIM_ERR;
11497 Jim_SetResult(interp, objPtr);
11498 return JIM_OK;
11500 /* argc == 3 case. */
11501 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11502 return JIM_ERR;
11503 Jim_SetResult(interp, argv[2]);
11504 return JIM_OK;
11507 /* [unset]
11509 * unset ?-nocomplain? ?--? ?varName ...?
11511 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11513 int i = 1;
11514 int complain = 1;
11516 while (i < argc) {
11517 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11518 i++;
11519 break;
11521 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11522 complain = 0;
11523 i++;
11524 continue;
11526 break;
11529 while (i < argc) {
11530 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11531 && complain) {
11532 return JIM_ERR;
11534 i++;
11536 return JIM_OK;
11539 /* [while] */
11540 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11542 if (argc != 3) {
11543 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11544 return JIM_ERR;
11547 /* The general purpose implementation of while starts here */
11548 while (1) {
11549 int boolean, retval;
11551 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11552 return retval;
11553 if (!boolean)
11554 break;
11556 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11557 switch (retval) {
11558 case JIM_BREAK:
11559 goto out;
11560 break;
11561 case JIM_CONTINUE:
11562 continue;
11563 break;
11564 default:
11565 return retval;
11569 out:
11570 Jim_SetEmptyResult(interp);
11571 return JIM_OK;
11574 /* [for] */
11575 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11577 int retval;
11578 int boolean = 1;
11579 Jim_Obj *varNamePtr = NULL;
11580 Jim_Obj *stopVarNamePtr = NULL;
11582 if (argc != 5) {
11583 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11584 return JIM_ERR;
11587 /* Do the initialisation */
11588 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11589 return retval;
11592 /* And do the first test now. Better for optimisation
11593 * if we can do next/test at the bottom of the loop
11595 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11597 /* Ready to do the body as follows:
11598 * while (1) {
11599 * body // check retcode
11600 * next // check retcode
11601 * test // check retcode/test bool
11605 #ifdef JIM_OPTIMIZATION
11606 /* Check if the for is on the form:
11607 * for ... {$i < CONST} {incr i}
11608 * for ... {$i < $j} {incr i}
11610 if (retval == JIM_OK && boolean) {
11611 ScriptObj *incrScript;
11612 struct ExprTree *expr;
11613 jim_wide stop, currentVal;
11614 Jim_Obj *objPtr;
11615 int cmpOffset;
11617 /* Do it only if there aren't shared arguments */
11618 expr = JimGetExpression(interp, argv[2]);
11619 incrScript = JimGetScript(interp, argv[3]);
11621 /* Ensure proper lengths to start */
11622 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11623 goto evalstart;
11625 /* Ensure proper token types. */
11626 if (incrScript->token[1].type != JIM_TT_ESC) {
11627 goto evalstart;
11630 if (expr->expr->type == JIM_EXPROP_LT) {
11631 cmpOffset = 0;
11633 else if (expr->expr->type == JIM_EXPROP_LTE) {
11634 cmpOffset = 1;
11636 else {
11637 goto evalstart;
11640 if (expr->expr->left->type != JIM_TT_VAR) {
11641 goto evalstart;
11644 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11645 goto evalstart;
11648 /* Update command must be incr */
11649 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11650 goto evalstart;
11653 /* incr, expression must be about the same variable */
11654 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11655 goto evalstart;
11658 /* Get the stop condition (must be a variable or integer) */
11659 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11660 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11661 goto evalstart;
11664 else {
11665 stopVarNamePtr = expr->expr->right->objPtr;
11666 Jim_IncrRefCount(stopVarNamePtr);
11667 /* Keep the compiler happy */
11668 stop = 0;
11671 /* Initialization */
11672 varNamePtr = expr->expr->left->objPtr;
11673 Jim_IncrRefCount(varNamePtr);
11675 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11676 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11677 goto testcond;
11680 /* --- OPTIMIZED FOR --- */
11681 while (retval == JIM_OK) {
11682 /* === Check condition === */
11683 /* Note that currentVal is already set here */
11685 /* Immediate or Variable? get the 'stop' value if the latter. */
11686 if (stopVarNamePtr) {
11687 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11688 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11689 goto testcond;
11693 if (currentVal >= stop + cmpOffset) {
11694 break;
11697 /* Eval body */
11698 retval = Jim_EvalObj(interp, argv[4]);
11699 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11700 retval = JIM_OK;
11702 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11704 /* Increment */
11705 if (objPtr == NULL) {
11706 retval = JIM_ERR;
11707 goto out;
11709 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11710 currentVal = ++JimWideValue(objPtr);
11711 Jim_InvalidateStringRep(objPtr);
11713 else {
11714 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11715 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11716 ++currentVal)) != JIM_OK) {
11717 goto evalnext;
11722 goto out;
11724 evalstart:
11725 #endif
11727 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11728 /* Body */
11729 retval = Jim_EvalObj(interp, argv[4]);
11731 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11732 /* increment */
11733 JIM_IF_OPTIM(evalnext:)
11734 retval = Jim_EvalObj(interp, argv[3]);
11735 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11736 /* test */
11737 JIM_IF_OPTIM(testcond:)
11738 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11742 JIM_IF_OPTIM(out:)
11743 if (stopVarNamePtr) {
11744 Jim_DecrRefCount(interp, stopVarNamePtr);
11746 if (varNamePtr) {
11747 Jim_DecrRefCount(interp, varNamePtr);
11750 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11751 Jim_SetEmptyResult(interp);
11752 return JIM_OK;
11755 return retval;
11758 /* [loop] */
11759 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11761 int retval;
11762 jim_wide i;
11763 jim_wide limit;
11764 jim_wide incr = 1;
11765 Jim_Obj *bodyObjPtr;
11767 if (argc != 5 && argc != 6) {
11768 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11769 return JIM_ERR;
11772 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11773 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11774 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11775 return JIM_ERR;
11777 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11779 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11781 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11782 retval = Jim_EvalObj(interp, bodyObjPtr);
11783 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11784 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11786 retval = JIM_OK;
11788 /* Increment */
11789 i += incr;
11791 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11792 if (argv[1]->typePtr != &variableObjType) {
11793 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11794 return JIM_ERR;
11797 JimWideValue(objPtr) = i;
11798 Jim_InvalidateStringRep(objPtr);
11800 /* The following step is required in order to invalidate the
11801 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11802 if (argv[1]->typePtr != &variableObjType) {
11803 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11804 retval = JIM_ERR;
11805 break;
11809 else {
11810 objPtr = Jim_NewIntObj(interp, i);
11811 retval = Jim_SetVariable(interp, argv[1], objPtr);
11812 if (retval != JIM_OK) {
11813 Jim_FreeNewObj(interp, objPtr);
11819 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11820 Jim_SetEmptyResult(interp);
11821 return JIM_OK;
11823 return retval;
11826 /* List iterators make it easy to iterate over a list.
11827 * At some point iterators will be expanded to support generators.
11829 typedef struct {
11830 Jim_Obj *objPtr;
11831 int idx;
11832 } Jim_ListIter;
11835 * Initialise the iterator at the start of the list.
11837 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11839 iter->objPtr = objPtr;
11840 iter->idx = 0;
11844 * Returns the next object from the list, or NULL on end-of-list.
11846 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11848 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11849 return NULL;
11851 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11855 * Returns 1 if end-of-list has been reached.
11857 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11859 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11862 /* foreach + lmap implementation. */
11863 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11865 int result = JIM_OK;
11866 int i, numargs;
11867 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11868 Jim_ListIter *iters;
11869 Jim_Obj *script;
11870 Jim_Obj *resultObj;
11872 if (argc < 4 || argc % 2 != 0) {
11873 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11874 return JIM_ERR;
11876 script = argv[argc - 1]; /* Last argument is a script */
11877 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11879 if (numargs == 2) {
11880 iters = twoiters;
11882 else {
11883 iters = Jim_Alloc(numargs * sizeof(*iters));
11885 for (i = 0; i < numargs; i++) {
11886 JimListIterInit(&iters[i], argv[i + 1]);
11887 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11888 result = JIM_ERR;
11891 if (result != JIM_OK) {
11892 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11893 goto empty_varlist;
11896 if (doMap) {
11897 resultObj = Jim_NewListObj(interp, NULL, 0);
11899 else {
11900 resultObj = interp->emptyObj;
11902 Jim_IncrRefCount(resultObj);
11904 while (1) {
11905 /* Have we expired all lists? */
11906 for (i = 0; i < numargs; i += 2) {
11907 if (!JimListIterDone(interp, &iters[i + 1])) {
11908 break;
11911 if (i == numargs) {
11912 /* All done */
11913 break;
11916 /* For each list */
11917 for (i = 0; i < numargs; i += 2) {
11918 Jim_Obj *varName;
11920 /* foreach var */
11921 JimListIterInit(&iters[i], argv[i + 1]);
11922 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11923 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11924 if (!valObj) {
11925 /* Ran out, so store the empty string */
11926 valObj = interp->emptyObj;
11928 /* Avoid shimmering */
11929 Jim_IncrRefCount(valObj);
11930 result = Jim_SetVariable(interp, varName, valObj);
11931 Jim_DecrRefCount(interp, valObj);
11932 if (result != JIM_OK) {
11933 goto err;
11937 switch (result = Jim_EvalObj(interp, script)) {
11938 case JIM_OK:
11939 if (doMap) {
11940 Jim_ListAppendElement(interp, resultObj, interp->result);
11942 break;
11943 case JIM_CONTINUE:
11944 break;
11945 case JIM_BREAK:
11946 goto out;
11947 default:
11948 goto err;
11951 out:
11952 result = JIM_OK;
11953 Jim_SetResult(interp, resultObj);
11954 err:
11955 Jim_DecrRefCount(interp, resultObj);
11956 empty_varlist:
11957 if (numargs > 2) {
11958 Jim_Free(iters);
11960 return result;
11963 /* [foreach] */
11964 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11966 return JimForeachMapHelper(interp, argc, argv, 0);
11969 /* [lmap] */
11970 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11972 return JimForeachMapHelper(interp, argc, argv, 1);
11975 /* [lassign] */
11976 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11978 int result = JIM_ERR;
11979 int i;
11980 Jim_ListIter iter;
11981 Jim_Obj *resultObj;
11983 if (argc < 2) {
11984 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11985 return JIM_ERR;
11988 JimListIterInit(&iter, argv[1]);
11990 for (i = 2; i < argc; i++) {
11991 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11992 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11993 if (result != JIM_OK) {
11994 return result;
11998 resultObj = Jim_NewListObj(interp, NULL, 0);
11999 while (!JimListIterDone(interp, &iter)) {
12000 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12003 Jim_SetResult(interp, resultObj);
12005 return JIM_OK;
12008 /* [if] */
12009 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12011 int boolean, retval, current = 1, falsebody = 0;
12013 if (argc >= 3) {
12014 while (1) {
12015 /* Far not enough arguments given! */
12016 if (current >= argc)
12017 goto err;
12018 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12019 != JIM_OK)
12020 return retval;
12021 /* There lacks something, isn't it? */
12022 if (current >= argc)
12023 goto err;
12024 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12025 current++;
12026 /* Tsk tsk, no then-clause? */
12027 if (current >= argc)
12028 goto err;
12029 if (boolean)
12030 return Jim_EvalObj(interp, argv[current]);
12031 /* Ok: no else-clause follows */
12032 if (++current >= argc) {
12033 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12034 return JIM_OK;
12036 falsebody = current++;
12037 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12038 /* IIICKS - else-clause isn't last cmd? */
12039 if (current != argc - 1)
12040 goto err;
12041 return Jim_EvalObj(interp, argv[current]);
12043 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12044 /* Ok: elseif follows meaning all the stuff
12045 * again (how boring...) */
12046 continue;
12047 /* OOPS - else-clause is not last cmd? */
12048 else if (falsebody != argc - 1)
12049 goto err;
12050 return Jim_EvalObj(interp, argv[falsebody]);
12052 return JIM_OK;
12054 err:
12055 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12056 return JIM_ERR;
12060 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12061 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12062 Jim_Obj *stringObj, int nocase)
12064 Jim_Obj *parms[4];
12065 int argc = 0;
12066 long eq;
12067 int rc;
12069 parms[argc++] = commandObj;
12070 if (nocase) {
12071 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12073 parms[argc++] = patternObj;
12074 parms[argc++] = stringObj;
12076 rc = Jim_EvalObjVector(interp, argc, parms);
12078 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12079 eq = -rc;
12082 return eq;
12085 /* [switch] */
12086 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12088 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12089 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12090 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12091 Jim_Obj **caseList;
12093 if (argc < 3) {
12094 wrongnumargs:
12095 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12096 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12097 return JIM_ERR;
12099 for (opt = 1; opt < argc; ++opt) {
12100 const char *option = Jim_String(argv[opt]);
12102 if (*option != '-')
12103 break;
12104 else if (strncmp(option, "--", 2) == 0) {
12105 ++opt;
12106 break;
12108 else if (strncmp(option, "-exact", 2) == 0)
12109 matchOpt = SWITCH_EXACT;
12110 else if (strncmp(option, "-glob", 2) == 0)
12111 matchOpt = SWITCH_GLOB;
12112 else if (strncmp(option, "-regexp", 2) == 0)
12113 matchOpt = SWITCH_RE;
12114 else if (strncmp(option, "-command", 2) == 0) {
12115 matchOpt = SWITCH_CMD;
12116 if ((argc - opt) < 2)
12117 goto wrongnumargs;
12118 command = argv[++opt];
12120 else {
12121 Jim_SetResultFormatted(interp,
12122 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12123 argv[opt]);
12124 return JIM_ERR;
12126 if ((argc - opt) < 2)
12127 goto wrongnumargs;
12129 strObj = argv[opt++];
12130 patCount = argc - opt;
12131 if (patCount == 1) {
12132 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12134 else
12135 caseList = (Jim_Obj **)&argv[opt];
12136 if (patCount == 0 || patCount % 2 != 0)
12137 goto wrongnumargs;
12138 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12139 Jim_Obj *patObj = caseList[i];
12141 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12142 || i < (patCount - 2)) {
12143 switch (matchOpt) {
12144 case SWITCH_EXACT:
12145 if (Jim_StringEqObj(strObj, patObj))
12146 scriptObj = caseList[i + 1];
12147 break;
12148 case SWITCH_GLOB:
12149 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12150 scriptObj = caseList[i + 1];
12151 break;
12152 case SWITCH_RE:
12153 command = Jim_NewStringObj(interp, "regexp", -1);
12154 /* Fall thru intentionally */
12155 case SWITCH_CMD:{
12156 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12158 /* After the execution of a command we need to
12159 * make sure to reconvert the object into a list
12160 * again. Only for the single-list style [switch]. */
12161 if (argc - opt == 1) {
12162 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12164 /* command is here already decref'd */
12165 if (rc < 0) {
12166 return -rc;
12168 if (rc)
12169 scriptObj = caseList[i + 1];
12170 break;
12174 else {
12175 scriptObj = caseList[i + 1];
12178 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12179 scriptObj = caseList[i + 1];
12180 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12181 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12182 return JIM_ERR;
12184 Jim_SetEmptyResult(interp);
12185 if (scriptObj) {
12186 return Jim_EvalObj(interp, scriptObj);
12188 return JIM_OK;
12191 /* [list] */
12192 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12194 Jim_Obj *listObjPtr;
12196 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12197 Jim_SetResult(interp, listObjPtr);
12198 return JIM_OK;
12201 /* [lindex] */
12202 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12204 Jim_Obj *objPtr, *listObjPtr;
12205 int i;
12206 int idx;
12208 if (argc < 2) {
12209 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12210 return JIM_ERR;
12212 objPtr = argv[1];
12213 Jim_IncrRefCount(objPtr);
12214 for (i = 2; i < argc; i++) {
12215 listObjPtr = objPtr;
12216 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12217 Jim_DecrRefCount(interp, listObjPtr);
12218 return JIM_ERR;
12220 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12221 /* Returns an empty object if the index
12222 * is out of range. */
12223 Jim_DecrRefCount(interp, listObjPtr);
12224 Jim_SetEmptyResult(interp);
12225 return JIM_OK;
12227 Jim_IncrRefCount(objPtr);
12228 Jim_DecrRefCount(interp, listObjPtr);
12230 Jim_SetResult(interp, objPtr);
12231 Jim_DecrRefCount(interp, objPtr);
12232 return JIM_OK;
12235 /* [llength] */
12236 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12238 if (argc != 2) {
12239 Jim_WrongNumArgs(interp, 1, argv, "list");
12240 return JIM_ERR;
12242 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12243 return JIM_OK;
12246 /* [lsearch] */
12247 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12249 static const char * const options[] = {
12250 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12251 NULL
12253 enum
12254 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12255 OPT_COMMAND };
12256 int i;
12257 int opt_bool = 0;
12258 int opt_not = 0;
12259 int opt_nocase = 0;
12260 int opt_all = 0;
12261 int opt_inline = 0;
12262 int opt_match = OPT_EXACT;
12263 int listlen;
12264 int rc = JIM_OK;
12265 Jim_Obj *listObjPtr = NULL;
12266 Jim_Obj *commandObj = NULL;
12268 if (argc < 3) {
12269 wrongargs:
12270 Jim_WrongNumArgs(interp, 1, argv,
12271 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12272 return JIM_ERR;
12275 for (i = 1; i < argc - 2; i++) {
12276 int option;
12278 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12279 return JIM_ERR;
12281 switch (option) {
12282 case OPT_BOOL:
12283 opt_bool = 1;
12284 opt_inline = 0;
12285 break;
12286 case OPT_NOT:
12287 opt_not = 1;
12288 break;
12289 case OPT_NOCASE:
12290 opt_nocase = 1;
12291 break;
12292 case OPT_INLINE:
12293 opt_inline = 1;
12294 opt_bool = 0;
12295 break;
12296 case OPT_ALL:
12297 opt_all = 1;
12298 break;
12299 case OPT_COMMAND:
12300 if (i >= argc - 2) {
12301 goto wrongargs;
12303 commandObj = argv[++i];
12304 /* fallthru */
12305 case OPT_EXACT:
12306 case OPT_GLOB:
12307 case OPT_REGEXP:
12308 opt_match = option;
12309 break;
12313 argv += i;
12315 if (opt_all) {
12316 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12318 if (opt_match == OPT_REGEXP) {
12319 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12321 if (commandObj) {
12322 Jim_IncrRefCount(commandObj);
12325 listlen = Jim_ListLength(interp, argv[0]);
12326 for (i = 0; i < listlen; i++) {
12327 int eq = 0;
12328 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12330 switch (opt_match) {
12331 case OPT_EXACT:
12332 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12333 break;
12335 case OPT_GLOB:
12336 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12337 break;
12339 case OPT_REGEXP:
12340 case OPT_COMMAND:
12341 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12342 if (eq < 0) {
12343 if (listObjPtr) {
12344 Jim_FreeNewObj(interp, listObjPtr);
12346 rc = JIM_ERR;
12347 goto done;
12349 break;
12352 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12353 if (!eq && opt_bool && opt_not && !opt_all) {
12354 continue;
12357 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12358 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12359 Jim_Obj *resultObj;
12361 if (opt_bool) {
12362 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12364 else if (!opt_inline) {
12365 resultObj = Jim_NewIntObj(interp, i);
12367 else {
12368 resultObj = objPtr;
12371 if (opt_all) {
12372 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12374 else {
12375 Jim_SetResult(interp, resultObj);
12376 goto done;
12381 if (opt_all) {
12382 Jim_SetResult(interp, listObjPtr);
12384 else {
12385 /* No match */
12386 if (opt_bool) {
12387 Jim_SetResultBool(interp, opt_not);
12389 else if (!opt_inline) {
12390 Jim_SetResultInt(interp, -1);
12394 done:
12395 if (commandObj) {
12396 Jim_DecrRefCount(interp, commandObj);
12398 return rc;
12401 /* [lappend] */
12402 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12404 Jim_Obj *listObjPtr;
12405 int new_obj = 0;
12406 int i;
12408 if (argc < 2) {
12409 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12410 return JIM_ERR;
12412 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12413 if (!listObjPtr) {
12414 /* Create the list if it does not exist */
12415 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12416 new_obj = 1;
12418 else if (Jim_IsShared(listObjPtr)) {
12419 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12420 new_obj = 1;
12422 for (i = 2; i < argc; i++)
12423 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12424 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12425 if (new_obj)
12426 Jim_FreeNewObj(interp, listObjPtr);
12427 return JIM_ERR;
12429 Jim_SetResult(interp, listObjPtr);
12430 return JIM_OK;
12433 /* [linsert] */
12434 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12436 int idx, len;
12437 Jim_Obj *listPtr;
12439 if (argc < 3) {
12440 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12441 return JIM_ERR;
12443 listPtr = argv[1];
12444 if (Jim_IsShared(listPtr))
12445 listPtr = Jim_DuplicateObj(interp, listPtr);
12446 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12447 goto err;
12448 len = Jim_ListLength(interp, listPtr);
12449 if (idx >= len)
12450 idx = len;
12451 else if (idx < 0)
12452 idx = len + idx + 1;
12453 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12454 Jim_SetResult(interp, listPtr);
12455 return JIM_OK;
12456 err:
12457 if (listPtr != argv[1]) {
12458 Jim_FreeNewObj(interp, listPtr);
12460 return JIM_ERR;
12463 /* [lreplace] */
12464 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12466 int first, last, len, rangeLen;
12467 Jim_Obj *listObj;
12468 Jim_Obj *newListObj;
12470 if (argc < 4) {
12471 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12472 return JIM_ERR;
12474 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12475 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12476 return JIM_ERR;
12479 listObj = argv[1];
12480 len = Jim_ListLength(interp, listObj);
12482 first = JimRelToAbsIndex(len, first);
12483 last = JimRelToAbsIndex(len, last);
12484 JimRelToAbsRange(len, &first, &last, &rangeLen);
12486 /* Now construct a new list which consists of:
12487 * <elements before first> <supplied elements> <elements after last>
12490 /* Trying to replace past the end of the list means end of list
12491 * See TIP #505
12493 if (first > len) {
12494 first = len;
12497 /* Add the first set of elements */
12498 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12500 /* Add supplied elements */
12501 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12503 /* Add the remaining elements */
12504 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12506 Jim_SetResult(interp, newListObj);
12507 return JIM_OK;
12510 /* [lset] */
12511 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12513 if (argc < 3) {
12514 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12515 return JIM_ERR;
12517 else if (argc == 3) {
12518 /* With no indexes, simply implements [set] */
12519 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12520 return JIM_ERR;
12521 Jim_SetResult(interp, argv[2]);
12522 return JIM_OK;
12524 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12527 /* [lsort] */
12528 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12530 static const char * const options[] = {
12531 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12533 enum
12534 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12535 Jim_Obj *resObj;
12536 int i;
12537 int retCode;
12538 int shared;
12540 struct lsort_info info;
12542 if (argc < 2) {
12543 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12544 return JIM_ERR;
12547 info.type = JIM_LSORT_ASCII;
12548 info.order = 1;
12549 info.indexed = 0;
12550 info.unique = 0;
12551 info.command = NULL;
12552 info.interp = interp;
12554 for (i = 1; i < (argc - 1); i++) {
12555 int option;
12557 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12558 != JIM_OK)
12559 return JIM_ERR;
12560 switch (option) {
12561 case OPT_ASCII:
12562 info.type = JIM_LSORT_ASCII;
12563 break;
12564 case OPT_NOCASE:
12565 info.type = JIM_LSORT_NOCASE;
12566 break;
12567 case OPT_INTEGER:
12568 info.type = JIM_LSORT_INTEGER;
12569 break;
12570 case OPT_REAL:
12571 info.type = JIM_LSORT_REAL;
12572 break;
12573 case OPT_INCREASING:
12574 info.order = 1;
12575 break;
12576 case OPT_DECREASING:
12577 info.order = -1;
12578 break;
12579 case OPT_UNIQUE:
12580 info.unique = 1;
12581 break;
12582 case OPT_COMMAND:
12583 if (i >= (argc - 2)) {
12584 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12585 return JIM_ERR;
12587 info.type = JIM_LSORT_COMMAND;
12588 info.command = argv[i + 1];
12589 i++;
12590 break;
12591 case OPT_INDEX:
12592 if (i >= (argc - 2)) {
12593 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12594 return JIM_ERR;
12596 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12597 return JIM_ERR;
12599 info.indexed = 1;
12600 i++;
12601 break;
12604 resObj = argv[argc - 1];
12605 if ((shared = Jim_IsShared(resObj)))
12606 resObj = Jim_DuplicateObj(interp, resObj);
12607 retCode = ListSortElements(interp, resObj, &info);
12608 if (retCode == JIM_OK) {
12609 Jim_SetResult(interp, resObj);
12611 else if (shared) {
12612 Jim_FreeNewObj(interp, resObj);
12614 return retCode;
12617 /* [append] */
12618 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12620 Jim_Obj *stringObjPtr;
12621 int i;
12623 if (argc < 2) {
12624 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12625 return JIM_ERR;
12627 if (argc == 2) {
12628 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12629 if (!stringObjPtr)
12630 return JIM_ERR;
12632 else {
12633 int new_obj = 0;
12634 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12635 if (!stringObjPtr) {
12636 /* Create the string if it doesn't exist */
12637 stringObjPtr = Jim_NewEmptyStringObj(interp);
12638 new_obj = 1;
12640 else if (Jim_IsShared(stringObjPtr)) {
12641 new_obj = 1;
12642 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12644 for (i = 2; i < argc; i++) {
12645 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12647 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12648 if (new_obj) {
12649 Jim_FreeNewObj(interp, stringObjPtr);
12651 return JIM_ERR;
12654 Jim_SetResult(interp, stringObjPtr);
12655 return JIM_OK;
12658 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12660 * Returns a zero-refcount list describing the expression at 'node'
12662 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12664 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12666 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12667 if (TOKEN_IS_EXPR_OP(node->type)) {
12668 if (node->left) {
12669 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12671 if (node->right) {
12672 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12674 if (node->ternary) {
12675 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12678 else {
12679 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12681 return listObjPtr;
12683 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12685 /* [debug] */
12686 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12688 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12689 static const char * const options[] = {
12690 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12691 "exprbc", "show",
12692 NULL
12694 enum
12696 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12697 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12699 int option;
12701 if (argc < 2) {
12702 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12703 return JIM_ERR;
12705 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12706 return Jim_CheckShowCommands(interp, argv[1], options);
12707 if (option == OPT_REFCOUNT) {
12708 if (argc != 3) {
12709 Jim_WrongNumArgs(interp, 2, argv, "object");
12710 return JIM_ERR;
12712 Jim_SetResultInt(interp, argv[2]->refCount);
12713 return JIM_OK;
12715 else if (option == OPT_OBJCOUNT) {
12716 int freeobj = 0, liveobj = 0;
12717 char buf[256];
12718 Jim_Obj *objPtr;
12720 if (argc != 2) {
12721 Jim_WrongNumArgs(interp, 2, argv, "");
12722 return JIM_ERR;
12724 /* Count the number of free objects. */
12725 objPtr = interp->freeList;
12726 while (objPtr) {
12727 freeobj++;
12728 objPtr = objPtr->nextObjPtr;
12730 /* Count the number of live objects. */
12731 objPtr = interp->liveList;
12732 while (objPtr) {
12733 liveobj++;
12734 objPtr = objPtr->nextObjPtr;
12736 /* Set the result string and return. */
12737 sprintf(buf, "free %d used %d", freeobj, liveobj);
12738 Jim_SetResultString(interp, buf, -1);
12739 return JIM_OK;
12741 else if (option == OPT_OBJECTS) {
12742 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12744 /* Count the number of live objects. */
12745 objPtr = interp->liveList;
12746 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12747 while (objPtr) {
12748 char buf[128];
12749 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12751 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12752 sprintf(buf, "%p", objPtr);
12753 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12754 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12755 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12756 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12757 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12758 objPtr = objPtr->nextObjPtr;
12760 Jim_SetResult(interp, listObjPtr);
12761 return JIM_OK;
12763 else if (option == OPT_INVSTR) {
12764 Jim_Obj *objPtr;
12766 if (argc != 3) {
12767 Jim_WrongNumArgs(interp, 2, argv, "object");
12768 return JIM_ERR;
12770 objPtr = argv[2];
12771 if (objPtr->typePtr != NULL)
12772 Jim_InvalidateStringRep(objPtr);
12773 Jim_SetEmptyResult(interp);
12774 return JIM_OK;
12776 else if (option == OPT_SHOW) {
12777 const char *s;
12778 int len, charlen;
12780 if (argc != 3) {
12781 Jim_WrongNumArgs(interp, 2, argv, "object");
12782 return JIM_ERR;
12784 s = Jim_GetString(argv[2], &len);
12785 #ifdef JIM_UTF8
12786 charlen = utf8_strlen(s, len);
12787 #else
12788 charlen = len;
12789 #endif
12790 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12791 printf("chars (%d): <<%s>>\n", charlen, s);
12792 printf("bytes (%d):", len);
12793 while (len--) {
12794 printf(" %02x", (unsigned char)*s++);
12796 printf("\n");
12797 return JIM_OK;
12799 else if (option == OPT_SCRIPTLEN) {
12800 ScriptObj *script;
12802 if (argc != 3) {
12803 Jim_WrongNumArgs(interp, 2, argv, "script");
12804 return JIM_ERR;
12806 script = JimGetScript(interp, argv[2]);
12807 if (script == NULL)
12808 return JIM_ERR;
12809 Jim_SetResultInt(interp, script->len);
12810 return JIM_OK;
12812 else if (option == OPT_EXPRLEN) {
12813 struct ExprTree *expr;
12815 if (argc != 3) {
12816 Jim_WrongNumArgs(interp, 2, argv, "expression");
12817 return JIM_ERR;
12819 expr = JimGetExpression(interp, argv[2]);
12820 if (expr == NULL)
12821 return JIM_ERR;
12822 Jim_SetResultInt(interp, expr->len);
12823 return JIM_OK;
12825 else if (option == OPT_EXPRBC) {
12826 struct ExprTree *expr;
12828 if (argc != 3) {
12829 Jim_WrongNumArgs(interp, 2, argv, "expression");
12830 return JIM_ERR;
12832 expr = JimGetExpression(interp, argv[2]);
12833 if (expr == NULL)
12834 return JIM_ERR;
12835 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12836 return JIM_OK;
12838 else {
12839 Jim_SetResultString(interp,
12840 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12841 return JIM_ERR;
12843 /* unreached */
12844 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12845 #if !defined(JIM_DEBUG_COMMAND)
12846 Jim_SetResultString(interp, "unsupported", -1);
12847 return JIM_ERR;
12848 #endif
12851 /* [eval] */
12852 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12854 int rc;
12856 if (argc < 2) {
12857 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12858 return JIM_ERR;
12861 if (argc == 2) {
12862 rc = Jim_EvalObj(interp, argv[1]);
12864 else {
12865 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12868 if (rc == JIM_ERR) {
12869 /* eval is "interesting", so add a stack frame here */
12870 interp->addStackTrace++;
12872 return rc;
12875 /* [uplevel] */
12876 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12878 if (argc >= 2) {
12879 int retcode;
12880 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12881 const char *str;
12883 /* Save the old callframe pointer */
12884 savedCallFrame = interp->framePtr;
12886 /* Lookup the target frame pointer */
12887 str = Jim_String(argv[1]);
12888 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12889 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12890 argc--;
12891 argv++;
12893 else {
12894 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12896 if (targetCallFrame == NULL) {
12897 return JIM_ERR;
12899 if (argc < 2) {
12900 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12901 return JIM_ERR;
12903 /* Eval the code in the target callframe. */
12904 interp->framePtr = targetCallFrame;
12905 if (argc == 2) {
12906 retcode = Jim_EvalObj(interp, argv[1]);
12908 else {
12909 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12911 interp->framePtr = savedCallFrame;
12912 return retcode;
12914 else {
12915 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12916 return JIM_ERR;
12920 /* [expr] */
12921 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12923 int retcode;
12925 if (argc == 2) {
12926 retcode = Jim_EvalExpression(interp, argv[1]);
12928 else if (argc > 2) {
12929 Jim_Obj *objPtr;
12931 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12932 Jim_IncrRefCount(objPtr);
12933 retcode = Jim_EvalExpression(interp, objPtr);
12934 Jim_DecrRefCount(interp, objPtr);
12936 else {
12937 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12938 return JIM_ERR;
12940 if (retcode != JIM_OK)
12941 return retcode;
12942 return JIM_OK;
12945 /* [break] */
12946 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12948 if (argc != 1) {
12949 Jim_WrongNumArgs(interp, 1, argv, "");
12950 return JIM_ERR;
12952 return JIM_BREAK;
12955 /* [continue] */
12956 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12958 if (argc != 1) {
12959 Jim_WrongNumArgs(interp, 1, argv, "");
12960 return JIM_ERR;
12962 return JIM_CONTINUE;
12965 /* [return] */
12966 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12968 int i;
12969 Jim_Obj *stackTraceObj = NULL;
12970 Jim_Obj *errorCodeObj = NULL;
12971 int returnCode = JIM_OK;
12972 long level = 1;
12974 for (i = 1; i < argc - 1; i += 2) {
12975 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12976 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12977 return JIM_ERR;
12980 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12981 stackTraceObj = argv[i + 1];
12983 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12984 errorCodeObj = argv[i + 1];
12986 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12987 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12988 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12989 return JIM_ERR;
12992 else {
12993 break;
12997 if (i != argc - 1 && i != argc) {
12998 Jim_WrongNumArgs(interp, 1, argv,
12999 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13002 /* If a stack trace is supplied and code is error, set the stack trace */
13003 if (stackTraceObj && returnCode == JIM_ERR) {
13004 JimSetStackTrace(interp, stackTraceObj);
13006 /* If an error code list is supplied, set the global $errorCode */
13007 if (errorCodeObj && returnCode == JIM_ERR) {
13008 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13010 interp->returnCode = returnCode;
13011 interp->returnLevel = level;
13013 if (i == argc - 1) {
13014 Jim_SetResult(interp, argv[i]);
13016 return JIM_RETURN;
13019 /* [tailcall] */
13020 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13022 if (interp->framePtr->level == 0) {
13023 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13024 return JIM_ERR;
13026 else if (argc >= 2) {
13027 /* Need to resolve the tailcall command in the current context */
13028 Jim_CallFrame *cf = interp->framePtr->parent;
13030 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13031 if (cmdPtr == NULL) {
13032 return JIM_ERR;
13035 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13037 /* And stash this pre-resolved command */
13038 JimIncrCmdRefCount(cmdPtr);
13039 cf->tailcallCmd = cmdPtr;
13041 /* And stash the command list */
13042 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13044 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13045 Jim_IncrRefCount(cf->tailcallObj);
13047 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13048 return JIM_EVAL;
13050 return JIM_OK;
13053 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13055 Jim_Obj *cmdList;
13056 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13058 /* prefixListObj is a list to which the args need to be appended */
13059 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13060 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13062 return JimEvalObjList(interp, cmdList);
13065 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13067 Jim_Obj *prefixListObj = privData;
13068 Jim_DecrRefCount(interp, prefixListObj);
13071 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13073 Jim_Obj *prefixListObj;
13074 const char *newname;
13076 if (argc < 3) {
13077 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13078 return JIM_ERR;
13081 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13082 Jim_IncrRefCount(prefixListObj);
13083 newname = Jim_String(argv[1]);
13084 if (newname[0] == ':' && newname[1] == ':') {
13085 while (*++newname == ':') {
13089 Jim_SetResult(interp, argv[1]);
13091 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13094 /* [proc] */
13095 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13097 Jim_Cmd *cmd;
13099 if (argc != 4 && argc != 5) {
13100 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13101 return JIM_ERR;
13104 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13105 return JIM_ERR;
13108 if (argc == 4) {
13109 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13111 else {
13112 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13115 if (cmd) {
13116 /* Add the new command */
13117 Jim_Obj *qualifiedCmdNameObj;
13118 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13120 JimCreateCommand(interp, cmdname, cmd);
13122 /* Calculate and set the namespace for this proc */
13123 JimUpdateProcNamespace(interp, cmd, cmdname);
13125 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13127 /* Unlike Tcl, set the name of the proc as the result */
13128 Jim_SetResult(interp, argv[1]);
13129 return JIM_OK;
13131 return JIM_ERR;
13134 /* [local] */
13135 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13137 int retcode;
13139 if (argc < 2) {
13140 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13141 return JIM_ERR;
13144 /* Evaluate the arguments with 'local' in force */
13145 interp->local++;
13146 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13147 interp->local--;
13150 /* If OK, and the result is a proc, add it to the list of local procs */
13151 if (retcode == 0) {
13152 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13154 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13155 return JIM_ERR;
13157 if (interp->framePtr->localCommands == NULL) {
13158 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13159 Jim_InitStack(interp->framePtr->localCommands);
13161 Jim_IncrRefCount(cmdNameObj);
13162 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13165 return retcode;
13168 /* [upcall] */
13169 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13171 if (argc < 2) {
13172 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13173 return JIM_ERR;
13175 else {
13176 int retcode;
13178 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13179 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13180 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13181 return JIM_ERR;
13183 /* OK. Mark this command as being in an upcall */
13184 cmdPtr->u.proc.upcall++;
13185 JimIncrCmdRefCount(cmdPtr);
13187 /* Invoke the command as normal */
13188 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13190 /* No longer in an upcall */
13191 cmdPtr->u.proc.upcall--;
13192 JimDecrCmdRefCount(interp, cmdPtr);
13194 return retcode;
13198 /* [apply] */
13199 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13201 if (argc < 2) {
13202 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13203 return JIM_ERR;
13205 else {
13206 int ret;
13207 Jim_Cmd *cmd;
13208 Jim_Obj *argListObjPtr;
13209 Jim_Obj *bodyObjPtr;
13210 Jim_Obj *nsObj = NULL;
13211 Jim_Obj **nargv;
13213 int len = Jim_ListLength(interp, argv[1]);
13214 if (len != 2 && len != 3) {
13215 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13216 return JIM_ERR;
13219 if (len == 3) {
13220 #ifdef jim_ext_namespace
13221 /* Need to canonicalise the given namespace. */
13222 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13223 #else
13224 Jim_SetResultString(interp, "namespaces not enabled", -1);
13225 return JIM_ERR;
13226 #endif
13228 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13229 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13231 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13233 if (cmd) {
13234 /* Create a new argv array with a dummy argv[0], for error messages */
13235 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13236 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13237 Jim_IncrRefCount(nargv[0]);
13238 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13239 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13240 Jim_DecrRefCount(interp, nargv[0]);
13241 Jim_Free(nargv);
13243 JimDecrCmdRefCount(interp, cmd);
13244 return ret;
13246 return JIM_ERR;
13251 /* [concat] */
13252 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13254 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13255 return JIM_OK;
13258 /* [upvar] */
13259 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13261 int i;
13262 Jim_CallFrame *targetCallFrame;
13264 /* Lookup the target frame pointer */
13265 if (argc > 3 && (argc % 2 == 0)) {
13266 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13267 argc--;
13268 argv++;
13270 else {
13271 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13273 if (targetCallFrame == NULL) {
13274 return JIM_ERR;
13277 /* Check for arity */
13278 if (argc < 3) {
13279 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13280 return JIM_ERR;
13283 /* Now... for every other/local couple: */
13284 for (i = 1; i < argc; i += 2) {
13285 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13286 return JIM_ERR;
13288 return JIM_OK;
13291 /* [global] */
13292 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13294 int i;
13296 if (argc < 2) {
13297 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13298 return JIM_ERR;
13300 /* Link every var to the toplevel having the same name */
13301 if (interp->framePtr->level == 0)
13302 return JIM_OK; /* global at toplevel... */
13303 for (i = 1; i < argc; i++) {
13304 /* global ::blah does nothing */
13305 const char *name = Jim_String(argv[i]);
13306 if (name[0] != ':' || name[1] != ':') {
13307 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13308 return JIM_ERR;
13311 return JIM_OK;
13314 /* does the [string map] operation. On error NULL is returned,
13315 * otherwise a new string object with the result, having refcount = 0,
13316 * is returned. */
13317 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13318 Jim_Obj *objPtr, int nocase)
13320 int numMaps;
13321 const char *str, *noMatchStart = NULL;
13322 int strLen, i;
13323 Jim_Obj *resultObjPtr;
13325 numMaps = Jim_ListLength(interp, mapListObjPtr);
13326 if (numMaps % 2) {
13327 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13328 return NULL;
13331 str = Jim_String(objPtr);
13332 strLen = Jim_Utf8Length(interp, objPtr);
13334 /* Map it */
13335 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13336 while (strLen) {
13337 for (i = 0; i < numMaps; i += 2) {
13338 Jim_Obj *eachObjPtr;
13339 const char *k;
13340 int kl;
13342 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13343 k = Jim_String(eachObjPtr);
13344 kl = Jim_Utf8Length(interp, eachObjPtr);
13346 if (strLen >= kl && kl) {
13347 int rc;
13348 rc = JimStringCompareLen(str, k, kl, nocase);
13349 if (rc == 0) {
13350 if (noMatchStart) {
13351 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13352 noMatchStart = NULL;
13354 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13355 str += utf8_index(str, kl);
13356 strLen -= kl;
13357 break;
13361 if (i == numMaps) { /* no match */
13362 int c;
13363 if (noMatchStart == NULL)
13364 noMatchStart = str;
13365 str += utf8_tounicode(str, &c);
13366 strLen--;
13369 if (noMatchStart) {
13370 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13372 return resultObjPtr;
13375 /* [string] */
13376 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13378 int len;
13379 int opt_case = 1;
13380 int option;
13381 static const char * const options[] = {
13382 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13383 "map", "repeat", "reverse", "index", "first", "last", "cat",
13384 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13386 enum
13388 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13389 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13390 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13392 static const char * const nocase_options[] = {
13393 "-nocase", NULL
13395 static const char * const nocase_length_options[] = {
13396 "-nocase", "-length", NULL
13399 if (argc < 2) {
13400 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13401 return JIM_ERR;
13403 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13404 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13405 return Jim_CheckShowCommands(interp, argv[1], options);
13407 switch (option) {
13408 case OPT_LENGTH:
13409 case OPT_BYTELENGTH:
13410 if (argc != 3) {
13411 Jim_WrongNumArgs(interp, 2, argv, "string");
13412 return JIM_ERR;
13414 if (option == OPT_LENGTH) {
13415 len = Jim_Utf8Length(interp, argv[2]);
13417 else {
13418 len = Jim_Length(argv[2]);
13420 Jim_SetResultInt(interp, len);
13421 return JIM_OK;
13423 case OPT_CAT:{
13424 Jim_Obj *objPtr;
13425 if (argc == 3) {
13426 /* optimise the one-arg case */
13427 objPtr = argv[2];
13429 else {
13430 int i;
13432 objPtr = Jim_NewStringObj(interp, "", 0);
13434 for (i = 2; i < argc; i++) {
13435 Jim_AppendObj(interp, objPtr, argv[i]);
13438 Jim_SetResult(interp, objPtr);
13439 return JIM_OK;
13442 case OPT_COMPARE:
13443 case OPT_EQUAL:
13445 /* n is the number of remaining option args */
13446 long opt_length = -1;
13447 int n = argc - 4;
13448 int i = 2;
13449 while (n > 0) {
13450 int subopt;
13451 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13452 JIM_ENUM_ABBREV) != JIM_OK) {
13453 badcompareargs:
13454 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13455 return JIM_ERR;
13457 if (subopt == 0) {
13458 /* -nocase */
13459 opt_case = 0;
13460 n--;
13462 else {
13463 /* -length */
13464 if (n < 2) {
13465 goto badcompareargs;
13467 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13468 return JIM_ERR;
13470 n -= 2;
13473 if (n) {
13474 goto badcompareargs;
13476 argv += argc - 2;
13477 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13478 /* Fast version - [string equal], case sensitive, no length */
13479 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13481 else {
13482 if (opt_length >= 0) {
13483 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13485 else {
13486 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13488 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13490 return JIM_OK;
13493 case OPT_MATCH:
13494 if (argc != 4 &&
13495 (argc != 5 ||
13496 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13497 JIM_ENUM_ABBREV) != JIM_OK)) {
13498 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13499 return JIM_ERR;
13501 if (opt_case == 0) {
13502 argv++;
13504 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13505 return JIM_OK;
13507 case OPT_MAP:{
13508 Jim_Obj *objPtr;
13510 if (argc != 4 &&
13511 (argc != 5 ||
13512 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13513 JIM_ENUM_ABBREV) != JIM_OK)) {
13514 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13515 return JIM_ERR;
13518 if (opt_case == 0) {
13519 argv++;
13521 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13522 if (objPtr == NULL) {
13523 return JIM_ERR;
13525 Jim_SetResult(interp, objPtr);
13526 return JIM_OK;
13529 case OPT_RANGE:
13530 case OPT_BYTERANGE:{
13531 Jim_Obj *objPtr;
13533 if (argc != 5) {
13534 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13535 return JIM_ERR;
13537 if (option == OPT_RANGE) {
13538 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13540 else
13542 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13545 if (objPtr == NULL) {
13546 return JIM_ERR;
13548 Jim_SetResult(interp, objPtr);
13549 return JIM_OK;
13552 case OPT_REPLACE:{
13553 Jim_Obj *objPtr;
13555 if (argc != 5 && argc != 6) {
13556 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13557 return JIM_ERR;
13559 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13560 if (objPtr == NULL) {
13561 return JIM_ERR;
13563 Jim_SetResult(interp, objPtr);
13564 return JIM_OK;
13568 case OPT_REPEAT:{
13569 Jim_Obj *objPtr;
13570 jim_wide count;
13572 if (argc != 4) {
13573 Jim_WrongNumArgs(interp, 2, argv, "string count");
13574 return JIM_ERR;
13576 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13577 return JIM_ERR;
13579 objPtr = Jim_NewStringObj(interp, "", 0);
13580 if (count > 0) {
13581 while (count--) {
13582 Jim_AppendObj(interp, objPtr, argv[2]);
13585 Jim_SetResult(interp, objPtr);
13586 return JIM_OK;
13589 case OPT_REVERSE:{
13590 char *buf, *p;
13591 const char *str;
13592 int i;
13594 if (argc != 3) {
13595 Jim_WrongNumArgs(interp, 2, argv, "string");
13596 return JIM_ERR;
13599 str = Jim_GetString(argv[2], &len);
13600 buf = Jim_Alloc(len + 1);
13601 p = buf + len;
13602 *p = 0;
13603 for (i = 0; i < len; ) {
13604 int c;
13605 int l = utf8_tounicode(str, &c);
13606 memcpy(p - l, str, l);
13607 p -= l;
13608 i += l;
13609 str += l;
13611 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13612 return JIM_OK;
13615 case OPT_INDEX:{
13616 int idx;
13617 const char *str;
13619 if (argc != 4) {
13620 Jim_WrongNumArgs(interp, 2, argv, "string index");
13621 return JIM_ERR;
13623 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13624 return JIM_ERR;
13626 str = Jim_String(argv[2]);
13627 len = Jim_Utf8Length(interp, argv[2]);
13628 if (idx != INT_MIN && idx != INT_MAX) {
13629 idx = JimRelToAbsIndex(len, idx);
13631 if (idx < 0 || idx >= len || str == NULL) {
13632 Jim_SetResultString(interp, "", 0);
13634 else if (len == Jim_Length(argv[2])) {
13635 /* ASCII optimisation */
13636 Jim_SetResultString(interp, str + idx, 1);
13638 else {
13639 int c;
13640 int i = utf8_index(str, idx);
13641 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13643 return JIM_OK;
13646 case OPT_FIRST:
13647 case OPT_LAST:{
13648 int idx = 0, l1, l2;
13649 const char *s1, *s2;
13651 if (argc != 4 && argc != 5) {
13652 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13653 return JIM_ERR;
13655 s1 = Jim_String(argv[2]);
13656 s2 = Jim_String(argv[3]);
13657 l1 = Jim_Utf8Length(interp, argv[2]);
13658 l2 = Jim_Utf8Length(interp, argv[3]);
13659 if (argc == 5) {
13660 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13661 return JIM_ERR;
13663 idx = JimRelToAbsIndex(l2, idx);
13665 else if (option == OPT_LAST) {
13666 idx = l2;
13668 if (option == OPT_FIRST) {
13669 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13671 else {
13672 #ifdef JIM_UTF8
13673 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13674 #else
13675 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13676 #endif
13678 return JIM_OK;
13681 case OPT_TRIM:
13682 case OPT_TRIMLEFT:
13683 case OPT_TRIMRIGHT:{
13684 Jim_Obj *trimchars;
13686 if (argc != 3 && argc != 4) {
13687 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13688 return JIM_ERR;
13690 trimchars = (argc == 4 ? argv[3] : NULL);
13691 if (option == OPT_TRIM) {
13692 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13694 else if (option == OPT_TRIMLEFT) {
13695 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13697 else if (option == OPT_TRIMRIGHT) {
13698 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13700 return JIM_OK;
13703 case OPT_TOLOWER:
13704 case OPT_TOUPPER:
13705 case OPT_TOTITLE:
13706 if (argc != 3) {
13707 Jim_WrongNumArgs(interp, 2, argv, "string");
13708 return JIM_ERR;
13710 if (option == OPT_TOLOWER) {
13711 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13713 else if (option == OPT_TOUPPER) {
13714 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13716 else {
13717 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13719 return JIM_OK;
13721 case OPT_IS:
13722 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13723 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13725 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13726 return JIM_ERR;
13728 return JIM_OK;
13731 /* [time] */
13732 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13734 long i, count = 1;
13735 jim_wide start, elapsed;
13736 char buf[60];
13737 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13739 if (argc < 2) {
13740 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13741 return JIM_ERR;
13743 if (argc == 3) {
13744 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13745 return JIM_ERR;
13747 if (count < 0)
13748 return JIM_OK;
13749 i = count;
13750 start = JimClock();
13751 while (i-- > 0) {
13752 int retval;
13754 retval = Jim_EvalObj(interp, argv[1]);
13755 if (retval != JIM_OK) {
13756 return retval;
13759 elapsed = JimClock() - start;
13760 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13761 Jim_SetResultString(interp, buf, -1);
13762 return JIM_OK;
13765 /* [exit] */
13766 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13768 long exitCode = 0;
13770 if (argc > 2) {
13771 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13772 return JIM_ERR;
13774 if (argc == 2) {
13775 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13776 return JIM_ERR;
13778 interp->exitCode = exitCode;
13779 return JIM_EXIT;
13782 /* [catch] */
13783 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13785 int exitCode = 0;
13786 int i;
13787 int sig = 0;
13789 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13790 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13791 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13793 /* Reset the error code before catch.
13794 * Note that this is not strictly correct.
13796 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13798 for (i = 1; i < argc - 1; i++) {
13799 const char *arg = Jim_String(argv[i]);
13800 jim_wide option;
13801 int ignore;
13803 /* It's a pity we can't use Jim_GetEnum here :-( */
13804 if (strcmp(arg, "--") == 0) {
13805 i++;
13806 break;
13808 if (*arg != '-') {
13809 break;
13812 if (strncmp(arg, "-no", 3) == 0) {
13813 arg += 3;
13814 ignore = 1;
13816 else {
13817 arg++;
13818 ignore = 0;
13821 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13822 option = -1;
13824 if (option < 0) {
13825 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13827 if (option < 0) {
13828 goto wrongargs;
13831 if (ignore) {
13832 ignore_mask |= ((jim_wide)1 << option);
13834 else {
13835 ignore_mask &= (~((jim_wide)1 << option));
13839 argc -= i;
13840 if (argc < 1 || argc > 3) {
13841 wrongargs:
13842 Jim_WrongNumArgs(interp, 1, argv,
13843 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13844 return JIM_ERR;
13846 argv += i;
13848 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13849 sig++;
13852 interp->signal_level += sig;
13853 if (Jim_CheckSignal(interp)) {
13854 /* If a signal is set, don't even try to execute the body */
13855 exitCode = JIM_SIGNAL;
13857 else {
13858 exitCode = Jim_EvalObj(interp, argv[0]);
13859 /* Don't want any caught error included in a later stack trace */
13860 interp->errorFlag = 0;
13862 interp->signal_level -= sig;
13864 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13865 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13866 /* Not caught, pass it up */
13867 return exitCode;
13870 if (sig && exitCode == JIM_SIGNAL) {
13871 /* Catch the signal at this level */
13872 if (interp->signal_set_result) {
13873 interp->signal_set_result(interp, interp->sigmask);
13875 else {
13876 Jim_SetResultInt(interp, interp->sigmask);
13878 interp->sigmask = 0;
13881 if (argc >= 2) {
13882 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13883 return JIM_ERR;
13885 if (argc == 3) {
13886 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13888 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13889 Jim_ListAppendElement(interp, optListObj,
13890 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13891 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13892 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13893 if (exitCode == JIM_ERR) {
13894 Jim_Obj *errorCode;
13895 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13896 -1));
13897 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13899 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13900 if (errorCode) {
13901 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13902 Jim_ListAppendElement(interp, optListObj, errorCode);
13905 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13906 return JIM_ERR;
13910 Jim_SetResultInt(interp, exitCode);
13911 return JIM_OK;
13914 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13916 /* [ref] */
13917 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13919 if (argc != 3 && argc != 4) {
13920 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13921 return JIM_ERR;
13923 if (argc == 3) {
13924 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13926 else {
13927 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13929 return JIM_OK;
13932 /* [getref] */
13933 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13935 Jim_Reference *refPtr;
13937 if (argc != 2) {
13938 Jim_WrongNumArgs(interp, 1, argv, "reference");
13939 return JIM_ERR;
13941 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13942 return JIM_ERR;
13943 Jim_SetResult(interp, refPtr->objPtr);
13944 return JIM_OK;
13947 /* [setref] */
13948 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13950 Jim_Reference *refPtr;
13952 if (argc != 3) {
13953 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13954 return JIM_ERR;
13956 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13957 return JIM_ERR;
13958 Jim_IncrRefCount(argv[2]);
13959 Jim_DecrRefCount(interp, refPtr->objPtr);
13960 refPtr->objPtr = argv[2];
13961 Jim_SetResult(interp, argv[2]);
13962 return JIM_OK;
13965 /* [collect] */
13966 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13968 if (argc != 1) {
13969 Jim_WrongNumArgs(interp, 1, argv, "");
13970 return JIM_ERR;
13972 Jim_SetResultInt(interp, Jim_Collect(interp));
13974 /* Free all the freed objects. */
13975 while (interp->freeList) {
13976 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13977 Jim_Free(interp->freeList);
13978 interp->freeList = nextObjPtr;
13981 return JIM_OK;
13984 /* [finalize] reference ?newValue? */
13985 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13987 if (argc != 2 && argc != 3) {
13988 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13989 return JIM_ERR;
13991 if (argc == 2) {
13992 Jim_Obj *cmdNamePtr;
13994 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13995 return JIM_ERR;
13996 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13997 Jim_SetResult(interp, cmdNamePtr);
13999 else {
14000 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14001 return JIM_ERR;
14002 Jim_SetResult(interp, argv[2]);
14004 return JIM_OK;
14007 /* [info references] */
14008 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14010 Jim_Obj *listObjPtr;
14011 Jim_HashTableIterator htiter;
14012 Jim_HashEntry *he;
14014 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14016 JimInitHashTableIterator(&interp->references, &htiter);
14017 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14018 char buf[JIM_REFERENCE_SPACE + 1];
14019 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14020 const unsigned long *refId = he->key;
14022 JimFormatReference(buf, refPtr, *refId);
14023 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14025 Jim_SetResult(interp, listObjPtr);
14026 return JIM_OK;
14028 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14030 /* [rename] */
14031 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14033 if (argc != 3) {
14034 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14035 return JIM_ERR;
14038 if (JimValidName(interp, "new procedure", argv[2])) {
14039 return JIM_ERR;
14042 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14045 #define JIM_DICTMATCH_KEYS 0x0001
14046 #define JIM_DICTMATCH_VALUES 0x002
14049 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14050 * return_types should be either or both
14052 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14054 Jim_HashEntry *he;
14055 Jim_Obj *listObjPtr;
14056 Jim_HashTableIterator htiter;
14058 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14059 return JIM_ERR;
14062 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14064 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14065 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14066 if (patternObj) {
14067 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14068 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14069 /* no match */
14070 continue;
14073 if (return_types & JIM_DICTMATCH_KEYS) {
14074 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14076 if (return_types & JIM_DICTMATCH_VALUES) {
14077 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14081 Jim_SetResult(interp, listObjPtr);
14082 return JIM_OK;
14085 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14087 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14088 return -1;
14090 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14094 * Must be called with at least one object.
14095 * Returns the new dictionary, or NULL on error.
14097 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14099 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14100 int i;
14102 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14104 /* Note that we don't optimise the trivial case of a single argument */
14106 for (i = 0; i < objc; i++) {
14107 Jim_HashTable *ht;
14108 Jim_HashTableIterator htiter;
14109 Jim_HashEntry *he;
14111 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14112 Jim_FreeNewObj(interp, objPtr);
14113 return NULL;
14115 ht = objv[i]->internalRep.ptr;
14116 JimInitHashTableIterator(ht, &htiter);
14117 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14118 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14121 return objPtr;
14124 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14126 Jim_HashTable *ht;
14127 unsigned int i;
14128 char buffer[100];
14129 int sum = 0;
14130 int nonzero_count = 0;
14131 Jim_Obj *output;
14132 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14134 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14135 return JIM_ERR;
14138 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14140 /* Note that this uses internal knowledge of the hash table */
14141 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14142 output = Jim_NewStringObj(interp, buffer, -1);
14144 for (i = 0; i < ht->size; i++) {
14145 Jim_HashEntry *he = ht->table[i];
14146 int entries = 0;
14147 while (he) {
14148 entries++;
14149 he = he->next;
14151 if (entries > 9) {
14152 bucket_counts[10]++;
14154 else {
14155 bucket_counts[entries]++;
14157 if (entries) {
14158 sum += entries;
14159 nonzero_count++;
14162 for (i = 0; i < 10; i++) {
14163 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14164 Jim_AppendString(interp, output, buffer, -1);
14166 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14167 Jim_AppendString(interp, output, buffer, -1);
14168 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14169 Jim_AppendString(interp, output, buffer, -1);
14170 Jim_SetResult(interp, output);
14171 return JIM_OK;
14174 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14176 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14178 Jim_AppendString(interp, prefixObj, " ", 1);
14179 Jim_AppendString(interp, prefixObj, subcmd, -1);
14181 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14185 * Implements the [dict with] command
14187 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14189 int i;
14190 Jim_Obj *objPtr;
14191 Jim_Obj *dictObj;
14192 Jim_Obj **dictValues;
14193 int len;
14194 int ret = JIM_OK;
14196 /* Open up the appropriate level of the dictionary */
14197 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14198 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14199 return JIM_ERR;
14201 /* Set the local variables */
14202 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14203 return JIM_ERR;
14205 for (i = 0; i < len; i += 2) {
14206 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14207 Jim_Free(dictValues);
14208 return JIM_ERR;
14212 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14213 if (Jim_Length(scriptObj)) {
14214 ret = Jim_EvalObj(interp, scriptObj);
14216 /* Now if the dictionary still exists, update it based on the local variables */
14217 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14218 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14219 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14220 for (i = 0; i < keyc; i++) {
14221 newkeyv[i] = keyv[i];
14224 for (i = 0; i < len; i += 2) {
14225 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14226 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14227 newkeyv[keyc] = dictValues[i];
14228 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14230 Jim_Free(newkeyv);
14234 Jim_Free(dictValues);
14236 return ret;
14239 /* [dict] */
14240 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14242 Jim_Obj *objPtr;
14243 int types = JIM_DICTMATCH_KEYS;
14244 int option;
14245 static const char * const options[] = {
14246 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14247 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14248 "replace", "update", NULL
14250 enum
14252 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14253 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14254 OPT_REPLACE, OPT_UPDATE,
14257 if (argc < 2) {
14258 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14259 return JIM_ERR;
14262 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14263 return Jim_CheckShowCommands(interp, argv[1], options);
14266 switch (option) {
14267 case OPT_GET:
14268 if (argc < 3) {
14269 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14270 return JIM_ERR;
14272 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14273 JIM_ERRMSG) != JIM_OK) {
14274 return JIM_ERR;
14276 Jim_SetResult(interp, objPtr);
14277 return JIM_OK;
14279 case OPT_SET:
14280 if (argc < 5) {
14281 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14282 return JIM_ERR;
14284 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14286 case OPT_EXISTS:
14287 if (argc < 4) {
14288 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14289 return JIM_ERR;
14291 else {
14292 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14293 if (rc < 0) {
14294 return JIM_ERR;
14296 Jim_SetResultBool(interp, rc == JIM_OK);
14297 return JIM_OK;
14300 case OPT_UNSET:
14301 if (argc < 4) {
14302 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14303 return JIM_ERR;
14305 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14306 return JIM_ERR;
14308 return JIM_OK;
14310 case OPT_VALUES:
14311 types = JIM_DICTMATCH_VALUES;
14312 /* fallthru */
14313 case OPT_KEYS:
14314 if (argc != 3 && argc != 4) {
14315 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14316 return JIM_ERR;
14318 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14320 case OPT_SIZE:
14321 if (argc != 3) {
14322 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14323 return JIM_ERR;
14325 else if (Jim_DictSize(interp, argv[2]) < 0) {
14326 return JIM_ERR;
14328 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14329 return JIM_OK;
14331 case OPT_MERGE:
14332 if (argc == 2) {
14333 return JIM_OK;
14335 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14336 if (objPtr == NULL) {
14337 return JIM_ERR;
14339 Jim_SetResult(interp, objPtr);
14340 return JIM_OK;
14342 case OPT_UPDATE:
14343 if (argc < 6 || argc % 2) {
14344 /* Better error message */
14345 argc = 2;
14347 break;
14349 case OPT_CREATE:
14350 if (argc % 2) {
14351 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14352 return JIM_ERR;
14354 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14355 Jim_SetResult(interp, objPtr);
14356 return JIM_OK;
14358 case OPT_INFO:
14359 if (argc != 3) {
14360 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14361 return JIM_ERR;
14363 return Jim_DictInfo(interp, argv[2]);
14365 case OPT_WITH:
14366 if (argc < 4) {
14367 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14368 return JIM_ERR;
14370 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14372 /* Handle command as an ensemble */
14373 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14376 /* [subst] */
14377 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14379 static const char * const options[] = {
14380 "-nobackslashes", "-nocommands", "-novariables", NULL
14382 enum
14383 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14384 int i;
14385 int flags = JIM_SUBST_FLAG;
14386 Jim_Obj *objPtr;
14388 if (argc < 2) {
14389 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14390 return JIM_ERR;
14392 for (i = 1; i < (argc - 1); i++) {
14393 int option;
14395 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14396 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14397 return JIM_ERR;
14399 switch (option) {
14400 case OPT_NOBACKSLASHES:
14401 flags |= JIM_SUBST_NOESC;
14402 break;
14403 case OPT_NOCOMMANDS:
14404 flags |= JIM_SUBST_NOCMD;
14405 break;
14406 case OPT_NOVARIABLES:
14407 flags |= JIM_SUBST_NOVAR;
14408 break;
14411 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14412 return JIM_ERR;
14414 Jim_SetResult(interp, objPtr);
14415 return JIM_OK;
14418 /* [info] */
14419 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14421 int cmd;
14422 Jim_Obj *objPtr;
14423 int mode = 0;
14425 static const char * const commands[] = {
14426 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14427 "vars", "version", "patchlevel", "complete", "args", "hostname",
14428 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14429 "references", "alias", NULL
14431 enum
14432 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14433 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14434 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14435 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14438 #ifdef jim_ext_namespace
14439 int nons = 0;
14441 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14442 /* This is for internal use only */
14443 argc--;
14444 argv++;
14445 nons = 1;
14447 #endif
14449 if (argc < 2) {
14450 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14451 return JIM_ERR;
14453 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14454 return Jim_CheckShowCommands(interp, argv[1], commands);
14457 /* Test for the most common commands first, just in case it makes a difference */
14458 switch (cmd) {
14459 case INFO_EXISTS:
14460 if (argc != 3) {
14461 Jim_WrongNumArgs(interp, 2, argv, "varName");
14462 return JIM_ERR;
14464 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14465 break;
14467 case INFO_ALIAS:{
14468 Jim_Cmd *cmdPtr;
14470 if (argc != 3) {
14471 Jim_WrongNumArgs(interp, 2, argv, "command");
14472 return JIM_ERR;
14474 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14475 return JIM_ERR;
14477 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14478 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14479 return JIM_ERR;
14481 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14482 return JIM_OK;
14485 case INFO_CHANNELS:
14486 mode++; /* JIM_CMDLIST_CHANNELS */
14487 #ifndef jim_ext_aio
14488 Jim_SetResultString(interp, "aio not enabled", -1);
14489 return JIM_ERR;
14490 #endif
14491 /* fall through */
14492 case INFO_PROCS:
14493 mode++; /* JIM_CMDLIST_PROCS */
14494 /* fall through */
14495 case INFO_COMMANDS:
14496 /* mode 0 => JIM_CMDLIST_COMMANDS */
14497 if (argc != 2 && argc != 3) {
14498 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14499 return JIM_ERR;
14501 #ifdef jim_ext_namespace
14502 if (!nons) {
14503 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14504 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14507 #endif
14508 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14509 break;
14511 case INFO_VARS:
14512 mode++; /* JIM_VARLIST_VARS */
14513 /* fall through */
14514 case INFO_LOCALS:
14515 mode++; /* JIM_VARLIST_LOCALS */
14516 /* fall through */
14517 case INFO_GLOBALS:
14518 /* mode 0 => JIM_VARLIST_GLOBALS */
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, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14531 break;
14533 case INFO_SCRIPT:
14534 if (argc != 2) {
14535 Jim_WrongNumArgs(interp, 2, argv, "");
14536 return JIM_ERR;
14538 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14539 break;
14541 case INFO_SOURCE:{
14542 jim_wide line;
14543 Jim_Obj *resObjPtr;
14544 Jim_Obj *fileNameObj;
14546 if (argc != 3 && argc != 5) {
14547 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14548 return JIM_ERR;
14550 if (argc == 5) {
14551 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14552 return JIM_ERR;
14554 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14555 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14557 else {
14558 if (argv[2]->typePtr == &sourceObjType) {
14559 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14560 line = argv[2]->internalRep.sourceValue.lineNumber;
14562 else if (argv[2]->typePtr == &scriptObjType) {
14563 ScriptObj *script = JimGetScript(interp, argv[2]);
14564 fileNameObj = script->fileNameObj;
14565 line = script->firstline;
14567 else {
14568 fileNameObj = interp->emptyObj;
14569 line = 1;
14571 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14572 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14573 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14575 Jim_SetResult(interp, resObjPtr);
14576 break;
14579 case INFO_STACKTRACE:
14580 Jim_SetResult(interp, interp->stackTrace);
14581 break;
14583 case INFO_LEVEL:
14584 case INFO_FRAME:
14585 switch (argc) {
14586 case 2:
14587 Jim_SetResultInt(interp, interp->framePtr->level);
14588 break;
14590 case 3:
14591 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14592 return JIM_ERR;
14594 Jim_SetResult(interp, objPtr);
14595 break;
14597 default:
14598 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14599 return JIM_ERR;
14601 break;
14603 case INFO_BODY:
14604 case INFO_STATICS:
14605 case INFO_ARGS:{
14606 Jim_Cmd *cmdPtr;
14608 if (argc != 3) {
14609 Jim_WrongNumArgs(interp, 2, argv, "procname");
14610 return JIM_ERR;
14612 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14613 return JIM_ERR;
14615 if (!cmdPtr->isproc) {
14616 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14617 return JIM_ERR;
14619 switch (cmd) {
14620 case INFO_BODY:
14621 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14622 break;
14623 case INFO_ARGS:
14624 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14625 break;
14626 case INFO_STATICS:
14627 if (cmdPtr->u.proc.staticVars) {
14628 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14629 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14631 break;
14633 break;
14636 case INFO_VERSION:
14637 case INFO_PATCHLEVEL:{
14638 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14640 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14641 Jim_SetResultString(interp, buf, -1);
14642 break;
14645 case INFO_COMPLETE:
14646 if (argc != 3 && argc != 4) {
14647 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14648 return JIM_ERR;
14650 else {
14651 char missing;
14653 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14654 if (missing != ' ' && argc == 4) {
14655 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14658 break;
14660 case INFO_HOSTNAME:
14661 /* Redirect to os.gethostname if it exists */
14662 return Jim_Eval(interp, "os.gethostname");
14664 case INFO_NAMEOFEXECUTABLE:
14665 /* Redirect to Tcl proc */
14666 return Jim_Eval(interp, "{info nameofexecutable}");
14668 case INFO_RETURNCODES:
14669 if (argc == 2) {
14670 int i;
14671 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14673 for (i = 0; jimReturnCodes[i]; i++) {
14674 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14675 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14676 jimReturnCodes[i], -1));
14679 Jim_SetResult(interp, listObjPtr);
14681 else if (argc == 3) {
14682 long code;
14683 const char *name;
14685 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14686 return JIM_ERR;
14688 name = Jim_ReturnCode(code);
14689 if (*name == '?') {
14690 Jim_SetResultInt(interp, code);
14692 else {
14693 Jim_SetResultString(interp, name, -1);
14696 else {
14697 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14698 return JIM_ERR;
14700 break;
14701 case INFO_REFERENCES:
14702 #ifdef JIM_REFERENCES
14703 return JimInfoReferences(interp, argc, argv);
14704 #else
14705 Jim_SetResultString(interp, "not supported", -1);
14706 return JIM_ERR;
14707 #endif
14709 return JIM_OK;
14712 /* [exists] */
14713 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14715 Jim_Obj *objPtr;
14716 int result = 0;
14718 static const char * const options[] = {
14719 "-command", "-proc", "-alias", "-var", NULL
14721 enum
14723 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14725 int option;
14727 if (argc == 2) {
14728 option = OPT_VAR;
14729 objPtr = argv[1];
14731 else if (argc == 3) {
14732 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14733 return JIM_ERR;
14735 objPtr = argv[2];
14737 else {
14738 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14739 return JIM_ERR;
14742 if (option == OPT_VAR) {
14743 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14745 else {
14746 /* Now different kinds of commands */
14747 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14749 if (cmd) {
14750 switch (option) {
14751 case OPT_COMMAND:
14752 result = 1;
14753 break;
14755 case OPT_ALIAS:
14756 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14757 break;
14759 case OPT_PROC:
14760 result = cmd->isproc;
14761 break;
14765 Jim_SetResultBool(interp, result);
14766 return JIM_OK;
14769 /* [split] */
14770 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14772 const char *str, *splitChars, *noMatchStart;
14773 int splitLen, strLen;
14774 Jim_Obj *resObjPtr;
14775 int c;
14776 int len;
14778 if (argc != 2 && argc != 3) {
14779 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14780 return JIM_ERR;
14783 str = Jim_GetString(argv[1], &len);
14784 if (len == 0) {
14785 return JIM_OK;
14787 strLen = Jim_Utf8Length(interp, argv[1]);
14789 /* Init */
14790 if (argc == 2) {
14791 splitChars = " \n\t\r";
14792 splitLen = 4;
14794 else {
14795 splitChars = Jim_String(argv[2]);
14796 splitLen = Jim_Utf8Length(interp, argv[2]);
14799 noMatchStart = str;
14800 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14802 /* Split */
14803 if (splitLen) {
14804 Jim_Obj *objPtr;
14805 while (strLen--) {
14806 const char *sc = splitChars;
14807 int scLen = splitLen;
14808 int sl = utf8_tounicode(str, &c);
14809 while (scLen--) {
14810 int pc;
14811 sc += utf8_tounicode(sc, &pc);
14812 if (c == pc) {
14813 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14814 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14815 noMatchStart = str + sl;
14816 break;
14819 str += sl;
14821 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14822 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14824 else {
14825 /* This handles the special case of splitchars eq {}
14826 * Optimise by sharing common (ASCII) characters
14828 Jim_Obj **commonObj = NULL;
14829 #define NUM_COMMON (128 - 9)
14830 while (strLen--) {
14831 int n = utf8_tounicode(str, &c);
14832 #ifdef JIM_OPTIMIZATION
14833 if (c >= 9 && c < 128) {
14834 /* Common ASCII char. Note that 9 is the tab character */
14835 c -= 9;
14836 if (!commonObj) {
14837 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14838 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14840 if (!commonObj[c]) {
14841 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14843 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14844 str++;
14845 continue;
14847 #endif
14848 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14849 str += n;
14851 Jim_Free(commonObj);
14854 Jim_SetResult(interp, resObjPtr);
14855 return JIM_OK;
14858 /* [join] */
14859 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14861 const char *joinStr;
14862 int joinStrLen;
14864 if (argc != 2 && argc != 3) {
14865 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14866 return JIM_ERR;
14868 /* Init */
14869 if (argc == 2) {
14870 joinStr = " ";
14871 joinStrLen = 1;
14873 else {
14874 joinStr = Jim_GetString(argv[2], &joinStrLen);
14876 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14877 return JIM_OK;
14880 /* [format] */
14881 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14883 Jim_Obj *objPtr;
14885 if (argc < 2) {
14886 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14887 return JIM_ERR;
14889 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14890 if (objPtr == NULL)
14891 return JIM_ERR;
14892 Jim_SetResult(interp, objPtr);
14893 return JIM_OK;
14896 /* [scan] */
14897 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14899 Jim_Obj *listPtr, **outVec;
14900 int outc, i;
14902 if (argc < 3) {
14903 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14904 return JIM_ERR;
14906 if (argv[2]->typePtr != &scanFmtStringObjType)
14907 SetScanFmtFromAny(interp, argv[2]);
14908 if (FormatGetError(argv[2]) != 0) {
14909 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14910 return JIM_ERR;
14912 if (argc > 3) {
14913 int maxPos = FormatGetMaxPos(argv[2]);
14914 int count = FormatGetCnvCount(argv[2]);
14916 if (maxPos > argc - 3) {
14917 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14918 return JIM_ERR;
14920 else if (count > argc - 3) {
14921 Jim_SetResultString(interp, "different numbers of variable names and "
14922 "field specifiers", -1);
14923 return JIM_ERR;
14925 else if (count < argc - 3) {
14926 Jim_SetResultString(interp, "variable is not assigned by any "
14927 "conversion specifiers", -1);
14928 return JIM_ERR;
14931 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14932 if (listPtr == 0)
14933 return JIM_ERR;
14934 if (argc > 3) {
14935 int rc = JIM_OK;
14936 int count = 0;
14938 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14939 int len = Jim_ListLength(interp, listPtr);
14941 if (len != 0) {
14942 JimListGetElements(interp, listPtr, &outc, &outVec);
14943 for (i = 0; i < outc; ++i) {
14944 if (Jim_Length(outVec[i]) > 0) {
14945 ++count;
14946 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14947 rc = JIM_ERR;
14952 Jim_FreeNewObj(interp, listPtr);
14954 else {
14955 count = -1;
14957 if (rc == JIM_OK) {
14958 Jim_SetResultInt(interp, count);
14960 return rc;
14962 else {
14963 if (listPtr == (Jim_Obj *)EOF) {
14964 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14965 return JIM_OK;
14967 Jim_SetResult(interp, listPtr);
14969 return JIM_OK;
14972 /* [error] */
14973 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14975 if (argc != 2 && argc != 3) {
14976 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14977 return JIM_ERR;
14979 Jim_SetResult(interp, argv[1]);
14980 if (argc == 3) {
14981 JimSetStackTrace(interp, argv[2]);
14982 return JIM_ERR;
14984 interp->addStackTrace++;
14985 return JIM_ERR;
14988 /* [lrange] */
14989 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14991 Jim_Obj *objPtr;
14993 if (argc != 4) {
14994 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14995 return JIM_ERR;
14997 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14998 return JIM_ERR;
14999 Jim_SetResult(interp, objPtr);
15000 return JIM_OK;
15003 /* [lrepeat] */
15004 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15006 Jim_Obj *objPtr;
15007 long count;
15009 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15010 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15011 return JIM_ERR;
15014 if (count == 0 || argc == 2) {
15015 return JIM_OK;
15018 argc -= 2;
15019 argv += 2;
15021 objPtr = Jim_NewListObj(interp, argv, argc);
15022 while (--count) {
15023 ListInsertElements(objPtr, -1, argc, argv);
15026 Jim_SetResult(interp, objPtr);
15027 return JIM_OK;
15030 char **Jim_GetEnviron(void)
15032 #if defined(HAVE__NSGETENVIRON)
15033 return *_NSGetEnviron();
15034 #else
15035 #if !defined(NO_ENVIRON_EXTERN)
15036 extern char **environ;
15037 #endif
15039 return environ;
15040 #endif
15043 void Jim_SetEnviron(char **env)
15045 #if defined(HAVE__NSGETENVIRON)
15046 *_NSGetEnviron() = env;
15047 #else
15048 #if !defined(NO_ENVIRON_EXTERN)
15049 extern char **environ;
15050 #endif
15052 environ = env;
15053 #endif
15056 /* [env] */
15057 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15059 const char *key;
15060 const char *val;
15062 if (argc == 1) {
15063 char **e = Jim_GetEnviron();
15065 int i;
15066 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15068 for (i = 0; e[i]; i++) {
15069 const char *equals = strchr(e[i], '=');
15071 if (equals) {
15072 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15073 equals - e[i]));
15074 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15078 Jim_SetResult(interp, listObjPtr);
15079 return JIM_OK;
15082 if (argc < 2) {
15083 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15084 return JIM_ERR;
15086 key = Jim_String(argv[1]);
15087 val = getenv(key);
15088 if (val == NULL) {
15089 if (argc < 3) {
15090 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15091 return JIM_ERR;
15093 val = Jim_String(argv[2]);
15095 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15096 return JIM_OK;
15099 /* [source] */
15100 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15102 int retval;
15104 if (argc != 2) {
15105 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15106 return JIM_ERR;
15108 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15109 if (retval == JIM_RETURN)
15110 return JIM_OK;
15111 return retval;
15114 /* [lreverse] */
15115 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15117 Jim_Obj *revObjPtr, **ele;
15118 int len;
15120 if (argc != 2) {
15121 Jim_WrongNumArgs(interp, 1, argv, "list");
15122 return JIM_ERR;
15124 JimListGetElements(interp, argv[1], &len, &ele);
15125 len--;
15126 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15127 while (len >= 0)
15128 ListAppendElement(revObjPtr, ele[len--]);
15129 Jim_SetResult(interp, revObjPtr);
15130 return JIM_OK;
15133 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15135 jim_wide len;
15137 if (step == 0)
15138 return -1;
15139 if (start == end)
15140 return 0;
15141 else if (step > 0 && start > end)
15142 return -1;
15143 else if (step < 0 && end > start)
15144 return -1;
15145 len = end - start;
15146 if (len < 0)
15147 len = -len; /* abs(len) */
15148 if (step < 0)
15149 step = -step; /* abs(step) */
15150 len = 1 + ((len - 1) / step);
15151 /* We can truncate safely to INT_MAX, the range command
15152 * will always return an error for a such long range
15153 * because Tcl lists can't be so long. */
15154 if (len > INT_MAX)
15155 len = INT_MAX;
15156 return (int)((len < 0) ? -1 : len);
15159 /* [range] */
15160 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15162 jim_wide start = 0, end, step = 1;
15163 int len, i;
15164 Jim_Obj *objPtr;
15166 if (argc < 2 || argc > 4) {
15167 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15168 return JIM_ERR;
15170 if (argc == 2) {
15171 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15172 return JIM_ERR;
15174 else {
15175 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15176 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15177 return JIM_ERR;
15178 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15179 return JIM_ERR;
15181 if ((len = JimRangeLen(start, end, step)) == -1) {
15182 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15183 return JIM_ERR;
15185 objPtr = Jim_NewListObj(interp, NULL, 0);
15186 for (i = 0; i < len; i++)
15187 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15188 Jim_SetResult(interp, objPtr);
15189 return JIM_OK;
15192 /* [rand] */
15193 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15195 jim_wide min = 0, max = 0, len, maxMul;
15197 if (argc < 1 || argc > 3) {
15198 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15199 return JIM_ERR;
15201 if (argc == 1) {
15202 max = JIM_WIDE_MAX;
15203 } else if (argc == 2) {
15204 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15205 return JIM_ERR;
15206 } else if (argc == 3) {
15207 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15208 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15209 return JIM_ERR;
15211 len = max-min;
15212 if (len < 0) {
15213 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15214 return JIM_ERR;
15216 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15217 while (1) {
15218 jim_wide r;
15220 JimRandomBytes(interp, &r, sizeof(jim_wide));
15221 if (r < 0 || r >= maxMul) continue;
15222 r = (len == 0) ? 0 : r%len;
15223 Jim_SetResultInt(interp, min+r);
15224 return JIM_OK;
15228 static const struct {
15229 const char *name;
15230 Jim_CmdProc *cmdProc;
15231 } Jim_CoreCommandsTable[] = {
15232 {"alias", Jim_AliasCoreCommand},
15233 {"set", Jim_SetCoreCommand},
15234 {"unset", Jim_UnsetCoreCommand},
15235 {"puts", Jim_PutsCoreCommand},
15236 {"+", Jim_AddCoreCommand},
15237 {"*", Jim_MulCoreCommand},
15238 {"-", Jim_SubCoreCommand},
15239 {"/", Jim_DivCoreCommand},
15240 {"incr", Jim_IncrCoreCommand},
15241 {"while", Jim_WhileCoreCommand},
15242 {"loop", Jim_LoopCoreCommand},
15243 {"for", Jim_ForCoreCommand},
15244 {"foreach", Jim_ForeachCoreCommand},
15245 {"lmap", Jim_LmapCoreCommand},
15246 {"lassign", Jim_LassignCoreCommand},
15247 {"if", Jim_IfCoreCommand},
15248 {"switch", Jim_SwitchCoreCommand},
15249 {"list", Jim_ListCoreCommand},
15250 {"lindex", Jim_LindexCoreCommand},
15251 {"lset", Jim_LsetCoreCommand},
15252 {"lsearch", Jim_LsearchCoreCommand},
15253 {"llength", Jim_LlengthCoreCommand},
15254 {"lappend", Jim_LappendCoreCommand},
15255 {"linsert", Jim_LinsertCoreCommand},
15256 {"lreplace", Jim_LreplaceCoreCommand},
15257 {"lsort", Jim_LsortCoreCommand},
15258 {"append", Jim_AppendCoreCommand},
15259 {"debug", Jim_DebugCoreCommand},
15260 {"eval", Jim_EvalCoreCommand},
15261 {"uplevel", Jim_UplevelCoreCommand},
15262 {"expr", Jim_ExprCoreCommand},
15263 {"break", Jim_BreakCoreCommand},
15264 {"continue", Jim_ContinueCoreCommand},
15265 {"proc", Jim_ProcCoreCommand},
15266 {"concat", Jim_ConcatCoreCommand},
15267 {"return", Jim_ReturnCoreCommand},
15268 {"upvar", Jim_UpvarCoreCommand},
15269 {"global", Jim_GlobalCoreCommand},
15270 {"string", Jim_StringCoreCommand},
15271 {"time", Jim_TimeCoreCommand},
15272 {"exit", Jim_ExitCoreCommand},
15273 {"catch", Jim_CatchCoreCommand},
15274 #ifdef JIM_REFERENCES
15275 {"ref", Jim_RefCoreCommand},
15276 {"getref", Jim_GetrefCoreCommand},
15277 {"setref", Jim_SetrefCoreCommand},
15278 {"finalize", Jim_FinalizeCoreCommand},
15279 {"collect", Jim_CollectCoreCommand},
15280 #endif
15281 {"rename", Jim_RenameCoreCommand},
15282 {"dict", Jim_DictCoreCommand},
15283 {"subst", Jim_SubstCoreCommand},
15284 {"info", Jim_InfoCoreCommand},
15285 {"exists", Jim_ExistsCoreCommand},
15286 {"split", Jim_SplitCoreCommand},
15287 {"join", Jim_JoinCoreCommand},
15288 {"format", Jim_FormatCoreCommand},
15289 {"scan", Jim_ScanCoreCommand},
15290 {"error", Jim_ErrorCoreCommand},
15291 {"lrange", Jim_LrangeCoreCommand},
15292 {"lrepeat", Jim_LrepeatCoreCommand},
15293 {"env", Jim_EnvCoreCommand},
15294 {"source", Jim_SourceCoreCommand},
15295 {"lreverse", Jim_LreverseCoreCommand},
15296 {"range", Jim_RangeCoreCommand},
15297 {"rand", Jim_RandCoreCommand},
15298 {"tailcall", Jim_TailcallCoreCommand},
15299 {"local", Jim_LocalCoreCommand},
15300 {"upcall", Jim_UpcallCoreCommand},
15301 {"apply", Jim_ApplyCoreCommand},
15302 {NULL, NULL},
15305 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15307 int i = 0;
15309 while (Jim_CoreCommandsTable[i].name != NULL) {
15310 Jim_CreateCommand(interp,
15311 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15312 i++;
15316 /* -----------------------------------------------------------------------------
15317 * Interactive prompt
15318 * ---------------------------------------------------------------------------*/
15319 void Jim_MakeErrorMessage(Jim_Interp *interp)
15321 Jim_Obj *argv[2];
15323 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15324 argv[1] = interp->result;
15326 Jim_EvalObjVector(interp, 2, argv);
15330 * Given a null terminated array of strings, returns an allocated, sorted
15331 * copy of the array.
15333 static char **JimSortStringTable(const char *const *tablePtr)
15335 int count;
15336 char **tablePtrSorted;
15338 /* Find the size of the table */
15339 for (count = 0; tablePtr[count]; count++) {
15342 /* Allocate one extra for the terminating NULL pointer */
15343 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15344 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15345 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15346 tablePtrSorted[count] = NULL;
15348 return tablePtrSorted;
15351 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15352 const char *prefix, const char *const *tablePtr, const char *name)
15354 char **tablePtrSorted;
15355 int i;
15357 if (name == NULL) {
15358 name = "option";
15361 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15362 tablePtrSorted = JimSortStringTable(tablePtr);
15363 for (i = 0; tablePtrSorted[i]; i++) {
15364 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15365 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15367 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15368 if (tablePtrSorted[i + 1]) {
15369 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15372 Jim_Free(tablePtrSorted);
15377 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15378 * and returns JIM_OK.
15380 * Otherwise returns JIM_ERR.
15382 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15384 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15385 int i;
15386 char **tablePtrSorted = JimSortStringTable(tablePtr);
15387 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15388 for (i = 0; tablePtrSorted[i]; i++) {
15389 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15391 Jim_Free(tablePtrSorted);
15392 return JIM_OK;
15394 return JIM_ERR;
15397 /* internal rep is stored in ptrIntvalue
15398 * ptr = tablePtr
15399 * int1 = flags
15400 * int2 = index
15402 static const Jim_ObjType getEnumObjType = {
15403 "get-enum",
15404 NULL,
15405 NULL,
15406 NULL,
15407 JIM_TYPE_REFERENCES
15410 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15411 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15413 const char *bad = "bad ";
15414 const char *const *entryPtr = NULL;
15415 int i;
15416 int match = -1;
15417 int arglen;
15418 const char *arg;
15420 if (objPtr->typePtr == &getEnumObjType) {
15421 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15422 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15423 return JIM_OK;
15427 arg = Jim_GetString(objPtr, &arglen);
15429 *indexPtr = -1;
15431 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15432 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15433 /* Found an exact match */
15434 match = i;
15435 goto found;
15437 if (flags & JIM_ENUM_ABBREV) {
15438 /* Accept an unambiguous abbreviation.
15439 * Note that '-' doesnt' consitute a valid abbreviation
15441 if (strncmp(arg, *entryPtr, arglen) == 0) {
15442 if (*arg == '-' && arglen == 1) {
15443 break;
15445 if (match >= 0) {
15446 bad = "ambiguous ";
15447 goto ambiguous;
15449 match = i;
15454 /* If we had an unambiguous partial match */
15455 if (match >= 0) {
15456 found:
15457 /* Record the match in the object */
15458 Jim_FreeIntRep(interp, objPtr);
15459 objPtr->typePtr = &getEnumObjType;
15460 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15461 objPtr->internalRep.ptrIntValue.int1 = flags;
15462 objPtr->internalRep.ptrIntValue.int2 = match;
15463 /* Return the result */
15464 *indexPtr = match;
15465 return JIM_OK;
15468 ambiguous:
15469 if (flags & JIM_ERRMSG) {
15470 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15472 return JIM_ERR;
15475 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15477 int i;
15479 for (i = 0; i < (int)len; i++) {
15480 if (array[i] && strcmp(array[i], name) == 0) {
15481 return i;
15484 return -1;
15487 int Jim_IsDict(Jim_Obj *objPtr)
15489 return objPtr->typePtr == &dictObjType;
15492 int Jim_IsList(Jim_Obj *objPtr)
15494 return objPtr->typePtr == &listObjType;
15498 * Very simple printf-like formatting, designed for error messages.
15500 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15501 * The resulting string is created and set as the result.
15503 * Each '%s' should correspond to a regular string parameter.
15504 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15505 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15507 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15509 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15511 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15513 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15515 /* Initial space needed */
15516 int len = strlen(format);
15517 int extra = 0;
15518 int n = 0;
15519 const char *params[5];
15520 int nobjparam = 0;
15521 Jim_Obj *objparam[5];
15522 char *buf;
15523 va_list args;
15524 int i;
15526 va_start(args, format);
15528 for (i = 0; i < len && n < 5; i++) {
15529 int l;
15531 if (strncmp(format + i, "%s", 2) == 0) {
15532 params[n] = va_arg(args, char *);
15534 l = strlen(params[n]);
15536 else if (strncmp(format + i, "%#s", 3) == 0) {
15537 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15539 params[n] = Jim_GetString(objPtr, &l);
15540 objparam[nobjparam++] = objPtr;
15541 Jim_IncrRefCount(objPtr);
15543 else {
15544 if (format[i] == '%') {
15545 i++;
15547 continue;
15549 n++;
15550 extra += l;
15553 len += extra;
15554 buf = Jim_Alloc(len + 1);
15555 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15557 va_end(args);
15559 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15561 for (i = 0; i < nobjparam; i++) {
15562 Jim_DecrRefCount(interp, objparam[i]);
15566 /* stubs */
15567 #ifndef jim_ext_package
15568 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15570 return JIM_OK;
15572 #endif
15573 #ifndef jim_ext_aio
15574 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15576 Jim_SetResultString(interp, "aio not enabled", -1);
15577 return NULL;
15579 #endif
15583 * Local Variables: ***
15584 * c-basic-offset: 4 ***
15585 * tab-width: 4 ***
15586 * End: ***