return: fix -level 0 -code xxx
[jimtcl.git] / jim.c
blob8bb5a20e3198fa12aca38b24c4bc24a27d2fcbfd
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 * utf-8 string comparison. case-insensitive if nocase is set.
322 * Returns -1, 0 or 1
324 * Note that the lengths are character lengths, not byte lengths.
326 static int JimStringCompareUtf8(const char *s1, int l1, const char *s2, int l2, int nocase)
328 int minlen = l1;
329 if (l2 < l1) {
330 minlen = l2;
332 while (minlen) {
333 int c1, c2;
334 s1 += utf8_tounicode_case(s1, &c1, nocase);
335 s2 += utf8_tounicode_case(s2, &c2, nocase);
336 if (c1 != c2) {
337 return JimSign(c1 - c2);
339 minlen--;
341 /* Equal to this point, so the shorter string is less */
342 if (l1 < l2) {
343 return -1;
345 if (l1 > l2) {
346 return 1;
348 return 0;
351 /* Search for 's1' inside 's2', starting to search from char 'index' of 's2'.
352 * The index of the first occurrence of s1 in s2 is returned.
353 * If s1 is not found inside s2, -1 is returned.
355 * Note: Lengths and return value are in bytes, not chars.
357 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
359 int i;
360 int l1bytelen;
362 if (!l1 || !l2 || l1 > l2) {
363 return -1;
365 if (idx < 0)
366 idx = 0;
367 s2 += utf8_index(s2, idx);
369 l1bytelen = utf8_index(s1, l1);
371 for (i = idx; i <= l2 - l1; i++) {
372 int c;
373 if (memcmp(s2, s1, l1bytelen) == 0) {
374 return i;
376 s2 += utf8_tounicode(s2, &c);
378 return -1;
381 /* Search for the last occurrence 's1' inside 's2', starting to search from char 'index' of 's2'.
382 * The index of the last occurrence of s1 in s2 is returned.
383 * If s1 is not found inside s2, -1 is returned.
385 * Note: Lengths and return value are in bytes, not chars.
387 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
389 const char *p;
391 if (!l1 || !l2 || l1 > l2)
392 return -1;
394 /* Now search for the needle */
395 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
396 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
397 return p - s2;
400 return -1;
403 #ifdef JIM_UTF8
405 * Per JimStringLast but lengths and return value are in chars, not bytes.
407 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
409 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
410 if (n > 0) {
411 n = utf8_strlen(s2, n);
413 return n;
415 #endif
418 * After an strtol()/strtod()-like conversion,
419 * check whether something was converted and that
420 * the only thing left is white space.
422 * Returns JIM_OK or JIM_ERR.
424 static int JimCheckConversion(const char *str, const char *endptr)
426 if (str[0] == '\0' || str == endptr) {
427 return JIM_ERR;
430 if (endptr[0] != '\0') {
431 while (*endptr) {
432 if (!isspace(UCHAR(*endptr))) {
433 return JIM_ERR;
435 endptr++;
438 return JIM_OK;
441 /* Parses the front of a number to determine its sign and base.
442 * Returns the index to start parsing according to the given base
444 static int JimNumberBase(const char *str, int *base, int *sign)
446 int i = 0;
448 *base = 10;
450 while (isspace(UCHAR(str[i]))) {
451 i++;
454 if (str[i] == '-') {
455 *sign = -1;
456 i++;
458 else {
459 if (str[i] == '+') {
460 i++;
462 *sign = 1;
465 if (str[i] != '0') {
466 /* base 10 */
467 return 0;
470 /* We have 0<x>, so see if we can convert it */
471 switch (str[i + 1]) {
472 case 'x': case 'X': *base = 16; break;
473 case 'o': case 'O': *base = 8; break;
474 case 'b': case 'B': *base = 2; break;
475 default: return 0;
477 i += 2;
478 /* Ensure that (e.g.) 0x-5 fails to parse */
479 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
480 /* Parse according to this base */
481 return i;
483 /* Parse as base 10 */
484 *base = 10;
485 return 0;
488 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
489 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
491 static long jim_strtol(const char *str, char **endptr)
493 int sign;
494 int base;
495 int i = JimNumberBase(str, &base, &sign);
497 if (base != 10) {
498 long value = strtol(str + i, endptr, base);
499 if (endptr == NULL || *endptr != str + i) {
500 return value * sign;
504 /* Can just do a regular base-10 conversion */
505 return strtol(str, endptr, 10);
509 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
510 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
512 static jim_wide jim_strtoull(const char *str, char **endptr)
514 #ifdef HAVE_LONG_LONG
515 int sign;
516 int base;
517 int i = JimNumberBase(str, &base, &sign);
519 if (base != 10) {
520 jim_wide value = strtoull(str + i, endptr, base);
521 if (endptr == NULL || *endptr != str + i) {
522 return value * sign;
526 /* Can just do a regular base-10 conversion */
527 return strtoull(str, endptr, 10);
528 #else
529 return (unsigned long)jim_strtol(str, endptr);
530 #endif
533 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
535 char *endptr;
537 if (base) {
538 *widePtr = strtoull(str, &endptr, base);
540 else {
541 *widePtr = jim_strtoull(str, &endptr);
544 return JimCheckConversion(str, endptr);
547 int Jim_StringToDouble(const char *str, double *doublePtr)
549 char *endptr;
551 /* Callers can check for underflow via ERANGE */
552 errno = 0;
554 *doublePtr = strtod(str, &endptr);
556 return JimCheckConversion(str, endptr);
559 static jim_wide JimPowWide(jim_wide b, jim_wide e)
561 jim_wide res = 1;
563 /* Special cases */
564 if (b == 1) {
565 /* 1 ^ any = 1 */
566 return 1;
568 if (e < 0) {
569 if (b != -1) {
570 return 0;
572 /* Only special case is -1 ^ -n
573 * -1^-1 = -1
574 * -1^-2 = 1
575 * i.e. same as +ve n
577 e = -e;
579 while (e)
581 if (e & 1) {
582 res *= b;
584 e >>= 1;
585 b *= b;
587 return res;
590 /* -----------------------------------------------------------------------------
591 * Special functions
592 * ---------------------------------------------------------------------------*/
593 #ifdef JIM_DEBUG_PANIC
594 static void JimPanicDump(int condition, const char *fmt, ...)
596 va_list ap;
598 if (!condition) {
599 return;
602 va_start(ap, fmt);
604 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
605 vfprintf(stderr, fmt, ap);
606 fprintf(stderr, "\n\n");
607 va_end(ap);
609 #ifdef HAVE_BACKTRACE
611 void *array[40];
612 int size, i;
613 char **strings;
615 size = backtrace(array, 40);
616 strings = backtrace_symbols(array, size);
617 for (i = 0; i < size; i++)
618 fprintf(stderr, "[backtrace] %s\n", strings[i]);
619 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
620 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
622 #endif
624 exit(1);
626 #endif
628 /* -----------------------------------------------------------------------------
629 * Memory allocation
630 * ---------------------------------------------------------------------------*/
632 void *Jim_Alloc(int size)
634 return size ? malloc(size) : NULL;
637 void Jim_Free(void *ptr)
639 free(ptr);
642 void *Jim_Realloc(void *ptr, int size)
644 return realloc(ptr, size);
647 char *Jim_StrDup(const char *s)
649 return strdup(s);
652 char *Jim_StrDupLen(const char *s, int l)
654 char *copy = Jim_Alloc(l + 1);
656 memcpy(copy, s, l + 1);
657 copy[l] = 0; /* Just to be sure, original could be substring */
658 return copy;
661 /* -----------------------------------------------------------------------------
662 * Time related functions
663 * ---------------------------------------------------------------------------*/
665 /* Returns current time in microseconds */
666 static jim_wide JimClock(void)
668 struct timeval tv;
670 gettimeofday(&tv, NULL);
671 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
674 /* -----------------------------------------------------------------------------
675 * Hash Tables
676 * ---------------------------------------------------------------------------*/
678 /* -------------------------- private prototypes ---------------------------- */
679 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
680 static unsigned int JimHashTableNextPower(unsigned int size);
681 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
683 /* -------------------------- hash functions -------------------------------- */
685 /* Thomas Wang's 32 bit Mix Function */
686 unsigned int Jim_IntHashFunction(unsigned int key)
688 key += ~(key << 15);
689 key ^= (key >> 10);
690 key += (key << 3);
691 key ^= (key >> 6);
692 key += ~(key << 11);
693 key ^= (key >> 16);
694 return key;
697 /* Generic hash function (we are using to multiply by 9 and add the byte
698 * as Tcl) */
699 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
701 unsigned int h = 0;
703 while (len--)
704 h += (h << 3) + *buf++;
705 return h;
708 /* ----------------------------- API implementation ------------------------- */
711 * Reset a hashtable already initialized.
712 * The table data should already have been freed.
714 * Note that type and privdata are not initialised
715 * to allow the now-empty hashtable to be reused
717 static void JimResetHashTable(Jim_HashTable *ht)
719 ht->table = NULL;
720 ht->size = 0;
721 ht->sizemask = 0;
722 ht->used = 0;
723 ht->collisions = 0;
724 #ifdef JIM_RANDOMISE_HASH
725 /* This is initialised to a random value to avoid a hash collision attack.
726 * See: n.runs-SA-2011.004
728 ht->uniq = (rand() ^ time(NULL) ^ clock());
729 #else
730 ht->uniq = 0;
731 #endif
734 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
736 iter->ht = ht;
737 iter->index = -1;
738 iter->entry = NULL;
739 iter->nextEntry = NULL;
742 /* Initialize the hash table */
743 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
745 JimResetHashTable(ht);
746 ht->type = type;
747 ht->privdata = privDataPtr;
748 return JIM_OK;
751 /* Expand or create the hashtable */
752 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
754 Jim_HashTable n; /* the new hashtable */
755 unsigned int realsize = JimHashTableNextPower(size), i;
757 /* the size is invalid if it is smaller than the number of
758 * elements already inside the hashtable */
759 if (size <= ht->used)
760 return;
762 Jim_InitHashTable(&n, ht->type, ht->privdata);
763 n.size = realsize;
764 n.sizemask = realsize - 1;
765 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
766 /* Keep the same 'uniq' as the original */
767 n.uniq = ht->uniq;
769 /* Initialize all the pointers to NULL */
770 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
772 /* Copy all the elements from the old to the new table:
773 * note that if the old hash table is empty ht->used is zero,
774 * so Jim_ExpandHashTable just creates an empty hash table. */
775 n.used = ht->used;
776 for (i = 0; ht->used > 0; i++) {
777 Jim_HashEntry *he, *nextHe;
779 if (ht->table[i] == NULL)
780 continue;
782 /* For each hash entry on this slot... */
783 he = ht->table[i];
784 while (he) {
785 unsigned int h;
787 nextHe = he->next;
788 /* Get the new element index */
789 h = Jim_HashKey(ht, he->key) & n.sizemask;
790 he->next = n.table[h];
791 n.table[h] = he;
792 ht->used--;
793 /* Pass to the next element */
794 he = nextHe;
797 assert(ht->used == 0);
798 Jim_Free(ht->table);
800 /* Remap the new hashtable in the old */
801 *ht = n;
804 /* Add an element to the target hash table */
805 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
807 Jim_HashEntry *entry;
809 /* Get the index of the new element, or -1 if
810 * the element already exists. */
811 entry = JimInsertHashEntry(ht, key, 0);
812 if (entry == NULL)
813 return JIM_ERR;
815 /* Set the hash entry fields. */
816 Jim_SetHashKey(ht, entry, key);
817 Jim_SetHashVal(ht, entry, val);
818 return JIM_OK;
821 /* Add an element, discarding the old if the key already exists */
822 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
824 int existed;
825 Jim_HashEntry *entry;
827 /* Get the index of the new element, or -1 if
828 * the element already exists. */
829 entry = JimInsertHashEntry(ht, key, 1);
830 if (entry->key) {
831 /* It already exists, so only replace the value.
832 * Note if both a destructor and a duplicate function exist,
833 * need to dup before destroy. perhaps they are the same
834 * reference counted object
836 if (ht->type->valDestructor && ht->type->valDup) {
837 void *newval = ht->type->valDup(ht->privdata, val);
838 ht->type->valDestructor(ht->privdata, entry->u.val);
839 entry->u.val = newval;
841 else {
842 Jim_FreeEntryVal(ht, entry);
843 Jim_SetHashVal(ht, entry, val);
845 existed = 1;
847 else {
848 /* Doesn't exist, so set the key */
849 Jim_SetHashKey(ht, entry, key);
850 Jim_SetHashVal(ht, entry, val);
851 existed = 0;
854 return existed;
857 /* Search and remove an element */
858 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
860 unsigned int h;
861 Jim_HashEntry *he, *prevHe;
863 if (ht->used == 0)
864 return JIM_ERR;
865 h = Jim_HashKey(ht, key) & ht->sizemask;
866 he = ht->table[h];
868 prevHe = NULL;
869 while (he) {
870 if (Jim_CompareHashKeys(ht, key, he->key)) {
871 /* Unlink the element from the list */
872 if (prevHe)
873 prevHe->next = he->next;
874 else
875 ht->table[h] = he->next;
876 Jim_FreeEntryKey(ht, he);
877 Jim_FreeEntryVal(ht, he);
878 Jim_Free(he);
879 ht->used--;
880 return JIM_OK;
882 prevHe = he;
883 he = he->next;
885 return JIM_ERR; /* not found */
888 /* Remove all entries from the hash table
889 * and leave it empty for reuse
891 int Jim_FreeHashTable(Jim_HashTable *ht)
893 unsigned int i;
895 /* Free all the elements */
896 for (i = 0; ht->used > 0; i++) {
897 Jim_HashEntry *he, *nextHe;
899 if ((he = ht->table[i]) == NULL)
900 continue;
901 while (he) {
902 nextHe = he->next;
903 Jim_FreeEntryKey(ht, he);
904 Jim_FreeEntryVal(ht, he);
905 Jim_Free(he);
906 ht->used--;
907 he = nextHe;
910 /* Free the table and the allocated cache structure */
911 Jim_Free(ht->table);
912 /* Re-initialize the table */
913 JimResetHashTable(ht);
914 return JIM_OK; /* never fails */
917 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
919 Jim_HashEntry *he;
920 unsigned int h;
922 if (ht->used == 0)
923 return NULL;
924 h = Jim_HashKey(ht, key) & ht->sizemask;
925 he = ht->table[h];
926 while (he) {
927 if (Jim_CompareHashKeys(ht, key, he->key))
928 return he;
929 he = he->next;
931 return NULL;
934 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
936 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
937 JimInitHashTableIterator(ht, iter);
938 return iter;
941 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
943 while (1) {
944 if (iter->entry == NULL) {
945 iter->index++;
946 if (iter->index >= (signed)iter->ht->size)
947 break;
948 iter->entry = iter->ht->table[iter->index];
950 else {
951 iter->entry = iter->nextEntry;
953 if (iter->entry) {
954 /* We need to save the 'next' here, the iterator user
955 * may delete the entry we are returning. */
956 iter->nextEntry = iter->entry->next;
957 return iter->entry;
960 return NULL;
963 /* ------------------------- private functions ------------------------------ */
965 /* Expand the hash table if needed */
966 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
968 /* If the hash table is empty expand it to the intial size,
969 * if the table is "full" double its size. */
970 if (ht->size == 0)
971 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
972 if (ht->size == ht->used)
973 Jim_ExpandHashTable(ht, ht->size * 2);
976 /* Our hash table capability is a power of two */
977 static unsigned int JimHashTableNextPower(unsigned int size)
979 unsigned int i = JIM_HT_INITIAL_SIZE;
981 if (size >= 2147483648U)
982 return 2147483648U;
983 while (1) {
984 if (i >= size)
985 return i;
986 i *= 2;
990 /* Returns the index of a free slot that can be populated with
991 * a hash entry for the given 'key'.
992 * If the key already exists, -1 is returned. */
993 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
995 unsigned int h;
996 Jim_HashEntry *he;
998 /* Expand the hashtable if needed */
999 JimExpandHashTableIfNeeded(ht);
1001 /* Compute the key hash value */
1002 h = Jim_HashKey(ht, key) & ht->sizemask;
1003 /* Search if this slot does not already contain the given key */
1004 he = ht->table[h];
1005 while (he) {
1006 if (Jim_CompareHashKeys(ht, key, he->key))
1007 return replace ? he : NULL;
1008 he = he->next;
1011 /* Allocates the memory and stores key */
1012 he = Jim_Alloc(sizeof(*he));
1013 he->next = ht->table[h];
1014 ht->table[h] = he;
1015 ht->used++;
1016 he->key = NULL;
1018 return he;
1021 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1023 static unsigned int JimStringCopyHTHashFunction(const void *key)
1025 return Jim_GenHashFunction(key, strlen(key));
1028 static void *JimStringCopyHTDup(void *privdata, const void *key)
1030 return Jim_StrDup(key);
1033 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1035 return strcmp(key1, key2) == 0;
1038 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1040 Jim_Free(key);
1043 static const Jim_HashTableType JimPackageHashTableType = {
1044 JimStringCopyHTHashFunction, /* hash function */
1045 JimStringCopyHTDup, /* key dup */
1046 NULL, /* val dup */
1047 JimStringCopyHTKeyCompare, /* key compare */
1048 JimStringCopyHTKeyDestructor, /* key destructor */
1049 NULL /* val destructor */
1052 typedef struct AssocDataValue
1054 Jim_InterpDeleteProc *delProc;
1055 void *data;
1056 } AssocDataValue;
1058 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1060 AssocDataValue *assocPtr = (AssocDataValue *) data;
1062 if (assocPtr->delProc != NULL)
1063 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1064 Jim_Free(data);
1067 static const Jim_HashTableType JimAssocDataHashTableType = {
1068 JimStringCopyHTHashFunction, /* hash function */
1069 JimStringCopyHTDup, /* key dup */
1070 NULL, /* val dup */
1071 JimStringCopyHTKeyCompare, /* key compare */
1072 JimStringCopyHTKeyDestructor, /* key destructor */
1073 JimAssocDataHashTableValueDestructor /* val destructor */
1076 /* -----------------------------------------------------------------------------
1077 * Stack - This is a simple generic stack implementation. It is used for
1078 * example in the 'expr' expression compiler.
1079 * ---------------------------------------------------------------------------*/
1080 void Jim_InitStack(Jim_Stack *stack)
1082 stack->len = 0;
1083 stack->maxlen = 0;
1084 stack->vector = NULL;
1087 void Jim_FreeStack(Jim_Stack *stack)
1089 Jim_Free(stack->vector);
1092 int Jim_StackLen(Jim_Stack *stack)
1094 return stack->len;
1097 void Jim_StackPush(Jim_Stack *stack, void *element)
1099 int neededLen = stack->len + 1;
1101 if (neededLen > stack->maxlen) {
1102 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1103 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1105 stack->vector[stack->len] = element;
1106 stack->len++;
1109 void *Jim_StackPop(Jim_Stack *stack)
1111 if (stack->len == 0)
1112 return NULL;
1113 stack->len--;
1114 return stack->vector[stack->len];
1117 void *Jim_StackPeek(Jim_Stack *stack)
1119 if (stack->len == 0)
1120 return NULL;
1121 return stack->vector[stack->len - 1];
1124 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1126 int i;
1128 for (i = 0; i < stack->len; i++)
1129 freeFunc(stack->vector[i]);
1132 /* -----------------------------------------------------------------------------
1133 * Tcl Parser
1134 * ---------------------------------------------------------------------------*/
1136 /* Token types */
1137 #define JIM_TT_NONE 0 /* No token returned */
1138 #define JIM_TT_STR 1 /* simple string */
1139 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1140 #define JIM_TT_VAR 3 /* var substitution */
1141 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1142 #define JIM_TT_CMD 5 /* command substitution */
1143 /* Note: Keep these three together for TOKEN_IS_SEP() */
1144 #define JIM_TT_SEP 6 /* word separator (white space) */
1145 #define JIM_TT_EOL 7 /* line separator */
1146 #define JIM_TT_EOF 8 /* end of script */
1148 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1149 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1151 /* Additional token types needed for expressions */
1152 #define JIM_TT_SUBEXPR_START 11
1153 #define JIM_TT_SUBEXPR_END 12
1154 #define JIM_TT_SUBEXPR_COMMA 13
1155 #define JIM_TT_EXPR_INT 14
1156 #define JIM_TT_EXPR_DOUBLE 15
1157 #define JIM_TT_EXPR_BOOLEAN 16
1159 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1161 /* Operator token types start here */
1162 #define JIM_TT_EXPR_OP 20
1164 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1165 /* Can this token start an expression? */
1166 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1167 /* Is this token an expression operator? */
1168 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1171 * Results of missing quotes, braces, etc. from parsing.
1173 struct JimParseMissing {
1174 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\', '}' if incomplete */
1175 int line; /* Line number starting the missing token */
1178 /* Parser context structure. The same context is used to parse
1179 * Tcl scripts, expressions and lists. */
1180 struct JimParserCtx
1182 const char *p; /* Pointer to the point of the program we are parsing */
1183 int len; /* Remaining length */
1184 int linenr; /* Current line number */
1185 const char *tstart;
1186 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1187 int tline; /* Line number of the returned token */
1188 int tt; /* Token type */
1189 int eof; /* Non zero if EOF condition is true. */
1190 int inquote; /* Parsing a quoted string */
1191 int comment; /* Non zero if the next chars may be a comment. */
1192 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1195 static int JimParseScript(struct JimParserCtx *pc);
1196 static int JimParseSep(struct JimParserCtx *pc);
1197 static int JimParseEol(struct JimParserCtx *pc);
1198 static int JimParseCmd(struct JimParserCtx *pc);
1199 static int JimParseQuote(struct JimParserCtx *pc);
1200 static int JimParseVar(struct JimParserCtx *pc);
1201 static int JimParseBrace(struct JimParserCtx *pc);
1202 static int JimParseStr(struct JimParserCtx *pc);
1203 static int JimParseComment(struct JimParserCtx *pc);
1204 static void JimParseSubCmd(struct JimParserCtx *pc);
1205 static int JimParseSubQuote(struct JimParserCtx *pc);
1206 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1208 /* Initialize a parser context.
1209 * 'prg' is a pointer to the program text, linenr is the line
1210 * number of the first line contained in the program. */
1211 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1213 pc->p = prg;
1214 pc->len = len;
1215 pc->tstart = NULL;
1216 pc->tend = NULL;
1217 pc->tline = 0;
1218 pc->tt = JIM_TT_NONE;
1219 pc->eof = 0;
1220 pc->inquote = 0;
1221 pc->linenr = linenr;
1222 pc->comment = 1;
1223 pc->missing.ch = ' ';
1224 pc->missing.line = linenr;
1227 static int JimParseScript(struct JimParserCtx *pc)
1229 while (1) { /* the while is used to reiterate with continue if needed */
1230 if (!pc->len) {
1231 pc->tstart = pc->p;
1232 pc->tend = pc->p - 1;
1233 pc->tline = pc->linenr;
1234 pc->tt = JIM_TT_EOL;
1235 pc->eof = 1;
1236 return JIM_OK;
1238 switch (*(pc->p)) {
1239 case '\\':
1240 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1241 return JimParseSep(pc);
1243 pc->comment = 0;
1244 return JimParseStr(pc);
1245 case ' ':
1246 case '\t':
1247 case '\r':
1248 case '\f':
1249 if (!pc->inquote)
1250 return JimParseSep(pc);
1251 pc->comment = 0;
1252 return JimParseStr(pc);
1253 case '\n':
1254 case ';':
1255 pc->comment = 1;
1256 if (!pc->inquote)
1257 return JimParseEol(pc);
1258 return JimParseStr(pc);
1259 case '[':
1260 pc->comment = 0;
1261 return JimParseCmd(pc);
1262 case '$':
1263 pc->comment = 0;
1264 if (JimParseVar(pc) == JIM_ERR) {
1265 /* An orphan $. Create as a separate token */
1266 pc->tstart = pc->tend = pc->p++;
1267 pc->len--;
1268 pc->tt = JIM_TT_ESC;
1270 return JIM_OK;
1271 case '#':
1272 if (pc->comment) {
1273 JimParseComment(pc);
1274 continue;
1276 return JimParseStr(pc);
1277 default:
1278 pc->comment = 0;
1279 return JimParseStr(pc);
1281 return JIM_OK;
1285 static int JimParseSep(struct JimParserCtx *pc)
1287 pc->tstart = pc->p;
1288 pc->tline = pc->linenr;
1289 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1290 if (*pc->p == '\n') {
1291 break;
1293 if (*pc->p == '\\') {
1294 pc->p++;
1295 pc->len--;
1296 pc->linenr++;
1298 pc->p++;
1299 pc->len--;
1301 pc->tend = pc->p - 1;
1302 pc->tt = JIM_TT_SEP;
1303 return JIM_OK;
1306 static int JimParseEol(struct JimParserCtx *pc)
1308 pc->tstart = pc->p;
1309 pc->tline = pc->linenr;
1310 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1311 if (*pc->p == '\n')
1312 pc->linenr++;
1313 pc->p++;
1314 pc->len--;
1316 pc->tend = pc->p - 1;
1317 pc->tt = JIM_TT_EOL;
1318 return JIM_OK;
1322 ** Here are the rules for parsing:
1323 ** {braced expression}
1324 ** - Count open and closing braces
1325 ** - Backslash escapes meaning of braces but doesn't remove the backslash
1327 ** "quoted expression"
1328 ** - Unescaped double quote terminates the expression
1329 ** - Backslash escapes next char
1330 ** - [commands brackets] are counted/nested
1331 ** - command rules apply within [brackets], not quoting rules (i.e. brackets have their own rules)
1333 ** [command expression]
1334 ** - Count open and closing brackets
1335 ** - Backslash escapes next char
1336 ** - [commands brackets] are counted/nested
1337 ** - "quoted expressions" are parsed according to quoting rules
1338 ** - {braced expressions} are parsed according to brace rules
1340 ** For everything, backslash escapes the next char, newline increments current line
1344 * Parses a braced expression starting at pc->p.
1346 * Positions the parser at the end of the braced expression,
1347 * sets pc->tend and possibly pc->missing.
1349 static void JimParseSubBrace(struct JimParserCtx *pc)
1351 int level = 1;
1353 /* Skip the brace */
1354 pc->p++;
1355 pc->len--;
1356 while (pc->len) {
1357 switch (*pc->p) {
1358 case '\\':
1359 if (pc->len > 1) {
1360 if (*++pc->p == '\n') {
1361 pc->linenr++;
1363 pc->len--;
1365 break;
1367 case '{':
1368 level++;
1369 break;
1371 case '}':
1372 if (--level == 0) {
1373 pc->tend = pc->p - 1;
1374 pc->p++;
1375 pc->len--;
1376 return;
1378 break;
1380 case '\n':
1381 pc->linenr++;
1382 break;
1384 pc->p++;
1385 pc->len--;
1387 pc->missing.ch = '{';
1388 pc->missing.line = pc->tline;
1389 pc->tend = pc->p - 1;
1393 * Parses a quoted expression starting at pc->p.
1395 * Positions the parser at the end of the quoted expression,
1396 * sets pc->tend and possibly pc->missing.
1398 * Returns the type of the token of the string,
1399 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1400 * or JIM_TT_STR.
1402 static int JimParseSubQuote(struct JimParserCtx *pc)
1404 int tt = JIM_TT_STR;
1405 int line = pc->tline;
1407 /* Skip the quote */
1408 pc->p++;
1409 pc->len--;
1410 while (pc->len) {
1411 switch (*pc->p) {
1412 case '\\':
1413 if (pc->len > 1) {
1414 if (*++pc->p == '\n') {
1415 pc->linenr++;
1417 pc->len--;
1418 tt = JIM_TT_ESC;
1420 break;
1422 case '"':
1423 pc->tend = pc->p - 1;
1424 pc->p++;
1425 pc->len--;
1426 return tt;
1428 case '[':
1429 JimParseSubCmd(pc);
1430 tt = JIM_TT_ESC;
1431 continue;
1433 case '\n':
1434 pc->linenr++;
1435 break;
1437 case '$':
1438 tt = JIM_TT_ESC;
1439 break;
1441 pc->p++;
1442 pc->len--;
1444 pc->missing.ch = '"';
1445 pc->missing.line = line;
1446 pc->tend = pc->p - 1;
1447 return tt;
1451 * Parses a [command] expression starting at pc->p.
1453 * Positions the parser at the end of the command expression,
1454 * sets pc->tend and possibly pc->missing.
1456 static void JimParseSubCmd(struct JimParserCtx *pc)
1458 int level = 1;
1459 int startofword = 1;
1460 int line = pc->tline;
1462 /* Skip the bracket */
1463 pc->p++;
1464 pc->len--;
1465 while (pc->len) {
1466 switch (*pc->p) {
1467 case '\\':
1468 if (pc->len > 1) {
1469 if (*++pc->p == '\n') {
1470 pc->linenr++;
1472 pc->len--;
1474 break;
1476 case '[':
1477 level++;
1478 break;
1480 case ']':
1481 if (--level == 0) {
1482 pc->tend = pc->p - 1;
1483 pc->p++;
1484 pc->len--;
1485 return;
1487 break;
1489 case '"':
1490 if (startofword) {
1491 JimParseSubQuote(pc);
1492 continue;
1494 break;
1496 case '{':
1497 JimParseSubBrace(pc);
1498 startofword = 0;
1499 continue;
1501 case '\n':
1502 pc->linenr++;
1503 break;
1505 startofword = isspace(UCHAR(*pc->p));
1506 pc->p++;
1507 pc->len--;
1509 pc->missing.ch = '[';
1510 pc->missing.line = line;
1511 pc->tend = pc->p - 1;
1514 static int JimParseBrace(struct JimParserCtx *pc)
1516 pc->tstart = pc->p + 1;
1517 pc->tline = pc->linenr;
1518 pc->tt = JIM_TT_STR;
1519 JimParseSubBrace(pc);
1520 return JIM_OK;
1523 static int JimParseCmd(struct JimParserCtx *pc)
1525 pc->tstart = pc->p + 1;
1526 pc->tline = pc->linenr;
1527 pc->tt = JIM_TT_CMD;
1528 JimParseSubCmd(pc);
1529 return JIM_OK;
1532 static int JimParseQuote(struct JimParserCtx *pc)
1534 pc->tstart = pc->p + 1;
1535 pc->tline = pc->linenr;
1536 pc->tt = JimParseSubQuote(pc);
1537 return JIM_OK;
1540 static int JimParseVar(struct JimParserCtx *pc)
1542 /* skip the $ */
1543 pc->p++;
1544 pc->len--;
1546 #ifdef EXPRSUGAR_BRACKET
1547 if (*pc->p == '[') {
1548 /* Parse $[...] expr shorthand syntax */
1549 JimParseCmd(pc);
1550 pc->tt = JIM_TT_EXPRSUGAR;
1551 return JIM_OK;
1553 #endif
1555 pc->tstart = pc->p;
1556 pc->tt = JIM_TT_VAR;
1557 pc->tline = pc->linenr;
1559 if (*pc->p == '{') {
1560 pc->tstart = ++pc->p;
1561 pc->len--;
1563 while (pc->len && *pc->p != '}') {
1564 if (*pc->p == '\n') {
1565 pc->linenr++;
1567 pc->p++;
1568 pc->len--;
1570 pc->tend = pc->p - 1;
1571 if (pc->len) {
1572 pc->p++;
1573 pc->len--;
1576 else {
1577 while (1) {
1578 /* Skip double colon, but not single colon! */
1579 if (pc->p[0] == ':' && pc->p[1] == ':') {
1580 while (*pc->p == ':') {
1581 pc->p++;
1582 pc->len--;
1584 continue;
1586 /* Note that any char >= 0x80 must be part of a utf-8 char.
1587 * We consider all unicode points outside of ASCII as letters
1589 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1590 pc->p++;
1591 pc->len--;
1592 continue;
1594 break;
1596 /* Parse [dict get] syntax sugar. */
1597 if (*pc->p == '(') {
1598 int count = 1;
1599 const char *paren = NULL;
1601 pc->tt = JIM_TT_DICTSUGAR;
1603 while (count && pc->len) {
1604 pc->p++;
1605 pc->len--;
1606 if (*pc->p == '\\' && pc->len >= 1) {
1607 pc->p++;
1608 pc->len--;
1610 else if (*pc->p == '(') {
1611 count++;
1613 else if (*pc->p == ')') {
1614 paren = pc->p;
1615 count--;
1618 if (count == 0) {
1619 pc->p++;
1620 pc->len--;
1622 else if (paren) {
1623 /* Did not find a matching paren. Back up */
1624 paren++;
1625 pc->len += (pc->p - paren);
1626 pc->p = paren;
1628 #ifndef EXPRSUGAR_BRACKET
1629 if (*pc->tstart == '(') {
1630 pc->tt = JIM_TT_EXPRSUGAR;
1632 #endif
1634 pc->tend = pc->p - 1;
1636 /* Check if we parsed just the '$' character.
1637 * That's not a variable so an error is returned
1638 * to tell the state machine to consider this '$' just
1639 * a string. */
1640 if (pc->tstart == pc->p) {
1641 pc->p--;
1642 pc->len++;
1643 return JIM_ERR;
1645 return JIM_OK;
1648 static int JimParseStr(struct JimParserCtx *pc)
1650 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1651 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1652 /* Starting a new word */
1653 if (*pc->p == '{') {
1654 return JimParseBrace(pc);
1656 if (*pc->p == '"') {
1657 pc->inquote = 1;
1658 pc->p++;
1659 pc->len--;
1660 /* In case the end quote is missing */
1661 pc->missing.line = pc->tline;
1664 pc->tstart = pc->p;
1665 pc->tline = pc->linenr;
1666 while (1) {
1667 if (pc->len == 0) {
1668 if (pc->inquote) {
1669 pc->missing.ch = '"';
1671 pc->tend = pc->p - 1;
1672 pc->tt = JIM_TT_ESC;
1673 return JIM_OK;
1675 switch (*pc->p) {
1676 case '\\':
1677 if (!pc->inquote && *(pc->p + 1) == '\n') {
1678 pc->tend = pc->p - 1;
1679 pc->tt = JIM_TT_ESC;
1680 return JIM_OK;
1682 if (pc->len >= 2) {
1683 if (*(pc->p + 1) == '\n') {
1684 pc->linenr++;
1686 pc->p++;
1687 pc->len--;
1689 else if (pc->len == 1) {
1690 /* End of script with trailing backslash */
1691 pc->missing.ch = '\\';
1693 break;
1694 case '(':
1695 /* If the following token is not '$' just keep going */
1696 if (pc->len > 1 && pc->p[1] != '$') {
1697 break;
1699 /* fall through */
1700 case ')':
1701 /* Only need a separate ')' token if the previous was a var */
1702 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1703 if (pc->p == pc->tstart) {
1704 /* At the start of the token, so just return this char */
1705 pc->p++;
1706 pc->len--;
1708 pc->tend = pc->p - 1;
1709 pc->tt = JIM_TT_ESC;
1710 return JIM_OK;
1712 break;
1714 case '$':
1715 case '[':
1716 pc->tend = pc->p - 1;
1717 pc->tt = JIM_TT_ESC;
1718 return JIM_OK;
1719 case ' ':
1720 case '\t':
1721 case '\n':
1722 case '\r':
1723 case '\f':
1724 case ';':
1725 if (!pc->inquote) {
1726 pc->tend = pc->p - 1;
1727 pc->tt = JIM_TT_ESC;
1728 return JIM_OK;
1730 else if (*pc->p == '\n') {
1731 pc->linenr++;
1733 break;
1734 case '"':
1735 if (pc->inquote) {
1736 pc->tend = pc->p - 1;
1737 pc->tt = JIM_TT_ESC;
1738 pc->p++;
1739 pc->len--;
1740 pc->inquote = 0;
1741 return JIM_OK;
1743 break;
1745 pc->p++;
1746 pc->len--;
1748 return JIM_OK; /* unreached */
1751 static int JimParseComment(struct JimParserCtx *pc)
1753 while (*pc->p) {
1754 if (*pc->p == '\\') {
1755 pc->p++;
1756 pc->len--;
1757 if (pc->len == 0) {
1758 pc->missing.ch = '\\';
1759 return JIM_OK;
1761 if (*pc->p == '\n') {
1762 pc->linenr++;
1765 else if (*pc->p == '\n') {
1766 pc->p++;
1767 pc->len--;
1768 pc->linenr++;
1769 break;
1771 pc->p++;
1772 pc->len--;
1774 return JIM_OK;
1777 /* xdigitval and odigitval are helper functions for JimEscape() */
1778 static int xdigitval(int c)
1780 if (c >= '0' && c <= '9')
1781 return c - '0';
1782 if (c >= 'a' && c <= 'f')
1783 return c - 'a' + 10;
1784 if (c >= 'A' && c <= 'F')
1785 return c - 'A' + 10;
1786 return -1;
1789 static int odigitval(int c)
1791 if (c >= '0' && c <= '7')
1792 return c - '0';
1793 return -1;
1796 /* Perform Tcl escape substitution of 's', storing the result
1797 * string into 'dest'. The escaped string is guaranteed to
1798 * be the same length or shorter than the source string.
1799 * slen is the length of the string at 's'.
1801 * The function returns the length of the resulting string. */
1802 static int JimEscape(char *dest, const char *s, int slen)
1804 char *p = dest;
1805 int i, len;
1807 for (i = 0; i < slen; i++) {
1808 switch (s[i]) {
1809 case '\\':
1810 switch (s[i + 1]) {
1811 case 'a':
1812 *p++ = 0x7;
1813 i++;
1814 break;
1815 case 'b':
1816 *p++ = 0x8;
1817 i++;
1818 break;
1819 case 'f':
1820 *p++ = 0xc;
1821 i++;
1822 break;
1823 case 'n':
1824 *p++ = 0xa;
1825 i++;
1826 break;
1827 case 'r':
1828 *p++ = 0xd;
1829 i++;
1830 break;
1831 case 't':
1832 *p++ = 0x9;
1833 i++;
1834 break;
1835 case 'u':
1836 case 'U':
1837 case 'x':
1838 /* A unicode or hex sequence.
1839 * \x Expect 1-2 hex chars and convert to hex.
1840 * \u Expect 1-4 hex chars and convert to utf-8.
1841 * \U Expect 1-8 hex chars and convert to utf-8.
1842 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1843 * An invalid sequence means simply the escaped char.
1846 unsigned val = 0;
1847 int k;
1848 int maxchars = 2;
1850 i++;
1852 if (s[i] == 'U') {
1853 maxchars = 8;
1855 else if (s[i] == 'u') {
1856 if (s[i + 1] == '{') {
1857 maxchars = 6;
1858 i++;
1860 else {
1861 maxchars = 4;
1865 for (k = 0; k < maxchars; k++) {
1866 int c = xdigitval(s[i + k + 1]);
1867 if (c == -1) {
1868 break;
1870 val = (val << 4) | c;
1872 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1873 if (s[i] == '{') {
1874 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1875 /* Back up */
1876 i--;
1877 k = 0;
1879 else {
1880 /* Skip the closing brace */
1881 k++;
1884 if (k) {
1885 /* Got a valid sequence, so convert */
1886 if (s[i] == 'x') {
1887 *p++ = val;
1889 else {
1890 p += utf8_fromunicode(p, val);
1892 i += k;
1893 break;
1895 /* Not a valid codepoint, just an escaped char */
1896 *p++ = s[i];
1898 break;
1899 case 'v':
1900 *p++ = 0xb;
1901 i++;
1902 break;
1903 case '\0':
1904 *p++ = '\\';
1905 i++;
1906 break;
1907 case '\n':
1908 /* Replace all spaces and tabs after backslash newline with a single space*/
1909 *p++ = ' ';
1910 do {
1911 i++;
1912 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1913 break;
1914 case '0':
1915 case '1':
1916 case '2':
1917 case '3':
1918 case '4':
1919 case '5':
1920 case '6':
1921 case '7':
1922 /* octal escape */
1924 int val = 0;
1925 int c = odigitval(s[i + 1]);
1927 val = c;
1928 c = odigitval(s[i + 2]);
1929 if (c == -1) {
1930 *p++ = val;
1931 i++;
1932 break;
1934 val = (val * 8) + c;
1935 c = odigitval(s[i + 3]);
1936 if (c == -1) {
1937 *p++ = val;
1938 i += 2;
1939 break;
1941 val = (val * 8) + c;
1942 *p++ = val;
1943 i += 3;
1945 break;
1946 default:
1947 *p++ = s[i + 1];
1948 i++;
1949 break;
1951 break;
1952 default:
1953 *p++ = s[i];
1954 break;
1957 len = p - dest;
1958 *p = '\0';
1959 return len;
1962 /* Returns a dynamically allocated copy of the current token in the
1963 * parser context. The function performs conversion of escapes if
1964 * the token is of type JIM_TT_ESC.
1966 * Note that after the conversion, tokens that are grouped with
1967 * braces in the source code, are always recognizable from the
1968 * identical string obtained in a different way from the type.
1970 * For example the string:
1972 * {*}$a
1974 * will return as first token "*", of type JIM_TT_STR
1976 * While the string:
1978 * *$a
1980 * will return as first token "*", of type JIM_TT_ESC
1982 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1984 const char *start, *end;
1985 char *token;
1986 int len;
1988 start = pc->tstart;
1989 end = pc->tend;
1990 len = (end - start) + 1;
1991 if (len < 0) {
1992 len = 0;
1994 token = Jim_Alloc(len + 1);
1995 if (pc->tt != JIM_TT_ESC) {
1996 /* No escape conversion needed? Just copy it. */
1997 memcpy(token, start, len);
1998 token[len] = '\0';
2000 else {
2001 /* Else convert the escape chars. */
2002 len = JimEscape(token, start, len);
2005 return Jim_NewStringObjNoAlloc(interp, token, len);
2008 /* -----------------------------------------------------------------------------
2009 * Tcl Lists parsing
2010 * ---------------------------------------------------------------------------*/
2011 static int JimParseListSep(struct JimParserCtx *pc);
2012 static int JimParseListStr(struct JimParserCtx *pc);
2013 static int JimParseListQuote(struct JimParserCtx *pc);
2015 static int JimParseList(struct JimParserCtx *pc)
2017 if (isspace(UCHAR(*pc->p))) {
2018 return JimParseListSep(pc);
2020 switch (*pc->p) {
2021 case '"':
2022 return JimParseListQuote(pc);
2024 case '{':
2025 return JimParseBrace(pc);
2027 default:
2028 if (pc->len) {
2029 return JimParseListStr(pc);
2031 break;
2034 pc->tstart = pc->tend = pc->p;
2035 pc->tline = pc->linenr;
2036 pc->tt = JIM_TT_EOL;
2037 pc->eof = 1;
2038 return JIM_OK;
2041 static int JimParseListSep(struct JimParserCtx *pc)
2043 pc->tstart = pc->p;
2044 pc->tline = pc->linenr;
2045 while (isspace(UCHAR(*pc->p))) {
2046 if (*pc->p == '\n') {
2047 pc->linenr++;
2049 pc->p++;
2050 pc->len--;
2052 pc->tend = pc->p - 1;
2053 pc->tt = JIM_TT_SEP;
2054 return JIM_OK;
2057 static int JimParseListQuote(struct JimParserCtx *pc)
2059 pc->p++;
2060 pc->len--;
2062 pc->tstart = pc->p;
2063 pc->tline = pc->linenr;
2064 pc->tt = JIM_TT_STR;
2066 while (pc->len) {
2067 switch (*pc->p) {
2068 case '\\':
2069 pc->tt = JIM_TT_ESC;
2070 if (--pc->len == 0) {
2071 /* Trailing backslash */
2072 pc->tend = pc->p;
2073 return JIM_OK;
2075 pc->p++;
2076 break;
2077 case '\n':
2078 pc->linenr++;
2079 break;
2080 case '"':
2081 pc->tend = pc->p - 1;
2082 pc->p++;
2083 pc->len--;
2084 return JIM_OK;
2086 pc->p++;
2087 pc->len--;
2090 pc->tend = pc->p - 1;
2091 return JIM_OK;
2094 static int JimParseListStr(struct JimParserCtx *pc)
2096 pc->tstart = pc->p;
2097 pc->tline = pc->linenr;
2098 pc->tt = JIM_TT_STR;
2100 while (pc->len) {
2101 if (isspace(UCHAR(*pc->p))) {
2102 pc->tend = pc->p - 1;
2103 return JIM_OK;
2105 if (*pc->p == '\\') {
2106 if (--pc->len == 0) {
2107 /* Trailing backslash */
2108 pc->tend = pc->p;
2109 return JIM_OK;
2111 pc->tt = JIM_TT_ESC;
2112 pc->p++;
2114 pc->p++;
2115 pc->len--;
2117 pc->tend = pc->p - 1;
2118 return JIM_OK;
2121 /* -----------------------------------------------------------------------------
2122 * Jim_Obj related functions
2123 * ---------------------------------------------------------------------------*/
2125 /* Return a new initialized object. */
2126 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2128 Jim_Obj *objPtr;
2130 /* -- Check if there are objects in the free list -- */
2131 if (interp->freeList != NULL) {
2132 /* -- Unlink the object from the free list -- */
2133 objPtr = interp->freeList;
2134 interp->freeList = objPtr->nextObjPtr;
2136 else {
2137 /* -- No ready to use objects: allocate a new one -- */
2138 objPtr = Jim_Alloc(sizeof(*objPtr));
2141 /* Object is returned with refCount of 0. Every
2142 * kind of GC implemented should take care to avoid
2143 * scanning objects with refCount == 0. */
2144 objPtr->refCount = 0;
2145 /* All the other fields are left uninitialized to save time.
2146 * The caller will probably want to set them to the right
2147 * value anyway. */
2149 /* -- Put the object into the live list -- */
2150 objPtr->prevObjPtr = NULL;
2151 objPtr->nextObjPtr = interp->liveList;
2152 if (interp->liveList)
2153 interp->liveList->prevObjPtr = objPtr;
2154 interp->liveList = objPtr;
2156 return objPtr;
2159 /* Free an object. Actually objects are never freed, but
2160 * just moved to the free objects list, where they will be
2161 * reused by Jim_NewObj(). */
2162 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2164 /* Check if the object was already freed, panic. */
2165 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2166 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2168 /* Free the internal representation */
2169 Jim_FreeIntRep(interp, objPtr);
2170 /* Free the string representation */
2171 if (objPtr->bytes != NULL) {
2172 if (objPtr->bytes != JimEmptyStringRep)
2173 Jim_Free(objPtr->bytes);
2175 /* Unlink the object from the live objects list */
2176 if (objPtr->prevObjPtr)
2177 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2178 if (objPtr->nextObjPtr)
2179 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2180 if (interp->liveList == objPtr)
2181 interp->liveList = objPtr->nextObjPtr;
2182 #ifdef JIM_DISABLE_OBJECT_POOL
2183 Jim_Free(objPtr);
2184 #else
2185 /* Link the object into the free objects list */
2186 objPtr->prevObjPtr = NULL;
2187 objPtr->nextObjPtr = interp->freeList;
2188 if (interp->freeList)
2189 interp->freeList->prevObjPtr = objPtr;
2190 interp->freeList = objPtr;
2191 objPtr->refCount = -1;
2192 #endif
2195 /* Invalidate the string representation of an object. */
2196 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2198 if (objPtr->bytes != NULL) {
2199 if (objPtr->bytes != JimEmptyStringRep)
2200 Jim_Free(objPtr->bytes);
2202 objPtr->bytes = NULL;
2205 /* Duplicate an object. The returned object has refcount = 0. */
2206 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2208 Jim_Obj *dupPtr;
2210 dupPtr = Jim_NewObj(interp);
2211 if (objPtr->bytes == NULL) {
2212 /* Object does not have a valid string representation. */
2213 dupPtr->bytes = NULL;
2215 else if (objPtr->length == 0) {
2216 /* Zero length, so don't even bother with the type-specific dup,
2217 * since all zero length objects look the same
2219 dupPtr->bytes = JimEmptyStringRep;
2220 dupPtr->length = 0;
2221 dupPtr->typePtr = NULL;
2222 return dupPtr;
2224 else {
2225 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2226 dupPtr->length = objPtr->length;
2227 /* Copy the null byte too */
2228 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2231 /* By default, the new object has the same type as the old object */
2232 dupPtr->typePtr = objPtr->typePtr;
2233 if (objPtr->typePtr != NULL) {
2234 if (objPtr->typePtr->dupIntRepProc == NULL) {
2235 dupPtr->internalRep = objPtr->internalRep;
2237 else {
2238 /* The dup proc may set a different type, e.g. NULL */
2239 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2242 return dupPtr;
2245 /* Return the string representation for objPtr. If the object's
2246 * string representation is invalid, calls the updateStringProc method to create
2247 * a new one from the internal representation of the object.
2249 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2251 if (objPtr->bytes == NULL) {
2252 /* Invalid string repr. Generate it. */
2253 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2254 objPtr->typePtr->updateStringProc(objPtr);
2256 if (lenPtr)
2257 *lenPtr = objPtr->length;
2258 return objPtr->bytes;
2261 /* Just returns the length (in bytes) of the object's string rep */
2262 int Jim_Length(Jim_Obj *objPtr)
2264 if (objPtr->bytes == NULL) {
2265 /* Invalid string repr. Generate it. */
2266 Jim_GetString(objPtr, NULL);
2268 return objPtr->length;
2271 /* Just returns object's string rep */
2272 const char *Jim_String(Jim_Obj *objPtr)
2274 if (objPtr->bytes == NULL) {
2275 /* Invalid string repr. Generate it. */
2276 Jim_GetString(objPtr, NULL);
2278 return objPtr->bytes;
2281 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2283 objPtr->bytes = Jim_StrDup(str);
2284 objPtr->length = strlen(str);
2287 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2288 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2290 static const Jim_ObjType dictSubstObjType = {
2291 "dict-substitution",
2292 FreeDictSubstInternalRep,
2293 DupDictSubstInternalRep,
2294 NULL,
2295 JIM_TYPE_NONE,
2298 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2299 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2301 static const Jim_ObjType interpolatedObjType = {
2302 "interpolated",
2303 FreeInterpolatedInternalRep,
2304 DupInterpolatedInternalRep,
2305 NULL,
2306 JIM_TYPE_NONE,
2309 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2311 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2314 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2316 /* Copy the interal rep */
2317 dupPtr->internalRep = srcPtr->internalRep;
2318 /* Need to increment the key ref count */
2319 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2322 /* -----------------------------------------------------------------------------
2323 * String Object
2324 * ---------------------------------------------------------------------------*/
2325 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2326 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2328 static const Jim_ObjType stringObjType = {
2329 "string",
2330 NULL,
2331 DupStringInternalRep,
2332 NULL,
2333 JIM_TYPE_REFERENCES,
2336 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2338 JIM_NOTUSED(interp);
2340 /* This is a bit subtle: the only caller of this function
2341 * should be Jim_DuplicateObj(), that will copy the
2342 * string representaion. After the copy, the duplicated
2343 * object will not have more room in the buffer than
2344 * srcPtr->length bytes. So we just set it to length. */
2345 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2346 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2349 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2351 if (objPtr->typePtr != &stringObjType) {
2352 /* Get a fresh string representation. */
2353 if (objPtr->bytes == NULL) {
2354 /* Invalid string repr. Generate it. */
2355 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2356 objPtr->typePtr->updateStringProc(objPtr);
2358 /* Free any other internal representation. */
2359 Jim_FreeIntRep(interp, objPtr);
2360 /* Set it as string, i.e. just set the maxLength field. */
2361 objPtr->typePtr = &stringObjType;
2362 objPtr->internalRep.strValue.maxLength = objPtr->length;
2363 /* Don't know the utf-8 length yet */
2364 objPtr->internalRep.strValue.charLength = -1;
2366 return JIM_OK;
2370 * Returns the length of the object string in chars, not bytes.
2372 * These may be different for a utf-8 string.
2374 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2376 #ifdef JIM_UTF8
2377 SetStringFromAny(interp, objPtr);
2379 if (objPtr->internalRep.strValue.charLength < 0) {
2380 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2382 return objPtr->internalRep.strValue.charLength;
2383 #else
2384 return Jim_Length(objPtr);
2385 #endif
2388 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2389 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2391 Jim_Obj *objPtr = Jim_NewObj(interp);
2393 /* Need to find out how many bytes the string requires */
2394 if (len == -1)
2395 len = strlen(s);
2396 /* Alloc/Set the string rep. */
2397 if (len == 0) {
2398 objPtr->bytes = JimEmptyStringRep;
2400 else {
2401 objPtr->bytes = Jim_StrDupLen(s, len);
2403 objPtr->length = len;
2405 /* No typePtr field for the vanilla string object. */
2406 objPtr->typePtr = NULL;
2407 return objPtr;
2410 /* charlen is in characters -- see also Jim_NewStringObj() */
2411 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2413 #ifdef JIM_UTF8
2414 /* Need to find out how many bytes the string requires */
2415 int bytelen = utf8_index(s, charlen);
2417 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2419 /* Remember the utf8 length, so set the type */
2420 objPtr->typePtr = &stringObjType;
2421 objPtr->internalRep.strValue.maxLength = bytelen;
2422 objPtr->internalRep.strValue.charLength = charlen;
2424 return objPtr;
2425 #else
2426 return Jim_NewStringObj(interp, s, charlen);
2427 #endif
2430 /* This version does not try to duplicate the 's' pointer, but
2431 * use it directly. */
2432 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2434 Jim_Obj *objPtr = Jim_NewObj(interp);
2436 objPtr->bytes = s;
2437 objPtr->length = (len == -1) ? strlen(s) : len;
2438 objPtr->typePtr = NULL;
2439 return objPtr;
2442 /* Low-level string append. Use it only against unshared objects
2443 * of type "string". */
2444 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2446 int needlen;
2448 if (len == -1)
2449 len = strlen(str);
2450 needlen = objPtr->length + len;
2451 if (objPtr->internalRep.strValue.maxLength < needlen ||
2452 objPtr->internalRep.strValue.maxLength == 0) {
2453 needlen *= 2;
2454 /* Inefficient to malloc() for less than 8 bytes */
2455 if (needlen < 7) {
2456 needlen = 7;
2458 if (objPtr->bytes == JimEmptyStringRep) {
2459 objPtr->bytes = Jim_Alloc(needlen + 1);
2461 else {
2462 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2464 objPtr->internalRep.strValue.maxLength = needlen;
2466 memcpy(objPtr->bytes + objPtr->length, str, len);
2467 objPtr->bytes[objPtr->length + len] = '\0';
2469 if (objPtr->internalRep.strValue.charLength >= 0) {
2470 /* Update the utf-8 char length */
2471 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2473 objPtr->length += len;
2476 /* Higher level API to append strings to objects.
2477 * Object must not be unshared for each of these.
2479 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2481 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2482 SetStringFromAny(interp, objPtr);
2483 StringAppendString(objPtr, str, len);
2486 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2488 int len;
2489 const char *str = Jim_GetString(appendObjPtr, &len);
2490 Jim_AppendString(interp, objPtr, str, len);
2493 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2495 va_list ap;
2497 SetStringFromAny(interp, objPtr);
2498 va_start(ap, objPtr);
2499 while (1) {
2500 const char *s = va_arg(ap, const char *);
2502 if (s == NULL)
2503 break;
2504 Jim_AppendString(interp, objPtr, s, -1);
2506 va_end(ap);
2509 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2511 if (aObjPtr == bObjPtr) {
2512 return 1;
2514 else {
2515 int Alen, Blen;
2516 const char *sA = Jim_GetString(aObjPtr, &Alen);
2517 const char *sB = Jim_GetString(bObjPtr, &Blen);
2519 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2524 * Note. Does not support embedded nulls in either the pattern or the object.
2526 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2528 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2531 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2533 const char *s1 = Jim_String(firstObjPtr);
2534 int l1 = Jim_Utf8Length(interp, firstObjPtr);
2535 const char *s2 = Jim_String(secondObjPtr);
2536 int l2 = Jim_Utf8Length(interp, secondObjPtr);
2537 return JimStringCompareUtf8(s1, l1, s2, l2, nocase);
2540 /* Convert a range, as returned by Jim_GetRange(), into
2541 * an absolute index into an object of the specified length.
2542 * This function may return negative values, or values
2543 * greater than or equal to the length of the list if the index
2544 * is out of range. */
2545 static int JimRelToAbsIndex(int len, int idx)
2547 if (idx < 0)
2548 return len + idx;
2549 return idx;
2552 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2553 * into a form suitable for implementation of commands like [string range] and [lrange].
2555 * The resulting range is guaranteed to address valid elements of
2556 * the structure.
2558 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2560 int rangeLen;
2562 if (*firstPtr > *lastPtr) {
2563 rangeLen = 0;
2565 else {
2566 rangeLen = *lastPtr - *firstPtr + 1;
2567 if (rangeLen) {
2568 if (*firstPtr < 0) {
2569 rangeLen += *firstPtr;
2570 *firstPtr = 0;
2572 if (*lastPtr >= len) {
2573 rangeLen -= (*lastPtr - (len - 1));
2574 *lastPtr = len - 1;
2578 if (rangeLen < 0)
2579 rangeLen = 0;
2581 *rangeLenPtr = rangeLen;
2584 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2585 int len, int *first, int *last, int *range)
2587 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2588 return JIM_ERR;
2590 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2591 return JIM_ERR;
2593 *first = JimRelToAbsIndex(len, *first);
2594 *last = JimRelToAbsIndex(len, *last);
2595 JimRelToAbsRange(len, first, last, range);
2596 return JIM_OK;
2599 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2600 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2602 int first, last;
2603 const char *str;
2604 int rangeLen;
2605 int bytelen;
2607 str = Jim_GetString(strObjPtr, &bytelen);
2609 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2610 return NULL;
2613 if (first == 0 && rangeLen == bytelen) {
2614 return strObjPtr;
2616 return Jim_NewStringObj(interp, str + first, rangeLen);
2619 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2620 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2622 #ifdef JIM_UTF8
2623 int first, last;
2624 const char *str;
2625 int len, rangeLen;
2626 int bytelen;
2628 str = Jim_GetString(strObjPtr, &bytelen);
2629 len = Jim_Utf8Length(interp, strObjPtr);
2631 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2632 return NULL;
2635 if (first == 0 && rangeLen == len) {
2636 return strObjPtr;
2638 if (len == bytelen) {
2639 /* ASCII optimisation */
2640 return Jim_NewStringObj(interp, str + first, rangeLen);
2642 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2643 #else
2644 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2645 #endif
2648 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2649 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2651 int first, last;
2652 const char *str;
2653 int len, rangeLen;
2654 Jim_Obj *objPtr;
2656 len = Jim_Utf8Length(interp, strObjPtr);
2658 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2659 return NULL;
2662 if (last < first) {
2663 return strObjPtr;
2666 str = Jim_String(strObjPtr);
2668 /* Before part */
2669 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2671 /* Replacement */
2672 if (newStrObj) {
2673 Jim_AppendObj(interp, objPtr, newStrObj);
2676 /* After part */
2677 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2679 return objPtr;
2683 * Note: does not support embedded nulls.
2685 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2687 while (*str) {
2688 int c;
2689 str += utf8_tounicode(str, &c);
2690 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2692 *dest = 0;
2696 * Note: does not support embedded nulls.
2698 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2700 char *buf;
2701 int len;
2702 const char *str;
2704 str = Jim_GetString(strObjPtr, &len);
2706 #ifdef JIM_UTF8
2707 /* Case mapping can change the utf-8 length of the string.
2708 * But at worst it will be by one extra byte per char
2710 len *= 2;
2711 #endif
2712 buf = Jim_Alloc(len + 1);
2713 JimStrCopyUpperLower(buf, str, 0);
2714 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2718 * Note: does not support embedded nulls.
2720 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2722 char *buf;
2723 const char *str;
2724 int len;
2726 str = Jim_GetString(strObjPtr, &len);
2728 #ifdef JIM_UTF8
2729 /* Case mapping can change the utf-8 length of the string.
2730 * But at worst it will be by one extra byte per char
2732 len *= 2;
2733 #endif
2734 buf = Jim_Alloc(len + 1);
2735 JimStrCopyUpperLower(buf, str, 1);
2736 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2740 * Note: does not support embedded nulls.
2742 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2744 char *buf, *p;
2745 int len;
2746 int c;
2747 const char *str;
2749 str = Jim_GetString(strObjPtr, &len);
2751 #ifdef JIM_UTF8
2752 /* Case mapping can change the utf-8 length of the string.
2753 * But at worst it will be by one extra byte per char
2755 len *= 2;
2756 #endif
2757 buf = p = Jim_Alloc(len + 1);
2759 str += utf8_tounicode(str, &c);
2760 p += utf8_getchars(p, utf8_title(c));
2762 JimStrCopyUpperLower(p, str, 0);
2764 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2767 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2768 * for unicode character 'c'.
2769 * Returns the position if found or NULL if not
2771 static const char *utf8_memchr(const char *str, int len, int c)
2773 #ifdef JIM_UTF8
2774 while (len) {
2775 int sc;
2776 int n = utf8_tounicode(str, &sc);
2777 if (sc == c) {
2778 return str;
2780 str += n;
2781 len -= n;
2783 return NULL;
2784 #else
2785 return memchr(str, c, len);
2786 #endif
2790 * Searches for the first non-trim char in string (str, len)
2792 * If none is found, returns just past the last char.
2794 * Lengths are in bytes.
2796 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2798 while (len) {
2799 int c;
2800 int n = utf8_tounicode(str, &c);
2802 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2803 /* Not a trim char, so stop */
2804 break;
2806 str += n;
2807 len -= n;
2809 return str;
2813 * Searches backwards for a non-trim char in string (str, len).
2815 * Returns a pointer to just after the non-trim char, or NULL if not found.
2817 * Lengths are in bytes.
2819 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2821 str += len;
2823 while (len) {
2824 int c;
2825 int n = utf8_prev_len(str, len);
2827 len -= n;
2828 str -= n;
2830 n = utf8_tounicode(str, &c);
2832 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2833 return str + n;
2837 return NULL;
2840 static const char default_trim_chars[] = " \t\n\r";
2841 /* sizeof() here includes the null byte */
2842 static int default_trim_chars_len = sizeof(default_trim_chars);
2844 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2846 int len;
2847 const char *str = Jim_GetString(strObjPtr, &len);
2848 const char *trimchars = default_trim_chars;
2849 int trimcharslen = default_trim_chars_len;
2850 const char *newstr;
2852 if (trimcharsObjPtr) {
2853 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2856 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2857 if (newstr == str) {
2858 return strObjPtr;
2861 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2864 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2866 int len;
2867 const char *trimchars = default_trim_chars;
2868 int trimcharslen = default_trim_chars_len;
2869 const char *nontrim;
2871 if (trimcharsObjPtr) {
2872 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2875 SetStringFromAny(interp, strObjPtr);
2877 len = Jim_Length(strObjPtr);
2878 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2880 if (nontrim == NULL) {
2881 /* All trim, so return a zero-length string */
2882 return Jim_NewEmptyStringObj(interp);
2884 if (nontrim == strObjPtr->bytes + len) {
2885 /* All non-trim, so return the original object */
2886 return strObjPtr;
2889 if (Jim_IsShared(strObjPtr)) {
2890 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2892 else {
2893 /* Can modify this string in place */
2894 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2895 strObjPtr->length = (nontrim - strObjPtr->bytes);
2898 return strObjPtr;
2901 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2903 /* First trim left. */
2904 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2906 /* Now trim right */
2907 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2909 /* Note: refCount check is needed since objPtr may be emptyObj */
2910 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2911 /* We don't want this object to be leaked */
2912 Jim_FreeNewObj(interp, objPtr);
2915 return strObjPtr;
2918 /* Some platforms don't have isascii - need a non-macro version */
2919 #ifdef HAVE_ISASCII
2920 #define jim_isascii isascii
2921 #else
2922 static int jim_isascii(int c)
2924 return !(c & ~0x7f);
2926 #endif
2928 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2930 static const char * const strclassnames[] = {
2931 "integer", "alpha", "alnum", "ascii", "digit",
2932 "double", "lower", "upper", "space", "xdigit",
2933 "control", "print", "graph", "punct", "boolean",
2934 NULL
2936 enum {
2937 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2938 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2939 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2941 int strclass;
2942 int len;
2943 int i;
2944 const char *str;
2945 int (*isclassfunc)(int c) = NULL;
2947 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2948 return JIM_ERR;
2951 str = Jim_GetString(strObjPtr, &len);
2952 if (len == 0) {
2953 Jim_SetResultBool(interp, !strict);
2954 return JIM_OK;
2957 switch (strclass) {
2958 case STR_IS_INTEGER:
2960 jim_wide w;
2961 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2962 return JIM_OK;
2965 case STR_IS_DOUBLE:
2967 double d;
2968 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
2969 return JIM_OK;
2972 case STR_IS_BOOLEAN:
2974 int b;
2975 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
2976 return JIM_OK;
2979 case STR_IS_ALPHA: isclassfunc = isalpha; break;
2980 case STR_IS_ALNUM: isclassfunc = isalnum; break;
2981 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
2982 case STR_IS_DIGIT: isclassfunc = isdigit; break;
2983 case STR_IS_LOWER: isclassfunc = islower; break;
2984 case STR_IS_UPPER: isclassfunc = isupper; break;
2985 case STR_IS_SPACE: isclassfunc = isspace; break;
2986 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
2987 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
2988 case STR_IS_PRINT: isclassfunc = isprint; break;
2989 case STR_IS_GRAPH: isclassfunc = isgraph; break;
2990 case STR_IS_PUNCT: isclassfunc = ispunct; break;
2991 default:
2992 return JIM_ERR;
2995 for (i = 0; i < len; i++) {
2996 if (!isclassfunc(UCHAR(str[i]))) {
2997 Jim_SetResultBool(interp, 0);
2998 return JIM_OK;
3001 Jim_SetResultBool(interp, 1);
3002 return JIM_OK;
3005 /* -----------------------------------------------------------------------------
3006 * Compared String Object
3007 * ---------------------------------------------------------------------------*/
3009 /* This is strange object that allows comparison of a C literal string
3010 * with a Jim object in a very short time if the same comparison is done
3011 * multiple times. For example every time the [if] command is executed,
3012 * Jim has to check if a given argument is "else".
3013 * If the code has no errors, this comparison is true most of the time,
3014 * so we can cache the pointer of the string of the last matching
3015 * comparison inside the object. Because most C compilers perform literal sharing,
3016 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3017 * this works pretty well even if comparisons are at different places
3018 * inside the C code. */
3020 static const Jim_ObjType comparedStringObjType = {
3021 "compared-string",
3022 NULL,
3023 NULL,
3024 NULL,
3025 JIM_TYPE_REFERENCES,
3028 /* The only way this object is exposed to the API is via the following
3029 * function. Returns true if the string and the object string repr.
3030 * are the same, otherwise zero is returned.
3032 * Note: this isn't binary safe, but it hardly needs to be.*/
3033 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3035 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3036 return 1;
3038 else {
3039 if (strcmp(str, Jim_String(objPtr)) != 0)
3040 return 0;
3042 if (objPtr->typePtr != &comparedStringObjType) {
3043 Jim_FreeIntRep(interp, objPtr);
3044 objPtr->typePtr = &comparedStringObjType;
3046 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3047 return 1;
3051 static int qsortCompareStringPointers(const void *a, const void *b)
3053 char *const *sa = (char *const *)a;
3054 char *const *sb = (char *const *)b;
3056 return strcmp(*sa, *sb);
3060 /* -----------------------------------------------------------------------------
3061 * Source Object
3063 * This object is just a string from the language point of view, but
3064 * the internal representation contains the filename and line number
3065 * where this token was read. This information is used by
3066 * Jim_EvalObj() if the object passed happens to be of type "source".
3068 * This allows propagation of the information about line numbers and file
3069 * names and gives error messages with absolute line numbers.
3071 * Note that this object uses the internal representation of the Jim_Object,
3072 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3074 * Also the object will be converted to something else if the given
3075 * token it represents in the source file is not something to be
3076 * evaluated (not a script), and will be specialized in some other way,
3077 * so the time overhead is also almost zero.
3078 * ---------------------------------------------------------------------------*/
3080 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3081 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3083 static const Jim_ObjType sourceObjType = {
3084 "source",
3085 FreeSourceInternalRep,
3086 DupSourceInternalRep,
3087 NULL,
3088 JIM_TYPE_REFERENCES,
3091 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3093 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3096 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3098 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3099 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3102 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3103 Jim_Obj *fileNameObj, int lineNumber)
3105 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3106 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3107 Jim_IncrRefCount(fileNameObj);
3108 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3109 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3110 objPtr->typePtr = &sourceObjType;
3113 /* -----------------------------------------------------------------------------
3114 * ScriptLine Object
3116 * This object is used only in the Script internal represenation.
3117 * For each line of the script, it holds the number of tokens on the line
3118 * and the source line number.
3120 static const Jim_ObjType scriptLineObjType = {
3121 "scriptline",
3122 NULL,
3123 NULL,
3124 NULL,
3125 JIM_NONE,
3128 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3130 Jim_Obj *objPtr;
3132 #ifdef DEBUG_SHOW_SCRIPT
3133 char buf[100];
3134 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3135 objPtr = Jim_NewStringObj(interp, buf, -1);
3136 #else
3137 objPtr = Jim_NewEmptyStringObj(interp);
3138 #endif
3139 objPtr->typePtr = &scriptLineObjType;
3140 objPtr->internalRep.scriptLineValue.argc = argc;
3141 objPtr->internalRep.scriptLineValue.line = line;
3143 return objPtr;
3146 /* -----------------------------------------------------------------------------
3147 * Script Object
3149 * This object holds the parsed internal representation of a script.
3150 * This representation is help within an allocated ScriptObj (see below)
3152 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3153 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3155 static const Jim_ObjType scriptObjType = {
3156 "script",
3157 FreeScriptInternalRep,
3158 DupScriptInternalRep,
3159 NULL,
3160 JIM_TYPE_REFERENCES,
3163 /* Each token of a script is represented by a ScriptToken.
3164 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3165 * can be specialized by commands operating on it.
3167 typedef struct ScriptToken
3169 Jim_Obj *objPtr;
3170 int type;
3171 } ScriptToken;
3173 /* This is the script object internal representation. An array of
3174 * ScriptToken structures, including a pre-computed representation of the
3175 * command length and arguments.
3177 * For example the script:
3179 * puts hello
3180 * set $i $x$y [foo]BAR
3182 * will produce a ScriptObj with the following ScriptToken's:
3184 * LIN 2
3185 * ESC puts
3186 * ESC hello
3187 * LIN 4
3188 * ESC set
3189 * VAR i
3190 * WRD 2
3191 * VAR x
3192 * VAR y
3193 * WRD 2
3194 * CMD foo
3195 * ESC BAR
3197 * "puts hello" has two args (LIN 2), composed of single tokens.
3198 * (Note that the WRD token is omitted for the common case of a single token.)
3200 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3201 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3203 * The precomputation of the command structure makes Jim_Eval() faster,
3204 * and simpler because there aren't dynamic lengths / allocations.
3206 * -- {expand}/{*} handling --
3208 * Expand is handled in a special way.
3210 * If a "word" begins with {*}, the word token count is -ve.
3212 * For example the command:
3214 * list {*}{a b}
3216 * Will produce the following cmdstruct array:
3218 * LIN 2
3219 * ESC list
3220 * WRD -1
3221 * STR a b
3223 * Note that the 'LIN' token also contains the source information for the
3224 * first word of the line for error reporting purposes
3226 * -- the substFlags field of the structure --
3228 * The scriptObj structure is used to represent both "script" objects
3229 * and "subst" objects. In the second case, there are no LIN and WRD
3230 * tokens. Instead SEP and EOL tokens are added as-is.
3231 * In addition, the field 'substFlags' is used to represent the flags used to turn
3232 * the string into the internal representation.
3233 * If these flags do not match what the application requires,
3234 * the scriptObj is created again. For example the script:
3236 * subst -nocommands $string
3237 * subst -novariables $string
3239 * Will (re)create the internal representation of the $string object
3240 * two times.
3242 typedef struct ScriptObj
3244 ScriptToken *token; /* Tokens array. */
3245 Jim_Obj *fileNameObj; /* Filename */
3246 int len; /* Length of token[] */
3247 int substFlags; /* flags used for the compilation of "subst" objects */
3248 int inUse; /* Used to share a ScriptObj. Currently
3249 only used by Jim_EvalObj() as protection against
3250 shimmering of the currently evaluated object. */
3251 int firstline; /* Line number of the first line */
3252 int linenr; /* Error line number, if any */
3253 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3254 } ScriptObj;
3256 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3257 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3258 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3260 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3262 int i;
3263 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3265 if (--script->inUse != 0)
3266 return;
3267 for (i = 0; i < script->len; i++) {
3268 Jim_DecrRefCount(interp, script->token[i].objPtr);
3270 Jim_Free(script->token);
3271 Jim_DecrRefCount(interp, script->fileNameObj);
3272 Jim_Free(script);
3275 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3277 JIM_NOTUSED(interp);
3278 JIM_NOTUSED(srcPtr);
3280 /* Just return a simple string. We don't try to preserve the source info
3281 * since in practice scripts are never duplicated
3283 dupPtr->typePtr = NULL;
3286 /* A simple parse token.
3287 * As the script is parsed, the created tokens point into the script string rep.
3289 typedef struct
3291 const char *token; /* Pointer to the start of the token */
3292 int len; /* Length of this token */
3293 int type; /* Token type */
3294 int line; /* Line number */
3295 } ParseToken;
3297 /* A list of parsed tokens representing a script.
3298 * Tokens are added to this list as the script is parsed.
3299 * It grows as needed.
3301 typedef struct
3303 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3304 ParseToken *list; /* Array of tokens */
3305 int size; /* Current size of the list */
3306 int count; /* Number of entries used */
3307 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3308 } ParseTokenList;
3310 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3312 tokenlist->list = tokenlist->static_list;
3313 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3314 tokenlist->count = 0;
3317 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3319 if (tokenlist->list != tokenlist->static_list) {
3320 Jim_Free(tokenlist->list);
3325 * Adds the new token to the tokenlist.
3326 * The token has the given length, type and line number.
3327 * The token list is resized as necessary.
3329 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3330 int line)
3332 ParseToken *t;
3334 if (tokenlist->count == tokenlist->size) {
3335 /* Resize the list */
3336 tokenlist->size *= 2;
3337 if (tokenlist->list != tokenlist->static_list) {
3338 tokenlist->list =
3339 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3341 else {
3342 /* The list needs to become allocated */
3343 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3344 memcpy(tokenlist->list, tokenlist->static_list,
3345 tokenlist->count * sizeof(*tokenlist->list));
3348 t = &tokenlist->list[tokenlist->count++];
3349 t->token = token;
3350 t->len = len;
3351 t->type = type;
3352 t->line = line;
3355 /* Counts the number of adjoining non-separator tokens.
3357 * Returns -ve if the first token is the expansion
3358 * operator (in which case the count doesn't include
3359 * that token).
3361 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3363 int expand = 1;
3364 int count = 0;
3366 /* Is the first word {*} or {expand}? */
3367 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3368 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3369 /* Create an expand token */
3370 expand = -1;
3371 t++;
3373 else {
3374 if (script->missing == ' ') {
3375 /* This is a "extra characters after close-brace" error. Report the first error */
3376 script->missing = '}';
3377 script->linenr = t[1].line;
3382 /* Now count non-separator words */
3383 while (!TOKEN_IS_SEP(t->type)) {
3384 t++;
3385 count++;
3388 return count * expand;
3392 * Create a script/subst object from the given token.
3394 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3396 Jim_Obj *objPtr;
3398 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3399 /* Convert backlash escapes. The result will never be longer than the original */
3400 int len = t->len;
3401 char *str = Jim_Alloc(len + 1);
3402 len = JimEscape(str, t->token, len);
3403 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3405 else {
3406 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3407 * with a single space.
3409 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3411 return objPtr;
3415 * Takes a tokenlist and creates the allocated list of script tokens
3416 * in script->token, of length script->len.
3418 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3419 * as required.
3421 * Also sets script->line to the line number of the first token
3423 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3424 ParseTokenList *tokenlist)
3426 int i;
3427 struct ScriptToken *token;
3428 /* Number of tokens so far for the current command */
3429 int lineargs = 0;
3430 /* This is the first token for the current command */
3431 ScriptToken *linefirst;
3432 int count;
3433 int linenr;
3435 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3436 printf("==== Tokens ====\n");
3437 for (i = 0; i < tokenlist->count; i++) {
3438 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3439 tokenlist->list[i].len, tokenlist->list[i].token);
3441 #endif
3443 /* May need up to one extra script token for each EOL in the worst case */
3444 count = tokenlist->count;
3445 for (i = 0; i < tokenlist->count; i++) {
3446 if (tokenlist->list[i].type == JIM_TT_EOL) {
3447 count++;
3450 linenr = script->firstline = tokenlist->list[0].line;
3452 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3454 /* This is the first token for the current command */
3455 linefirst = token++;
3457 for (i = 0; i < tokenlist->count; ) {
3458 /* Look ahead to find out how many tokens make up the next word */
3459 int wordtokens;
3461 /* Skip any leading separators */
3462 while (tokenlist->list[i].type == JIM_TT_SEP) {
3463 i++;
3466 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3468 if (wordtokens == 0) {
3469 /* None, so at end of line */
3470 if (lineargs) {
3471 linefirst->type = JIM_TT_LINE;
3472 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3473 Jim_IncrRefCount(linefirst->objPtr);
3475 /* Reset for new line */
3476 lineargs = 0;
3477 linefirst = token++;
3479 i++;
3480 continue;
3482 else if (wordtokens != 1) {
3483 /* More than 1, or {*}, so insert a WORD token */
3484 token->type = JIM_TT_WORD;
3485 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3486 Jim_IncrRefCount(token->objPtr);
3487 token++;
3488 if (wordtokens < 0) {
3489 /* Skip the expand token */
3490 i++;
3491 wordtokens = -wordtokens - 1;
3492 lineargs--;
3496 if (lineargs == 0) {
3497 /* First real token on the line, so record the line number */
3498 linenr = tokenlist->list[i].line;
3500 lineargs++;
3502 /* Add each non-separator word token to the line */
3503 while (wordtokens--) {
3504 const ParseToken *t = &tokenlist->list[i++];
3506 token->type = t->type;
3507 token->objPtr = JimMakeScriptObj(interp, t);
3508 Jim_IncrRefCount(token->objPtr);
3510 /* Every object is initially a string of type 'source', but the
3511 * internal type may be specialized during execution of the
3512 * script. */
3513 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3514 token++;
3518 if (lineargs == 0) {
3519 token--;
3522 script->len = token - script->token;
3524 JimPanic((script->len >= count, "allocated script array is too short"));
3526 #ifdef DEBUG_SHOW_SCRIPT
3527 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3528 for (i = 0; i < script->len; i++) {
3529 const ScriptToken *t = &script->token[i];
3530 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3532 #endif
3536 /* Parses the given string object to determine if it represents a complete script.
3538 * This is useful for interactive shells implementation, for [info complete].
3540 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3541 * '{' on scripts incomplete missing one or more '}' to be balanced.
3542 * '[' on scripts incomplete missing one or more ']' to be balanced.
3543 * '"' on scripts incomplete missing a '"' char.
3544 * '\\' on scripts with a trailing backslash.
3546 * If the script is complete, 1 is returned, otherwise 0.
3548 * If the script has extra characters after a close brace, this still returns 1,
3549 * but sets *stateCharPtr to '}'
3550 * Evaluating the script will give the error "extra characters after close-brace".
3552 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3554 ScriptObj *script = JimGetScript(interp, scriptObj);
3555 if (stateCharPtr) {
3556 *stateCharPtr = script->missing;
3558 return script->missing == ' ' || script->missing == '}';
3562 * Sets an appropriate error message for a missing script/expression terminator.
3564 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3566 * Note that a trailing backslash is not considered to be an error.
3568 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3570 const char *msg;
3572 switch (ch) {
3573 case '\\':
3574 case ' ':
3575 return JIM_OK;
3577 case '[':
3578 msg = "unmatched \"[\"";
3579 break;
3580 case '{':
3581 msg = "missing close-brace";
3582 break;
3583 case '}':
3584 msg = "extra characters after close-brace";
3585 break;
3586 case '"':
3587 default:
3588 msg = "missing quote";
3589 break;
3592 Jim_SetResultString(interp, msg, -1);
3593 return JIM_ERR;
3597 * Similar to ScriptObjAddTokens(), but for subst objects.
3599 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3600 ParseTokenList *tokenlist)
3602 int i;
3603 struct ScriptToken *token;
3605 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3607 for (i = 0; i < tokenlist->count; i++) {
3608 const ParseToken *t = &tokenlist->list[i];
3610 /* Create a token for 't' */
3611 token->type = t->type;
3612 token->objPtr = JimMakeScriptObj(interp, t);
3613 Jim_IncrRefCount(token->objPtr);
3614 token++;
3617 script->len = i;
3620 /* This method takes the string representation of an object
3621 * as a Tcl script, and generates the pre-parsed internal representation
3622 * of the script.
3624 * On parse error, sets an error message and returns JIM_ERR
3625 * (Note: the object is still converted to a script, even if an error occurs)
3627 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3629 int scriptTextLen;
3630 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3631 struct JimParserCtx parser;
3632 struct ScriptObj *script;
3633 ParseTokenList tokenlist;
3634 int line = 1;
3636 /* Try to get information about filename / line number */
3637 if (objPtr->typePtr == &sourceObjType) {
3638 line = objPtr->internalRep.sourceValue.lineNumber;
3641 /* Initially parse the script into tokens (in tokenlist) */
3642 ScriptTokenListInit(&tokenlist);
3644 JimParserInit(&parser, scriptText, scriptTextLen, line);
3645 while (!parser.eof) {
3646 JimParseScript(&parser);
3647 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3648 parser.tline);
3651 /* Add a final EOF token */
3652 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3654 /* Create the "real" script tokens from the parsed tokens */
3655 script = Jim_Alloc(sizeof(*script));
3656 memset(script, 0, sizeof(*script));
3657 script->inUse = 1;
3658 if (objPtr->typePtr == &sourceObjType) {
3659 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3661 else {
3662 script->fileNameObj = interp->emptyObj;
3664 Jim_IncrRefCount(script->fileNameObj);
3665 script->missing = parser.missing.ch;
3666 script->linenr = parser.missing.line;
3668 ScriptObjAddTokens(interp, script, &tokenlist);
3670 /* No longer need the token list */
3671 ScriptTokenListFree(&tokenlist);
3673 /* Free the old internal rep and set the new one. */
3674 Jim_FreeIntRep(interp, objPtr);
3675 Jim_SetIntRepPtr(objPtr, script);
3676 objPtr->typePtr = &scriptObjType;
3679 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3682 * Returns the parsed script.
3683 * Note that if there is any possibility that the script is not valid,
3684 * call JimScriptValid() to check
3686 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3688 if (objPtr == interp->emptyObj) {
3689 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3690 objPtr = interp->nullScriptObj;
3693 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3694 JimSetScriptFromAny(interp, objPtr);
3697 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3701 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3702 * and leaves an error message in the interp result.
3705 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3707 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3708 JimAddErrorToStack(interp, script);
3709 return 0;
3711 return 1;
3715 /* -----------------------------------------------------------------------------
3716 * Commands
3717 * ---------------------------------------------------------------------------*/
3718 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3720 cmdPtr->inUse++;
3723 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3725 if (--cmdPtr->inUse == 0) {
3726 if (cmdPtr->isproc) {
3727 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3728 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3729 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3730 if (cmdPtr->u.proc.staticVars) {
3731 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3732 Jim_Free(cmdPtr->u.proc.staticVars);
3735 else {
3736 /* native (C) */
3737 if (cmdPtr->u.native.delProc) {
3738 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3741 if (cmdPtr->prevCmd) {
3742 /* Delete any pushed command too */
3743 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3745 Jim_Free(cmdPtr);
3749 /* Variables HashTable Type.
3751 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3753 static void JimVariablesHTValDestructor(void *interp, void *val)
3755 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3756 Jim_Free(val);
3759 static const Jim_HashTableType JimVariablesHashTableType = {
3760 JimStringCopyHTHashFunction, /* hash function */
3761 JimStringCopyHTDup, /* key dup */
3762 NULL, /* val dup */
3763 JimStringCopyHTKeyCompare, /* key compare */
3764 JimStringCopyHTKeyDestructor, /* key destructor */
3765 JimVariablesHTValDestructor /* val destructor */
3768 /* Commands HashTable Type.
3770 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3772 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3774 JimDecrCmdRefCount(interp, val);
3777 static const Jim_HashTableType JimCommandsHashTableType = {
3778 JimStringCopyHTHashFunction, /* hash function */
3779 JimStringCopyHTDup, /* key dup */
3780 NULL, /* val dup */
3781 JimStringCopyHTKeyCompare, /* key compare */
3782 JimStringCopyHTKeyDestructor, /* key destructor */
3783 JimCommandsHT_ValDestructor /* val destructor */
3786 /* ------------------------- Commands related functions --------------------- */
3788 #ifdef jim_ext_namespace
3790 * Returns the "unscoped" version of the given namespace.
3791 * That is, the fully qualified name without the leading ::
3792 * The returned value is either nsObj, or an object with a zero ref count.
3794 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3796 const char *name = Jim_String(nsObj);
3797 if (name[0] == ':' && name[1] == ':') {
3798 /* This command is being defined in the global namespace */
3799 while (*++name == ':') {
3801 nsObj = Jim_NewStringObj(interp, name, -1);
3803 else if (Jim_Length(interp->framePtr->nsObj)) {
3804 /* This command is being defined in a non-global namespace */
3805 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3806 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3808 return nsObj;
3812 * If nameObjPtr starts with "::", returns it.
3813 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3814 * In this case, decrements the ref count of nameObjPtr.
3816 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3818 Jim_Obj *resultObj;
3820 const char *name = Jim_String(nameObjPtr);
3821 if (name[0] == ':' && name[1] == ':') {
3822 return nameObjPtr;
3824 Jim_IncrRefCount(nameObjPtr);
3825 resultObj = Jim_NewStringObj(interp, "::", -1);
3826 Jim_AppendObj(interp, resultObj, nameObjPtr);
3827 Jim_DecrRefCount(interp, nameObjPtr);
3829 return resultObj;
3833 * An efficient version of JimQualifyNameObj() where the name is
3834 * available (and needed) as a 'const char *'.
3835 * Avoids creating an object if not necessary.
3836 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3838 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3840 Jim_Obj *objPtr = interp->emptyObj;
3842 if (name[0] == ':' && name[1] == ':') {
3843 /* This command is being defined in the global namespace */
3844 while (*++name == ':') {
3847 else if (Jim_Length(interp->framePtr->nsObj)) {
3848 /* This command is being defined in a non-global namespace */
3849 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3850 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3851 name = Jim_String(objPtr);
3853 Jim_IncrRefCount(objPtr);
3854 *objPtrPtr = objPtr;
3855 return name;
3858 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3860 #else
3861 /* We can be more efficient in the no-namespace case */
3862 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3863 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3865 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3867 return nameObjPtr;
3869 #endif
3871 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3873 /* It may already exist, so we try to delete the old one.
3874 * Note that reference count means that it won't be deleted yet if
3875 * it exists in the call stack.
3877 * BUT, if 'local' is in force, instead of deleting the existing
3878 * proc, we stash a reference to the old proc here.
3880 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3881 if (he) {
3882 /* There was an old cmd with the same name,
3883 * so this requires a 'proc epoch' update. */
3885 /* If a procedure with the same name didn't exist there is no need
3886 * to increment the 'proc epoch' because creation of a new procedure
3887 * can never affect existing cached commands. We don't do
3888 * negative caching. */
3889 Jim_InterpIncrProcEpoch(interp);
3892 if (he && interp->local) {
3893 /* Push this command over the top of the previous one */
3894 cmd->prevCmd = Jim_GetHashEntryVal(he);
3895 Jim_SetHashVal(&interp->commands, he, cmd);
3897 else {
3898 if (he) {
3899 /* Replace the existing command */
3900 Jim_DeleteHashEntry(&interp->commands, name);
3903 Jim_AddHashEntry(&interp->commands, name, cmd);
3905 return JIM_OK;
3909 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3910 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3912 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3914 /* Store the new details for this command */
3915 memset(cmdPtr, 0, sizeof(*cmdPtr));
3916 cmdPtr->inUse = 1;
3917 cmdPtr->u.native.delProc = delProc;
3918 cmdPtr->u.native.cmdProc = cmdProc;
3919 cmdPtr->u.native.privData = privData;
3921 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3923 return JIM_OK;
3926 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3928 int len, i;
3930 len = Jim_ListLength(interp, staticsListObjPtr);
3931 if (len == 0) {
3932 return JIM_OK;
3935 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3936 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3937 for (i = 0; i < len; i++) {
3938 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3939 Jim_Var *varPtr;
3940 int subLen;
3942 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3943 /* Check if it's composed of two elements. */
3944 subLen = Jim_ListLength(interp, objPtr);
3945 if (subLen == 1 || subLen == 2) {
3946 /* Try to get the variable value from the current
3947 * environment. */
3948 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3949 if (subLen == 1) {
3950 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3951 if (initObjPtr == NULL) {
3952 Jim_SetResultFormatted(interp,
3953 "variable for initialization of static \"%#s\" not found in the local context",
3954 nameObjPtr);
3955 return JIM_ERR;
3958 else {
3959 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3961 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3962 return JIM_ERR;
3965 varPtr = Jim_Alloc(sizeof(*varPtr));
3966 varPtr->objPtr = initObjPtr;
3967 Jim_IncrRefCount(initObjPtr);
3968 varPtr->linkFramePtr = NULL;
3969 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3970 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3971 Jim_SetResultFormatted(interp,
3972 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3973 Jim_DecrRefCount(interp, initObjPtr);
3974 Jim_Free(varPtr);
3975 return JIM_ERR;
3978 else {
3979 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3980 objPtr);
3981 return JIM_ERR;
3984 return JIM_OK;
3988 * If the command is a proc, sets/updates the cached namespace (nsObj)
3989 * based on the command name.
3991 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3993 #ifdef jim_ext_namespace
3994 if (cmdPtr->isproc) {
3995 /* XXX: Really need JimNamespaceSplit() */
3996 const char *pt = strrchr(cmdname, ':');
3997 if (pt && pt != cmdname && pt[-1] == ':') {
3998 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3999 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4000 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4002 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4003 /* This command shadows a global command, so a proc epoch update is required */
4004 Jim_InterpIncrProcEpoch(interp);
4008 #endif
4011 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4012 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4014 Jim_Cmd *cmdPtr;
4015 int argListLen;
4016 int i;
4018 argListLen = Jim_ListLength(interp, argListObjPtr);
4020 /* Allocate space for both the command pointer and the arg list */
4021 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4022 memset(cmdPtr, 0, sizeof(*cmdPtr));
4023 cmdPtr->inUse = 1;
4024 cmdPtr->isproc = 1;
4025 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4026 cmdPtr->u.proc.argListLen = argListLen;
4027 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4028 cmdPtr->u.proc.argsPos = -1;
4029 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4030 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4031 Jim_IncrRefCount(argListObjPtr);
4032 Jim_IncrRefCount(bodyObjPtr);
4033 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4035 /* Create the statics hash table. */
4036 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4037 goto err;
4040 /* Parse the args out into arglist, validating as we go */
4041 /* Examine the argument list for default parameters and 'args' */
4042 for (i = 0; i < argListLen; i++) {
4043 Jim_Obj *argPtr;
4044 Jim_Obj *nameObjPtr;
4045 Jim_Obj *defaultObjPtr;
4046 int len;
4048 /* Examine a parameter */
4049 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4050 len = Jim_ListLength(interp, argPtr);
4051 if (len == 0) {
4052 Jim_SetResultString(interp, "argument with no name", -1);
4053 err:
4054 JimDecrCmdRefCount(interp, cmdPtr);
4055 return NULL;
4057 if (len > 2) {
4058 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4059 goto err;
4062 if (len == 2) {
4063 /* Optional parameter */
4064 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4065 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4067 else {
4068 /* Required parameter */
4069 nameObjPtr = argPtr;
4070 defaultObjPtr = NULL;
4074 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4075 if (cmdPtr->u.proc.argsPos >= 0) {
4076 Jim_SetResultString(interp, "'args' specified more than once", -1);
4077 goto err;
4079 cmdPtr->u.proc.argsPos = i;
4081 else {
4082 if (len == 2) {
4083 cmdPtr->u.proc.optArity++;
4085 else {
4086 cmdPtr->u.proc.reqArity++;
4090 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4091 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4094 return cmdPtr;
4097 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4099 int ret = JIM_OK;
4100 Jim_Obj *qualifiedNameObj;
4101 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4103 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4104 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4105 ret = JIM_ERR;
4107 else {
4108 Jim_InterpIncrProcEpoch(interp);
4111 JimFreeQualifiedName(interp, qualifiedNameObj);
4113 return ret;
4116 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4118 int ret = JIM_ERR;
4119 Jim_HashEntry *he;
4120 Jim_Cmd *cmdPtr;
4121 Jim_Obj *qualifiedOldNameObj;
4122 Jim_Obj *qualifiedNewNameObj;
4123 const char *fqold;
4124 const char *fqnew;
4126 if (newName[0] == 0) {
4127 return Jim_DeleteCommand(interp, oldName);
4130 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4131 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4133 /* Does it exist? */
4134 he = Jim_FindHashEntry(&interp->commands, fqold);
4135 if (he == NULL) {
4136 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4138 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4139 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4141 else {
4142 /* Add the new name first */
4143 cmdPtr = Jim_GetHashEntryVal(he);
4144 JimIncrCmdRefCount(cmdPtr);
4145 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4146 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4148 /* Now remove the old name */
4149 Jim_DeleteHashEntry(&interp->commands, fqold);
4151 /* Increment the epoch */
4152 Jim_InterpIncrProcEpoch(interp);
4154 ret = JIM_OK;
4157 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4158 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4160 return ret;
4163 /* -----------------------------------------------------------------------------
4164 * Command object
4165 * ---------------------------------------------------------------------------*/
4167 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4169 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4172 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4174 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4175 dupPtr->typePtr = srcPtr->typePtr;
4176 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4179 static const Jim_ObjType commandObjType = {
4180 "command",
4181 FreeCommandInternalRep,
4182 DupCommandInternalRep,
4183 NULL,
4184 JIM_TYPE_REFERENCES,
4187 /* This function returns the command structure for the command name
4188 * stored in objPtr. It specializes the objPtr to contain
4189 * cached info instead of performing the lookup into the hash table
4190 * every time. The information cached may not be up-to-date, in this
4191 * case the lookup is performed and the cache updated.
4193 * Respects the 'upcall' setting.
4195 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4197 Jim_Cmd *cmd;
4199 /* In order to be valid, the proc epoch must match and
4200 * the lookup must have occurred in the same namespace
4202 if (objPtr->typePtr != &commandObjType ||
4203 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4204 #ifdef jim_ext_namespace
4205 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4206 #endif
4208 /* Not cached or out of date, so lookup */
4210 /* Do we need to try the local namespace? */
4211 const char *name = Jim_String(objPtr);
4212 Jim_HashEntry *he;
4214 if (name[0] == ':' && name[1] == ':') {
4215 while (*++name == ':') {
4218 #ifdef jim_ext_namespace
4219 else if (Jim_Length(interp->framePtr->nsObj)) {
4220 /* This command is being defined in a non-global namespace */
4221 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4222 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4223 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4224 Jim_FreeNewObj(interp, nameObj);
4225 if (he) {
4226 goto found;
4229 #endif
4231 /* Lookup in the global namespace */
4232 he = Jim_FindHashEntry(&interp->commands, name);
4233 if (he == NULL) {
4234 if (flags & JIM_ERRMSG) {
4235 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4237 return NULL;
4239 #ifdef jim_ext_namespace
4240 found:
4241 #endif
4242 cmd = Jim_GetHashEntryVal(he);
4244 /* Free the old internal rep and set the new one. */
4245 Jim_FreeIntRep(interp, objPtr);
4246 objPtr->typePtr = &commandObjType;
4247 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4248 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4249 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4250 Jim_IncrRefCount(interp->framePtr->nsObj);
4252 else {
4253 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4255 while (cmd->u.proc.upcall) {
4256 cmd = cmd->prevCmd;
4258 return cmd;
4261 /* -----------------------------------------------------------------------------
4262 * Variables
4263 * ---------------------------------------------------------------------------*/
4265 /* -----------------------------------------------------------------------------
4266 * Variable object
4267 * ---------------------------------------------------------------------------*/
4269 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4271 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4273 static const Jim_ObjType variableObjType = {
4274 "variable",
4275 NULL,
4276 NULL,
4277 NULL,
4278 JIM_TYPE_REFERENCES,
4282 * Check that the name does not contain embedded nulls.
4284 * Variable and procedure names are manipulated as null terminated strings, so
4285 * don't allow names with embedded nulls.
4287 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4289 /* Variable names and proc names can't contain embedded nulls */
4290 if (nameObjPtr->typePtr != &variableObjType) {
4291 int len;
4292 const char *str = Jim_GetString(nameObjPtr, &len);
4293 if (memchr(str, '\0', len)) {
4294 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4295 return JIM_ERR;
4298 return JIM_OK;
4301 /* This method should be called only by the variable API.
4302 * It returns JIM_OK on success (variable already exists),
4303 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4304 * a variable name, but syntax glue for [dict] i.e. the last
4305 * character is ')' */
4306 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4308 const char *varName;
4309 Jim_CallFrame *framePtr;
4310 Jim_HashEntry *he;
4311 int global;
4312 int len;
4314 /* Check if the object is already an uptodate variable */
4315 if (objPtr->typePtr == &variableObjType) {
4316 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4317 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4318 /* nothing to do */
4319 return JIM_OK;
4321 /* Need to re-resolve the variable in the updated callframe */
4323 else if (objPtr->typePtr == &dictSubstObjType) {
4324 return JIM_DICT_SUGAR;
4326 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4327 return JIM_ERR;
4331 varName = Jim_GetString(objPtr, &len);
4333 /* Make sure it's not syntax glue to get/set dict. */
4334 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4335 return JIM_DICT_SUGAR;
4338 if (varName[0] == ':' && varName[1] == ':') {
4339 while (*++varName == ':') {
4341 global = 1;
4342 framePtr = interp->topFramePtr;
4344 else {
4345 global = 0;
4346 framePtr = interp->framePtr;
4349 /* Resolve this name in the variables hash table */
4350 he = Jim_FindHashEntry(&framePtr->vars, varName);
4351 if (he == NULL) {
4352 if (!global && framePtr->staticVars) {
4353 /* Try with static vars. */
4354 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4356 if (he == NULL) {
4357 return JIM_ERR;
4361 /* Free the old internal repr and set the new one. */
4362 Jim_FreeIntRep(interp, objPtr);
4363 objPtr->typePtr = &variableObjType;
4364 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4365 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4366 objPtr->internalRep.varValue.global = global;
4367 return JIM_OK;
4370 /* -------------------- Variables related functions ------------------------- */
4371 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4372 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4374 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4376 const char *name;
4377 Jim_CallFrame *framePtr;
4378 int global;
4380 /* New variable to create */
4381 Jim_Var *var = Jim_Alloc(sizeof(*var));
4383 var->objPtr = valObjPtr;
4384 Jim_IncrRefCount(valObjPtr);
4385 var->linkFramePtr = NULL;
4387 name = Jim_String(nameObjPtr);
4388 if (name[0] == ':' && name[1] == ':') {
4389 while (*++name == ':') {
4391 framePtr = interp->topFramePtr;
4392 global = 1;
4394 else {
4395 framePtr = interp->framePtr;
4396 global = 0;
4399 /* Insert the new variable */
4400 Jim_AddHashEntry(&framePtr->vars, name, var);
4402 /* Make the object int rep a variable */
4403 Jim_FreeIntRep(interp, nameObjPtr);
4404 nameObjPtr->typePtr = &variableObjType;
4405 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4406 nameObjPtr->internalRep.varValue.varPtr = var;
4407 nameObjPtr->internalRep.varValue.global = global;
4409 return var;
4412 /* For now that's dummy. Variables lookup should be optimized
4413 * in many ways, with caching of lookups, and possibly with
4414 * a table of pre-allocated vars in every CallFrame for local vars.
4415 * All the caching should also have an 'epoch' mechanism similar
4416 * to the one used by Tcl for procedures lookup caching. */
4419 * Set the variable nameObjPtr to value valObjptr.
4421 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4423 int err;
4424 Jim_Var *var;
4426 switch (SetVariableFromAny(interp, nameObjPtr)) {
4427 case JIM_DICT_SUGAR:
4428 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4430 case JIM_ERR:
4431 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4432 return JIM_ERR;
4434 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4435 break;
4437 case JIM_OK:
4438 var = nameObjPtr->internalRep.varValue.varPtr;
4439 if (var->linkFramePtr == NULL) {
4440 Jim_IncrRefCount(valObjPtr);
4441 Jim_DecrRefCount(interp, var->objPtr);
4442 var->objPtr = valObjPtr;
4444 else { /* Else handle the link */
4445 Jim_CallFrame *savedCallFrame;
4447 savedCallFrame = interp->framePtr;
4448 interp->framePtr = var->linkFramePtr;
4449 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4450 interp->framePtr = savedCallFrame;
4451 if (err != JIM_OK)
4452 return err;
4455 return JIM_OK;
4458 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4460 Jim_Obj *nameObjPtr;
4461 int result;
4463 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4464 Jim_IncrRefCount(nameObjPtr);
4465 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4466 Jim_DecrRefCount(interp, nameObjPtr);
4467 return result;
4470 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4472 Jim_CallFrame *savedFramePtr;
4473 int result;
4475 savedFramePtr = interp->framePtr;
4476 interp->framePtr = interp->topFramePtr;
4477 result = Jim_SetVariableStr(interp, name, objPtr);
4478 interp->framePtr = savedFramePtr;
4479 return result;
4482 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4484 Jim_Obj *valObjPtr;
4485 int result;
4487 valObjPtr = Jim_NewStringObj(interp, val, -1);
4488 Jim_IncrRefCount(valObjPtr);
4489 result = Jim_SetVariableStr(interp, name, valObjPtr);
4490 Jim_DecrRefCount(interp, valObjPtr);
4491 return result;
4494 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4495 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4497 const char *varName;
4498 const char *targetName;
4499 Jim_CallFrame *framePtr;
4500 Jim_Var *varPtr;
4502 /* Check for an existing variable or link */
4503 switch (SetVariableFromAny(interp, nameObjPtr)) {
4504 case JIM_DICT_SUGAR:
4505 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4506 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4507 return JIM_ERR;
4509 case JIM_OK:
4510 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4512 if (varPtr->linkFramePtr == NULL) {
4513 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4514 return JIM_ERR;
4517 /* It exists, but is a link, so first delete the link */
4518 varPtr->linkFramePtr = NULL;
4519 break;
4522 /* Resolve the call frames for both variables */
4523 /* XXX: SetVariableFromAny() already did this! */
4524 varName = Jim_String(nameObjPtr);
4526 if (varName[0] == ':' && varName[1] == ':') {
4527 while (*++varName == ':') {
4529 /* Linking a global var does nothing */
4530 framePtr = interp->topFramePtr;
4532 else {
4533 framePtr = interp->framePtr;
4536 targetName = Jim_String(targetNameObjPtr);
4537 if (targetName[0] == ':' && targetName[1] == ':') {
4538 while (*++targetName == ':') {
4540 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4541 targetCallFrame = interp->topFramePtr;
4543 Jim_IncrRefCount(targetNameObjPtr);
4545 if (framePtr->level < targetCallFrame->level) {
4546 Jim_SetResultFormatted(interp,
4547 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4548 nameObjPtr);
4549 Jim_DecrRefCount(interp, targetNameObjPtr);
4550 return JIM_ERR;
4553 /* Check for cycles. */
4554 if (framePtr == targetCallFrame) {
4555 Jim_Obj *objPtr = targetNameObjPtr;
4557 /* Cycles are only possible with 'uplevel 0' */
4558 while (1) {
4559 if (strcmp(Jim_String(objPtr), varName) == 0) {
4560 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4561 Jim_DecrRefCount(interp, targetNameObjPtr);
4562 return JIM_ERR;
4564 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4565 break;
4566 varPtr = objPtr->internalRep.varValue.varPtr;
4567 if (varPtr->linkFramePtr != targetCallFrame)
4568 break;
4569 objPtr = varPtr->objPtr;
4573 /* Perform the binding */
4574 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4575 /* We are now sure 'nameObjPtr' type is variableObjType */
4576 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4577 Jim_DecrRefCount(interp, targetNameObjPtr);
4578 return JIM_OK;
4581 /* Return the Jim_Obj pointer associated with a variable name,
4582 * or NULL if the variable was not found in the current context.
4583 * The same optimization discussed in the comment to the
4584 * 'SetVariable' function should apply here.
4586 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4587 * in a dictionary which is shared, the array variable value is duplicated first.
4588 * This allows the array element to be updated (e.g. append, lappend) without
4589 * affecting other references to the dictionary.
4591 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4593 switch (SetVariableFromAny(interp, nameObjPtr)) {
4594 case JIM_OK:{
4595 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4597 if (varPtr->linkFramePtr == NULL) {
4598 return varPtr->objPtr;
4600 else {
4601 Jim_Obj *objPtr;
4603 /* The variable is a link? Resolve it. */
4604 Jim_CallFrame *savedCallFrame = interp->framePtr;
4606 interp->framePtr = varPtr->linkFramePtr;
4607 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4608 interp->framePtr = savedCallFrame;
4609 if (objPtr) {
4610 return objPtr;
4612 /* Error, so fall through to the error message */
4615 break;
4617 case JIM_DICT_SUGAR:
4618 /* [dict] syntax sugar. */
4619 return JimDictSugarGet(interp, nameObjPtr, flags);
4621 if (flags & JIM_ERRMSG) {
4622 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4624 return NULL;
4627 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4629 Jim_CallFrame *savedFramePtr;
4630 Jim_Obj *objPtr;
4632 savedFramePtr = interp->framePtr;
4633 interp->framePtr = interp->topFramePtr;
4634 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4635 interp->framePtr = savedFramePtr;
4637 return objPtr;
4640 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4642 Jim_Obj *nameObjPtr, *varObjPtr;
4644 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4645 Jim_IncrRefCount(nameObjPtr);
4646 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4647 Jim_DecrRefCount(interp, nameObjPtr);
4648 return varObjPtr;
4651 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4653 Jim_CallFrame *savedFramePtr;
4654 Jim_Obj *objPtr;
4656 savedFramePtr = interp->framePtr;
4657 interp->framePtr = interp->topFramePtr;
4658 objPtr = Jim_GetVariableStr(interp, name, flags);
4659 interp->framePtr = savedFramePtr;
4661 return objPtr;
4664 /* Unset a variable.
4665 * Note: On success unset invalidates all the (cached) variable objects
4666 * by incrementing callFrameEpoch
4668 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4670 Jim_Var *varPtr;
4671 int retval;
4672 Jim_CallFrame *framePtr;
4674 retval = SetVariableFromAny(interp, nameObjPtr);
4675 if (retval == JIM_DICT_SUGAR) {
4676 /* [dict] syntax sugar. */
4677 return JimDictSugarSet(interp, nameObjPtr, NULL);
4679 else if (retval == JIM_OK) {
4680 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4682 /* If it's a link call UnsetVariable recursively */
4683 if (varPtr->linkFramePtr) {
4684 framePtr = interp->framePtr;
4685 interp->framePtr = varPtr->linkFramePtr;
4686 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4687 interp->framePtr = framePtr;
4689 else {
4690 const char *name = Jim_String(nameObjPtr);
4691 if (nameObjPtr->internalRep.varValue.global) {
4692 name += 2;
4693 framePtr = interp->topFramePtr;
4695 else {
4696 framePtr = interp->framePtr;
4699 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4700 if (retval == JIM_OK) {
4701 /* Change the callframe id, invalidating var lookup caching */
4702 framePtr->id = interp->callFrameEpoch++;
4706 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4707 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4709 return retval;
4712 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4714 /* Given a variable name for [dict] operation syntax sugar,
4715 * this function returns two objects, the first with the name
4716 * of the variable to set, and the second with the respective key.
4717 * For example "foo(bar)" will return objects with string repr. of
4718 * "foo" and "bar".
4720 * The returned objects have refcount = 1. The function can't fail. */
4721 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4722 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4724 const char *str, *p;
4725 int len, keyLen;
4726 Jim_Obj *varObjPtr, *keyObjPtr;
4728 str = Jim_GetString(objPtr, &len);
4730 p = strchr(str, '(');
4731 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4733 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4735 p++;
4736 keyLen = (str + len) - p;
4737 if (str[len - 1] == ')') {
4738 keyLen--;
4741 /* Create the objects with the variable name and key. */
4742 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4744 Jim_IncrRefCount(varObjPtr);
4745 Jim_IncrRefCount(keyObjPtr);
4746 *varPtrPtr = varObjPtr;
4747 *keyPtrPtr = keyObjPtr;
4750 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4751 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4752 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4754 int err;
4756 SetDictSubstFromAny(interp, objPtr);
4758 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4759 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4761 if (err == JIM_OK) {
4762 /* Don't keep an extra ref to the result */
4763 Jim_SetEmptyResult(interp);
4765 else {
4766 if (!valObjPtr) {
4767 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4768 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4769 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4770 objPtr);
4771 return err;
4774 /* Make the error more informative and Tcl-compatible */
4775 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4776 (valObjPtr ? "set" : "unset"), objPtr);
4778 return err;
4782 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4784 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4785 * and stored back to the variable before expansion.
4787 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4788 Jim_Obj *keyObjPtr, int flags)
4790 Jim_Obj *dictObjPtr;
4791 Jim_Obj *resObjPtr = NULL;
4792 int ret;
4794 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4795 if (!dictObjPtr) {
4796 return NULL;
4799 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4800 if (ret != JIM_OK) {
4801 Jim_SetResultFormatted(interp,
4802 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4803 ret < 0 ? "variable isn't" : "no such element in");
4805 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4806 /* Update the variable to have an unshared copy */
4807 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4810 return resObjPtr;
4813 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4814 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4816 SetDictSubstFromAny(interp, objPtr);
4818 return JimDictExpandArrayVariable(interp,
4819 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4820 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4823 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4825 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4827 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4828 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4831 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4833 /* Copy the internal rep */
4834 dupPtr->internalRep = srcPtr->internalRep;
4835 /* Need to increment the ref counts */
4836 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4837 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4840 /* Note: The object *must* be in dict-sugar format */
4841 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4843 if (objPtr->typePtr != &dictSubstObjType) {
4844 Jim_Obj *varObjPtr, *keyObjPtr;
4846 if (objPtr->typePtr == &interpolatedObjType) {
4847 /* An interpolated object in dict-sugar form */
4849 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4850 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4852 Jim_IncrRefCount(varObjPtr);
4853 Jim_IncrRefCount(keyObjPtr);
4855 else {
4856 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4859 Jim_FreeIntRep(interp, objPtr);
4860 objPtr->typePtr = &dictSubstObjType;
4861 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4862 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4866 /* This function is used to expand [dict get] sugar in the form
4867 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4868 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4869 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4870 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4871 * the [dict]ionary contained in variable VARNAME. */
4872 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4874 Jim_Obj *resObjPtr = NULL;
4875 Jim_Obj *substKeyObjPtr = NULL;
4877 SetDictSubstFromAny(interp, objPtr);
4879 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4880 &substKeyObjPtr, JIM_NONE)
4881 != JIM_OK) {
4882 return NULL;
4884 Jim_IncrRefCount(substKeyObjPtr);
4885 resObjPtr =
4886 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4887 substKeyObjPtr, 0);
4888 Jim_DecrRefCount(interp, substKeyObjPtr);
4890 return resObjPtr;
4893 /* -----------------------------------------------------------------------------
4894 * CallFrame
4895 * ---------------------------------------------------------------------------*/
4897 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4899 Jim_CallFrame *cf;
4901 if (interp->freeFramesList) {
4902 cf = interp->freeFramesList;
4903 interp->freeFramesList = cf->next;
4905 cf->argv = NULL;
4906 cf->argc = 0;
4907 cf->procArgsObjPtr = NULL;
4908 cf->procBodyObjPtr = NULL;
4909 cf->next = NULL;
4910 cf->staticVars = NULL;
4911 cf->localCommands = NULL;
4912 cf->tailcallObj = NULL;
4913 cf->tailcallCmd = NULL;
4915 else {
4916 cf = Jim_Alloc(sizeof(*cf));
4917 memset(cf, 0, sizeof(*cf));
4919 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4922 cf->id = interp->callFrameEpoch++;
4923 cf->parent = parent;
4924 cf->level = parent ? parent->level + 1 : 0;
4925 cf->nsObj = nsObj;
4926 Jim_IncrRefCount(nsObj);
4928 return cf;
4931 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4933 /* Delete any local procs */
4934 if (localCommands) {
4935 Jim_Obj *cmdNameObj;
4937 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4938 Jim_HashEntry *he;
4939 Jim_Obj *fqObjName;
4940 Jim_HashTable *ht = &interp->commands;
4942 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4944 he = Jim_FindHashEntry(ht, fqname);
4946 if (he) {
4947 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4948 if (cmd->prevCmd) {
4949 Jim_Cmd *prevCmd = cmd->prevCmd;
4950 cmd->prevCmd = NULL;
4952 /* Delete the old command */
4953 JimDecrCmdRefCount(interp, cmd);
4955 /* And restore the original */
4956 Jim_SetHashVal(ht, he, prevCmd);
4958 else {
4959 Jim_DeleteHashEntry(ht, fqname);
4961 Jim_InterpIncrProcEpoch(interp);
4963 Jim_DecrRefCount(interp, cmdNameObj);
4964 JimFreeQualifiedName(interp, fqObjName);
4966 Jim_FreeStack(localCommands);
4967 Jim_Free(localCommands);
4969 return JIM_OK;
4973 * Run any $jim::defer scripts for the current call frame.
4975 * retcode is the return code from the current proc.
4977 * Returns the new return code.
4979 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
4981 Jim_Obj *objPtr;
4983 /* Fast check for the likely case that the variable doesn't exist */
4984 if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
4985 return retcode;
4988 objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
4990 if (objPtr) {
4991 int ret = JIM_OK;
4992 int i;
4993 int listLen = Jim_ListLength(interp, objPtr);
4994 Jim_Obj *resultObjPtr;
4996 Jim_IncrRefCount(objPtr);
4998 /* Need to save away the current interp result and
4999 * restore it if appropriate
5001 resultObjPtr = Jim_GetResult(interp);
5002 Jim_IncrRefCount(resultObjPtr);
5003 Jim_SetEmptyResult(interp);
5005 /* Invoke in reverse order */
5006 for (i = listLen; i > 0; i--) {
5007 /* If a defer script returns an error, don't evaluate remaining scripts */
5008 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5009 ret = Jim_EvalObj(interp, scriptObjPtr);
5010 if (ret != JIM_OK) {
5011 break;
5015 if (ret == JIM_OK || retcode == JIM_ERR) {
5016 /* defer script had no error, or proc had an error so restore proc result */
5017 Jim_SetResult(interp, resultObjPtr);
5019 else {
5020 retcode = ret;
5023 Jim_DecrRefCount(interp, resultObjPtr);
5024 Jim_DecrRefCount(interp, objPtr);
5026 return retcode;
5029 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5030 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5031 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5033 JimDeleteLocalProcs(interp, cf->localCommands);
5035 if (cf->procArgsObjPtr)
5036 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5037 if (cf->procBodyObjPtr)
5038 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5039 Jim_DecrRefCount(interp, cf->nsObj);
5040 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5041 Jim_FreeHashTable(&cf->vars);
5042 else {
5043 int i;
5044 Jim_HashEntry **table = cf->vars.table, *he;
5046 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5047 he = table[i];
5048 while (he != NULL) {
5049 Jim_HashEntry *nextEntry = he->next;
5050 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5052 Jim_DecrRefCount(interp, varPtr->objPtr);
5053 Jim_Free(Jim_GetHashEntryKey(he));
5054 Jim_Free(varPtr);
5055 Jim_Free(he);
5056 table[i] = NULL;
5057 he = nextEntry;
5060 cf->vars.used = 0;
5062 cf->next = interp->freeFramesList;
5063 interp->freeFramesList = cf;
5067 /* -----------------------------------------------------------------------------
5068 * References
5069 * ---------------------------------------------------------------------------*/
5070 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5072 /* References HashTable Type.
5074 * Keys are unsigned long integers, dynamically allocated for now but in the
5075 * future it's worth to cache this 4 bytes objects. Values are pointers
5076 * to Jim_References. */
5077 static void JimReferencesHTValDestructor(void *interp, void *val)
5079 Jim_Reference *refPtr = (void *)val;
5081 Jim_DecrRefCount(interp, refPtr->objPtr);
5082 if (refPtr->finalizerCmdNamePtr != NULL) {
5083 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5085 Jim_Free(val);
5088 static unsigned int JimReferencesHTHashFunction(const void *key)
5090 /* Only the least significant bits are used. */
5091 const unsigned long *widePtr = key;
5092 unsigned int intValue = (unsigned int)*widePtr;
5094 return Jim_IntHashFunction(intValue);
5097 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5099 void *copy = Jim_Alloc(sizeof(unsigned long));
5101 JIM_NOTUSED(privdata);
5103 memcpy(copy, key, sizeof(unsigned long));
5104 return copy;
5107 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5109 JIM_NOTUSED(privdata);
5111 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5114 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5116 JIM_NOTUSED(privdata);
5118 Jim_Free(key);
5121 static const Jim_HashTableType JimReferencesHashTableType = {
5122 JimReferencesHTHashFunction, /* hash function */
5123 JimReferencesHTKeyDup, /* key dup */
5124 NULL, /* val dup */
5125 JimReferencesHTKeyCompare, /* key compare */
5126 JimReferencesHTKeyDestructor, /* key destructor */
5127 JimReferencesHTValDestructor /* val destructor */
5130 /* -----------------------------------------------------------------------------
5131 * Reference object type and References API
5132 * ---------------------------------------------------------------------------*/
5134 /* The string representation of references has two features in order
5135 * to make the GC faster. The first is that every reference starts
5136 * with a non common character '<', in order to make the string matching
5137 * faster. The second is that the reference string rep is 42 characters
5138 * in length, this means that it is not necessary to check any object with a string
5139 * repr < 42, and usually there aren't many of these objects. */
5141 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5143 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5145 const char *fmt = "<reference.<%s>.%020lu>";
5147 sprintf(buf, fmt, refPtr->tag, id);
5148 return JIM_REFERENCE_SPACE;
5151 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5153 static const Jim_ObjType referenceObjType = {
5154 "reference",
5155 NULL,
5156 NULL,
5157 UpdateStringOfReference,
5158 JIM_TYPE_REFERENCES,
5161 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5163 char buf[JIM_REFERENCE_SPACE + 1];
5165 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5166 JimSetStringBytes(objPtr, buf);
5169 /* returns true if 'c' is a valid reference tag character.
5170 * i.e. inside the range [_a-zA-Z0-9] */
5171 static int isrefchar(int c)
5173 return (c == '_' || isalnum(c));
5176 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5178 unsigned long value;
5179 int i, len;
5180 const char *str, *start, *end;
5181 char refId[21];
5182 Jim_Reference *refPtr;
5183 Jim_HashEntry *he;
5184 char *endptr;
5186 /* Get the string representation */
5187 str = Jim_GetString(objPtr, &len);
5188 /* Check if it looks like a reference */
5189 if (len < JIM_REFERENCE_SPACE)
5190 goto badformat;
5191 /* Trim spaces */
5192 start = str;
5193 end = str + len - 1;
5194 while (*start == ' ')
5195 start++;
5196 while (*end == ' ' && end > start)
5197 end--;
5198 if (end - start + 1 != JIM_REFERENCE_SPACE)
5199 goto badformat;
5200 /* <reference.<1234567>.%020> */
5201 if (memcmp(start, "<reference.<", 12) != 0)
5202 goto badformat;
5203 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5204 goto badformat;
5205 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5206 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5207 if (!isrefchar(start[12 + i]))
5208 goto badformat;
5210 /* Extract info from the reference. */
5211 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5212 refId[20] = '\0';
5213 /* Try to convert the ID into an unsigned long */
5214 value = strtoul(refId, &endptr, 10);
5215 if (JimCheckConversion(refId, endptr) != JIM_OK)
5216 goto badformat;
5217 /* Check if the reference really exists! */
5218 he = Jim_FindHashEntry(&interp->references, &value);
5219 if (he == NULL) {
5220 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5221 return JIM_ERR;
5223 refPtr = Jim_GetHashEntryVal(he);
5224 /* Free the old internal repr and set the new one. */
5225 Jim_FreeIntRep(interp, objPtr);
5226 objPtr->typePtr = &referenceObjType;
5227 objPtr->internalRep.refValue.id = value;
5228 objPtr->internalRep.refValue.refPtr = refPtr;
5229 return JIM_OK;
5231 badformat:
5232 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5233 return JIM_ERR;
5236 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5237 * as finalizer command (or NULL if there is no finalizer).
5238 * The returned reference object has refcount = 0. */
5239 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5241 struct Jim_Reference *refPtr;
5242 unsigned long id;
5243 Jim_Obj *refObjPtr;
5244 const char *tag;
5245 int tagLen, i;
5247 /* Perform the Garbage Collection if needed. */
5248 Jim_CollectIfNeeded(interp);
5250 refPtr = Jim_Alloc(sizeof(*refPtr));
5251 refPtr->objPtr = objPtr;
5252 Jim_IncrRefCount(objPtr);
5253 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5254 if (cmdNamePtr)
5255 Jim_IncrRefCount(cmdNamePtr);
5256 id = interp->referenceNextId++;
5257 Jim_AddHashEntry(&interp->references, &id, refPtr);
5258 refObjPtr = Jim_NewObj(interp);
5259 refObjPtr->typePtr = &referenceObjType;
5260 refObjPtr->bytes = NULL;
5261 refObjPtr->internalRep.refValue.id = id;
5262 refObjPtr->internalRep.refValue.refPtr = refPtr;
5263 interp->referenceNextId++;
5264 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5265 * that does not pass the 'isrefchar' test is replaced with '_' */
5266 tag = Jim_GetString(tagPtr, &tagLen);
5267 if (tagLen > JIM_REFERENCE_TAGLEN)
5268 tagLen = JIM_REFERENCE_TAGLEN;
5269 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5270 if (i < tagLen && isrefchar(tag[i]))
5271 refPtr->tag[i] = tag[i];
5272 else
5273 refPtr->tag[i] = '_';
5275 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5276 return refObjPtr;
5279 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5281 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5282 return NULL;
5283 return objPtr->internalRep.refValue.refPtr;
5286 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5288 Jim_Reference *refPtr;
5290 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5291 return JIM_ERR;
5292 Jim_IncrRefCount(cmdNamePtr);
5293 if (refPtr->finalizerCmdNamePtr)
5294 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5295 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5296 return JIM_OK;
5299 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5301 Jim_Reference *refPtr;
5303 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5304 return JIM_ERR;
5305 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5306 return JIM_OK;
5309 /* -----------------------------------------------------------------------------
5310 * References Garbage Collection
5311 * ---------------------------------------------------------------------------*/
5313 /* This the hash table type for the "MARK" phase of the GC */
5314 static const Jim_HashTableType JimRefMarkHashTableType = {
5315 JimReferencesHTHashFunction, /* hash function */
5316 JimReferencesHTKeyDup, /* key dup */
5317 NULL, /* val dup */
5318 JimReferencesHTKeyCompare, /* key compare */
5319 JimReferencesHTKeyDestructor, /* key destructor */
5320 NULL /* val destructor */
5323 /* Performs the garbage collection. */
5324 int Jim_Collect(Jim_Interp *interp)
5326 int collected = 0;
5327 Jim_HashTable marks;
5328 Jim_HashTableIterator htiter;
5329 Jim_HashEntry *he;
5330 Jim_Obj *objPtr;
5332 /* Avoid recursive calls */
5333 if (interp->lastCollectId == (unsigned long)~0) {
5334 /* Jim_Collect() already running. Return just now. */
5335 return 0;
5337 interp->lastCollectId = ~0;
5339 /* Mark all the references found into the 'mark' hash table.
5340 * The references are searched in every live object that
5341 * is of a type that can contain references. */
5342 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5343 objPtr = interp->liveList;
5344 while (objPtr) {
5345 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5346 const char *str, *p;
5347 int len;
5349 /* If the object is of type reference, to get the
5350 * Id is simple... */
5351 if (objPtr->typePtr == &referenceObjType) {
5352 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5353 #ifdef JIM_DEBUG_GC
5354 printf("MARK (reference): %d refcount: %d\n",
5355 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5356 #endif
5357 objPtr = objPtr->nextObjPtr;
5358 continue;
5360 /* Get the string repr of the object we want
5361 * to scan for references. */
5362 p = str = Jim_GetString(objPtr, &len);
5363 /* Skip objects too little to contain references. */
5364 if (len < JIM_REFERENCE_SPACE) {
5365 objPtr = objPtr->nextObjPtr;
5366 continue;
5368 /* Extract references from the object string repr. */
5369 while (1) {
5370 int i;
5371 unsigned long id;
5373 if ((p = strstr(p, "<reference.<")) == NULL)
5374 break;
5375 /* Check if it's a valid reference. */
5376 if (len - (p - str) < JIM_REFERENCE_SPACE)
5377 break;
5378 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5379 break;
5380 for (i = 21; i <= 40; i++)
5381 if (!isdigit(UCHAR(p[i])))
5382 break;
5383 /* Get the ID */
5384 id = strtoul(p + 21, NULL, 10);
5386 /* Ok, a reference for the given ID
5387 * was found. Mark it. */
5388 Jim_AddHashEntry(&marks, &id, NULL);
5389 #ifdef JIM_DEBUG_GC
5390 printf("MARK: %d\n", (int)id);
5391 #endif
5392 p += JIM_REFERENCE_SPACE;
5395 objPtr = objPtr->nextObjPtr;
5398 /* Run the references hash table to destroy every reference that
5399 * is not referenced outside (not present in the mark HT). */
5400 JimInitHashTableIterator(&interp->references, &htiter);
5401 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5402 const unsigned long *refId;
5403 Jim_Reference *refPtr;
5405 refId = he->key;
5406 /* Check if in the mark phase we encountered
5407 * this reference. */
5408 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5409 #ifdef JIM_DEBUG_GC
5410 printf("COLLECTING %d\n", (int)*refId);
5411 #endif
5412 collected++;
5413 /* Drop the reference, but call the
5414 * finalizer first if registered. */
5415 refPtr = Jim_GetHashEntryVal(he);
5416 if (refPtr->finalizerCmdNamePtr) {
5417 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5418 Jim_Obj *objv[3], *oldResult;
5420 JimFormatReference(refstr, refPtr, *refId);
5422 objv[0] = refPtr->finalizerCmdNamePtr;
5423 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5424 objv[2] = refPtr->objPtr;
5426 /* Drop the reference itself */
5427 /* Avoid the finaliser being freed here */
5428 Jim_IncrRefCount(objv[0]);
5429 /* Don't remove the reference from the hash table just yet
5430 * since that will free refPtr, and hence refPtr->objPtr
5433 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5434 oldResult = interp->result;
5435 Jim_IncrRefCount(oldResult);
5436 Jim_EvalObjVector(interp, 3, objv);
5437 Jim_SetResult(interp, oldResult);
5438 Jim_DecrRefCount(interp, oldResult);
5440 Jim_DecrRefCount(interp, objv[0]);
5442 Jim_DeleteHashEntry(&interp->references, refId);
5445 Jim_FreeHashTable(&marks);
5446 interp->lastCollectId = interp->referenceNextId;
5447 interp->lastCollectTime = time(NULL);
5448 return collected;
5451 #define JIM_COLLECT_ID_PERIOD 5000
5452 #define JIM_COLLECT_TIME_PERIOD 300
5454 void Jim_CollectIfNeeded(Jim_Interp *interp)
5456 unsigned long elapsedId;
5457 int elapsedTime;
5459 elapsedId = interp->referenceNextId - interp->lastCollectId;
5460 elapsedTime = time(NULL) - interp->lastCollectTime;
5463 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5464 Jim_Collect(interp);
5467 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5469 int Jim_IsBigEndian(void)
5471 union {
5472 unsigned short s;
5473 unsigned char c[2];
5474 } uval = {0x0102};
5476 return uval.c[0] == 1;
5479 /* -----------------------------------------------------------------------------
5480 * Interpreter related functions
5481 * ---------------------------------------------------------------------------*/
5483 Jim_Interp *Jim_CreateInterp(void)
5485 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5487 memset(i, 0, sizeof(*i));
5489 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5490 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5491 i->lastCollectTime = time(NULL);
5493 /* Note that we can create objects only after the
5494 * interpreter liveList and freeList pointers are
5495 * initialized to NULL. */
5496 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5497 #ifdef JIM_REFERENCES
5498 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5499 #endif
5500 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5501 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5502 i->emptyObj = Jim_NewEmptyStringObj(i);
5503 i->trueObj = Jim_NewIntObj(i, 1);
5504 i->falseObj = Jim_NewIntObj(i, 0);
5505 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5506 i->errorFileNameObj = i->emptyObj;
5507 i->result = i->emptyObj;
5508 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5509 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5510 i->errorProc = i->emptyObj;
5511 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5512 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5513 Jim_IncrRefCount(i->emptyObj);
5514 Jim_IncrRefCount(i->errorFileNameObj);
5515 Jim_IncrRefCount(i->result);
5516 Jim_IncrRefCount(i->stackTrace);
5517 Jim_IncrRefCount(i->unknown);
5518 Jim_IncrRefCount(i->currentScriptObj);
5519 Jim_IncrRefCount(i->nullScriptObj);
5520 Jim_IncrRefCount(i->errorProc);
5521 Jim_IncrRefCount(i->trueObj);
5522 Jim_IncrRefCount(i->falseObj);
5524 /* Initialize key variables every interpreter should contain */
5525 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5526 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5528 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5529 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5530 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5531 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5532 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5533 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5534 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5535 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5537 return i;
5540 void Jim_FreeInterp(Jim_Interp *i)
5542 Jim_CallFrame *cf, *cfx;
5544 Jim_Obj *objPtr, *nextObjPtr;
5546 /* Free the active call frames list - must be done before i->commands is destroyed */
5547 for (cf = i->framePtr; cf; cf = cfx) {
5548 /* Note that we ignore any errors */
5549 JimInvokeDefer(i, JIM_OK);
5550 cfx = cf->parent;
5551 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5554 Jim_DecrRefCount(i, i->emptyObj);
5555 Jim_DecrRefCount(i, i->trueObj);
5556 Jim_DecrRefCount(i, i->falseObj);
5557 Jim_DecrRefCount(i, i->result);
5558 Jim_DecrRefCount(i, i->stackTrace);
5559 Jim_DecrRefCount(i, i->errorProc);
5560 Jim_DecrRefCount(i, i->unknown);
5561 Jim_DecrRefCount(i, i->errorFileNameObj);
5562 Jim_DecrRefCount(i, i->currentScriptObj);
5563 Jim_DecrRefCount(i, i->nullScriptObj);
5564 Jim_FreeHashTable(&i->commands);
5565 #ifdef JIM_REFERENCES
5566 Jim_FreeHashTable(&i->references);
5567 #endif
5568 Jim_FreeHashTable(&i->packages);
5569 Jim_Free(i->prngState);
5570 Jim_FreeHashTable(&i->assocData);
5572 /* Check that the live object list is empty, otherwise
5573 * there is a memory leak. */
5574 #ifdef JIM_MAINTAINER
5575 if (i->liveList != NULL) {
5576 objPtr = i->liveList;
5578 printf("\n-------------------------------------\n");
5579 printf("Objects still in the free list:\n");
5580 while (objPtr) {
5581 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5582 Jim_String(objPtr);
5584 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5585 printf("%p (%d) %-10s: '%.20s...'\n",
5586 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5588 else {
5589 printf("%p (%d) %-10s: '%s'\n",
5590 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5592 if (objPtr->typePtr == &sourceObjType) {
5593 printf("FILE %s LINE %d\n",
5594 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5595 objPtr->internalRep.sourceValue.lineNumber);
5597 objPtr = objPtr->nextObjPtr;
5599 printf("-------------------------------------\n\n");
5600 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5602 #endif
5604 /* Free all the freed objects. */
5605 objPtr = i->freeList;
5606 while (objPtr) {
5607 nextObjPtr = objPtr->nextObjPtr;
5608 Jim_Free(objPtr);
5609 objPtr = nextObjPtr;
5612 /* Free the free call frames list */
5613 for (cf = i->freeFramesList; cf; cf = cfx) {
5614 cfx = cf->next;
5615 if (cf->vars.table)
5616 Jim_FreeHashTable(&cf->vars);
5617 Jim_Free(cf);
5620 /* Free the interpreter structure. */
5621 Jim_Free(i);
5624 /* Returns the call frame relative to the level represented by
5625 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5627 * This function accepts the 'level' argument in the form
5628 * of the commands [uplevel] and [upvar].
5630 * Returns NULL on error.
5632 * Note: for a function accepting a relative integer as level suitable
5633 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5635 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5637 long level;
5638 const char *str;
5639 Jim_CallFrame *framePtr;
5641 if (levelObjPtr) {
5642 str = Jim_String(levelObjPtr);
5643 if (str[0] == '#') {
5644 char *endptr;
5646 level = jim_strtol(str + 1, &endptr);
5647 if (str[1] == '\0' || endptr[0] != '\0') {
5648 level = -1;
5651 else {
5652 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5653 level = -1;
5655 else {
5656 /* Convert from a relative to an absolute level */
5657 level = interp->framePtr->level - level;
5661 else {
5662 str = "1"; /* Needed to format the error message. */
5663 level = interp->framePtr->level - 1;
5666 if (level == 0) {
5667 return interp->topFramePtr;
5669 if (level > 0) {
5670 /* Lookup */
5671 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5672 if (framePtr->level == level) {
5673 return framePtr;
5678 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5679 return NULL;
5682 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5683 * as a relative integer like in the [info level ?level?] command.
5685 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5687 long level;
5688 Jim_CallFrame *framePtr;
5690 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5691 if (level <= 0) {
5692 /* Convert from a relative to an absolute level */
5693 level = interp->framePtr->level + level;
5696 if (level == 0) {
5697 return interp->topFramePtr;
5700 /* Lookup */
5701 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5702 if (framePtr->level == level) {
5703 return framePtr;
5708 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5709 return NULL;
5712 static void JimResetStackTrace(Jim_Interp *interp)
5714 Jim_DecrRefCount(interp, interp->stackTrace);
5715 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5716 Jim_IncrRefCount(interp->stackTrace);
5719 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5721 int len;
5723 /* Increment reference first in case these are the same object */
5724 Jim_IncrRefCount(stackTraceObj);
5725 Jim_DecrRefCount(interp, interp->stackTrace);
5726 interp->stackTrace = stackTraceObj;
5727 interp->errorFlag = 1;
5729 /* This is a bit ugly.
5730 * If the filename of the last entry of the stack trace is empty,
5731 * the next stack level should be added.
5733 len = Jim_ListLength(interp, interp->stackTrace);
5734 if (len >= 3) {
5735 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5736 interp->addStackTrace = 1;
5741 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5742 Jim_Obj *fileNameObj, int linenr)
5744 if (strcmp(procname, "unknown") == 0) {
5745 procname = "";
5747 if (!*procname && !Jim_Length(fileNameObj)) {
5748 /* No useful info here */
5749 return;
5752 if (Jim_IsShared(interp->stackTrace)) {
5753 Jim_DecrRefCount(interp, interp->stackTrace);
5754 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5755 Jim_IncrRefCount(interp->stackTrace);
5758 /* If we have no procname but the previous element did, merge with that frame */
5759 if (!*procname && Jim_Length(fileNameObj)) {
5760 /* Just a filename. Check the previous entry */
5761 int len = Jim_ListLength(interp, interp->stackTrace);
5763 if (len >= 3) {
5764 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5765 if (Jim_Length(objPtr)) {
5766 /* Yes, the previous level had procname */
5767 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5768 if (Jim_Length(objPtr) == 0) {
5769 /* But no filename, so merge the new info with that frame */
5770 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5771 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5772 return;
5778 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5779 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5780 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5783 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5784 void *data)
5786 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5788 assocEntryPtr->delProc = delProc;
5789 assocEntryPtr->data = data;
5790 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5793 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5795 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5797 if (entryPtr != NULL) {
5798 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5799 return assocEntryPtr->data;
5801 return NULL;
5804 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5806 return Jim_DeleteHashEntry(&interp->assocData, key);
5809 int Jim_GetExitCode(Jim_Interp *interp)
5811 return interp->exitCode;
5814 /* -----------------------------------------------------------------------------
5815 * Integer object
5816 * ---------------------------------------------------------------------------*/
5817 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5818 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5820 static const Jim_ObjType intObjType = {
5821 "int",
5822 NULL,
5823 NULL,
5824 UpdateStringOfInt,
5825 JIM_TYPE_NONE,
5828 /* A coerced double is closer to an int than a double.
5829 * It is an int value temporarily masquerading as a double value.
5830 * i.e. it has the same string value as an int and Jim_GetWide()
5831 * succeeds, but also Jim_GetDouble() returns the value directly.
5833 static const Jim_ObjType coercedDoubleObjType = {
5834 "coerced-double",
5835 NULL,
5836 NULL,
5837 UpdateStringOfInt,
5838 JIM_TYPE_NONE,
5842 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5844 char buf[JIM_INTEGER_SPACE + 1];
5845 jim_wide wideValue = JimWideValue(objPtr);
5846 int pos = 0;
5848 if (wideValue == 0) {
5849 buf[pos++] = '0';
5851 else {
5852 char tmp[JIM_INTEGER_SPACE];
5853 int num = 0;
5854 int i;
5856 if (wideValue < 0) {
5857 buf[pos++] = '-';
5858 i = wideValue % 10;
5859 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5860 * whereas C99 is always -6
5861 * coverity[dead_error_line]
5863 tmp[num++] = (i > 0) ? (10 - i) : -i;
5864 wideValue /= -10;
5867 while (wideValue) {
5868 tmp[num++] = wideValue % 10;
5869 wideValue /= 10;
5872 for (i = 0; i < num; i++) {
5873 buf[pos++] = '0' + tmp[num - i - 1];
5876 buf[pos] = 0;
5878 JimSetStringBytes(objPtr, buf);
5881 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5883 jim_wide wideValue;
5884 const char *str;
5886 if (objPtr->typePtr == &coercedDoubleObjType) {
5887 /* Simple switch */
5888 objPtr->typePtr = &intObjType;
5889 return JIM_OK;
5892 /* Get the string representation */
5893 str = Jim_String(objPtr);
5894 /* Try to convert into a jim_wide */
5895 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5896 if (flags & JIM_ERRMSG) {
5897 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5899 return JIM_ERR;
5901 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5902 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5903 return JIM_ERR;
5905 /* Free the old internal repr and set the new one. */
5906 Jim_FreeIntRep(interp, objPtr);
5907 objPtr->typePtr = &intObjType;
5908 objPtr->internalRep.wideValue = wideValue;
5909 return JIM_OK;
5912 #ifdef JIM_OPTIMIZATION
5913 static int JimIsWide(Jim_Obj *objPtr)
5915 return objPtr->typePtr == &intObjType;
5917 #endif
5919 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5921 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5922 return JIM_ERR;
5923 *widePtr = JimWideValue(objPtr);
5924 return JIM_OK;
5927 /* Get a wide but does not set an error if the format is bad. */
5928 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5930 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5931 return JIM_ERR;
5932 *widePtr = JimWideValue(objPtr);
5933 return JIM_OK;
5936 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5938 jim_wide wideValue;
5939 int retval;
5941 retval = Jim_GetWide(interp, objPtr, &wideValue);
5942 if (retval == JIM_OK) {
5943 *longPtr = (long)wideValue;
5944 return JIM_OK;
5946 return JIM_ERR;
5949 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5951 Jim_Obj *objPtr;
5953 objPtr = Jim_NewObj(interp);
5954 objPtr->typePtr = &intObjType;
5955 objPtr->bytes = NULL;
5956 objPtr->internalRep.wideValue = wideValue;
5957 return objPtr;
5960 /* -----------------------------------------------------------------------------
5961 * Double object
5962 * ---------------------------------------------------------------------------*/
5963 #define JIM_DOUBLE_SPACE 30
5965 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5966 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5968 static const Jim_ObjType doubleObjType = {
5969 "double",
5970 NULL,
5971 NULL,
5972 UpdateStringOfDouble,
5973 JIM_TYPE_NONE,
5976 #ifndef HAVE_ISNAN
5977 #undef isnan
5978 #define isnan(X) ((X) != (X))
5979 #endif
5980 #ifndef HAVE_ISINF
5981 #undef isinf
5982 #define isinf(X) (1.0 / (X) == 0.0)
5983 #endif
5985 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5987 double value = objPtr->internalRep.doubleValue;
5989 if (isnan(value)) {
5990 JimSetStringBytes(objPtr, "NaN");
5991 return;
5993 if (isinf(value)) {
5994 if (value < 0) {
5995 JimSetStringBytes(objPtr, "-Inf");
5997 else {
5998 JimSetStringBytes(objPtr, "Inf");
6000 return;
6003 char buf[JIM_DOUBLE_SPACE + 1];
6004 int i;
6005 int len = sprintf(buf, "%.12g", value);
6007 /* Add a final ".0" if necessary */
6008 for (i = 0; i < len; i++) {
6009 if (buf[i] == '.' || buf[i] == 'e') {
6010 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6011 /* If 'buf' ends in e-0nn or e+0nn, remove
6012 * the 0 after the + or - and reduce the length by 1
6014 char *e = strchr(buf, 'e');
6015 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6016 /* Move it up */
6017 e += 2;
6018 memmove(e, e + 1, len - (e - buf));
6020 #endif
6021 break;
6024 if (buf[i] == '\0') {
6025 buf[i++] = '.';
6026 buf[i++] = '0';
6027 buf[i] = '\0';
6029 JimSetStringBytes(objPtr, buf);
6033 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6035 double doubleValue;
6036 jim_wide wideValue;
6037 const char *str;
6039 #ifdef HAVE_LONG_LONG
6040 /* Assume a 53 bit mantissa */
6041 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6042 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6044 if (objPtr->typePtr == &intObjType
6045 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6046 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6048 /* Direct conversion to coerced double */
6049 objPtr->typePtr = &coercedDoubleObjType;
6050 return JIM_OK;
6052 #endif
6053 /* Preserve the string representation.
6054 * Needed so we can convert back to int without loss
6056 str = Jim_String(objPtr);
6058 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6059 /* Managed to convert to an int, so we can use this as a cooerced double */
6060 Jim_FreeIntRep(interp, objPtr);
6061 objPtr->typePtr = &coercedDoubleObjType;
6062 objPtr->internalRep.wideValue = wideValue;
6063 return JIM_OK;
6065 else {
6066 /* Try to convert into a double */
6067 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6068 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6069 return JIM_ERR;
6071 /* Free the old internal repr and set the new one. */
6072 Jim_FreeIntRep(interp, objPtr);
6074 objPtr->typePtr = &doubleObjType;
6075 objPtr->internalRep.doubleValue = doubleValue;
6076 return JIM_OK;
6079 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6081 if (objPtr->typePtr == &coercedDoubleObjType) {
6082 *doublePtr = JimWideValue(objPtr);
6083 return JIM_OK;
6085 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6086 return JIM_ERR;
6088 if (objPtr->typePtr == &coercedDoubleObjType) {
6089 *doublePtr = JimWideValue(objPtr);
6091 else {
6092 *doublePtr = objPtr->internalRep.doubleValue;
6094 return JIM_OK;
6097 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6099 Jim_Obj *objPtr;
6101 objPtr = Jim_NewObj(interp);
6102 objPtr->typePtr = &doubleObjType;
6103 objPtr->bytes = NULL;
6104 objPtr->internalRep.doubleValue = doubleValue;
6105 return objPtr;
6108 /* -----------------------------------------------------------------------------
6109 * Boolean conversion
6110 * ---------------------------------------------------------------------------*/
6111 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6113 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6115 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6116 return JIM_ERR;
6117 *booleanPtr = (int) JimWideValue(objPtr);
6118 return JIM_OK;
6121 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6123 static const char * const falses[] = {
6124 "0", "false", "no", "off", NULL
6126 static const char * const trues[] = {
6127 "1", "true", "yes", "on", NULL
6130 int boolean;
6132 int index;
6133 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6134 boolean = 0;
6135 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6136 boolean = 1;
6137 } else {
6138 if (flags & JIM_ERRMSG) {
6139 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6141 return JIM_ERR;
6144 /* Free the old internal repr and set the new one. */
6145 Jim_FreeIntRep(interp, objPtr);
6146 objPtr->typePtr = &intObjType;
6147 objPtr->internalRep.wideValue = boolean;
6148 return JIM_OK;
6151 /* -----------------------------------------------------------------------------
6152 * List object
6153 * ---------------------------------------------------------------------------*/
6154 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6155 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6156 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6157 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6158 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6159 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6161 /* Note that while the elements of the list may contain references,
6162 * the list object itself can't. This basically means that the
6163 * list object string representation as a whole can't contain references
6164 * that are not presents in the single elements. */
6165 static const Jim_ObjType listObjType = {
6166 "list",
6167 FreeListInternalRep,
6168 DupListInternalRep,
6169 UpdateStringOfList,
6170 JIM_TYPE_NONE,
6173 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6175 int i;
6177 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6178 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6180 Jim_Free(objPtr->internalRep.listValue.ele);
6183 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6185 int i;
6187 JIM_NOTUSED(interp);
6189 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6190 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6191 dupPtr->internalRep.listValue.ele =
6192 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6193 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6194 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6195 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6196 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6198 dupPtr->typePtr = &listObjType;
6201 /* The following function checks if a given string can be encoded
6202 * into a list element without any kind of quoting, surrounded by braces,
6203 * or using escapes to quote. */
6204 #define JIM_ELESTR_SIMPLE 0
6205 #define JIM_ELESTR_BRACE 1
6206 #define JIM_ELESTR_QUOTE 2
6207 static unsigned char ListElementQuotingType(const char *s, int len)
6209 int i, level, blevel, trySimple = 1;
6211 /* Try with the SIMPLE case */
6212 if (len == 0)
6213 return JIM_ELESTR_BRACE;
6214 if (s[0] == '"' || s[0] == '{') {
6215 trySimple = 0;
6216 goto testbrace;
6218 for (i = 0; i < len; i++) {
6219 switch (s[i]) {
6220 case ' ':
6221 case '$':
6222 case '"':
6223 case '[':
6224 case ']':
6225 case ';':
6226 case '\\':
6227 case '\r':
6228 case '\n':
6229 case '\t':
6230 case '\f':
6231 case '\v':
6232 trySimple = 0;
6233 /* fall through */
6234 case '{':
6235 case '}':
6236 goto testbrace;
6239 return JIM_ELESTR_SIMPLE;
6241 testbrace:
6242 /* Test if it's possible to do with braces */
6243 if (s[len - 1] == '\\')
6244 return JIM_ELESTR_QUOTE;
6245 level = 0;
6246 blevel = 0;
6247 for (i = 0; i < len; i++) {
6248 switch (s[i]) {
6249 case '{':
6250 level++;
6251 break;
6252 case '}':
6253 level--;
6254 if (level < 0)
6255 return JIM_ELESTR_QUOTE;
6256 break;
6257 case '[':
6258 blevel++;
6259 break;
6260 case ']':
6261 blevel--;
6262 break;
6263 case '\\':
6264 if (s[i + 1] == '\n')
6265 return JIM_ELESTR_QUOTE;
6266 else if (s[i + 1] != '\0')
6267 i++;
6268 break;
6271 if (blevel < 0) {
6272 return JIM_ELESTR_QUOTE;
6275 if (level == 0) {
6276 if (!trySimple)
6277 return JIM_ELESTR_BRACE;
6278 for (i = 0; i < len; i++) {
6279 switch (s[i]) {
6280 case ' ':
6281 case '$':
6282 case '"':
6283 case '[':
6284 case ']':
6285 case ';':
6286 case '\\':
6287 case '\r':
6288 case '\n':
6289 case '\t':
6290 case '\f':
6291 case '\v':
6292 return JIM_ELESTR_BRACE;
6293 break;
6296 return JIM_ELESTR_SIMPLE;
6298 return JIM_ELESTR_QUOTE;
6301 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6302 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6303 * scenario.
6304 * Returns the length of the result.
6306 static int BackslashQuoteString(const char *s, int len, char *q)
6308 char *p = q;
6310 while (len--) {
6311 switch (*s) {
6312 case ' ':
6313 case '$':
6314 case '"':
6315 case '[':
6316 case ']':
6317 case '{':
6318 case '}':
6319 case ';':
6320 case '\\':
6321 *p++ = '\\';
6322 *p++ = *s++;
6323 break;
6324 case '\n':
6325 *p++ = '\\';
6326 *p++ = 'n';
6327 s++;
6328 break;
6329 case '\r':
6330 *p++ = '\\';
6331 *p++ = 'r';
6332 s++;
6333 break;
6334 case '\t':
6335 *p++ = '\\';
6336 *p++ = 't';
6337 s++;
6338 break;
6339 case '\f':
6340 *p++ = '\\';
6341 *p++ = 'f';
6342 s++;
6343 break;
6344 case '\v':
6345 *p++ = '\\';
6346 *p++ = 'v';
6347 s++;
6348 break;
6349 default:
6350 *p++ = *s++;
6351 break;
6354 *p = '\0';
6356 return p - q;
6359 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6361 #define STATIC_QUOTING_LEN 32
6362 int i, bufLen, realLength;
6363 const char *strRep;
6364 char *p;
6365 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6367 /* Estimate the space needed. */
6368 if (objc > STATIC_QUOTING_LEN) {
6369 quotingType = Jim_Alloc(objc);
6371 else {
6372 quotingType = staticQuoting;
6374 bufLen = 0;
6375 for (i = 0; i < objc; i++) {
6376 int len;
6378 strRep = Jim_GetString(objv[i], &len);
6379 quotingType[i] = ListElementQuotingType(strRep, len);
6380 switch (quotingType[i]) {
6381 case JIM_ELESTR_SIMPLE:
6382 if (i != 0 || strRep[0] != '#') {
6383 bufLen += len;
6384 break;
6386 /* Special case '#' on first element needs braces */
6387 quotingType[i] = JIM_ELESTR_BRACE;
6388 /* fall through */
6389 case JIM_ELESTR_BRACE:
6390 bufLen += len + 2;
6391 break;
6392 case JIM_ELESTR_QUOTE:
6393 bufLen += len * 2;
6394 break;
6396 bufLen++; /* elements separator. */
6398 bufLen++;
6400 /* Generate the string rep. */
6401 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6402 realLength = 0;
6403 for (i = 0; i < objc; i++) {
6404 int len, qlen;
6406 strRep = Jim_GetString(objv[i], &len);
6408 switch (quotingType[i]) {
6409 case JIM_ELESTR_SIMPLE:
6410 memcpy(p, strRep, len);
6411 p += len;
6412 realLength += len;
6413 break;
6414 case JIM_ELESTR_BRACE:
6415 *p++ = '{';
6416 memcpy(p, strRep, len);
6417 p += len;
6418 *p++ = '}';
6419 realLength += len + 2;
6420 break;
6421 case JIM_ELESTR_QUOTE:
6422 if (i == 0 && strRep[0] == '#') {
6423 *p++ = '\\';
6424 realLength++;
6426 qlen = BackslashQuoteString(strRep, len, p);
6427 p += qlen;
6428 realLength += qlen;
6429 break;
6431 /* Add a separating space */
6432 if (i + 1 != objc) {
6433 *p++ = ' ';
6434 realLength++;
6437 *p = '\0'; /* nul term. */
6438 objPtr->length = realLength;
6440 if (quotingType != staticQuoting) {
6441 Jim_Free(quotingType);
6445 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6447 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6450 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6452 struct JimParserCtx parser;
6453 const char *str;
6454 int strLen;
6455 Jim_Obj *fileNameObj;
6456 int linenr;
6458 if (objPtr->typePtr == &listObjType) {
6459 return JIM_OK;
6462 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6463 * it also preserves any source location of the dict elements
6464 * which can be very useful
6466 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6467 Jim_Obj **listObjPtrPtr;
6468 int len;
6469 int i;
6471 listObjPtrPtr = JimDictPairs(objPtr, &len);
6472 for (i = 0; i < len; i++) {
6473 Jim_IncrRefCount(listObjPtrPtr[i]);
6476 /* Now just switch the internal rep */
6477 Jim_FreeIntRep(interp, objPtr);
6478 objPtr->typePtr = &listObjType;
6479 objPtr->internalRep.listValue.len = len;
6480 objPtr->internalRep.listValue.maxLen = len;
6481 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6483 return JIM_OK;
6486 /* Try to preserve information about filename / line number */
6487 if (objPtr->typePtr == &sourceObjType) {
6488 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6489 linenr = objPtr->internalRep.sourceValue.lineNumber;
6491 else {
6492 fileNameObj = interp->emptyObj;
6493 linenr = 1;
6495 Jim_IncrRefCount(fileNameObj);
6497 /* Get the string representation */
6498 str = Jim_GetString(objPtr, &strLen);
6500 /* Free the old internal repr just now and initialize the
6501 * new one just now. The string->list conversion can't fail. */
6502 Jim_FreeIntRep(interp, objPtr);
6503 objPtr->typePtr = &listObjType;
6504 objPtr->internalRep.listValue.len = 0;
6505 objPtr->internalRep.listValue.maxLen = 0;
6506 objPtr->internalRep.listValue.ele = NULL;
6508 /* Convert into a list */
6509 if (strLen) {
6510 JimParserInit(&parser, str, strLen, linenr);
6511 while (!parser.eof) {
6512 Jim_Obj *elementPtr;
6514 JimParseList(&parser);
6515 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6516 continue;
6517 elementPtr = JimParserGetTokenObj(interp, &parser);
6518 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6519 ListAppendElement(objPtr, elementPtr);
6522 Jim_DecrRefCount(interp, fileNameObj);
6523 return JIM_OK;
6526 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6528 Jim_Obj *objPtr;
6530 objPtr = Jim_NewObj(interp);
6531 objPtr->typePtr = &listObjType;
6532 objPtr->bytes = NULL;
6533 objPtr->internalRep.listValue.ele = NULL;
6534 objPtr->internalRep.listValue.len = 0;
6535 objPtr->internalRep.listValue.maxLen = 0;
6537 if (len) {
6538 ListInsertElements(objPtr, 0, len, elements);
6541 return objPtr;
6544 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6545 * length of the vector. Note that the user of this function should make
6546 * sure that the list object can't shimmer while the vector returned
6547 * is in use, this vector is the one stored inside the internal representation
6548 * of the list object. This function is not exported, extensions should
6549 * always access to the List object elements using Jim_ListIndex(). */
6550 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6551 Jim_Obj ***listVec)
6553 *listLen = Jim_ListLength(interp, listObj);
6554 *listVec = listObj->internalRep.listValue.ele;
6557 /* Sorting uses ints, but commands may return wide */
6558 static int JimSign(jim_wide w)
6560 if (w == 0) {
6561 return 0;
6563 else if (w < 0) {
6564 return -1;
6566 return 1;
6569 /* ListSortElements type values */
6570 struct lsort_info {
6571 jmp_buf jmpbuf;
6572 Jim_Obj *command;
6573 Jim_Interp *interp;
6574 enum {
6575 JIM_LSORT_ASCII,
6576 JIM_LSORT_NOCASE,
6577 JIM_LSORT_INTEGER,
6578 JIM_LSORT_REAL,
6579 JIM_LSORT_COMMAND
6580 } type;
6581 int order;
6582 int index;
6583 int indexed;
6584 int unique;
6585 int (*subfn)(Jim_Obj **, Jim_Obj **);
6588 static struct lsort_info *sort_info;
6590 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6592 Jim_Obj *lObj, *rObj;
6594 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6595 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6596 longjmp(sort_info->jmpbuf, JIM_ERR);
6598 return sort_info->subfn(&lObj, &rObj);
6601 /* Sort the internal rep of a list. */
6602 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6604 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6607 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6609 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6612 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6614 jim_wide lhs = 0, rhs = 0;
6616 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6617 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6618 longjmp(sort_info->jmpbuf, JIM_ERR);
6621 return JimSign(lhs - rhs) * sort_info->order;
6624 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6626 double lhs = 0, rhs = 0;
6628 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6629 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6630 longjmp(sort_info->jmpbuf, JIM_ERR);
6632 if (lhs == rhs) {
6633 return 0;
6635 if (lhs > rhs) {
6636 return sort_info->order;
6638 return -sort_info->order;
6641 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6643 Jim_Obj *compare_script;
6644 int rc;
6646 jim_wide ret = 0;
6648 /* This must be a valid list */
6649 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6650 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6651 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6653 rc = Jim_EvalObj(sort_info->interp, compare_script);
6655 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6656 longjmp(sort_info->jmpbuf, rc);
6659 return JimSign(ret) * sort_info->order;
6662 /* Remove duplicate elements from the (sorted) list in-place, according to the
6663 * comparison function, comp.
6665 * Note that the last unique value is kept, not the first
6667 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6669 int src;
6670 int dst = 0;
6671 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6673 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6674 if (comp(&ele[dst], &ele[src]) == 0) {
6675 /* Match, so replace the dest with the current source */
6676 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6678 else {
6679 /* No match, so keep the current source and move to the next destination */
6680 dst++;
6682 ele[dst] = ele[src];
6685 /* At end of list, keep the final element unless all elements were kept */
6686 dst++;
6687 if (dst < listObjPtr->internalRep.listValue.len) {
6688 ele[dst] = ele[src];
6691 /* Set the new length */
6692 listObjPtr->internalRep.listValue.len = dst;
6695 /* Sort a list *in place*. MUST be called with a non-shared list. */
6696 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6698 struct lsort_info *prev_info;
6700 typedef int (qsort_comparator) (const void *, const void *);
6701 int (*fn) (Jim_Obj **, Jim_Obj **);
6702 Jim_Obj **vector;
6703 int len;
6704 int rc;
6706 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6707 SetListFromAny(interp, listObjPtr);
6709 /* Allow lsort to be called reentrantly */
6710 prev_info = sort_info;
6711 sort_info = info;
6713 vector = listObjPtr->internalRep.listValue.ele;
6714 len = listObjPtr->internalRep.listValue.len;
6715 switch (info->type) {
6716 case JIM_LSORT_ASCII:
6717 fn = ListSortString;
6718 break;
6719 case JIM_LSORT_NOCASE:
6720 fn = ListSortStringNoCase;
6721 break;
6722 case JIM_LSORT_INTEGER:
6723 fn = ListSortInteger;
6724 break;
6725 case JIM_LSORT_REAL:
6726 fn = ListSortReal;
6727 break;
6728 case JIM_LSORT_COMMAND:
6729 fn = ListSortCommand;
6730 break;
6731 default:
6732 fn = NULL; /* avoid warning */
6733 JimPanic((1, "ListSort called with invalid sort type"));
6734 return -1; /* Should not be run but keeps static analysers happy */
6737 if (info->indexed) {
6738 /* Need to interpose a "list index" function */
6739 info->subfn = fn;
6740 fn = ListSortIndexHelper;
6743 if ((rc = setjmp(info->jmpbuf)) == 0) {
6744 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6746 if (info->unique && len > 1) {
6747 ListRemoveDuplicates(listObjPtr, fn);
6750 Jim_InvalidateStringRep(listObjPtr);
6752 sort_info = prev_info;
6754 return rc;
6757 /* This is the low-level function to insert elements into a list.
6758 * The higher-level Jim_ListInsertElements() performs shared object
6759 * check and invalidates the string repr. This version is used
6760 * in the internals of the List Object and is not exported.
6762 * NOTE: this function can be called only against objects
6763 * with internal type of List.
6765 * An insertion point (idx) of -1 means end-of-list.
6767 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6769 int currentLen = listPtr->internalRep.listValue.len;
6770 int requiredLen = currentLen + elemc;
6771 int i;
6772 Jim_Obj **point;
6774 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6775 if (requiredLen < 2) {
6776 /* Don't do allocations of under 4 pointers. */
6777 requiredLen = 4;
6779 else {
6780 requiredLen *= 2;
6783 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6784 sizeof(Jim_Obj *) * requiredLen);
6786 listPtr->internalRep.listValue.maxLen = requiredLen;
6788 if (idx < 0) {
6789 idx = currentLen;
6791 point = listPtr->internalRep.listValue.ele + idx;
6792 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6793 for (i = 0; i < elemc; ++i) {
6794 point[i] = elemVec[i];
6795 Jim_IncrRefCount(point[i]);
6797 listPtr->internalRep.listValue.len += elemc;
6800 /* Convenience call to ListInsertElements() to append a single element.
6802 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6804 ListInsertElements(listPtr, -1, 1, &objPtr);
6807 /* Appends every element of appendListPtr into listPtr.
6808 * Both have to be of the list type.
6809 * Convenience call to ListInsertElements()
6811 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6813 ListInsertElements(listPtr, -1,
6814 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6817 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6819 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6820 SetListFromAny(interp, listPtr);
6821 Jim_InvalidateStringRep(listPtr);
6822 ListAppendElement(listPtr, objPtr);
6825 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6827 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6828 SetListFromAny(interp, listPtr);
6829 SetListFromAny(interp, appendListPtr);
6830 Jim_InvalidateStringRep(listPtr);
6831 ListAppendList(listPtr, appendListPtr);
6834 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6836 SetListFromAny(interp, objPtr);
6837 return objPtr->internalRep.listValue.len;
6840 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6841 int objc, Jim_Obj *const *objVec)
6843 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6844 SetListFromAny(interp, listPtr);
6845 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6846 idx = listPtr->internalRep.listValue.len;
6847 else if (idx < 0)
6848 idx = 0;
6849 Jim_InvalidateStringRep(listPtr);
6850 ListInsertElements(listPtr, idx, objc, objVec);
6853 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6855 SetListFromAny(interp, listPtr);
6856 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6857 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6858 return NULL;
6860 if (idx < 0)
6861 idx = listPtr->internalRep.listValue.len + idx;
6862 return listPtr->internalRep.listValue.ele[idx];
6865 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6867 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6868 if (*objPtrPtr == NULL) {
6869 if (flags & JIM_ERRMSG) {
6870 Jim_SetResultString(interp, "list index out of range", -1);
6872 return JIM_ERR;
6874 return JIM_OK;
6877 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6878 Jim_Obj *newObjPtr, int flags)
6880 SetListFromAny(interp, listPtr);
6881 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6882 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6883 if (flags & JIM_ERRMSG) {
6884 Jim_SetResultString(interp, "list index out of range", -1);
6886 return JIM_ERR;
6888 if (idx < 0)
6889 idx = listPtr->internalRep.listValue.len + idx;
6890 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6891 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6892 Jim_IncrRefCount(newObjPtr);
6893 return JIM_OK;
6896 /* Modify the list stored in the variable named 'varNamePtr'
6897 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6898 * with the new element 'newObjptr'. (implements the [lset] command) */
6899 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6900 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6902 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6903 int shared, i, idx;
6905 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6906 if (objPtr == NULL)
6907 return JIM_ERR;
6908 if ((shared = Jim_IsShared(objPtr)))
6909 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6910 for (i = 0; i < indexc - 1; i++) {
6911 listObjPtr = objPtr;
6912 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6913 goto err;
6914 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6915 goto err;
6917 if (Jim_IsShared(objPtr)) {
6918 objPtr = Jim_DuplicateObj(interp, objPtr);
6919 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6921 Jim_InvalidateStringRep(listObjPtr);
6923 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6924 goto err;
6925 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6926 goto err;
6927 Jim_InvalidateStringRep(objPtr);
6928 Jim_InvalidateStringRep(varObjPtr);
6929 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6930 goto err;
6931 Jim_SetResult(interp, varObjPtr);
6932 return JIM_OK;
6933 err:
6934 if (shared) {
6935 Jim_FreeNewObj(interp, varObjPtr);
6937 return JIM_ERR;
6940 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6942 int i;
6943 int listLen = Jim_ListLength(interp, listObjPtr);
6944 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6946 for (i = 0; i < listLen; ) {
6947 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6948 if (++i != listLen) {
6949 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6952 return resObjPtr;
6955 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6957 int i;
6959 /* If all the objects in objv are lists,
6960 * it's possible to return a list as result, that's the
6961 * concatenation of all the lists. */
6962 for (i = 0; i < objc; i++) {
6963 if (!Jim_IsList(objv[i]))
6964 break;
6966 if (i == objc) {
6967 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6969 for (i = 0; i < objc; i++)
6970 ListAppendList(objPtr, objv[i]);
6971 return objPtr;
6973 else {
6974 /* Else... we have to glue strings together */
6975 int len = 0, objLen;
6976 char *bytes, *p;
6978 /* Compute the length */
6979 for (i = 0; i < objc; i++) {
6980 len += Jim_Length(objv[i]);
6982 if (objc)
6983 len += objc - 1;
6984 /* Create the string rep, and a string object holding it. */
6985 p = bytes = Jim_Alloc(len + 1);
6986 for (i = 0; i < objc; i++) {
6987 const char *s = Jim_GetString(objv[i], &objLen);
6989 /* Remove leading space */
6990 while (objLen && isspace(UCHAR(*s))) {
6991 s++;
6992 objLen--;
6993 len--;
6995 /* And trailing space */
6996 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6997 /* Handle trailing backslash-space case */
6998 if (objLen > 1 && s[objLen - 2] == '\\') {
6999 break;
7001 objLen--;
7002 len--;
7004 memcpy(p, s, objLen);
7005 p += objLen;
7006 if (i + 1 != objc) {
7007 if (objLen)
7008 *p++ = ' ';
7009 else {
7010 /* Drop the space calculated for this
7011 * element that is instead null. */
7012 len--;
7016 *p = '\0';
7017 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7021 /* Returns a list composed of the elements in the specified range.
7022 * first and start are directly accepted as Jim_Objects and
7023 * processed for the end?-index? case. */
7024 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7025 Jim_Obj *lastObjPtr)
7027 int first, last;
7028 int len, rangeLen;
7030 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7031 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7032 return NULL;
7033 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7034 first = JimRelToAbsIndex(len, first);
7035 last = JimRelToAbsIndex(len, last);
7036 JimRelToAbsRange(len, &first, &last, &rangeLen);
7037 if (first == 0 && last == len) {
7038 return listObjPtr;
7040 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7043 /* -----------------------------------------------------------------------------
7044 * Dict object
7045 * ---------------------------------------------------------------------------*/
7046 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7047 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7048 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7049 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7051 /* Dict HashTable Type.
7053 * Keys and Values are Jim objects. */
7055 static unsigned int JimObjectHTHashFunction(const void *key)
7057 int len;
7058 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7059 return Jim_GenHashFunction((const unsigned char *)str, len);
7062 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7064 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7067 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7069 Jim_IncrRefCount((Jim_Obj *)val);
7070 return (void *)val;
7073 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7075 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7078 static const Jim_HashTableType JimDictHashTableType = {
7079 JimObjectHTHashFunction, /* hash function */
7080 JimObjectHTKeyValDup, /* key dup */
7081 JimObjectHTKeyValDup, /* val dup */
7082 JimObjectHTKeyCompare, /* key compare */
7083 JimObjectHTKeyValDestructor, /* key destructor */
7084 JimObjectHTKeyValDestructor /* val destructor */
7087 /* Note that while the elements of the dict may contain references,
7088 * the list object itself can't. This basically means that the
7089 * dict object string representation as a whole can't contain references
7090 * that are not presents in the single elements. */
7091 static const Jim_ObjType dictObjType = {
7092 "dict",
7093 FreeDictInternalRep,
7094 DupDictInternalRep,
7095 UpdateStringOfDict,
7096 JIM_TYPE_NONE,
7099 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7101 JIM_NOTUSED(interp);
7103 Jim_FreeHashTable(objPtr->internalRep.ptr);
7104 Jim_Free(objPtr->internalRep.ptr);
7107 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7109 Jim_HashTable *ht, *dupHt;
7110 Jim_HashTableIterator htiter;
7111 Jim_HashEntry *he;
7113 /* Create a new hash table */
7114 ht = srcPtr->internalRep.ptr;
7115 dupHt = Jim_Alloc(sizeof(*dupHt));
7116 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7117 if (ht->size != 0)
7118 Jim_ExpandHashTable(dupHt, ht->size);
7119 /* Copy every element from the source to the dup hash table */
7120 JimInitHashTableIterator(ht, &htiter);
7121 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7122 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7125 dupPtr->internalRep.ptr = dupHt;
7126 dupPtr->typePtr = &dictObjType;
7129 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7131 Jim_HashTable *ht;
7132 Jim_HashTableIterator htiter;
7133 Jim_HashEntry *he;
7134 Jim_Obj **objv;
7135 int i;
7137 ht = dictPtr->internalRep.ptr;
7139 /* Turn the hash table into a flat vector of Jim_Objects. */
7140 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7141 JimInitHashTableIterator(ht, &htiter);
7142 i = 0;
7143 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7144 objv[i++] = Jim_GetHashEntryKey(he);
7145 objv[i++] = Jim_GetHashEntryVal(he);
7147 *len = i;
7148 return objv;
7151 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7153 /* Turn the hash table into a flat vector of Jim_Objects. */
7154 int len;
7155 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7157 /* And now generate the string rep as a list */
7158 JimMakeListStringRep(objPtr, objv, len);
7160 Jim_Free(objv);
7163 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7165 int listlen;
7167 if (objPtr->typePtr == &dictObjType) {
7168 return JIM_OK;
7171 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7172 /* A shared list, so get the string representation now to avoid
7173 * changing the order in case of fast conversion to dict.
7175 Jim_String(objPtr);
7178 /* For simplicity, convert a non-list object to a list and then to a dict */
7179 listlen = Jim_ListLength(interp, objPtr);
7180 if (listlen % 2) {
7181 Jim_SetResultString(interp, "missing value to go with key", -1);
7182 return JIM_ERR;
7184 else {
7185 /* Converting from a list to a dict can't fail */
7186 Jim_HashTable *ht;
7187 int i;
7189 ht = Jim_Alloc(sizeof(*ht));
7190 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7192 for (i = 0; i < listlen; i += 2) {
7193 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7194 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7196 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7199 Jim_FreeIntRep(interp, objPtr);
7200 objPtr->typePtr = &dictObjType;
7201 objPtr->internalRep.ptr = ht;
7203 return JIM_OK;
7207 /* Dict object API */
7209 /* Add an element to a dict. objPtr must be of the "dict" type.
7210 * The higher-level exported function is Jim_DictAddElement().
7211 * If an element with the specified key already exists, the value
7212 * associated is replaced with the new one.
7214 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7215 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7216 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7218 Jim_HashTable *ht = objPtr->internalRep.ptr;
7220 if (valueObjPtr == NULL) { /* unset */
7221 return Jim_DeleteHashEntry(ht, keyObjPtr);
7223 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7224 return JIM_OK;
7227 /* Add an element, higher-level interface for DictAddElement().
7228 * If valueObjPtr == NULL, the key is removed if it exists. */
7229 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7230 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7232 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7233 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7234 return JIM_ERR;
7236 Jim_InvalidateStringRep(objPtr);
7237 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7240 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7242 Jim_Obj *objPtr;
7243 int i;
7245 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7247 objPtr = Jim_NewObj(interp);
7248 objPtr->typePtr = &dictObjType;
7249 objPtr->bytes = NULL;
7250 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7251 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7252 for (i = 0; i < len; i += 2)
7253 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7254 return objPtr;
7257 /* Return the value associated to the specified dict key
7258 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7260 * Sets *objPtrPtr to non-NULL only upon success.
7262 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7263 Jim_Obj **objPtrPtr, int flags)
7265 Jim_HashEntry *he;
7266 Jim_HashTable *ht;
7268 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7269 return -1;
7271 ht = dictPtr->internalRep.ptr;
7272 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7273 if (flags & JIM_ERRMSG) {
7274 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7276 return JIM_ERR;
7278 else {
7279 *objPtrPtr = Jim_GetHashEntryVal(he);
7280 return JIM_OK;
7284 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7285 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7287 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7288 return JIM_ERR;
7290 *objPtrPtr = JimDictPairs(dictPtr, len);
7292 return JIM_OK;
7296 /* Return the value associated to the specified dict keys */
7297 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7298 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7300 int i;
7302 if (keyc == 0) {
7303 *objPtrPtr = dictPtr;
7304 return JIM_OK;
7307 for (i = 0; i < keyc; i++) {
7308 Jim_Obj *objPtr;
7310 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7311 if (rc != JIM_OK) {
7312 return rc;
7314 dictPtr = objPtr;
7316 *objPtrPtr = dictPtr;
7317 return JIM_OK;
7320 /* Modify the dict stored into the variable named 'varNamePtr'
7321 * setting the element specified by the 'keyc' keys objects in 'keyv',
7322 * with the new value of the element 'newObjPtr'.
7324 * If newObjPtr == NULL the operation is to remove the given key
7325 * from the dictionary.
7327 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7328 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7330 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7331 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7333 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7334 int shared, i;
7336 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7337 if (objPtr == NULL) {
7338 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7339 /* Cannot remove a key from non existing var */
7340 return JIM_ERR;
7342 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7343 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7344 Jim_FreeNewObj(interp, varObjPtr);
7345 return JIM_ERR;
7348 if ((shared = Jim_IsShared(objPtr)))
7349 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7350 for (i = 0; i < keyc; i++) {
7351 dictObjPtr = objPtr;
7353 /* Check if it's a valid dictionary */
7354 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7355 goto err;
7358 if (i == keyc - 1) {
7359 /* Last key: Note that error on unset with missing last key is OK */
7360 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7361 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7362 goto err;
7365 break;
7368 /* Check if the given key exists. */
7369 Jim_InvalidateStringRep(dictObjPtr);
7370 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7371 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7372 /* This key exists at the current level.
7373 * Make sure it's not shared!. */
7374 if (Jim_IsShared(objPtr)) {
7375 objPtr = Jim_DuplicateObj(interp, objPtr);
7376 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7379 else {
7380 /* Key not found. If it's an [unset] operation
7381 * this is an error. Only the last key may not
7382 * exist. */
7383 if (newObjPtr == NULL) {
7384 goto err;
7386 /* Otherwise set an empty dictionary
7387 * as key's value. */
7388 objPtr = Jim_NewDictObj(interp, NULL, 0);
7389 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7392 /* XXX: Is this necessary? */
7393 Jim_InvalidateStringRep(objPtr);
7394 Jim_InvalidateStringRep(varObjPtr);
7395 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7396 goto err;
7398 Jim_SetResult(interp, varObjPtr);
7399 return JIM_OK;
7400 err:
7401 if (shared) {
7402 Jim_FreeNewObj(interp, varObjPtr);
7404 return JIM_ERR;
7407 /* -----------------------------------------------------------------------------
7408 * Index object
7409 * ---------------------------------------------------------------------------*/
7410 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7411 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7413 static const Jim_ObjType indexObjType = {
7414 "index",
7415 NULL,
7416 NULL,
7417 UpdateStringOfIndex,
7418 JIM_TYPE_NONE,
7421 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7423 if (objPtr->internalRep.intValue == -1) {
7424 JimSetStringBytes(objPtr, "end");
7426 else {
7427 char buf[JIM_INTEGER_SPACE + 1];
7428 if (objPtr->internalRep.intValue >= 0) {
7429 sprintf(buf, "%d", objPtr->internalRep.intValue);
7431 else {
7432 /* Must be <= -2 */
7433 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7435 JimSetStringBytes(objPtr, buf);
7439 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7441 int idx, end = 0;
7442 const char *str;
7443 char *endptr;
7445 /* Get the string representation */
7446 str = Jim_String(objPtr);
7448 /* Try to convert into an index */
7449 if (strncmp(str, "end", 3) == 0) {
7450 end = 1;
7451 str += 3;
7452 idx = 0;
7454 else {
7455 idx = jim_strtol(str, &endptr);
7457 if (endptr == str) {
7458 goto badindex;
7460 str = endptr;
7463 /* Now str may include or +<num> or -<num> */
7464 if (*str == '+' || *str == '-') {
7465 int sign = (*str == '+' ? 1 : -1);
7467 idx += sign * jim_strtol(++str, &endptr);
7468 if (str == endptr || *endptr) {
7469 goto badindex;
7471 str = endptr;
7473 /* The only thing left should be spaces */
7474 while (isspace(UCHAR(*str))) {
7475 str++;
7477 if (*str) {
7478 goto badindex;
7480 if (end) {
7481 if (idx > 0) {
7482 idx = INT_MAX;
7484 else {
7485 /* end-1 is repesented as -2 */
7486 idx--;
7489 else if (idx < 0) {
7490 idx = -INT_MAX;
7493 /* Free the old internal repr and set the new one. */
7494 Jim_FreeIntRep(interp, objPtr);
7495 objPtr->typePtr = &indexObjType;
7496 objPtr->internalRep.intValue = idx;
7497 return JIM_OK;
7499 badindex:
7500 Jim_SetResultFormatted(interp,
7501 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7502 return JIM_ERR;
7505 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7507 /* Avoid shimmering if the object is an integer. */
7508 if (objPtr->typePtr == &intObjType) {
7509 jim_wide val = JimWideValue(objPtr);
7511 if (val < 0)
7512 *indexPtr = -INT_MAX;
7513 else if (val > INT_MAX)
7514 *indexPtr = INT_MAX;
7515 else
7516 *indexPtr = (int)val;
7517 return JIM_OK;
7519 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7520 return JIM_ERR;
7521 *indexPtr = objPtr->internalRep.intValue;
7522 return JIM_OK;
7525 /* -----------------------------------------------------------------------------
7526 * Return Code Object.
7527 * ---------------------------------------------------------------------------*/
7529 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7530 static const char * const jimReturnCodes[] = {
7531 "ok",
7532 "error",
7533 "return",
7534 "break",
7535 "continue",
7536 "signal",
7537 "exit",
7538 "eval",
7539 NULL
7542 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7544 static const Jim_ObjType returnCodeObjType = {
7545 "return-code",
7546 NULL,
7547 NULL,
7548 NULL,
7549 JIM_TYPE_NONE,
7552 /* Converts a (standard) return code to a string. Returns "?" for
7553 * non-standard return codes.
7555 const char *Jim_ReturnCode(int code)
7557 if (code < 0 || code >= (int)jimReturnCodesSize) {
7558 return "?";
7560 else {
7561 return jimReturnCodes[code];
7565 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7567 int returnCode;
7568 jim_wide wideValue;
7570 /* Try to convert into an integer */
7571 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7572 returnCode = (int)wideValue;
7573 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7574 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7575 return JIM_ERR;
7577 /* Free the old internal repr and set the new one. */
7578 Jim_FreeIntRep(interp, objPtr);
7579 objPtr->typePtr = &returnCodeObjType;
7580 objPtr->internalRep.intValue = returnCode;
7581 return JIM_OK;
7584 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7586 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7587 return JIM_ERR;
7588 *intPtr = objPtr->internalRep.intValue;
7589 return JIM_OK;
7592 /* -----------------------------------------------------------------------------
7593 * Expression Parsing
7594 * ---------------------------------------------------------------------------*/
7595 static int JimParseExprOperator(struct JimParserCtx *pc);
7596 static int JimParseExprNumber(struct JimParserCtx *pc);
7597 static int JimParseExprIrrational(struct JimParserCtx *pc);
7598 static int JimParseExprBoolean(struct JimParserCtx *pc);
7600 /* expr operator opcodes. */
7601 enum
7603 /* Continues on from the JIM_TT_ space */
7605 /* Binary operators (numbers) */
7606 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7607 JIM_EXPROP_DIV,
7608 JIM_EXPROP_MOD,
7609 JIM_EXPROP_SUB,
7610 JIM_EXPROP_ADD,
7611 JIM_EXPROP_LSHIFT,
7612 JIM_EXPROP_RSHIFT,
7613 JIM_EXPROP_ROTL,
7614 JIM_EXPROP_ROTR,
7615 JIM_EXPROP_LT,
7616 JIM_EXPROP_GT,
7617 JIM_EXPROP_LTE,
7618 JIM_EXPROP_GTE,
7619 JIM_EXPROP_NUMEQ,
7620 JIM_EXPROP_NUMNE,
7621 JIM_EXPROP_BITAND, /* 35 */
7622 JIM_EXPROP_BITXOR,
7623 JIM_EXPROP_BITOR,
7624 JIM_EXPROP_LOGICAND, /* 38 */
7625 JIM_EXPROP_LOGICOR, /* 39 */
7626 JIM_EXPROP_TERNARY, /* 40 */
7627 JIM_EXPROP_COLON, /* 41 */
7628 JIM_EXPROP_POW, /* 42 */
7630 /* Binary operators (strings) */
7631 JIM_EXPROP_STREQ, /* 43 */
7632 JIM_EXPROP_STRNE,
7633 JIM_EXPROP_STRIN,
7634 JIM_EXPROP_STRNI,
7636 /* Unary operators (numbers) */
7637 JIM_EXPROP_NOT, /* 47 */
7638 JIM_EXPROP_BITNOT,
7639 JIM_EXPROP_UNARYMINUS,
7640 JIM_EXPROP_UNARYPLUS,
7642 /* Functions */
7643 JIM_EXPROP_FUNC_INT, /* 51 */
7644 JIM_EXPROP_FUNC_WIDE,
7645 JIM_EXPROP_FUNC_ABS,
7646 JIM_EXPROP_FUNC_DOUBLE,
7647 JIM_EXPROP_FUNC_ROUND,
7648 JIM_EXPROP_FUNC_RAND,
7649 JIM_EXPROP_FUNC_SRAND,
7651 /* math functions from libm */
7652 JIM_EXPROP_FUNC_SIN, /* 65 */
7653 JIM_EXPROP_FUNC_COS,
7654 JIM_EXPROP_FUNC_TAN,
7655 JIM_EXPROP_FUNC_ASIN,
7656 JIM_EXPROP_FUNC_ACOS,
7657 JIM_EXPROP_FUNC_ATAN,
7658 JIM_EXPROP_FUNC_ATAN2,
7659 JIM_EXPROP_FUNC_SINH,
7660 JIM_EXPROP_FUNC_COSH,
7661 JIM_EXPROP_FUNC_TANH,
7662 JIM_EXPROP_FUNC_CEIL,
7663 JIM_EXPROP_FUNC_FLOOR,
7664 JIM_EXPROP_FUNC_EXP,
7665 JIM_EXPROP_FUNC_LOG,
7666 JIM_EXPROP_FUNC_LOG10,
7667 JIM_EXPROP_FUNC_SQRT,
7668 JIM_EXPROP_FUNC_POW,
7669 JIM_EXPROP_FUNC_HYPOT,
7670 JIM_EXPROP_FUNC_FMOD,
7673 /* A expression node is either a term or an operator
7674 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7676 struct JimExprNode {
7677 int type; /* JIM_TT_xxx */
7678 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7680 struct JimExprNode *left; /* For all operators */
7681 struct JimExprNode *right; /* For binary operators */
7682 struct JimExprNode *ternary; /* For ternary operator only */
7685 /* Operators table */
7686 typedef struct Jim_ExprOperator
7688 const char *name;
7689 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7690 unsigned char precedence;
7691 unsigned char arity;
7692 unsigned char attr;
7693 unsigned char namelen;
7694 } Jim_ExprOperator;
7696 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7697 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7698 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7700 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7702 int intresult = 1;
7703 int rc;
7704 double dA, dC = 0;
7705 jim_wide wA, wC = 0;
7706 Jim_Obj *A;
7708 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7709 return rc;
7712 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7713 switch (node->type) {
7714 case JIM_EXPROP_FUNC_INT:
7715 case JIM_EXPROP_FUNC_WIDE:
7716 case JIM_EXPROP_FUNC_ROUND:
7717 case JIM_EXPROP_UNARYPLUS:
7718 wC = wA;
7719 break;
7720 case JIM_EXPROP_FUNC_DOUBLE:
7721 dC = wA;
7722 intresult = 0;
7723 break;
7724 case JIM_EXPROP_FUNC_ABS:
7725 wC = wA >= 0 ? wA : -wA;
7726 break;
7727 case JIM_EXPROP_UNARYMINUS:
7728 wC = -wA;
7729 break;
7730 case JIM_EXPROP_NOT:
7731 wC = !wA;
7732 break;
7733 default:
7734 abort();
7737 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7738 switch (node->type) {
7739 case JIM_EXPROP_FUNC_INT:
7740 case JIM_EXPROP_FUNC_WIDE:
7741 wC = dA;
7742 break;
7743 case JIM_EXPROP_FUNC_ROUND:
7744 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7745 break;
7746 case JIM_EXPROP_FUNC_DOUBLE:
7747 case JIM_EXPROP_UNARYPLUS:
7748 dC = dA;
7749 intresult = 0;
7750 break;
7751 case JIM_EXPROP_FUNC_ABS:
7752 #ifdef JIM_MATH_FUNCTIONS
7753 dC = fabs(dA);
7754 #else
7755 dC = dA >= 0 ? dA : -dA;
7756 #endif
7757 intresult = 0;
7758 break;
7759 case JIM_EXPROP_UNARYMINUS:
7760 dC = -dA;
7761 intresult = 0;
7762 break;
7763 case JIM_EXPROP_NOT:
7764 wC = !dA;
7765 break;
7766 default:
7767 abort();
7771 if (rc == JIM_OK) {
7772 if (intresult) {
7773 Jim_SetResultInt(interp, wC);
7775 else {
7776 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7780 Jim_DecrRefCount(interp, A);
7782 return rc;
7785 static double JimRandDouble(Jim_Interp *interp)
7787 unsigned long x;
7788 JimRandomBytes(interp, &x, sizeof(x));
7790 return (double)x / (unsigned long)~0;
7793 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7795 jim_wide wA;
7796 Jim_Obj *A;
7797 int rc;
7799 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7800 return rc;
7803 rc = Jim_GetWide(interp, A, &wA);
7804 if (rc == JIM_OK) {
7805 switch (node->type) {
7806 case JIM_EXPROP_BITNOT:
7807 Jim_SetResultInt(interp, ~wA);
7808 break;
7809 case JIM_EXPROP_FUNC_SRAND:
7810 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7811 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7812 break;
7813 default:
7814 abort();
7818 Jim_DecrRefCount(interp, A);
7820 return rc;
7823 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7825 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7827 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7829 return JIM_OK;
7832 #ifdef JIM_MATH_FUNCTIONS
7833 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7835 int rc;
7836 double dA, dC;
7837 Jim_Obj *A;
7839 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7840 return rc;
7843 rc = Jim_GetDouble(interp, A, &dA);
7844 if (rc == JIM_OK) {
7845 switch (node->type) {
7846 case JIM_EXPROP_FUNC_SIN:
7847 dC = sin(dA);
7848 break;
7849 case JIM_EXPROP_FUNC_COS:
7850 dC = cos(dA);
7851 break;
7852 case JIM_EXPROP_FUNC_TAN:
7853 dC = tan(dA);
7854 break;
7855 case JIM_EXPROP_FUNC_ASIN:
7856 dC = asin(dA);
7857 break;
7858 case JIM_EXPROP_FUNC_ACOS:
7859 dC = acos(dA);
7860 break;
7861 case JIM_EXPROP_FUNC_ATAN:
7862 dC = atan(dA);
7863 break;
7864 case JIM_EXPROP_FUNC_SINH:
7865 dC = sinh(dA);
7866 break;
7867 case JIM_EXPROP_FUNC_COSH:
7868 dC = cosh(dA);
7869 break;
7870 case JIM_EXPROP_FUNC_TANH:
7871 dC = tanh(dA);
7872 break;
7873 case JIM_EXPROP_FUNC_CEIL:
7874 dC = ceil(dA);
7875 break;
7876 case JIM_EXPROP_FUNC_FLOOR:
7877 dC = floor(dA);
7878 break;
7879 case JIM_EXPROP_FUNC_EXP:
7880 dC = exp(dA);
7881 break;
7882 case JIM_EXPROP_FUNC_LOG:
7883 dC = log(dA);
7884 break;
7885 case JIM_EXPROP_FUNC_LOG10:
7886 dC = log10(dA);
7887 break;
7888 case JIM_EXPROP_FUNC_SQRT:
7889 dC = sqrt(dA);
7890 break;
7891 default:
7892 abort();
7894 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7897 Jim_DecrRefCount(interp, A);
7899 return rc;
7901 #endif
7903 /* A binary operation on two ints */
7904 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7906 jim_wide wA, wB;
7907 int rc;
7908 Jim_Obj *A, *B;
7910 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7911 return rc;
7913 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7914 Jim_DecrRefCount(interp, A);
7915 return rc;
7918 rc = JIM_ERR;
7920 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7921 jim_wide wC;
7923 rc = JIM_OK;
7925 switch (node->type) {
7926 case JIM_EXPROP_LSHIFT:
7927 wC = wA << wB;
7928 break;
7929 case JIM_EXPROP_RSHIFT:
7930 wC = wA >> wB;
7931 break;
7932 case JIM_EXPROP_BITAND:
7933 wC = wA & wB;
7934 break;
7935 case JIM_EXPROP_BITXOR:
7936 wC = wA ^ wB;
7937 break;
7938 case JIM_EXPROP_BITOR:
7939 wC = wA | wB;
7940 break;
7941 case JIM_EXPROP_MOD:
7942 if (wB == 0) {
7943 wC = 0;
7944 Jim_SetResultString(interp, "Division by zero", -1);
7945 rc = JIM_ERR;
7947 else {
7949 * From Tcl 8.x
7951 * This code is tricky: C doesn't guarantee much
7952 * about the quotient or remainder, but Tcl does.
7953 * The remainder always has the same sign as the
7954 * divisor and a smaller absolute value.
7956 int negative = 0;
7958 if (wB < 0) {
7959 wB = -wB;
7960 wA = -wA;
7961 negative = 1;
7963 wC = wA % wB;
7964 if (wC < 0) {
7965 wC += wB;
7967 if (negative) {
7968 wC = -wC;
7971 break;
7972 case JIM_EXPROP_ROTL:
7973 case JIM_EXPROP_ROTR:{
7974 /* uint32_t would be better. But not everyone has inttypes.h? */
7975 unsigned long uA = (unsigned long)wA;
7976 unsigned long uB = (unsigned long)wB;
7977 const unsigned int S = sizeof(unsigned long) * 8;
7979 /* Shift left by the word size or more is undefined. */
7980 uB %= S;
7982 if (node->type == JIM_EXPROP_ROTR) {
7983 uB = S - uB;
7985 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7986 break;
7988 default:
7989 abort();
7991 Jim_SetResultInt(interp, wC);
7994 Jim_DecrRefCount(interp, A);
7995 Jim_DecrRefCount(interp, B);
7997 return rc;
8001 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8002 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8004 int rc = JIM_OK;
8005 double dA, dB, dC = 0;
8006 jim_wide wA, wB, wC = 0;
8007 Jim_Obj *A, *B;
8009 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8010 return rc;
8012 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8013 Jim_DecrRefCount(interp, A);
8014 return rc;
8017 if ((A->typePtr != &doubleObjType || A->bytes) &&
8018 (B->typePtr != &doubleObjType || B->bytes) &&
8019 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8021 /* Both are ints */
8023 switch (node->type) {
8024 case JIM_EXPROP_POW:
8025 case JIM_EXPROP_FUNC_POW:
8026 if (wA == 0 && wB < 0) {
8027 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8028 rc = JIM_ERR;
8029 goto done;
8031 wC = JimPowWide(wA, wB);
8032 goto intresult;
8033 case JIM_EXPROP_ADD:
8034 wC = wA + wB;
8035 goto intresult;
8036 case JIM_EXPROP_SUB:
8037 wC = wA - wB;
8038 goto intresult;
8039 case JIM_EXPROP_MUL:
8040 wC = wA * wB;
8041 goto intresult;
8042 case JIM_EXPROP_DIV:
8043 if (wB == 0) {
8044 Jim_SetResultString(interp, "Division by zero", -1);
8045 rc = JIM_ERR;
8046 goto done;
8048 else {
8050 * From Tcl 8.x
8052 * This code is tricky: C doesn't guarantee much
8053 * about the quotient or remainder, but Tcl does.
8054 * The remainder always has the same sign as the
8055 * divisor and a smaller absolute value.
8057 if (wB < 0) {
8058 wB = -wB;
8059 wA = -wA;
8061 wC = wA / wB;
8062 if (wA % wB < 0) {
8063 wC--;
8065 goto intresult;
8067 case JIM_EXPROP_LT:
8068 wC = wA < wB;
8069 goto intresult;
8070 case JIM_EXPROP_GT:
8071 wC = wA > wB;
8072 goto intresult;
8073 case JIM_EXPROP_LTE:
8074 wC = wA <= wB;
8075 goto intresult;
8076 case JIM_EXPROP_GTE:
8077 wC = wA >= wB;
8078 goto intresult;
8079 case JIM_EXPROP_NUMEQ:
8080 wC = wA == wB;
8081 goto intresult;
8082 case JIM_EXPROP_NUMNE:
8083 wC = wA != wB;
8084 goto intresult;
8087 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8088 switch (node->type) {
8089 #ifndef JIM_MATH_FUNCTIONS
8090 case JIM_EXPROP_POW:
8091 case JIM_EXPROP_FUNC_POW:
8092 case JIM_EXPROP_FUNC_ATAN2:
8093 case JIM_EXPROP_FUNC_HYPOT:
8094 case JIM_EXPROP_FUNC_FMOD:
8095 Jim_SetResultString(interp, "unsupported", -1);
8096 rc = JIM_ERR;
8097 goto done;
8098 #else
8099 case JIM_EXPROP_POW:
8100 case JIM_EXPROP_FUNC_POW:
8101 dC = pow(dA, dB);
8102 goto doubleresult;
8103 case JIM_EXPROP_FUNC_ATAN2:
8104 dC = atan2(dA, dB);
8105 goto doubleresult;
8106 case JIM_EXPROP_FUNC_HYPOT:
8107 dC = hypot(dA, dB);
8108 goto doubleresult;
8109 case JIM_EXPROP_FUNC_FMOD:
8110 dC = fmod(dA, dB);
8111 goto doubleresult;
8112 #endif
8113 case JIM_EXPROP_ADD:
8114 dC = dA + dB;
8115 goto doubleresult;
8116 case JIM_EXPROP_SUB:
8117 dC = dA - dB;
8118 goto doubleresult;
8119 case JIM_EXPROP_MUL:
8120 dC = dA * dB;
8121 goto doubleresult;
8122 case JIM_EXPROP_DIV:
8123 if (dB == 0) {
8124 #ifdef INFINITY
8125 dC = dA < 0 ? -INFINITY : INFINITY;
8126 #else
8127 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8128 #endif
8130 else {
8131 dC = dA / dB;
8133 goto doubleresult;
8134 case JIM_EXPROP_LT:
8135 wC = dA < dB;
8136 goto intresult;
8137 case JIM_EXPROP_GT:
8138 wC = dA > dB;
8139 goto intresult;
8140 case JIM_EXPROP_LTE:
8141 wC = dA <= dB;
8142 goto intresult;
8143 case JIM_EXPROP_GTE:
8144 wC = dA >= dB;
8145 goto intresult;
8146 case JIM_EXPROP_NUMEQ:
8147 wC = dA == dB;
8148 goto intresult;
8149 case JIM_EXPROP_NUMNE:
8150 wC = dA != dB;
8151 goto intresult;
8154 else {
8155 /* Handle the string case */
8157 /* XXX: Could optimise the eq/ne case by checking lengths */
8158 int i = Jim_StringCompareObj(interp, A, B, 0);
8160 switch (node->type) {
8161 case JIM_EXPROP_LT:
8162 wC = i < 0;
8163 goto intresult;
8164 case JIM_EXPROP_GT:
8165 wC = i > 0;
8166 goto intresult;
8167 case JIM_EXPROP_LTE:
8168 wC = i <= 0;
8169 goto intresult;
8170 case JIM_EXPROP_GTE:
8171 wC = i >= 0;
8172 goto intresult;
8173 case JIM_EXPROP_NUMEQ:
8174 wC = i == 0;
8175 goto intresult;
8176 case JIM_EXPROP_NUMNE:
8177 wC = i != 0;
8178 goto intresult;
8181 /* If we get here, it is an error */
8182 rc = JIM_ERR;
8183 done:
8184 Jim_DecrRefCount(interp, A);
8185 Jim_DecrRefCount(interp, B);
8186 return rc;
8187 intresult:
8188 Jim_SetResultInt(interp, wC);
8189 goto done;
8190 doubleresult:
8191 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8192 goto done;
8195 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8197 int listlen;
8198 int i;
8200 listlen = Jim_ListLength(interp, listObjPtr);
8201 for (i = 0; i < listlen; i++) {
8202 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8203 return 1;
8206 return 0;
8211 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8213 Jim_Obj *A, *B;
8214 jim_wide wC;
8215 int rc;
8217 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8218 return rc;
8220 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8221 Jim_DecrRefCount(interp, A);
8222 return rc;
8225 switch (node->type) {
8226 case JIM_EXPROP_STREQ:
8227 case JIM_EXPROP_STRNE:
8228 wC = Jim_StringEqObj(A, B);
8229 if (node->type == JIM_EXPROP_STRNE) {
8230 wC = !wC;
8232 break;
8233 case JIM_EXPROP_STRIN:
8234 wC = JimSearchList(interp, B, A);
8235 break;
8236 case JIM_EXPROP_STRNI:
8237 wC = !JimSearchList(interp, B, A);
8238 break;
8239 default:
8240 abort();
8242 Jim_SetResultInt(interp, wC);
8244 Jim_DecrRefCount(interp, A);
8245 Jim_DecrRefCount(interp, B);
8247 return rc;
8250 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8252 long l;
8253 double d;
8254 int b;
8255 int ret = -1;
8257 /* In case the object is interp->result with refcount 1*/
8258 Jim_IncrRefCount(obj);
8260 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8261 ret = (l != 0);
8263 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8264 ret = (d != 0);
8266 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8267 ret = (b != 0);
8270 Jim_DecrRefCount(interp, obj);
8271 return ret;
8274 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8276 /* evaluate left */
8277 int result = JimExprGetTermBoolean(interp, node->left);
8279 if (result == 1) {
8280 /* true so evaluate right */
8281 result = JimExprGetTermBoolean(interp, node->right);
8283 if (result == -1) {
8284 return JIM_ERR;
8286 Jim_SetResultInt(interp, result);
8287 return JIM_OK;
8290 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8292 /* evaluate left */
8293 int result = JimExprGetTermBoolean(interp, node->left);
8295 if (result == 0) {
8296 /* false so evaluate right */
8297 result = JimExprGetTermBoolean(interp, node->right);
8299 if (result == -1) {
8300 return JIM_ERR;
8302 Jim_SetResultInt(interp, result);
8303 return JIM_OK;
8306 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8308 /* evaluate left */
8309 int result = JimExprGetTermBoolean(interp, node->left);
8311 if (result == 1) {
8312 /* true so select right */
8313 return JimExprEvalTermNode(interp, node->right);
8315 else if (result == 0) {
8316 /* false so select ternary */
8317 return JimExprEvalTermNode(interp, node->ternary);
8319 /* error */
8320 return JIM_ERR;
8323 enum
8325 OP_FUNC = 0x0001, /* function syntax */
8326 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8329 /* name - precedence - arity - opcode
8331 * This array *must* be kept in sync with the JIM_EXPROP enum.
8333 * The following macros pre-compute the string length at compile time.
8335 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8336 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8338 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8339 OPRINIT("*", 110, 2, JimExprOpBin),
8340 OPRINIT("/", 110, 2, JimExprOpBin),
8341 OPRINIT("%", 110, 2, JimExprOpIntBin),
8343 OPRINIT("-", 100, 2, JimExprOpBin),
8344 OPRINIT("+", 100, 2, JimExprOpBin),
8346 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8347 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8349 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8350 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8352 OPRINIT("<", 80, 2, JimExprOpBin),
8353 OPRINIT(">", 80, 2, JimExprOpBin),
8354 OPRINIT("<=", 80, 2, JimExprOpBin),
8355 OPRINIT(">=", 80, 2, JimExprOpBin),
8357 OPRINIT("==", 70, 2, JimExprOpBin),
8358 OPRINIT("!=", 70, 2, JimExprOpBin),
8360 OPRINIT("&", 50, 2, JimExprOpIntBin),
8361 OPRINIT("^", 49, 2, JimExprOpIntBin),
8362 OPRINIT("|", 48, 2, JimExprOpIntBin),
8364 OPRINIT("&&", 10, 2, JimExprOpAnd),
8365 OPRINIT("||", 9, 2, JimExprOpOr),
8366 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8367 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8369 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8370 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8372 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8373 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8375 OPRINIT("in", 55, 2, JimExprOpStrBin),
8376 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8378 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8379 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8380 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8381 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8385 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8386 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8387 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8388 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8389 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8390 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8391 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8393 #ifdef JIM_MATH_FUNCTIONS
8394 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8395 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8396 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8397 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8398 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8399 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8400 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8401 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8402 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8403 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8404 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8405 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8406 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8407 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8408 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8409 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8410 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8411 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8412 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8413 #endif
8415 #undef OPRINIT
8416 #undef OPRINIT_ATTR
8418 #define JIM_EXPR_OPERATORS_NUM \
8419 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8421 static int JimParseExpression(struct JimParserCtx *pc)
8423 /* Discard spaces and quoted newline */
8424 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8425 if (*pc->p == '\n') {
8426 pc->linenr++;
8428 pc->p++;
8429 pc->len--;
8432 /* Common case */
8433 pc->tline = pc->linenr;
8434 pc->tstart = pc->p;
8436 if (pc->len == 0) {
8437 pc->tend = pc->p;
8438 pc->tt = JIM_TT_EOL;
8439 pc->eof = 1;
8440 return JIM_OK;
8442 switch (*(pc->p)) {
8443 case '(':
8444 pc->tt = JIM_TT_SUBEXPR_START;
8445 goto singlechar;
8446 case ')':
8447 pc->tt = JIM_TT_SUBEXPR_END;
8448 goto singlechar;
8449 case ',':
8450 pc->tt = JIM_TT_SUBEXPR_COMMA;
8451 singlechar:
8452 pc->tend = pc->p;
8453 pc->p++;
8454 pc->len--;
8455 break;
8456 case '[':
8457 return JimParseCmd(pc);
8458 case '$':
8459 if (JimParseVar(pc) == JIM_ERR)
8460 return JimParseExprOperator(pc);
8461 else {
8462 /* Don't allow expr sugar in expressions */
8463 if (pc->tt == JIM_TT_EXPRSUGAR) {
8464 return JIM_ERR;
8466 return JIM_OK;
8468 break;
8469 case '0':
8470 case '1':
8471 case '2':
8472 case '3':
8473 case '4':
8474 case '5':
8475 case '6':
8476 case '7':
8477 case '8':
8478 case '9':
8479 case '.':
8480 return JimParseExprNumber(pc);
8481 case '"':
8482 return JimParseQuote(pc);
8483 case '{':
8484 return JimParseBrace(pc);
8486 case 'N':
8487 case 'I':
8488 case 'n':
8489 case 'i':
8490 if (JimParseExprIrrational(pc) == JIM_ERR)
8491 if (JimParseExprBoolean(pc) == JIM_ERR)
8492 return JimParseExprOperator(pc);
8493 break;
8494 case 't':
8495 case 'f':
8496 case 'o':
8497 case 'y':
8498 if (JimParseExprBoolean(pc) == JIM_ERR)
8499 return JimParseExprOperator(pc);
8500 break;
8501 default:
8502 return JimParseExprOperator(pc);
8503 break;
8505 return JIM_OK;
8508 static int JimParseExprNumber(struct JimParserCtx *pc)
8510 char *end;
8512 /* Assume an integer for now */
8513 pc->tt = JIM_TT_EXPR_INT;
8515 jim_strtoull(pc->p, (char **)&pc->p);
8516 /* Tried as an integer, but perhaps it parses as a double */
8517 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8518 /* Some stupid compilers insist they are cleverer that
8519 * we are. Even a (void) cast doesn't prevent this warning!
8521 if (strtod(pc->tstart, &end)) { /* nothing */ }
8522 if (end == pc->tstart)
8523 return JIM_ERR;
8524 if (end > pc->p) {
8525 /* Yes, double captured more chars */
8526 pc->tt = JIM_TT_EXPR_DOUBLE;
8527 pc->p = end;
8530 pc->tend = pc->p - 1;
8531 pc->len -= (pc->p - pc->tstart);
8532 return JIM_OK;
8535 static int JimParseExprIrrational(struct JimParserCtx *pc)
8537 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8538 int i;
8540 for (i = 0; irrationals[i]; i++) {
8541 const char *irr = irrationals[i];
8543 if (strncmp(irr, pc->p, 3) == 0) {
8544 pc->p += 3;
8545 pc->len -= 3;
8546 pc->tend = pc->p - 1;
8547 pc->tt = JIM_TT_EXPR_DOUBLE;
8548 return JIM_OK;
8551 return JIM_ERR;
8554 static int JimParseExprBoolean(struct JimParserCtx *pc)
8556 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8557 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8558 int i;
8560 for (i = 0; booleans[i]; i++) {
8561 const char *boolean = booleans[i];
8562 int length = lengths[i];
8564 if (strncmp(boolean, pc->p, length) == 0) {
8565 pc->p += length;
8566 pc->len -= length;
8567 pc->tend = pc->p - 1;
8568 pc->tt = JIM_TT_EXPR_BOOLEAN;
8569 return JIM_OK;
8572 return JIM_ERR;
8575 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8577 static Jim_ExprOperator dummy_op;
8578 if (opcode < JIM_TT_EXPR_OP) {
8579 return &dummy_op;
8581 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8584 static int JimParseExprOperator(struct JimParserCtx *pc)
8586 int i;
8587 const struct Jim_ExprOperator *bestOp = NULL;
8588 int bestLen = 0;
8590 /* Try to get the longest match. */
8591 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8592 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8594 if (op->name[0] != pc->p[0]) {
8595 continue;
8598 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8599 bestOp = op;
8600 bestLen = op->namelen;
8603 if (bestOp == NULL) {
8604 return JIM_ERR;
8607 /* Validate paretheses around function arguments */
8608 if (bestOp->attr & OP_FUNC) {
8609 const char *p = pc->p + bestLen;
8610 int len = pc->len - bestLen;
8612 while (len && isspace(UCHAR(*p))) {
8613 len--;
8614 p++;
8616 if (*p != '(') {
8617 return JIM_ERR;
8620 pc->tend = pc->p + bestLen - 1;
8621 pc->p += bestLen;
8622 pc->len -= bestLen;
8624 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8625 return JIM_OK;
8628 const char *jim_tt_name(int type)
8630 static const char * const tt_names[JIM_TT_EXPR_OP] =
8631 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8632 "DBL", "BOO", "$()" };
8633 if (type < JIM_TT_EXPR_OP) {
8634 return tt_names[type];
8636 else if (type == JIM_EXPROP_UNARYMINUS) {
8637 return "-VE";
8639 else if (type == JIM_EXPROP_UNARYPLUS) {
8640 return "+VE";
8642 else {
8643 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8644 static char buf[20];
8646 if (op->name) {
8647 return op->name;
8649 sprintf(buf, "(%d)", type);
8650 return buf;
8654 /* -----------------------------------------------------------------------------
8655 * Expression Object
8656 * ---------------------------------------------------------------------------*/
8657 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8658 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8659 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8661 static const Jim_ObjType exprObjType = {
8662 "expression",
8663 FreeExprInternalRep,
8664 DupExprInternalRep,
8665 NULL,
8666 JIM_TYPE_REFERENCES,
8669 /* expr tree structure */
8670 struct ExprTree
8672 struct JimExprNode *expr; /* The first operator or term */
8673 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8674 int len; /* Number of nodes in use */
8675 int inUse; /* Used for sharing. */
8678 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8680 int i;
8681 for (i = 0; i < num; i++) {
8682 if (nodes[i].objPtr) {
8683 Jim_DecrRefCount(interp, nodes[i].objPtr);
8686 Jim_Free(nodes);
8689 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8691 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8692 Jim_Free(expr);
8695 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8697 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8699 if (expr) {
8700 if (--expr->inUse != 0) {
8701 return;
8704 ExprTreeFree(interp, expr);
8708 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8710 JIM_NOTUSED(interp);
8711 JIM_NOTUSED(srcPtr);
8713 /* Just returns an simple string. */
8714 dupPtr->typePtr = NULL;
8717 struct ExprBuilder {
8718 int parencount; /* count of outstanding parentheses */
8719 int level; /* recursion depth */
8720 ParseToken *token; /* The current token */
8721 ParseToken *first_token; /* The first token */
8722 Jim_Stack stack; /* stack of pending terms */
8723 Jim_Obj *exprObjPtr; /* the original expression */
8724 Jim_Obj *fileNameObj; /* filename of the original expression */
8725 struct JimExprNode *nodes; /* storage for all nodes */
8726 struct JimExprNode *next; /* storage for the next node */
8729 #ifdef DEBUG_SHOW_EXPR
8730 static void JimShowExprNode(struct JimExprNode *node, int level)
8732 int i;
8733 for (i = 0; i < level; i++) {
8734 printf(" ");
8736 if (TOKEN_IS_EXPR_OP(node->type)) {
8737 printf("%s\n", jim_tt_name(node->type));
8738 if (node->left) {
8739 JimShowExprNode(node->left, level + 1);
8741 if (node->right) {
8742 JimShowExprNode(node->right, level + 1);
8744 if (node->ternary) {
8745 JimShowExprNode(node->ternary, level + 1);
8748 else {
8749 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8752 #endif
8754 #define EXPR_UNTIL_CLOSE 0x0001
8755 #define EXPR_FUNC_ARGS 0x0002
8756 #define EXPR_TERNARY 0x0004
8759 * Parse the subexpression at builder->token and return with the node on the stack.
8760 * builder->token is advanced to the next unconsumed token.
8761 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8763 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8764 * with an equal or lower precedence is reached (or strictly lower if right associative).
8766 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8767 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8768 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8770 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8772 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8774 int rc;
8775 struct JimExprNode *node;
8776 /* Calculate the stack length expected after pushing the number of expected terms */
8777 int exp_stacklen = builder->stack.len + exp_numterms;
8779 if (builder->level++ > 200) {
8780 Jim_SetResultString(interp, "Expression too complex", -1);
8781 return JIM_ERR;
8784 while (builder->token->type != JIM_TT_EOL) {
8785 ParseToken *t = builder->token++;
8786 int prevtt;
8788 if (t == builder->first_token) {
8789 prevtt = JIM_TT_NONE;
8791 else {
8792 prevtt = t[-1].type;
8795 if (t->type == JIM_TT_SUBEXPR_START) {
8796 if (builder->stack.len == exp_stacklen) {
8797 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8798 return JIM_ERR;
8800 builder->parencount++;
8801 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8802 if (rc != JIM_OK) {
8803 return rc;
8805 /* A complete subexpression is on the stack */
8807 else if (t->type == JIM_TT_SUBEXPR_END) {
8808 if (!(flags & EXPR_UNTIL_CLOSE)) {
8809 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8810 builder->token--;
8811 builder->level--;
8812 return JIM_OK;
8814 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8815 return JIM_ERR;
8817 builder->parencount--;
8818 if (builder->stack.len == exp_stacklen) {
8819 /* Return with the expected number of subexpressions on the stack */
8820 break;
8823 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8824 if (!(flags & EXPR_FUNC_ARGS)) {
8825 if (builder->stack.len == exp_stacklen) {
8826 /* handle the comma back at the parent level */
8827 builder->token--;
8828 builder->level--;
8829 return JIM_OK;
8831 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8832 return JIM_ERR;
8834 else {
8835 /* If we see more terms than expected, it is an error */
8836 if (builder->stack.len > exp_stacklen) {
8837 Jim_SetResultFormatted(interp, "too many arguments to math function");
8838 return JIM_ERR;
8841 /* just go onto the next arg */
8843 else if (t->type == JIM_EXPROP_COLON) {
8844 if (!(flags & EXPR_TERNARY)) {
8845 if (builder->level != 1) {
8846 /* handle the comma back at the parent level */
8847 builder->token--;
8848 builder->level--;
8849 return JIM_OK;
8851 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8852 return JIM_ERR;
8854 if (builder->stack.len == exp_stacklen) {
8855 /* handle the comma back at the parent level */
8856 builder->token--;
8857 builder->level--;
8858 return JIM_OK;
8860 /* just go onto the next term */
8862 else if (TOKEN_IS_EXPR_OP(t->type)) {
8863 const struct Jim_ExprOperator *op;
8865 /* Convert -/+ to unary minus or unary plus if necessary */
8866 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8867 if (t->type == JIM_EXPROP_SUB) {
8868 t->type = JIM_EXPROP_UNARYMINUS;
8870 else if (t->type == JIM_EXPROP_ADD) {
8871 t->type = JIM_EXPROP_UNARYPLUS;
8875 op = JimExprOperatorInfoByOpcode(t->type);
8877 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8878 /* next op is lower precedence, or equal and left associative, so done here */
8879 builder->token--;
8880 break;
8883 if (op->attr & OP_FUNC) {
8884 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8885 Jim_SetResultString(interp, "missing arguments for math function", -1);
8886 return JIM_ERR;
8888 builder->token++;
8889 if (op->arity == 0) {
8890 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8891 Jim_SetResultString(interp, "too many arguments for math function", -1);
8892 return JIM_ERR;
8894 builder->token++;
8895 goto noargs;
8897 builder->parencount++;
8899 /* This will push left and return right */
8900 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8902 else if (t->type == JIM_EXPROP_TERNARY) {
8903 /* Collect the two arguments to the ternary operator */
8904 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8906 else {
8907 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8908 * and push that on the term stack
8910 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8913 if (rc != JIM_OK) {
8914 return rc;
8917 noargs:
8918 node = builder->next++;
8919 node->type = t->type;
8921 if (op->arity >= 3) {
8922 node->ternary = Jim_StackPop(&builder->stack);
8923 if (node->ternary == NULL) {
8924 goto missingoperand;
8927 if (op->arity >= 2) {
8928 node->right = Jim_StackPop(&builder->stack);
8929 if (node->right == NULL) {
8930 goto missingoperand;
8933 if (op->arity >= 1) {
8934 node->left = Jim_StackPop(&builder->stack);
8935 if (node->left == NULL) {
8936 missingoperand:
8937 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8938 builder->next--;
8939 return JIM_ERR;
8944 /* Now push the node */
8945 Jim_StackPush(&builder->stack, node);
8947 else {
8948 Jim_Obj *objPtr = NULL;
8950 /* This is a simple non-operator term, so create and push the appropriate object */
8952 /* Two consecutive terms without an operator is invalid */
8953 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
8954 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
8955 return JIM_ERR;
8958 /* Immediately create a double or int object? */
8959 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
8960 char *endptr;
8961 if (t->type == JIM_TT_EXPR_INT) {
8962 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8964 else {
8965 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8967 if (endptr != t->token + t->len) {
8968 /* Conversion failed, so just store it as a string */
8969 Jim_FreeNewObj(interp, objPtr);
8970 objPtr = NULL;
8974 if (!objPtr) {
8975 /* Everything else is stored a simple string term */
8976 objPtr = Jim_NewStringObj(interp, t->token, t->len);
8977 if (t->type == JIM_TT_CMD) {
8978 /* Only commands need source info */
8979 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
8983 /* Now push a term node */
8984 node = builder->next++;
8985 node->objPtr = objPtr;
8986 Jim_IncrRefCount(node->objPtr);
8987 node->type = t->type;
8988 Jim_StackPush(&builder->stack, node);
8992 if (builder->stack.len == exp_stacklen) {
8993 builder->level--;
8994 return JIM_OK;
8997 if ((flags & EXPR_FUNC_ARGS)) {
8998 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9000 else {
9001 if (builder->stack.len < exp_stacklen) {
9002 if (builder->level == 0) {
9003 Jim_SetResultFormatted(interp, "empty expression");
9005 else {
9006 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9009 else {
9010 Jim_SetResultFormatted(interp, "extra terms after expression");
9014 return JIM_ERR;
9017 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9019 struct ExprTree *expr;
9020 struct ExprBuilder builder;
9021 int rc;
9022 struct JimExprNode *top = NULL;
9024 builder.parencount = 0;
9025 builder.level = 0;
9026 builder.token = builder.first_token = tokenlist->list;
9027 builder.exprObjPtr = exprObjPtr;
9028 builder.fileNameObj = fileNameObj;
9029 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9030 builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9031 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9032 builder.next = builder.nodes;
9033 Jim_InitStack(&builder.stack);
9035 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9037 if (rc == JIM_OK) {
9038 top = Jim_StackPop(&builder.stack);
9040 if (builder.parencount) {
9041 Jim_SetResultString(interp, "missing close parenthesis", -1);
9042 rc = JIM_ERR;
9046 /* Free the stack used for the compilation. */
9047 Jim_FreeStack(&builder.stack);
9049 if (rc != JIM_OK) {
9050 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9051 return NULL;
9054 expr = Jim_Alloc(sizeof(*expr));
9055 expr->inUse = 1;
9056 expr->expr = top;
9057 expr->nodes = builder.nodes;
9058 expr->len = builder.next - builder.nodes;
9060 assert(expr->len <= tokenlist->count - 1);
9062 return expr;
9065 /* This method takes the string representation of an expression
9066 * and generates a program for the expr engine */
9067 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9069 int exprTextLen;
9070 const char *exprText;
9071 struct JimParserCtx parser;
9072 struct ExprTree *expr;
9073 ParseTokenList tokenlist;
9074 int line;
9075 Jim_Obj *fileNameObj;
9076 int rc = JIM_ERR;
9078 /* Try to get information about filename / line number */
9079 if (objPtr->typePtr == &sourceObjType) {
9080 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9081 line = objPtr->internalRep.sourceValue.lineNumber;
9083 else {
9084 fileNameObj = interp->emptyObj;
9085 line = 1;
9087 Jim_IncrRefCount(fileNameObj);
9089 exprText = Jim_GetString(objPtr, &exprTextLen);
9091 /* Initially tokenise the expression into tokenlist */
9092 ScriptTokenListInit(&tokenlist);
9094 JimParserInit(&parser, exprText, exprTextLen, line);
9095 while (!parser.eof) {
9096 if (JimParseExpression(&parser) != JIM_OK) {
9097 ScriptTokenListFree(&tokenlist);
9098 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9099 expr = NULL;
9100 goto err;
9103 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9104 parser.tline);
9107 #ifdef DEBUG_SHOW_EXPR_TOKENS
9109 int i;
9110 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9111 for (i = 0; i < tokenlist.count; i++) {
9112 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9113 tokenlist.list[i].len, tokenlist.list[i].token);
9116 #endif
9118 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9119 ScriptTokenListFree(&tokenlist);
9120 Jim_DecrRefCount(interp, fileNameObj);
9121 return JIM_ERR;
9124 /* Now create the expression bytecode from the tokenlist */
9125 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9127 /* No longer need the token list */
9128 ScriptTokenListFree(&tokenlist);
9130 if (!expr) {
9131 goto err;
9134 #ifdef DEBUG_SHOW_EXPR
9135 printf("==== Expr ====\n");
9136 JimShowExprNode(expr->expr, 0);
9137 #endif
9139 rc = JIM_OK;
9141 err:
9142 /* Free the old internal rep and set the new one. */
9143 Jim_DecrRefCount(interp, fileNameObj);
9144 Jim_FreeIntRep(interp, objPtr);
9145 Jim_SetIntRepPtr(objPtr, expr);
9146 objPtr->typePtr = &exprObjType;
9147 return rc;
9150 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9152 if (objPtr->typePtr != &exprObjType) {
9153 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9154 return NULL;
9157 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9160 #ifdef JIM_OPTIMIZATION
9161 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9163 if (node->type == JIM_TT_EXPR_INT)
9164 return node->objPtr;
9165 else if (node->type == JIM_TT_VAR)
9166 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9167 else if (node->type == JIM_TT_DICTSUGAR)
9168 return JimExpandDictSugar(interp, node->objPtr);
9169 else
9170 return NULL;
9172 #endif
9174 /* -----------------------------------------------------------------------------
9175 * Expressions evaluation.
9176 * Jim uses a recursive evaluation engine for expressions,
9177 * that takes advantage of the fact that expr's operators
9178 * can't be redefined.
9180 * Jim_EvalExpression() uses the expression tree compiled by
9181 * SetExprFromAny() method of the "expression" object.
9183 * On success a Tcl Object containing the result of the evaluation
9184 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9185 * returned.
9186 * On error the function returns a retcode != to JIM_OK and set a suitable
9187 * error on the interp.
9188 * ---------------------------------------------------------------------------*/
9190 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9192 if (TOKEN_IS_EXPR_OP(node->type)) {
9193 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9194 return op->funcop(interp, node);
9196 else {
9197 Jim_Obj *objPtr;
9199 /* A term */
9200 switch (node->type) {
9201 case JIM_TT_EXPR_INT:
9202 case JIM_TT_EXPR_DOUBLE:
9203 case JIM_TT_EXPR_BOOLEAN:
9204 case JIM_TT_STR:
9205 Jim_SetResult(interp, node->objPtr);
9206 return JIM_OK;
9208 case JIM_TT_VAR:
9209 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9210 if (objPtr) {
9211 Jim_SetResult(interp, objPtr);
9212 return JIM_OK;
9214 return JIM_ERR;
9216 case JIM_TT_DICTSUGAR:
9217 objPtr = JimExpandDictSugar(interp, node->objPtr);
9218 if (objPtr) {
9219 Jim_SetResult(interp, objPtr);
9220 return JIM_OK;
9222 return JIM_ERR;
9224 case JIM_TT_ESC:
9225 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9226 Jim_SetResult(interp, objPtr);
9227 return JIM_OK;
9229 return JIM_ERR;
9231 case JIM_TT_CMD:
9232 return Jim_EvalObj(interp, node->objPtr);
9234 default:
9235 /* Should never get here */
9236 return JIM_ERR;
9241 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9243 int rc = JimExprEvalTermNode(interp, node);
9244 if (rc == JIM_OK) {
9245 *objPtrPtr = Jim_GetResult(interp);
9246 Jim_IncrRefCount(*objPtrPtr);
9248 return rc;
9251 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9253 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9254 return ExprBool(interp, Jim_GetResult(interp));
9256 return -1;
9259 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9261 struct ExprTree *expr;
9262 int retcode = JIM_OK;
9264 expr = JimGetExpression(interp, exprObjPtr);
9265 if (!expr) {
9266 return JIM_ERR; /* error in expression. */
9269 #ifdef JIM_OPTIMIZATION
9270 /* Check for one of the following common expressions used by while/for
9272 * CONST
9273 * $a
9274 * !$a
9275 * $a < CONST, $a < $b
9276 * $a <= CONST, $a <= $b
9277 * $a > CONST, $a > $b
9278 * $a >= CONST, $a >= $b
9279 * $a != CONST, $a != $b
9280 * $a == CONST, $a == $b
9283 Jim_Obj *objPtr;
9285 /* STEP 1 -- Check if there are the conditions to run the specialized
9286 * version of while */
9288 switch (expr->len) {
9289 case 1:
9290 objPtr = JimExprIntValOrVar(interp, expr->expr);
9291 if (objPtr) {
9292 Jim_SetResult(interp, objPtr);
9293 return JIM_OK;
9295 break;
9297 case 2:
9298 if (expr->expr->type == JIM_EXPROP_NOT) {
9299 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9301 if (objPtr && JimIsWide(objPtr)) {
9302 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9303 return JIM_OK;
9306 break;
9308 case 3:
9309 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9310 if (objPtr && JimIsWide(objPtr)) {
9311 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9312 if (objPtr2 && JimIsWide(objPtr2)) {
9313 jim_wide wideValueA = JimWideValue(objPtr);
9314 jim_wide wideValueB = JimWideValue(objPtr2);
9315 int cmpRes;
9316 switch (expr->expr->type) {
9317 case JIM_EXPROP_LT:
9318 cmpRes = wideValueA < wideValueB;
9319 break;
9320 case JIM_EXPROP_LTE:
9321 cmpRes = wideValueA <= wideValueB;
9322 break;
9323 case JIM_EXPROP_GT:
9324 cmpRes = wideValueA > wideValueB;
9325 break;
9326 case JIM_EXPROP_GTE:
9327 cmpRes = wideValueA >= wideValueB;
9328 break;
9329 case JIM_EXPROP_NUMEQ:
9330 cmpRes = wideValueA == wideValueB;
9331 break;
9332 case JIM_EXPROP_NUMNE:
9333 cmpRes = wideValueA != wideValueB;
9334 break;
9335 default:
9336 goto noopt;
9338 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9339 return JIM_OK;
9342 break;
9345 noopt:
9346 #endif
9348 /* In order to avoid the internal repr being freed due to
9349 * shimmering of the exprObjPtr's object, we make the internal rep
9350 * shared. */
9351 expr->inUse++;
9353 /* Evaluate with the recursive expr engine */
9354 retcode = JimExprEvalTermNode(interp, expr->expr);
9356 expr->inUse--;
9358 return retcode;
9361 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9363 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9365 if (retcode == JIM_OK) {
9366 switch (ExprBool(interp, Jim_GetResult(interp))) {
9367 case 0:
9368 *boolPtr = 0;
9369 break;
9371 case 1:
9372 *boolPtr = 1;
9373 break;
9375 case -1:
9376 retcode = JIM_ERR;
9377 break;
9380 return retcode;
9383 /* -----------------------------------------------------------------------------
9384 * ScanFormat String Object
9385 * ---------------------------------------------------------------------------*/
9387 /* This Jim_Obj will held a parsed representation of a format string passed to
9388 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9389 * to be parsed in its entirely first and then, if correct, can be used for
9390 * scanning. To avoid endless re-parsing, the parsed representation will be
9391 * stored in an internal representation and re-used for performance reason. */
9393 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9394 * scanformat string. This part will later be used to extract information
9395 * out from the string to be parsed by Jim_ScanString */
9397 typedef struct ScanFmtPartDescr
9399 const char *arg; /* Specification of a CHARSET conversion */
9400 const char *prefix; /* Prefix to be scanned literally before conversion */
9401 size_t width; /* Maximal width of input to be converted */
9402 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9403 char type; /* Type of conversion (e.g. c, d, f) */
9404 char modifier; /* Modify type (e.g. l - long, h - short */
9405 } ScanFmtPartDescr;
9407 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9408 * string parsed and separated in part descriptions. Furthermore it contains
9409 * the original string representation of the scanformat string to allow for
9410 * fast update of the Jim_Obj's string representation part.
9412 * As an add-on the internal object representation adds some scratch pad area
9413 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9414 * memory for purpose of string scanning.
9416 * The error member points to a static allocated string in case of a mal-
9417 * formed scanformat string or it contains '0' (NULL) in case of a valid
9418 * parse representation.
9420 * The whole memory of the internal representation is allocated as a single
9421 * area of memory that will be internally separated. So freeing and duplicating
9422 * of such an object is cheap */
9424 typedef struct ScanFmtStringObj
9426 jim_wide size; /* Size of internal repr in bytes */
9427 char *stringRep; /* Original string representation */
9428 size_t count; /* Number of ScanFmtPartDescr contained */
9429 size_t convCount; /* Number of conversions that will assign */
9430 size_t maxPos; /* Max position index if XPG3 is used */
9431 const char *error; /* Ptr to error text (NULL if no error */
9432 char *scratch; /* Some scratch pad used by Jim_ScanString */
9433 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9434 } ScanFmtStringObj;
9437 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9438 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9439 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9441 static const Jim_ObjType scanFmtStringObjType = {
9442 "scanformatstring",
9443 FreeScanFmtInternalRep,
9444 DupScanFmtInternalRep,
9445 UpdateStringOfScanFmt,
9446 JIM_TYPE_NONE,
9449 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9451 JIM_NOTUSED(interp);
9452 Jim_Free((char *)objPtr->internalRep.ptr);
9453 objPtr->internalRep.ptr = 0;
9456 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9458 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9459 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9461 JIM_NOTUSED(interp);
9462 memcpy(newVec, srcPtr->internalRep.ptr, size);
9463 dupPtr->internalRep.ptr = newVec;
9464 dupPtr->typePtr = &scanFmtStringObjType;
9467 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9469 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9472 /* SetScanFmtFromAny will parse a given string and create the internal
9473 * representation of the format specification. In case of an error
9474 * the error data member of the internal representation will be set
9475 * to an descriptive error text and the function will be left with
9476 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9477 * specification */
9479 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9481 ScanFmtStringObj *fmtObj;
9482 char *buffer;
9483 int maxCount, i, approxSize, lastPos = -1;
9484 const char *fmt = Jim_String(objPtr);
9485 int maxFmtLen = Jim_Length(objPtr);
9486 const char *fmtEnd = fmt + maxFmtLen;
9487 int curr;
9489 Jim_FreeIntRep(interp, objPtr);
9490 /* Count how many conversions could take place maximally */
9491 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9492 if (fmt[i] == '%')
9493 ++maxCount;
9494 /* Calculate an approximation of the memory necessary */
9495 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9496 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9497 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9498 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9499 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9500 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9501 +1; /* safety byte */
9502 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9503 memset(fmtObj, 0, approxSize);
9504 fmtObj->size = approxSize;
9505 fmtObj->maxPos = 0;
9506 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9507 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9508 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9509 buffer = fmtObj->stringRep + maxFmtLen + 1;
9510 objPtr->internalRep.ptr = fmtObj;
9511 objPtr->typePtr = &scanFmtStringObjType;
9512 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9513 int width = 0, skip;
9514 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9516 fmtObj->count++;
9517 descr->width = 0; /* Assume width unspecified */
9518 /* Overread and store any "literal" prefix */
9519 if (*fmt != '%' || fmt[1] == '%') {
9520 descr->type = 0;
9521 descr->prefix = &buffer[i];
9522 for (; fmt < fmtEnd; ++fmt) {
9523 if (*fmt == '%') {
9524 if (fmt[1] != '%')
9525 break;
9526 ++fmt;
9528 buffer[i++] = *fmt;
9530 buffer[i++] = 0;
9532 /* Skip the conversion introducing '%' sign */
9533 ++fmt;
9534 /* End reached due to non-conversion literal only? */
9535 if (fmt >= fmtEnd)
9536 goto done;
9537 descr->pos = 0; /* Assume "natural" positioning */
9538 if (*fmt == '*') {
9539 descr->pos = -1; /* Okay, conversion will not be assigned */
9540 ++fmt;
9542 else
9543 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9544 /* Check if next token is a number (could be width or pos */
9545 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9546 fmt += skip;
9547 /* Was the number a XPG3 position specifier? */
9548 if (descr->pos != -1 && *fmt == '$') {
9549 int prev;
9551 ++fmt;
9552 descr->pos = width;
9553 width = 0;
9554 /* Look if "natural" postioning and XPG3 one was mixed */
9555 if ((lastPos == 0 && descr->pos > 0)
9556 || (lastPos > 0 && descr->pos == 0)) {
9557 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9558 return JIM_ERR;
9560 /* Look if this position was already used */
9561 for (prev = 0; prev < curr; ++prev) {
9562 if (fmtObj->descr[prev].pos == -1)
9563 continue;
9564 if (fmtObj->descr[prev].pos == descr->pos) {
9565 fmtObj->error =
9566 "variable is assigned by multiple \"%n$\" conversion specifiers";
9567 return JIM_ERR;
9570 if (descr->pos < 0) {
9571 fmtObj->error =
9572 "\"%n$\" conversion specifier is negative";
9573 return JIM_ERR;
9575 /* Try to find a width after the XPG3 specifier */
9576 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9577 descr->width = width;
9578 fmt += skip;
9580 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9581 fmtObj->maxPos = descr->pos;
9583 else {
9584 /* Number was not a XPG3, so it has to be a width */
9585 descr->width = width;
9588 /* If positioning mode was undetermined yet, fix this */
9589 if (lastPos == -1)
9590 lastPos = descr->pos;
9591 /* Handle CHARSET conversion type ... */
9592 if (*fmt == '[') {
9593 int swapped = 1, beg = i, end, j;
9595 descr->type = '[';
9596 descr->arg = &buffer[i];
9597 ++fmt;
9598 if (*fmt == '^')
9599 buffer[i++] = *fmt++;
9600 if (*fmt == ']')
9601 buffer[i++] = *fmt++;
9602 while (*fmt && *fmt != ']')
9603 buffer[i++] = *fmt++;
9604 if (*fmt != ']') {
9605 fmtObj->error = "unmatched [ in format string";
9606 return JIM_ERR;
9608 end = i;
9609 buffer[i++] = 0;
9610 /* In case a range fence was given "backwards", swap it */
9611 while (swapped) {
9612 swapped = 0;
9613 for (j = beg + 1; j < end - 1; ++j) {
9614 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9615 char tmp = buffer[j - 1];
9617 buffer[j - 1] = buffer[j + 1];
9618 buffer[j + 1] = tmp;
9619 swapped = 1;
9624 else {
9625 /* Remember any valid modifier if given */
9626 if (fmt < fmtEnd && strchr("hlL", *fmt))
9627 descr->modifier = tolower((int)*fmt++);
9629 if (fmt >= fmtEnd) {
9630 fmtObj->error = "missing scan conversion character";
9631 return JIM_ERR;
9634 descr->type = *fmt;
9635 if (strchr("efgcsndoxui", *fmt) == 0) {
9636 fmtObj->error = "bad scan conversion character";
9637 return JIM_ERR;
9639 else if (*fmt == 'c' && descr->width != 0) {
9640 fmtObj->error = "field width may not be specified in %c " "conversion";
9641 return JIM_ERR;
9643 else if (*fmt == 'u' && descr->modifier == 'l') {
9644 fmtObj->error = "unsigned wide not supported";
9645 return JIM_ERR;
9648 curr++;
9650 done:
9651 return JIM_OK;
9654 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9656 #define FormatGetCnvCount(_fo_) \
9657 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9658 #define FormatGetMaxPos(_fo_) \
9659 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9660 #define FormatGetError(_fo_) \
9661 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9663 /* JimScanAString is used to scan an unspecified string that ends with
9664 * next WS, or a string that is specified via a charset.
9667 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9669 char *buffer = Jim_StrDup(str);
9670 char *p = buffer;
9672 while (*str) {
9673 int c;
9674 int n;
9676 if (!sdescr && isspace(UCHAR(*str)))
9677 break; /* EOS via WS if unspecified */
9679 n = utf8_tounicode(str, &c);
9680 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9681 break;
9682 while (n--)
9683 *p++ = *str++;
9685 *p = 0;
9686 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9689 /* ScanOneEntry will scan one entry out of the string passed as argument.
9690 * It use the sscanf() function for this task. After extracting and
9691 * converting of the value, the count of scanned characters will be
9692 * returned of -1 in case of no conversion tool place and string was
9693 * already scanned thru */
9695 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9696 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9698 const char *tok;
9699 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9700 size_t scanned = 0;
9701 size_t anchor = pos;
9702 int i;
9703 Jim_Obj *tmpObj = NULL;
9705 /* First pessimistically assume, we will not scan anything :-) */
9706 *valObjPtr = 0;
9707 if (descr->prefix) {
9708 /* There was a prefix given before the conversion, skip it and adjust
9709 * the string-to-be-parsed accordingly */
9710 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9711 /* If prefix require, skip WS */
9712 if (isspace(UCHAR(descr->prefix[i])))
9713 while (pos < strLen && isspace(UCHAR(str[pos])))
9714 ++pos;
9715 else if (descr->prefix[i] != str[pos])
9716 break; /* Prefix do not match here, leave the loop */
9717 else
9718 ++pos; /* Prefix matched so far, next round */
9720 if (pos >= strLen) {
9721 return -1; /* All of str consumed: EOF condition */
9723 else if (descr->prefix[i] != 0)
9724 return 0; /* Not whole prefix consumed, no conversion possible */
9726 /* For all but following conversion, skip leading WS */
9727 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9728 while (isspace(UCHAR(str[pos])))
9729 ++pos;
9730 /* Determine how much skipped/scanned so far */
9731 scanned = pos - anchor;
9733 /* %c is a special, simple case. no width */
9734 if (descr->type == 'n') {
9735 /* Return pseudo conversion means: how much scanned so far? */
9736 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9738 else if (pos >= strLen) {
9739 /* Cannot scan anything, as str is totally consumed */
9740 return -1;
9742 else if (descr->type == 'c') {
9743 int c;
9744 scanned += utf8_tounicode(&str[pos], &c);
9745 *valObjPtr = Jim_NewIntObj(interp, c);
9746 return scanned;
9748 else {
9749 /* Processing of conversions follows ... */
9750 if (descr->width > 0) {
9751 /* Do not try to scan as fas as possible but only the given width.
9752 * To ensure this, we copy the part that should be scanned. */
9753 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9754 size_t tLen = descr->width > sLen ? sLen : descr->width;
9756 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9757 tok = tmpObj->bytes;
9759 else {
9760 /* As no width was given, simply refer to the original string */
9761 tok = &str[pos];
9763 switch (descr->type) {
9764 case 'd':
9765 case 'o':
9766 case 'x':
9767 case 'u':
9768 case 'i':{
9769 char *endp; /* Position where the number finished */
9770 jim_wide w;
9772 int base = descr->type == 'o' ? 8
9773 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9775 /* Try to scan a number with the given base */
9776 if (base == 0) {
9777 w = jim_strtoull(tok, &endp);
9779 else {
9780 w = strtoull(tok, &endp, base);
9783 if (endp != tok) {
9784 /* There was some number sucessfully scanned! */
9785 *valObjPtr = Jim_NewIntObj(interp, w);
9787 /* Adjust the number-of-chars scanned so far */
9788 scanned += endp - tok;
9790 else {
9791 /* Nothing was scanned. We have to determine if this
9792 * happened due to e.g. prefix mismatch or input str
9793 * exhausted */
9794 scanned = *tok ? 0 : -1;
9796 break;
9798 case 's':
9799 case '[':{
9800 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9801 scanned += Jim_Length(*valObjPtr);
9802 break;
9804 case 'e':
9805 case 'f':
9806 case 'g':{
9807 char *endp;
9808 double value = strtod(tok, &endp);
9810 if (endp != tok) {
9811 /* There was some number sucessfully scanned! */
9812 *valObjPtr = Jim_NewDoubleObj(interp, value);
9813 /* Adjust the number-of-chars scanned so far */
9814 scanned += endp - tok;
9816 else {
9817 /* Nothing was scanned. We have to determine if this
9818 * happened due to e.g. prefix mismatch or input str
9819 * exhausted */
9820 scanned = *tok ? 0 : -1;
9822 break;
9825 /* If a substring was allocated (due to pre-defined width) do not
9826 * forget to free it */
9827 if (tmpObj) {
9828 Jim_FreeNewObj(interp, tmpObj);
9831 return scanned;
9834 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9835 * string and returns all converted (and not ignored) values in a list back
9836 * to the caller. If an error occured, a NULL pointer will be returned */
9838 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9840 size_t i, pos;
9841 int scanned = 1;
9842 const char *str = Jim_String(strObjPtr);
9843 int strLen = Jim_Utf8Length(interp, strObjPtr);
9844 Jim_Obj *resultList = 0;
9845 Jim_Obj **resultVec = 0;
9846 int resultc;
9847 Jim_Obj *emptyStr = 0;
9848 ScanFmtStringObj *fmtObj;
9850 /* This should never happen. The format object should already be of the correct type */
9851 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9853 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9854 /* Check if format specification was valid */
9855 if (fmtObj->error != 0) {
9856 if (flags & JIM_ERRMSG)
9857 Jim_SetResultString(interp, fmtObj->error, -1);
9858 return 0;
9860 /* Allocate a new "shared" empty string for all unassigned conversions */
9861 emptyStr = Jim_NewEmptyStringObj(interp);
9862 Jim_IncrRefCount(emptyStr);
9863 /* Create a list and fill it with empty strings up to max specified XPG3 */
9864 resultList = Jim_NewListObj(interp, NULL, 0);
9865 if (fmtObj->maxPos > 0) {
9866 for (i = 0; i < fmtObj->maxPos; ++i)
9867 Jim_ListAppendElement(interp, resultList, emptyStr);
9868 JimListGetElements(interp, resultList, &resultc, &resultVec);
9870 /* Now handle every partial format description */
9871 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9872 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9873 Jim_Obj *value = 0;
9875 /* Only last type may be "literal" w/o conversion - skip it! */
9876 if (descr->type == 0)
9877 continue;
9878 /* As long as any conversion could be done, we will proceed */
9879 if (scanned > 0)
9880 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9881 /* In case our first try results in EOF, we will leave */
9882 if (scanned == -1 && i == 0)
9883 goto eof;
9884 /* Advance next pos-to-be-scanned for the amount scanned already */
9885 pos += scanned;
9887 /* value == 0 means no conversion took place so take empty string */
9888 if (value == 0)
9889 value = Jim_NewEmptyStringObj(interp);
9890 /* If value is a non-assignable one, skip it */
9891 if (descr->pos == -1) {
9892 Jim_FreeNewObj(interp, value);
9894 else if (descr->pos == 0)
9895 /* Otherwise append it to the result list if no XPG3 was given */
9896 Jim_ListAppendElement(interp, resultList, value);
9897 else if (resultVec[descr->pos - 1] == emptyStr) {
9898 /* But due to given XPG3, put the value into the corr. slot */
9899 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9900 Jim_IncrRefCount(value);
9901 resultVec[descr->pos - 1] = value;
9903 else {
9904 /* Otherwise, the slot was already used - free obj and ERROR */
9905 Jim_FreeNewObj(interp, value);
9906 goto err;
9909 Jim_DecrRefCount(interp, emptyStr);
9910 return resultList;
9911 eof:
9912 Jim_DecrRefCount(interp, emptyStr);
9913 Jim_FreeNewObj(interp, resultList);
9914 return (Jim_Obj *)EOF;
9915 err:
9916 Jim_DecrRefCount(interp, emptyStr);
9917 Jim_FreeNewObj(interp, resultList);
9918 return 0;
9921 /* -----------------------------------------------------------------------------
9922 * Pseudo Random Number Generation
9923 * ---------------------------------------------------------------------------*/
9924 /* Initialize the sbox with the numbers from 0 to 255 */
9925 static void JimPrngInit(Jim_Interp *interp)
9927 #define PRNG_SEED_SIZE 256
9928 int i;
9929 unsigned int *seed;
9930 time_t t = time(NULL);
9932 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9934 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9935 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9936 seed[i] = (rand() ^ t ^ clock());
9938 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9939 Jim_Free(seed);
9942 /* Generates N bytes of random data */
9943 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9945 Jim_PrngState *prng;
9946 unsigned char *destByte = (unsigned char *)dest;
9947 unsigned int si, sj, x;
9949 /* initialization, only needed the first time */
9950 if (interp->prngState == NULL)
9951 JimPrngInit(interp);
9952 prng = interp->prngState;
9953 /* generates 'len' bytes of pseudo-random numbers */
9954 for (x = 0; x < len; x++) {
9955 prng->i = (prng->i + 1) & 0xff;
9956 si = prng->sbox[prng->i];
9957 prng->j = (prng->j + si) & 0xff;
9958 sj = prng->sbox[prng->j];
9959 prng->sbox[prng->i] = sj;
9960 prng->sbox[prng->j] = si;
9961 *destByte++ = prng->sbox[(si + sj) & 0xff];
9965 /* Re-seed the generator with user-provided bytes */
9966 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
9968 int i;
9969 Jim_PrngState *prng;
9971 /* initialization, only needed the first time */
9972 if (interp->prngState == NULL)
9973 JimPrngInit(interp);
9974 prng = interp->prngState;
9976 /* Set the sbox[i] with i */
9977 for (i = 0; i < 256; i++)
9978 prng->sbox[i] = i;
9979 /* Now use the seed to perform a random permutation of the sbox */
9980 for (i = 0; i < seedLen; i++) {
9981 unsigned char t;
9983 t = prng->sbox[i & 0xFF];
9984 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
9985 prng->sbox[seed[i]] = t;
9987 prng->i = prng->j = 0;
9989 /* discard at least the first 256 bytes of stream.
9990 * borrow the seed buffer for this
9992 for (i = 0; i < 256; i += seedLen) {
9993 JimRandomBytes(interp, seed, seedLen);
9997 /* [incr] */
9998 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10000 jim_wide wideValue, increment = 1;
10001 Jim_Obj *intObjPtr;
10003 if (argc != 2 && argc != 3) {
10004 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10005 return JIM_ERR;
10007 if (argc == 3) {
10008 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10009 return JIM_ERR;
10011 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10012 if (!intObjPtr) {
10013 /* Set missing variable to 0 */
10014 wideValue = 0;
10016 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10017 return JIM_ERR;
10019 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10020 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10021 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10022 Jim_FreeNewObj(interp, intObjPtr);
10023 return JIM_ERR;
10026 else {
10027 /* Can do it the quick way */
10028 Jim_InvalidateStringRep(intObjPtr);
10029 JimWideValue(intObjPtr) = wideValue + increment;
10031 /* The following step is required in order to invalidate the
10032 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10033 if (argv[1]->typePtr != &variableObjType) {
10034 /* Note that this can't fail since GetVariable already succeeded */
10035 Jim_SetVariable(interp, argv[1], intObjPtr);
10038 Jim_SetResult(interp, intObjPtr);
10039 return JIM_OK;
10043 /* -----------------------------------------------------------------------------
10044 * Eval
10045 * ---------------------------------------------------------------------------*/
10046 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10047 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10049 /* Handle calls to the [unknown] command */
10050 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10052 int retcode;
10054 /* If JimUnknown() is recursively called too many times...
10055 * done here
10057 if (interp->unknown_called > 50) {
10058 return JIM_ERR;
10061 /* The object interp->unknown just contains
10062 * the "unknown" string, it is used in order to
10063 * avoid to lookup the unknown command every time
10064 * but instead to cache the result. */
10066 /* If the [unknown] command does not exist ... */
10067 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10068 return JIM_ERR;
10070 interp->unknown_called++;
10071 /* XXX: Are we losing fileNameObj and linenr? */
10072 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10073 interp->unknown_called--;
10075 return retcode;
10078 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10080 int retcode;
10081 Jim_Cmd *cmdPtr;
10082 void *prevPrivData;
10084 #if 0
10085 printf("invoke");
10086 int j;
10087 for (j = 0; j < objc; j++) {
10088 printf(" '%s'", Jim_String(objv[j]));
10090 printf("\n");
10091 #endif
10093 if (interp->framePtr->tailcallCmd) {
10094 /* Special tailcall command was pre-resolved */
10095 cmdPtr = interp->framePtr->tailcallCmd;
10096 interp->framePtr->tailcallCmd = NULL;
10098 else {
10099 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10100 if (cmdPtr == NULL) {
10101 return JimUnknown(interp, objc, objv);
10103 JimIncrCmdRefCount(cmdPtr);
10106 if (interp->evalDepth == interp->maxEvalDepth) {
10107 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10108 retcode = JIM_ERR;
10109 goto out;
10111 interp->evalDepth++;
10112 prevPrivData = interp->cmdPrivData;
10114 /* Call it -- Make sure result is an empty object. */
10115 Jim_SetEmptyResult(interp);
10116 if (cmdPtr->isproc) {
10117 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10119 else {
10120 interp->cmdPrivData = cmdPtr->u.native.privData;
10121 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10123 interp->cmdPrivData = prevPrivData;
10124 interp->evalDepth--;
10126 out:
10127 JimDecrCmdRefCount(interp, cmdPtr);
10129 return retcode;
10132 /* Eval the object vector 'objv' composed of 'objc' elements.
10133 * Every element is used as single argument.
10134 * Jim_EvalObj() will call this function every time its object
10135 * argument is of "list" type, with no string representation.
10137 * This is possible because the string representation of a
10138 * list object generated by the UpdateStringOfList is made
10139 * in a way that ensures that every list element is a different
10140 * command argument. */
10141 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10143 int i, retcode;
10145 /* Incr refcount of arguments. */
10146 for (i = 0; i < objc; i++)
10147 Jim_IncrRefCount(objv[i]);
10149 retcode = JimInvokeCommand(interp, objc, objv);
10151 /* Decr refcount of arguments and return the retcode */
10152 for (i = 0; i < objc; i++)
10153 Jim_DecrRefCount(interp, objv[i]);
10155 return retcode;
10159 * Invokes 'prefix' as a command with the objv array as arguments.
10161 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10163 int ret;
10164 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10166 nargv[0] = prefix;
10167 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10168 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10169 Jim_Free(nargv);
10170 return ret;
10173 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10175 if (!interp->errorFlag) {
10176 /* This is the first error, so save the file/line information and reset the stack */
10177 interp->errorFlag = 1;
10178 Jim_IncrRefCount(script->fileNameObj);
10179 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10180 interp->errorFileNameObj = script->fileNameObj;
10181 interp->errorLine = script->linenr;
10183 JimResetStackTrace(interp);
10184 /* Always add a level where the error first occurs */
10185 interp->addStackTrace++;
10188 /* Now if this is an "interesting" level, add it to the stack trace */
10189 if (interp->addStackTrace > 0) {
10190 /* Add the stack info for the current level */
10192 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10194 /* Note: if we didn't have a filename for this level,
10195 * don't clear the addStackTrace flag
10196 * so we can pick it up at the next level
10198 if (Jim_Length(script->fileNameObj)) {
10199 interp->addStackTrace = 0;
10202 Jim_DecrRefCount(interp, interp->errorProc);
10203 interp->errorProc = interp->emptyObj;
10204 Jim_IncrRefCount(interp->errorProc);
10208 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10210 Jim_Obj *objPtr;
10211 int ret = JIM_ERR;
10213 switch (token->type) {
10214 case JIM_TT_STR:
10215 case JIM_TT_ESC:
10216 objPtr = token->objPtr;
10217 break;
10218 case JIM_TT_VAR:
10219 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10220 break;
10221 case JIM_TT_DICTSUGAR:
10222 objPtr = JimExpandDictSugar(interp, token->objPtr);
10223 break;
10224 case JIM_TT_EXPRSUGAR:
10225 ret = Jim_EvalExpression(interp, token->objPtr);
10226 if (ret == JIM_OK) {
10227 objPtr = Jim_GetResult(interp);
10229 else {
10230 objPtr = NULL;
10232 break;
10233 case JIM_TT_CMD:
10234 ret = Jim_EvalObj(interp, token->objPtr);
10235 if (ret == JIM_OK || ret == JIM_RETURN) {
10236 objPtr = interp->result;
10237 } else {
10238 /* includes JIM_BREAK, JIM_CONTINUE */
10239 objPtr = NULL;
10241 break;
10242 default:
10243 JimPanic((1,
10244 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10245 objPtr = NULL;
10246 break;
10248 if (objPtr) {
10249 *objPtrPtr = objPtr;
10250 return JIM_OK;
10252 return ret;
10255 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10256 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10257 * The returned object has refcount = 0.
10259 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10261 int totlen = 0, i;
10262 Jim_Obj **intv;
10263 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10264 Jim_Obj *objPtr;
10265 char *s;
10267 if (tokens <= JIM_EVAL_SINTV_LEN)
10268 intv = sintv;
10269 else
10270 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10272 /* Compute every token forming the argument
10273 * in the intv objects vector. */
10274 for (i = 0; i < tokens; i++) {
10275 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10276 case JIM_OK:
10277 case JIM_RETURN:
10278 break;
10279 case JIM_BREAK:
10280 if (flags & JIM_SUBST_FLAG) {
10281 /* Stop here */
10282 tokens = i;
10283 continue;
10285 /* XXX: Should probably set an error about break outside loop */
10286 /* fall through to error */
10287 case JIM_CONTINUE:
10288 if (flags & JIM_SUBST_FLAG) {
10289 intv[i] = NULL;
10290 continue;
10292 /* XXX: Ditto continue outside loop */
10293 /* fall through to error */
10294 default:
10295 while (i--) {
10296 Jim_DecrRefCount(interp, intv[i]);
10298 if (intv != sintv) {
10299 Jim_Free(intv);
10301 return NULL;
10303 Jim_IncrRefCount(intv[i]);
10304 Jim_String(intv[i]);
10305 totlen += intv[i]->length;
10308 /* Fast path return for a single token */
10309 if (tokens == 1 && intv[0] && intv == sintv) {
10310 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10311 intv[0]->refCount--;
10312 return intv[0];
10315 /* Concatenate every token in an unique
10316 * object. */
10317 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10319 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10320 && token[2].type == JIM_TT_VAR) {
10321 /* May be able to do fast interpolated object -> dictSubst */
10322 objPtr->typePtr = &interpolatedObjType;
10323 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10324 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10325 Jim_IncrRefCount(intv[2]);
10327 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10328 /* The first interpolated token is source, so preserve the source info */
10329 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10333 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10334 objPtr->length = totlen;
10335 for (i = 0; i < tokens; i++) {
10336 if (intv[i]) {
10337 memcpy(s, intv[i]->bytes, intv[i]->length);
10338 s += intv[i]->length;
10339 Jim_DecrRefCount(interp, intv[i]);
10342 objPtr->bytes[totlen] = '\0';
10343 /* Free the intv vector if not static. */
10344 if (intv != sintv) {
10345 Jim_Free(intv);
10348 return objPtr;
10352 /* listPtr *must* be a list.
10353 * The contents of the list is evaluated with the first element as the command and
10354 * the remaining elements as the arguments.
10356 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10358 int retcode = JIM_OK;
10360 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10362 if (listPtr->internalRep.listValue.len) {
10363 Jim_IncrRefCount(listPtr);
10364 retcode = JimInvokeCommand(interp,
10365 listPtr->internalRep.listValue.len,
10366 listPtr->internalRep.listValue.ele);
10367 Jim_DecrRefCount(interp, listPtr);
10369 return retcode;
10372 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10374 SetListFromAny(interp, listPtr);
10375 return JimEvalObjList(interp, listPtr);
10378 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10380 int i;
10381 ScriptObj *script;
10382 ScriptToken *token;
10383 int retcode = JIM_OK;
10384 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10385 Jim_Obj *prevScriptObj;
10387 /* If the object is of type "list", with no string rep we can call
10388 * a specialized version of Jim_EvalObj() */
10389 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10390 return JimEvalObjList(interp, scriptObjPtr);
10393 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10394 script = JimGetScript(interp, scriptObjPtr);
10395 if (!JimScriptValid(interp, script)) {
10396 Jim_DecrRefCount(interp, scriptObjPtr);
10397 return JIM_ERR;
10400 /* Reset the interpreter result. This is useful to
10401 * return the empty result in the case of empty program. */
10402 Jim_SetEmptyResult(interp);
10404 token = script->token;
10406 #ifdef JIM_OPTIMIZATION
10407 /* Check for one of the following common scripts used by for, while
10409 * {}
10410 * incr a
10412 if (script->len == 0) {
10413 Jim_DecrRefCount(interp, scriptObjPtr);
10414 return JIM_OK;
10416 if (script->len == 3
10417 && token[1].objPtr->typePtr == &commandObjType
10418 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10419 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10420 && token[2].objPtr->typePtr == &variableObjType) {
10422 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10424 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10425 JimWideValue(objPtr)++;
10426 Jim_InvalidateStringRep(objPtr);
10427 Jim_DecrRefCount(interp, scriptObjPtr);
10428 Jim_SetResult(interp, objPtr);
10429 return JIM_OK;
10432 #endif
10434 /* Now we have to make sure the internal repr will not be
10435 * freed on shimmering.
10437 * Think for example to this:
10439 * set x {llength $x; ... some more code ...}; eval $x
10441 * In order to preserve the internal rep, we increment the
10442 * inUse field of the script internal rep structure. */
10443 script->inUse++;
10445 /* Stash the current script */
10446 prevScriptObj = interp->currentScriptObj;
10447 interp->currentScriptObj = scriptObjPtr;
10449 interp->errorFlag = 0;
10450 argv = sargv;
10452 /* Execute every command sequentially until the end of the script
10453 * or an error occurs.
10455 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10456 int argc;
10457 int j;
10459 /* First token of the line is always JIM_TT_LINE */
10460 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10461 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10463 /* Allocate the arguments vector if required */
10464 if (argc > JIM_EVAL_SARGV_LEN)
10465 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10467 /* Skip the JIM_TT_LINE token */
10468 i++;
10470 /* Populate the arguments objects.
10471 * If an error occurs, retcode will be set and
10472 * 'j' will be set to the number of args expanded
10474 for (j = 0; j < argc; j++) {
10475 long wordtokens = 1;
10476 int expand = 0;
10477 Jim_Obj *wordObjPtr = NULL;
10479 if (token[i].type == JIM_TT_WORD) {
10480 wordtokens = JimWideValue(token[i++].objPtr);
10481 if (wordtokens < 0) {
10482 expand = 1;
10483 wordtokens = -wordtokens;
10487 if (wordtokens == 1) {
10488 /* Fast path if the token does not
10489 * need interpolation */
10491 switch (token[i].type) {
10492 case JIM_TT_ESC:
10493 case JIM_TT_STR:
10494 wordObjPtr = token[i].objPtr;
10495 break;
10496 case JIM_TT_VAR:
10497 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10498 break;
10499 case JIM_TT_EXPRSUGAR:
10500 retcode = Jim_EvalExpression(interp, token[i].objPtr);
10501 if (retcode == JIM_OK) {
10502 wordObjPtr = Jim_GetResult(interp);
10504 else {
10505 wordObjPtr = NULL;
10507 break;
10508 case JIM_TT_DICTSUGAR:
10509 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10510 break;
10511 case JIM_TT_CMD:
10512 retcode = Jim_EvalObj(interp, token[i].objPtr);
10513 if (retcode == JIM_OK) {
10514 wordObjPtr = Jim_GetResult(interp);
10516 break;
10517 default:
10518 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10521 else {
10522 /* For interpolation we call a helper
10523 * function to do the work for us. */
10524 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10527 if (!wordObjPtr) {
10528 if (retcode == JIM_OK) {
10529 retcode = JIM_ERR;
10531 break;
10534 Jim_IncrRefCount(wordObjPtr);
10535 i += wordtokens;
10537 if (!expand) {
10538 argv[j] = wordObjPtr;
10540 else {
10541 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10542 int len = Jim_ListLength(interp, wordObjPtr);
10543 int newargc = argc + len - 1;
10544 int k;
10546 if (len > 1) {
10547 if (argv == sargv) {
10548 if (newargc > JIM_EVAL_SARGV_LEN) {
10549 argv = Jim_Alloc(sizeof(*argv) * newargc);
10550 memcpy(argv, sargv, sizeof(*argv) * j);
10553 else {
10554 /* Need to realloc to make room for (len - 1) more entries */
10555 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10559 /* Now copy in the expanded version */
10560 for (k = 0; k < len; k++) {
10561 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10562 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10565 /* The original object reference is no longer needed,
10566 * after the expansion it is no longer present on
10567 * the argument vector, but the single elements are
10568 * in its place. */
10569 Jim_DecrRefCount(interp, wordObjPtr);
10571 /* And update the indexes */
10572 j--;
10573 argc += len - 1;
10577 if (retcode == JIM_OK && argc) {
10578 /* Invoke the command */
10579 retcode = JimInvokeCommand(interp, argc, argv);
10580 /* Check for a signal after each command */
10581 if (Jim_CheckSignal(interp)) {
10582 retcode = JIM_SIGNAL;
10586 /* Finished with the command, so decrement ref counts of each argument */
10587 while (j-- > 0) {
10588 Jim_DecrRefCount(interp, argv[j]);
10591 if (argv != sargv) {
10592 Jim_Free(argv);
10593 argv = sargv;
10597 /* Possibly add to the error stack trace */
10598 if (retcode == JIM_ERR) {
10599 JimAddErrorToStack(interp, script);
10601 /* Propagate the addStackTrace value through 'return -code error' */
10602 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10603 /* No need to add stack trace */
10604 interp->addStackTrace = 0;
10607 /* Restore the current script */
10608 interp->currentScriptObj = prevScriptObj;
10610 /* Note that we don't have to decrement inUse, because the
10611 * following code transfers our use of the reference again to
10612 * the script object. */
10613 Jim_FreeIntRep(interp, scriptObjPtr);
10614 scriptObjPtr->typePtr = &scriptObjType;
10615 Jim_SetIntRepPtr(scriptObjPtr, script);
10616 Jim_DecrRefCount(interp, scriptObjPtr);
10618 return retcode;
10621 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10623 int retcode;
10624 /* If argObjPtr begins with '&', do an automatic upvar */
10625 const char *varname = Jim_String(argNameObj);
10626 if (*varname == '&') {
10627 /* First check that the target variable exists */
10628 Jim_Obj *objPtr;
10629 Jim_CallFrame *savedCallFrame = interp->framePtr;
10631 interp->framePtr = interp->framePtr->parent;
10632 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10633 interp->framePtr = savedCallFrame;
10634 if (!objPtr) {
10635 return JIM_ERR;
10638 /* It exists, so perform the binding. */
10639 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10640 Jim_IncrRefCount(objPtr);
10641 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10642 Jim_DecrRefCount(interp, objPtr);
10644 else {
10645 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10647 return retcode;
10651 * Sets the interp result to be an error message indicating the required proc args.
10653 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10655 /* Create a nice error message, consistent with Tcl 8.5 */
10656 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10657 int i;
10659 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10660 Jim_AppendString(interp, argmsg, " ", 1);
10662 if (i == cmd->u.proc.argsPos) {
10663 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10664 /* Renamed args */
10665 Jim_AppendString(interp, argmsg, "?", 1);
10666 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10667 Jim_AppendString(interp, argmsg, " ...?", -1);
10669 else {
10670 /* We have plain args */
10671 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10674 else {
10675 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10676 Jim_AppendString(interp, argmsg, "?", 1);
10677 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10678 Jim_AppendString(interp, argmsg, "?", 1);
10680 else {
10681 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10682 if (*arg == '&') {
10683 arg++;
10685 Jim_AppendString(interp, argmsg, arg, -1);
10689 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10692 #ifdef jim_ext_namespace
10694 * [namespace eval]
10696 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10698 Jim_CallFrame *callFramePtr;
10699 int retcode;
10701 /* Create a new callframe */
10702 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10703 callFramePtr->argv = &interp->emptyObj;
10704 callFramePtr->argc = 0;
10705 callFramePtr->procArgsObjPtr = NULL;
10706 callFramePtr->procBodyObjPtr = scriptObj;
10707 callFramePtr->staticVars = NULL;
10708 callFramePtr->fileNameObj = interp->emptyObj;
10709 callFramePtr->line = 0;
10710 Jim_IncrRefCount(scriptObj);
10711 interp->framePtr = callFramePtr;
10713 /* Check if there are too nested calls */
10714 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10715 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10716 retcode = JIM_ERR;
10718 else {
10719 /* Eval the body */
10720 retcode = Jim_EvalObj(interp, scriptObj);
10723 /* Destroy the callframe */
10724 interp->framePtr = interp->framePtr->parent;
10725 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10727 return retcode;
10729 #endif
10731 /* Call a procedure implemented in Tcl.
10732 * It's possible to speed-up a lot this function, currently
10733 * the callframes are not cached, but allocated and
10734 * destroied every time. What is expecially costly is
10735 * to create/destroy the local vars hash table every time.
10737 * This can be fixed just implementing callframes caching
10738 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10739 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10741 Jim_CallFrame *callFramePtr;
10742 int i, d, retcode, optargs;
10743 ScriptObj *script;
10745 /* Check arity */
10746 if (argc - 1 < cmd->u.proc.reqArity ||
10747 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10748 JimSetProcWrongArgs(interp, argv[0], cmd);
10749 return JIM_ERR;
10752 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10753 /* Optimise for procedure with no body - useful for optional debugging */
10754 return JIM_OK;
10757 /* Check if there are too nested calls */
10758 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10759 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10760 return JIM_ERR;
10763 /* Create a new callframe */
10764 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10765 callFramePtr->argv = argv;
10766 callFramePtr->argc = argc;
10767 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10768 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10769 callFramePtr->staticVars = cmd->u.proc.staticVars;
10771 /* Remember where we were called from. */
10772 script = JimGetScript(interp, interp->currentScriptObj);
10773 callFramePtr->fileNameObj = script->fileNameObj;
10774 callFramePtr->line = script->linenr;
10776 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10777 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10778 interp->framePtr = callFramePtr;
10780 /* How many optional args are available */
10781 optargs = (argc - 1 - cmd->u.proc.reqArity);
10783 /* Step 'i' along the actual args, and step 'd' along the formal args */
10784 i = 1;
10785 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10786 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10787 if (d == cmd->u.proc.argsPos) {
10788 /* assign $args */
10789 Jim_Obj *listObjPtr;
10790 int argsLen = 0;
10791 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10792 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10794 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10796 /* It is possible to rename args. */
10797 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10798 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10800 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10801 if (retcode != JIM_OK) {
10802 goto badargset;
10805 i += argsLen;
10806 continue;
10809 /* Optional or required? */
10810 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10811 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10813 else {
10814 /* Ran out, so use the default */
10815 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10817 if (retcode != JIM_OK) {
10818 goto badargset;
10822 /* Eval the body */
10823 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10825 badargset:
10827 /* Invoke $jim::defer then destroy the callframe */
10828 retcode = JimInvokeDefer(interp, retcode);
10829 interp->framePtr = interp->framePtr->parent;
10830 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10832 /* Now chain any tailcalls in the parent frame */
10833 if (interp->framePtr->tailcallObj) {
10834 do {
10835 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10837 interp->framePtr->tailcallObj = NULL;
10839 if (retcode == JIM_EVAL) {
10840 retcode = Jim_EvalObjList(interp, tailcallObj);
10841 if (retcode == JIM_RETURN) {
10842 /* If the result of the tailcall is 'return', push
10843 * it up to the caller
10845 interp->returnLevel++;
10848 Jim_DecrRefCount(interp, tailcallObj);
10849 } while (interp->framePtr->tailcallObj);
10851 /* If the tailcall chain finished early, may need to manually discard the command */
10852 if (interp->framePtr->tailcallCmd) {
10853 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10854 interp->framePtr->tailcallCmd = NULL;
10858 /* Handle the JIM_RETURN return code */
10859 if (retcode == JIM_RETURN) {
10860 if (--interp->returnLevel <= 0) {
10861 retcode = interp->returnCode;
10862 interp->returnCode = JIM_OK;
10863 interp->returnLevel = 0;
10866 else if (retcode == JIM_ERR) {
10867 interp->addStackTrace++;
10868 Jim_DecrRefCount(interp, interp->errorProc);
10869 interp->errorProc = argv[0];
10870 Jim_IncrRefCount(interp->errorProc);
10873 return retcode;
10876 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10878 int retval;
10879 Jim_Obj *scriptObjPtr;
10881 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10882 Jim_IncrRefCount(scriptObjPtr);
10884 if (filename) {
10885 Jim_Obj *prevScriptObj;
10887 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10889 prevScriptObj = interp->currentScriptObj;
10890 interp->currentScriptObj = scriptObjPtr;
10892 retval = Jim_EvalObj(interp, scriptObjPtr);
10894 interp->currentScriptObj = prevScriptObj;
10896 else {
10897 retval = Jim_EvalObj(interp, scriptObjPtr);
10899 Jim_DecrRefCount(interp, scriptObjPtr);
10900 return retval;
10903 int Jim_Eval(Jim_Interp *interp, const char *script)
10905 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10908 /* Execute script in the scope of the global level */
10909 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10911 int retval;
10912 Jim_CallFrame *savedFramePtr = interp->framePtr;
10914 interp->framePtr = interp->topFramePtr;
10915 retval = Jim_Eval(interp, script);
10916 interp->framePtr = savedFramePtr;
10918 return retval;
10921 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10923 int retval;
10924 Jim_CallFrame *savedFramePtr = interp->framePtr;
10926 interp->framePtr = interp->topFramePtr;
10927 retval = Jim_EvalFile(interp, filename);
10928 interp->framePtr = savedFramePtr;
10930 return retval;
10933 #include <sys/stat.h>
10935 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10937 FILE *fp;
10938 char *buf;
10939 Jim_Obj *scriptObjPtr;
10940 Jim_Obj *prevScriptObj;
10941 struct stat sb;
10942 int retcode;
10943 int readlen;
10945 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10946 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10947 return JIM_ERR;
10949 if (sb.st_size == 0) {
10950 fclose(fp);
10951 return JIM_OK;
10954 buf = Jim_Alloc(sb.st_size + 1);
10955 readlen = fread(buf, 1, sb.st_size, fp);
10956 if (ferror(fp)) {
10957 fclose(fp);
10958 Jim_Free(buf);
10959 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10960 return JIM_ERR;
10962 fclose(fp);
10963 buf[readlen] = 0;
10965 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10966 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
10967 Jim_IncrRefCount(scriptObjPtr);
10969 prevScriptObj = interp->currentScriptObj;
10970 interp->currentScriptObj = scriptObjPtr;
10972 retcode = Jim_EvalObj(interp, scriptObjPtr);
10974 /* Handle the JIM_RETURN return code */
10975 if (retcode == JIM_RETURN) {
10976 if (--interp->returnLevel <= 0) {
10977 retcode = interp->returnCode;
10978 interp->returnCode = JIM_OK;
10979 interp->returnLevel = 0;
10982 if (retcode == JIM_ERR) {
10983 /* EvalFile changes context, so add a stack frame here */
10984 interp->addStackTrace++;
10987 interp->currentScriptObj = prevScriptObj;
10989 Jim_DecrRefCount(interp, scriptObjPtr);
10991 return retcode;
10994 /* -----------------------------------------------------------------------------
10995 * Subst
10996 * ---------------------------------------------------------------------------*/
10997 static void JimParseSubst(struct JimParserCtx *pc, int flags)
10999 pc->tstart = pc->p;
11000 pc->tline = pc->linenr;
11002 if (pc->len == 0) {
11003 pc->tend = pc->p;
11004 pc->tt = JIM_TT_EOL;
11005 pc->eof = 1;
11006 return;
11008 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11009 JimParseCmd(pc);
11010 return;
11012 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11013 if (JimParseVar(pc) == JIM_OK) {
11014 return;
11016 /* Not a var, so treat as a string */
11017 pc->tstart = pc->p;
11018 flags |= JIM_SUBST_NOVAR;
11020 while (pc->len) {
11021 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11022 break;
11024 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11025 break;
11027 if (*pc->p == '\\' && pc->len > 1) {
11028 pc->p++;
11029 pc->len--;
11031 pc->p++;
11032 pc->len--;
11034 pc->tend = pc->p - 1;
11035 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11038 /* The subst object type reuses most of the data structures and functions
11039 * of the script object. Script's data structures are a bit more complex
11040 * for what is needed for [subst]itution tasks, but the reuse helps to
11041 * deal with a single data structure at the cost of some more memory
11042 * usage for substitutions. */
11044 /* This method takes the string representation of an object
11045 * as a Tcl string where to perform [subst]itution, and generates
11046 * the pre-parsed internal representation. */
11047 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11049 int scriptTextLen;
11050 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11051 struct JimParserCtx parser;
11052 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11053 ParseTokenList tokenlist;
11055 /* Initially parse the subst into tokens (in tokenlist) */
11056 ScriptTokenListInit(&tokenlist);
11058 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11059 while (1) {
11060 JimParseSubst(&parser, flags);
11061 if (parser.eof) {
11062 /* Note that subst doesn't need the EOL token */
11063 break;
11065 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11066 parser.tline);
11069 /* Create the "real" subst/script tokens from the initial token list */
11070 script->inUse = 1;
11071 script->substFlags = flags;
11072 script->fileNameObj = interp->emptyObj;
11073 Jim_IncrRefCount(script->fileNameObj);
11074 SubstObjAddTokens(interp, script, &tokenlist);
11076 /* No longer need the token list */
11077 ScriptTokenListFree(&tokenlist);
11079 #ifdef DEBUG_SHOW_SUBST
11081 int i;
11083 printf("==== Subst ====\n");
11084 for (i = 0; i < script->len; i++) {
11085 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11086 Jim_String(script->token[i].objPtr));
11089 #endif
11091 /* Free the old internal rep and set the new one. */
11092 Jim_FreeIntRep(interp, objPtr);
11093 Jim_SetIntRepPtr(objPtr, script);
11094 objPtr->typePtr = &scriptObjType;
11095 return JIM_OK;
11098 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11100 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11101 SetSubstFromAny(interp, objPtr, flags);
11102 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11105 /* Performs commands,variables,blackslashes substitution,
11106 * storing the result object (with refcount 0) into
11107 * resObjPtrPtr. */
11108 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11110 ScriptObj *script;
11112 JimPanic((substObjPtr->refCount == 0, "Jim_SubstObj() called with zero refcount object"));
11114 script = Jim_GetSubst(interp, substObjPtr, flags);
11116 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11117 /* In order to preserve the internal rep, we increment the
11118 * inUse field of the script internal rep structure. */
11119 script->inUse++;
11121 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11123 script->inUse--;
11124 Jim_DecrRefCount(interp, substObjPtr);
11125 if (*resObjPtrPtr == NULL) {
11126 return JIM_ERR;
11128 return JIM_OK;
11131 /* -----------------------------------------------------------------------------
11132 * Core commands utility functions
11133 * ---------------------------------------------------------------------------*/
11134 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11136 Jim_Obj *objPtr;
11137 Jim_Obj *listObjPtr;
11139 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11141 listObjPtr = Jim_NewListObj(interp, argv, argc);
11143 if (msg && *msg) {
11144 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11146 Jim_IncrRefCount(listObjPtr);
11147 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11148 Jim_DecrRefCount(interp, listObjPtr);
11150 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11154 * May add the key and/or value to the list.
11156 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11157 Jim_HashEntry *he, int type);
11159 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11162 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11163 * invoke the callback to add entries to a list.
11164 * Returns the list.
11166 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11167 JimHashtableIteratorCallbackType *callback, int type)
11169 Jim_HashEntry *he;
11170 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11172 /* Check for the non-pattern case. We can do this much more efficiently. */
11173 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11174 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11175 if (he) {
11176 callback(interp, listObjPtr, he, type);
11179 else {
11180 Jim_HashTableIterator htiter;
11181 JimInitHashTableIterator(ht, &htiter);
11182 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11183 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11184 callback(interp, listObjPtr, he, type);
11188 return listObjPtr;
11191 /* Keep these in order */
11192 #define JIM_CMDLIST_COMMANDS 0
11193 #define JIM_CMDLIST_PROCS 1
11194 #define JIM_CMDLIST_CHANNELS 2
11197 * Adds matching command names (procs, channels) to the list.
11199 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11200 Jim_HashEntry *he, int type)
11202 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11203 Jim_Obj *objPtr;
11205 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11206 /* not a proc */
11207 return;
11210 objPtr = Jim_NewStringObj(interp, he->key, -1);
11211 Jim_IncrRefCount(objPtr);
11213 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11214 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11216 Jim_DecrRefCount(interp, objPtr);
11219 /* type is JIM_CMDLIST_xxx */
11220 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11222 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11225 /* Keep these in order */
11226 #define JIM_VARLIST_GLOBALS 0
11227 #define JIM_VARLIST_LOCALS 1
11228 #define JIM_VARLIST_VARS 2
11230 #define JIM_VARLIST_VALUES 0x1000
11233 * Adds matching variable names to the list.
11235 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11236 Jim_HashEntry *he, int type)
11238 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11240 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11241 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11242 if (type & JIM_VARLIST_VALUES) {
11243 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11248 /* mode is JIM_VARLIST_xxx */
11249 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11251 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11252 /* For [info locals], if we are at top level an emtpy list
11253 * is returned. I don't agree, but we aim at compatibility (SS) */
11254 return interp->emptyObj;
11256 else {
11257 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11258 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11262 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11263 Jim_Obj **objPtrPtr, int info_level_cmd)
11265 Jim_CallFrame *targetCallFrame;
11267 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11268 if (targetCallFrame == NULL) {
11269 return JIM_ERR;
11271 /* No proc call at toplevel callframe */
11272 if (targetCallFrame == interp->topFramePtr) {
11273 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11274 return JIM_ERR;
11276 if (info_level_cmd) {
11277 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11279 else {
11280 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11282 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11283 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11284 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11285 *objPtrPtr = listObj;
11287 return JIM_OK;
11290 /* -----------------------------------------------------------------------------
11291 * Core commands
11292 * ---------------------------------------------------------------------------*/
11294 /* fake [puts] -- not the real puts, just for debugging. */
11295 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11297 if (argc != 2 && argc != 3) {
11298 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11299 return JIM_ERR;
11301 if (argc == 3) {
11302 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11303 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11304 return JIM_ERR;
11306 else {
11307 fputs(Jim_String(argv[2]), stdout);
11310 else {
11311 puts(Jim_String(argv[1]));
11313 return JIM_OK;
11316 /* Helper for [+] and [*] */
11317 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11319 jim_wide wideValue, res;
11320 double doubleValue, doubleRes;
11321 int i;
11323 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11325 for (i = 1; i < argc; i++) {
11326 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11327 goto trydouble;
11328 if (op == JIM_EXPROP_ADD)
11329 res += wideValue;
11330 else
11331 res *= wideValue;
11333 Jim_SetResultInt(interp, res);
11334 return JIM_OK;
11335 trydouble:
11336 doubleRes = (double)res;
11337 for (; i < argc; i++) {
11338 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11339 return JIM_ERR;
11340 if (op == JIM_EXPROP_ADD)
11341 doubleRes += doubleValue;
11342 else
11343 doubleRes *= doubleValue;
11345 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11346 return JIM_OK;
11349 /* Helper for [-] and [/] */
11350 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11352 jim_wide wideValue, res = 0;
11353 double doubleValue, doubleRes = 0;
11354 int i = 2;
11356 if (argc < 2) {
11357 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11358 return JIM_ERR;
11360 else if (argc == 2) {
11361 /* The arity = 2 case is different. For [- x] returns -x,
11362 * while [/ x] returns 1/x. */
11363 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11364 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11365 return JIM_ERR;
11367 else {
11368 if (op == JIM_EXPROP_SUB)
11369 doubleRes = -doubleValue;
11370 else
11371 doubleRes = 1.0 / doubleValue;
11372 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11373 return JIM_OK;
11376 if (op == JIM_EXPROP_SUB) {
11377 res = -wideValue;
11378 Jim_SetResultInt(interp, res);
11380 else {
11381 doubleRes = 1.0 / wideValue;
11382 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11384 return JIM_OK;
11386 else {
11387 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11388 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11389 != JIM_OK) {
11390 return JIM_ERR;
11392 else {
11393 goto trydouble;
11397 for (i = 2; i < argc; i++) {
11398 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11399 doubleRes = (double)res;
11400 goto trydouble;
11402 if (op == JIM_EXPROP_SUB)
11403 res -= wideValue;
11404 else {
11405 if (wideValue == 0) {
11406 Jim_SetResultString(interp, "Division by zero", -1);
11407 return JIM_ERR;
11409 res /= wideValue;
11412 Jim_SetResultInt(interp, res);
11413 return JIM_OK;
11414 trydouble:
11415 for (; i < argc; i++) {
11416 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11417 return JIM_ERR;
11418 if (op == JIM_EXPROP_SUB)
11419 doubleRes -= doubleValue;
11420 else
11421 doubleRes /= doubleValue;
11423 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11424 return JIM_OK;
11428 /* [+] */
11429 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11431 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11434 /* [*] */
11435 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11437 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11440 /* [-] */
11441 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11443 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11446 /* [/] */
11447 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11449 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11452 /* [set] */
11453 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11455 if (argc != 2 && argc != 3) {
11456 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11457 return JIM_ERR;
11459 if (argc == 2) {
11460 Jim_Obj *objPtr;
11462 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11463 if (!objPtr)
11464 return JIM_ERR;
11465 Jim_SetResult(interp, objPtr);
11466 return JIM_OK;
11468 /* argc == 3 case. */
11469 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11470 return JIM_ERR;
11471 Jim_SetResult(interp, argv[2]);
11472 return JIM_OK;
11475 /* [unset]
11477 * unset ?-nocomplain? ?--? ?varName ...?
11479 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11481 int i = 1;
11482 int complain = 1;
11484 while (i < argc) {
11485 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11486 i++;
11487 break;
11489 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11490 complain = 0;
11491 i++;
11492 continue;
11494 break;
11497 while (i < argc) {
11498 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11499 && complain) {
11500 return JIM_ERR;
11502 i++;
11504 return JIM_OK;
11507 /* [while] */
11508 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11510 if (argc != 3) {
11511 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11512 return JIM_ERR;
11515 /* The general purpose implementation of while starts here */
11516 while (1) {
11517 int boolean, retval;
11519 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11520 return retval;
11521 if (!boolean)
11522 break;
11524 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11525 switch (retval) {
11526 case JIM_BREAK:
11527 goto out;
11528 break;
11529 case JIM_CONTINUE:
11530 continue;
11531 break;
11532 default:
11533 return retval;
11537 out:
11538 Jim_SetEmptyResult(interp);
11539 return JIM_OK;
11542 /* [for] */
11543 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11545 int retval;
11546 int boolean = 1;
11547 Jim_Obj *varNamePtr = NULL;
11548 Jim_Obj *stopVarNamePtr = NULL;
11550 if (argc != 5) {
11551 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11552 return JIM_ERR;
11555 /* Do the initialisation */
11556 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11557 return retval;
11560 /* And do the first test now. Better for optimisation
11561 * if we can do next/test at the bottom of the loop
11563 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11565 /* Ready to do the body as follows:
11566 * while (1) {
11567 * body // check retcode
11568 * next // check retcode
11569 * test // check retcode/test bool
11573 #ifdef JIM_OPTIMIZATION
11574 /* Check if the for is on the form:
11575 * for ... {$i < CONST} {incr i}
11576 * for ... {$i < $j} {incr i}
11578 if (retval == JIM_OK && boolean) {
11579 ScriptObj *incrScript;
11580 struct ExprTree *expr;
11581 jim_wide stop, currentVal;
11582 Jim_Obj *objPtr;
11583 int cmpOffset;
11585 /* Do it only if there aren't shared arguments */
11586 expr = JimGetExpression(interp, argv[2]);
11587 incrScript = JimGetScript(interp, argv[3]);
11589 /* Ensure proper lengths to start */
11590 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11591 goto evalstart;
11593 /* Ensure proper token types. */
11594 if (incrScript->token[1].type != JIM_TT_ESC) {
11595 goto evalstart;
11598 if (expr->expr->type == JIM_EXPROP_LT) {
11599 cmpOffset = 0;
11601 else if (expr->expr->type == JIM_EXPROP_LTE) {
11602 cmpOffset = 1;
11604 else {
11605 goto evalstart;
11608 if (expr->expr->left->type != JIM_TT_VAR) {
11609 goto evalstart;
11612 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11613 goto evalstart;
11616 /* Update command must be incr */
11617 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11618 goto evalstart;
11621 /* incr, expression must be about the same variable */
11622 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11623 goto evalstart;
11626 /* Get the stop condition (must be a variable or integer) */
11627 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11628 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11629 goto evalstart;
11632 else {
11633 stopVarNamePtr = expr->expr->right->objPtr;
11634 Jim_IncrRefCount(stopVarNamePtr);
11635 /* Keep the compiler happy */
11636 stop = 0;
11639 /* Initialization */
11640 varNamePtr = expr->expr->left->objPtr;
11641 Jim_IncrRefCount(varNamePtr);
11643 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11644 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11645 goto testcond;
11648 /* --- OPTIMIZED FOR --- */
11649 while (retval == JIM_OK) {
11650 /* === Check condition === */
11651 /* Note that currentVal is already set here */
11653 /* Immediate or Variable? get the 'stop' value if the latter. */
11654 if (stopVarNamePtr) {
11655 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11656 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11657 goto testcond;
11661 if (currentVal >= stop + cmpOffset) {
11662 break;
11665 /* Eval body */
11666 retval = Jim_EvalObj(interp, argv[4]);
11667 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11668 retval = JIM_OK;
11670 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11672 /* Increment */
11673 if (objPtr == NULL) {
11674 retval = JIM_ERR;
11675 goto out;
11677 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11678 currentVal = ++JimWideValue(objPtr);
11679 Jim_InvalidateStringRep(objPtr);
11681 else {
11682 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11683 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11684 ++currentVal)) != JIM_OK) {
11685 goto evalnext;
11690 goto out;
11692 evalstart:
11693 #endif
11695 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11696 /* Body */
11697 retval = Jim_EvalObj(interp, argv[4]);
11699 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11700 /* increment */
11701 JIM_IF_OPTIM(evalnext:)
11702 retval = Jim_EvalObj(interp, argv[3]);
11703 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11704 /* test */
11705 JIM_IF_OPTIM(testcond:)
11706 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11710 JIM_IF_OPTIM(out:)
11711 if (stopVarNamePtr) {
11712 Jim_DecrRefCount(interp, stopVarNamePtr);
11714 if (varNamePtr) {
11715 Jim_DecrRefCount(interp, varNamePtr);
11718 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11719 Jim_SetEmptyResult(interp);
11720 return JIM_OK;
11723 return retval;
11726 /* [loop] */
11727 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11729 int retval;
11730 jim_wide i;
11731 jim_wide limit;
11732 jim_wide incr = 1;
11733 Jim_Obj *bodyObjPtr;
11735 if (argc != 5 && argc != 6) {
11736 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11737 return JIM_ERR;
11740 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11741 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11742 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11743 return JIM_ERR;
11745 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11747 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11749 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11750 retval = Jim_EvalObj(interp, bodyObjPtr);
11751 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11752 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11754 retval = JIM_OK;
11756 /* Increment */
11757 i += incr;
11759 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11760 if (argv[1]->typePtr != &variableObjType) {
11761 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11762 return JIM_ERR;
11765 JimWideValue(objPtr) = i;
11766 Jim_InvalidateStringRep(objPtr);
11768 /* The following step is required in order to invalidate the
11769 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11770 if (argv[1]->typePtr != &variableObjType) {
11771 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11772 retval = JIM_ERR;
11773 break;
11777 else {
11778 objPtr = Jim_NewIntObj(interp, i);
11779 retval = Jim_SetVariable(interp, argv[1], objPtr);
11780 if (retval != JIM_OK) {
11781 Jim_FreeNewObj(interp, objPtr);
11787 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11788 Jim_SetEmptyResult(interp);
11789 return JIM_OK;
11791 return retval;
11794 /* List iterators make it easy to iterate over a list.
11795 * At some point iterators will be expanded to support generators.
11797 typedef struct {
11798 Jim_Obj *objPtr;
11799 int idx;
11800 } Jim_ListIter;
11803 * Initialise the iterator at the start of the list.
11805 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11807 iter->objPtr = objPtr;
11808 iter->idx = 0;
11812 * Returns the next object from the list, or NULL on end-of-list.
11814 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11816 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11817 return NULL;
11819 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11823 * Returns 1 if end-of-list has been reached.
11825 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11827 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11830 /* foreach + lmap implementation. */
11831 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11833 int result = JIM_OK;
11834 int i, numargs;
11835 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11836 Jim_ListIter *iters;
11837 Jim_Obj *script;
11838 Jim_Obj *resultObj;
11840 if (argc < 4 || argc % 2 != 0) {
11841 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11842 return JIM_ERR;
11844 script = argv[argc - 1]; /* Last argument is a script */
11845 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11847 if (numargs == 2) {
11848 iters = twoiters;
11850 else {
11851 iters = Jim_Alloc(numargs * sizeof(*iters));
11853 for (i = 0; i < numargs; i++) {
11854 JimListIterInit(&iters[i], argv[i + 1]);
11855 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11856 result = JIM_ERR;
11859 if (result != JIM_OK) {
11860 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11861 goto empty_varlist;
11864 if (doMap) {
11865 resultObj = Jim_NewListObj(interp, NULL, 0);
11867 else {
11868 resultObj = interp->emptyObj;
11870 Jim_IncrRefCount(resultObj);
11872 while (1) {
11873 /* Have we expired all lists? */
11874 for (i = 0; i < numargs; i += 2) {
11875 if (!JimListIterDone(interp, &iters[i + 1])) {
11876 break;
11879 if (i == numargs) {
11880 /* All done */
11881 break;
11884 /* For each list */
11885 for (i = 0; i < numargs; i += 2) {
11886 Jim_Obj *varName;
11888 /* foreach var */
11889 JimListIterInit(&iters[i], argv[i + 1]);
11890 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11891 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11892 if (!valObj) {
11893 /* Ran out, so store the empty string */
11894 valObj = interp->emptyObj;
11896 /* Avoid shimmering */
11897 Jim_IncrRefCount(valObj);
11898 result = Jim_SetVariable(interp, varName, valObj);
11899 Jim_DecrRefCount(interp, valObj);
11900 if (result != JIM_OK) {
11901 goto err;
11905 switch (result = Jim_EvalObj(interp, script)) {
11906 case JIM_OK:
11907 if (doMap) {
11908 Jim_ListAppendElement(interp, resultObj, interp->result);
11910 break;
11911 case JIM_CONTINUE:
11912 break;
11913 case JIM_BREAK:
11914 goto out;
11915 default:
11916 goto err;
11919 out:
11920 result = JIM_OK;
11921 Jim_SetResult(interp, resultObj);
11922 err:
11923 Jim_DecrRefCount(interp, resultObj);
11924 empty_varlist:
11925 if (numargs > 2) {
11926 Jim_Free(iters);
11928 return result;
11931 /* [foreach] */
11932 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11934 return JimForeachMapHelper(interp, argc, argv, 0);
11937 /* [lmap] */
11938 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11940 return JimForeachMapHelper(interp, argc, argv, 1);
11943 /* [lassign] */
11944 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11946 int result = JIM_ERR;
11947 int i;
11948 Jim_ListIter iter;
11949 Jim_Obj *resultObj;
11951 if (argc < 2) {
11952 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11953 return JIM_ERR;
11956 JimListIterInit(&iter, argv[1]);
11958 for (i = 2; i < argc; i++) {
11959 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11960 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11961 if (result != JIM_OK) {
11962 return result;
11966 resultObj = Jim_NewListObj(interp, NULL, 0);
11967 while (!JimListIterDone(interp, &iter)) {
11968 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
11971 Jim_SetResult(interp, resultObj);
11973 return JIM_OK;
11976 /* [if] */
11977 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11979 int boolean, retval, current = 1, falsebody = 0;
11981 if (argc >= 3) {
11982 while (1) {
11983 /* Far not enough arguments given! */
11984 if (current >= argc)
11985 goto err;
11986 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
11987 != JIM_OK)
11988 return retval;
11989 /* There lacks something, isn't it? */
11990 if (current >= argc)
11991 goto err;
11992 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
11993 current++;
11994 /* Tsk tsk, no then-clause? */
11995 if (current >= argc)
11996 goto err;
11997 if (boolean)
11998 return Jim_EvalObj(interp, argv[current]);
11999 /* Ok: no else-clause follows */
12000 if (++current >= argc) {
12001 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12002 return JIM_OK;
12004 falsebody = current++;
12005 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12006 /* IIICKS - else-clause isn't last cmd? */
12007 if (current != argc - 1)
12008 goto err;
12009 return Jim_EvalObj(interp, argv[current]);
12011 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12012 /* Ok: elseif follows meaning all the stuff
12013 * again (how boring...) */
12014 continue;
12015 /* OOPS - else-clause is not last cmd? */
12016 else if (falsebody != argc - 1)
12017 goto err;
12018 return Jim_EvalObj(interp, argv[falsebody]);
12020 return JIM_OK;
12022 err:
12023 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12024 return JIM_ERR;
12028 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12029 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12030 Jim_Obj *stringObj, int nocase)
12032 Jim_Obj *parms[4];
12033 int argc = 0;
12034 long eq;
12035 int rc;
12037 parms[argc++] = commandObj;
12038 if (nocase) {
12039 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12041 parms[argc++] = patternObj;
12042 parms[argc++] = stringObj;
12044 rc = Jim_EvalObjVector(interp, argc, parms);
12046 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12047 eq = -rc;
12050 return eq;
12053 /* [switch] */
12054 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12056 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12057 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12058 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12059 Jim_Obj **caseList;
12061 if (argc < 3) {
12062 wrongnumargs:
12063 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12064 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12065 return JIM_ERR;
12067 for (opt = 1; opt < argc; ++opt) {
12068 const char *option = Jim_String(argv[opt]);
12070 if (*option != '-')
12071 break;
12072 else if (strncmp(option, "--", 2) == 0) {
12073 ++opt;
12074 break;
12076 else if (strncmp(option, "-exact", 2) == 0)
12077 matchOpt = SWITCH_EXACT;
12078 else if (strncmp(option, "-glob", 2) == 0)
12079 matchOpt = SWITCH_GLOB;
12080 else if (strncmp(option, "-regexp", 2) == 0)
12081 matchOpt = SWITCH_RE;
12082 else if (strncmp(option, "-command", 2) == 0) {
12083 matchOpt = SWITCH_CMD;
12084 if ((argc - opt) < 2)
12085 goto wrongnumargs;
12086 command = argv[++opt];
12088 else {
12089 Jim_SetResultFormatted(interp,
12090 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12091 argv[opt]);
12092 return JIM_ERR;
12094 if ((argc - opt) < 2)
12095 goto wrongnumargs;
12097 strObj = argv[opt++];
12098 patCount = argc - opt;
12099 if (patCount == 1) {
12100 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12102 else
12103 caseList = (Jim_Obj **)&argv[opt];
12104 if (patCount == 0 || patCount % 2 != 0)
12105 goto wrongnumargs;
12106 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12107 Jim_Obj *patObj = caseList[i];
12109 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12110 || i < (patCount - 2)) {
12111 switch (matchOpt) {
12112 case SWITCH_EXACT:
12113 if (Jim_StringEqObj(strObj, patObj))
12114 scriptObj = caseList[i + 1];
12115 break;
12116 case SWITCH_GLOB:
12117 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12118 scriptObj = caseList[i + 1];
12119 break;
12120 case SWITCH_RE:
12121 command = Jim_NewStringObj(interp, "regexp", -1);
12122 /* Fall thru intentionally */
12123 case SWITCH_CMD:{
12124 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12126 /* After the execution of a command we need to
12127 * make sure to reconvert the object into a list
12128 * again. Only for the single-list style [switch]. */
12129 if (argc - opt == 1) {
12130 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12132 /* command is here already decref'd */
12133 if (rc < 0) {
12134 return -rc;
12136 if (rc)
12137 scriptObj = caseList[i + 1];
12138 break;
12142 else {
12143 scriptObj = caseList[i + 1];
12146 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12147 scriptObj = caseList[i + 1];
12148 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12149 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12150 return JIM_ERR;
12152 Jim_SetEmptyResult(interp);
12153 if (scriptObj) {
12154 return Jim_EvalObj(interp, scriptObj);
12156 return JIM_OK;
12159 /* [list] */
12160 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12162 Jim_Obj *listObjPtr;
12164 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12165 Jim_SetResult(interp, listObjPtr);
12166 return JIM_OK;
12169 /* [lindex] */
12170 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12172 Jim_Obj *objPtr, *listObjPtr;
12173 int i;
12174 int idx;
12176 if (argc < 2) {
12177 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12178 return JIM_ERR;
12180 objPtr = argv[1];
12181 Jim_IncrRefCount(objPtr);
12182 for (i = 2; i < argc; i++) {
12183 listObjPtr = objPtr;
12184 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12185 Jim_DecrRefCount(interp, listObjPtr);
12186 return JIM_ERR;
12188 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12189 /* Returns an empty object if the index
12190 * is out of range. */
12191 Jim_DecrRefCount(interp, listObjPtr);
12192 Jim_SetEmptyResult(interp);
12193 return JIM_OK;
12195 Jim_IncrRefCount(objPtr);
12196 Jim_DecrRefCount(interp, listObjPtr);
12198 Jim_SetResult(interp, objPtr);
12199 Jim_DecrRefCount(interp, objPtr);
12200 return JIM_OK;
12203 /* [llength] */
12204 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12206 if (argc != 2) {
12207 Jim_WrongNumArgs(interp, 1, argv, "list");
12208 return JIM_ERR;
12210 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12211 return JIM_OK;
12214 /* [lsearch] */
12215 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12217 static const char * const options[] = {
12218 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12219 NULL
12221 enum
12222 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12223 OPT_COMMAND };
12224 int i;
12225 int opt_bool = 0;
12226 int opt_not = 0;
12227 int opt_nocase = 0;
12228 int opt_all = 0;
12229 int opt_inline = 0;
12230 int opt_match = OPT_EXACT;
12231 int listlen;
12232 int rc = JIM_OK;
12233 Jim_Obj *listObjPtr = NULL;
12234 Jim_Obj *commandObj = NULL;
12236 if (argc < 3) {
12237 wrongargs:
12238 Jim_WrongNumArgs(interp, 1, argv,
12239 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12240 return JIM_ERR;
12243 for (i = 1; i < argc - 2; i++) {
12244 int option;
12246 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12247 return JIM_ERR;
12249 switch (option) {
12250 case OPT_BOOL:
12251 opt_bool = 1;
12252 opt_inline = 0;
12253 break;
12254 case OPT_NOT:
12255 opt_not = 1;
12256 break;
12257 case OPT_NOCASE:
12258 opt_nocase = 1;
12259 break;
12260 case OPT_INLINE:
12261 opt_inline = 1;
12262 opt_bool = 0;
12263 break;
12264 case OPT_ALL:
12265 opt_all = 1;
12266 break;
12267 case OPT_COMMAND:
12268 if (i >= argc - 2) {
12269 goto wrongargs;
12271 commandObj = argv[++i];
12272 /* fallthru */
12273 case OPT_EXACT:
12274 case OPT_GLOB:
12275 case OPT_REGEXP:
12276 opt_match = option;
12277 break;
12281 argv += i;
12283 if (opt_all) {
12284 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12286 if (opt_match == OPT_REGEXP) {
12287 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12289 if (commandObj) {
12290 Jim_IncrRefCount(commandObj);
12293 listlen = Jim_ListLength(interp, argv[0]);
12294 for (i = 0; i < listlen; i++) {
12295 int eq = 0;
12296 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12298 switch (opt_match) {
12299 case OPT_EXACT:
12300 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12301 break;
12303 case OPT_GLOB:
12304 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12305 break;
12307 case OPT_REGEXP:
12308 case OPT_COMMAND:
12309 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12310 if (eq < 0) {
12311 if (listObjPtr) {
12312 Jim_FreeNewObj(interp, listObjPtr);
12314 rc = JIM_ERR;
12315 goto done;
12317 break;
12320 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12321 if (!eq && opt_bool && opt_not && !opt_all) {
12322 continue;
12325 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12326 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12327 Jim_Obj *resultObj;
12329 if (opt_bool) {
12330 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12332 else if (!opt_inline) {
12333 resultObj = Jim_NewIntObj(interp, i);
12335 else {
12336 resultObj = objPtr;
12339 if (opt_all) {
12340 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12342 else {
12343 Jim_SetResult(interp, resultObj);
12344 goto done;
12349 if (opt_all) {
12350 Jim_SetResult(interp, listObjPtr);
12352 else {
12353 /* No match */
12354 if (opt_bool) {
12355 Jim_SetResultBool(interp, opt_not);
12357 else if (!opt_inline) {
12358 Jim_SetResultInt(interp, -1);
12362 done:
12363 if (commandObj) {
12364 Jim_DecrRefCount(interp, commandObj);
12366 return rc;
12369 /* [lappend] */
12370 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12372 Jim_Obj *listObjPtr;
12373 int new_obj = 0;
12374 int i;
12376 if (argc < 2) {
12377 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12378 return JIM_ERR;
12380 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12381 if (!listObjPtr) {
12382 /* Create the list if it does not exist */
12383 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12384 new_obj = 1;
12386 else if (Jim_IsShared(listObjPtr)) {
12387 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12388 new_obj = 1;
12390 for (i = 2; i < argc; i++)
12391 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12392 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12393 if (new_obj)
12394 Jim_FreeNewObj(interp, listObjPtr);
12395 return JIM_ERR;
12397 Jim_SetResult(interp, listObjPtr);
12398 return JIM_OK;
12401 /* [linsert] */
12402 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12404 int idx, len;
12405 Jim_Obj *listPtr;
12407 if (argc < 3) {
12408 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12409 return JIM_ERR;
12411 listPtr = argv[1];
12412 if (Jim_IsShared(listPtr))
12413 listPtr = Jim_DuplicateObj(interp, listPtr);
12414 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12415 goto err;
12416 len = Jim_ListLength(interp, listPtr);
12417 if (idx >= len)
12418 idx = len;
12419 else if (idx < 0)
12420 idx = len + idx + 1;
12421 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12422 Jim_SetResult(interp, listPtr);
12423 return JIM_OK;
12424 err:
12425 if (listPtr != argv[1]) {
12426 Jim_FreeNewObj(interp, listPtr);
12428 return JIM_ERR;
12431 /* [lreplace] */
12432 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12434 int first, last, len, rangeLen;
12435 Jim_Obj *listObj;
12436 Jim_Obj *newListObj;
12438 if (argc < 4) {
12439 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12440 return JIM_ERR;
12442 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12443 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12444 return JIM_ERR;
12447 listObj = argv[1];
12448 len = Jim_ListLength(interp, listObj);
12450 first = JimRelToAbsIndex(len, first);
12451 last = JimRelToAbsIndex(len, last);
12452 JimRelToAbsRange(len, &first, &last, &rangeLen);
12454 /* Now construct a new list which consists of:
12455 * <elements before first> <supplied elements> <elements after last>
12458 /* Trying to replace past the end of the list means end of list
12459 * See TIP #505
12461 if (first > len) {
12462 first = len;
12465 /* Add the first set of elements */
12466 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12468 /* Add supplied elements */
12469 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12471 /* Add the remaining elements */
12472 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12474 Jim_SetResult(interp, newListObj);
12475 return JIM_OK;
12478 /* [lset] */
12479 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12481 if (argc < 3) {
12482 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12483 return JIM_ERR;
12485 else if (argc == 3) {
12486 /* With no indexes, simply implements [set] */
12487 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12488 return JIM_ERR;
12489 Jim_SetResult(interp, argv[2]);
12490 return JIM_OK;
12492 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12495 /* [lsort] */
12496 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12498 static const char * const options[] = {
12499 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12501 enum
12502 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12503 Jim_Obj *resObj;
12504 int i;
12505 int retCode;
12506 int shared;
12508 struct lsort_info info;
12510 if (argc < 2) {
12511 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12512 return JIM_ERR;
12515 info.type = JIM_LSORT_ASCII;
12516 info.order = 1;
12517 info.indexed = 0;
12518 info.unique = 0;
12519 info.command = NULL;
12520 info.interp = interp;
12522 for (i = 1; i < (argc - 1); i++) {
12523 int option;
12525 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12526 != JIM_OK)
12527 return JIM_ERR;
12528 switch (option) {
12529 case OPT_ASCII:
12530 info.type = JIM_LSORT_ASCII;
12531 break;
12532 case OPT_NOCASE:
12533 info.type = JIM_LSORT_NOCASE;
12534 break;
12535 case OPT_INTEGER:
12536 info.type = JIM_LSORT_INTEGER;
12537 break;
12538 case OPT_REAL:
12539 info.type = JIM_LSORT_REAL;
12540 break;
12541 case OPT_INCREASING:
12542 info.order = 1;
12543 break;
12544 case OPT_DECREASING:
12545 info.order = -1;
12546 break;
12547 case OPT_UNIQUE:
12548 info.unique = 1;
12549 break;
12550 case OPT_COMMAND:
12551 if (i >= (argc - 2)) {
12552 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12553 return JIM_ERR;
12555 info.type = JIM_LSORT_COMMAND;
12556 info.command = argv[i + 1];
12557 i++;
12558 break;
12559 case OPT_INDEX:
12560 if (i >= (argc - 2)) {
12561 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12562 return JIM_ERR;
12564 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12565 return JIM_ERR;
12567 info.indexed = 1;
12568 i++;
12569 break;
12572 resObj = argv[argc - 1];
12573 if ((shared = Jim_IsShared(resObj)))
12574 resObj = Jim_DuplicateObj(interp, resObj);
12575 retCode = ListSortElements(interp, resObj, &info);
12576 if (retCode == JIM_OK) {
12577 Jim_SetResult(interp, resObj);
12579 else if (shared) {
12580 Jim_FreeNewObj(interp, resObj);
12582 return retCode;
12585 /* [append] */
12586 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12588 Jim_Obj *stringObjPtr;
12589 int i;
12591 if (argc < 2) {
12592 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12593 return JIM_ERR;
12595 if (argc == 2) {
12596 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12597 if (!stringObjPtr)
12598 return JIM_ERR;
12600 else {
12601 int new_obj = 0;
12602 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12603 if (!stringObjPtr) {
12604 /* Create the string if it doesn't exist */
12605 stringObjPtr = Jim_NewEmptyStringObj(interp);
12606 new_obj = 1;
12608 else if (Jim_IsShared(stringObjPtr)) {
12609 new_obj = 1;
12610 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12612 for (i = 2; i < argc; i++) {
12613 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12615 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12616 if (new_obj) {
12617 Jim_FreeNewObj(interp, stringObjPtr);
12619 return JIM_ERR;
12622 Jim_SetResult(interp, stringObjPtr);
12623 return JIM_OK;
12626 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12628 * Returns a zero-refcount list describing the expression at 'node'
12630 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12632 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12634 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12635 if (TOKEN_IS_EXPR_OP(node->type)) {
12636 if (node->left) {
12637 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12639 if (node->right) {
12640 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12642 if (node->ternary) {
12643 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12646 else {
12647 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12649 return listObjPtr;
12651 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12653 /* [debug] */
12654 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12656 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12657 static const char * const options[] = {
12658 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12659 "exprbc", "show",
12660 NULL
12662 enum
12664 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12665 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12667 int option;
12669 if (argc < 2) {
12670 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12671 return JIM_ERR;
12673 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12674 return Jim_CheckShowCommands(interp, argv[1], options);
12675 if (option == OPT_REFCOUNT) {
12676 if (argc != 3) {
12677 Jim_WrongNumArgs(interp, 2, argv, "object");
12678 return JIM_ERR;
12680 Jim_SetResultInt(interp, argv[2]->refCount);
12681 return JIM_OK;
12683 else if (option == OPT_OBJCOUNT) {
12684 int freeobj = 0, liveobj = 0;
12685 char buf[256];
12686 Jim_Obj *objPtr;
12688 if (argc != 2) {
12689 Jim_WrongNumArgs(interp, 2, argv, "");
12690 return JIM_ERR;
12692 /* Count the number of free objects. */
12693 objPtr = interp->freeList;
12694 while (objPtr) {
12695 freeobj++;
12696 objPtr = objPtr->nextObjPtr;
12698 /* Count the number of live objects. */
12699 objPtr = interp->liveList;
12700 while (objPtr) {
12701 liveobj++;
12702 objPtr = objPtr->nextObjPtr;
12704 /* Set the result string and return. */
12705 sprintf(buf, "free %d used %d", freeobj, liveobj);
12706 Jim_SetResultString(interp, buf, -1);
12707 return JIM_OK;
12709 else if (option == OPT_OBJECTS) {
12710 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12712 /* Count the number of live objects. */
12713 objPtr = interp->liveList;
12714 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12715 while (objPtr) {
12716 char buf[128];
12717 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12719 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12720 sprintf(buf, "%p", objPtr);
12721 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12722 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12723 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12724 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12725 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12726 objPtr = objPtr->nextObjPtr;
12728 Jim_SetResult(interp, listObjPtr);
12729 return JIM_OK;
12731 else if (option == OPT_INVSTR) {
12732 Jim_Obj *objPtr;
12734 if (argc != 3) {
12735 Jim_WrongNumArgs(interp, 2, argv, "object");
12736 return JIM_ERR;
12738 objPtr = argv[2];
12739 if (objPtr->typePtr != NULL)
12740 Jim_InvalidateStringRep(objPtr);
12741 Jim_SetEmptyResult(interp);
12742 return JIM_OK;
12744 else if (option == OPT_SHOW) {
12745 const char *s;
12746 int len, charlen;
12748 if (argc != 3) {
12749 Jim_WrongNumArgs(interp, 2, argv, "object");
12750 return JIM_ERR;
12752 s = Jim_GetString(argv[2], &len);
12753 #ifdef JIM_UTF8
12754 charlen = utf8_strlen(s, len);
12755 #else
12756 charlen = len;
12757 #endif
12758 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12759 printf("chars (%d): <<%s>>\n", charlen, s);
12760 printf("bytes (%d):", len);
12761 while (len--) {
12762 printf(" %02x", (unsigned char)*s++);
12764 printf("\n");
12765 return JIM_OK;
12767 else if (option == OPT_SCRIPTLEN) {
12768 ScriptObj *script;
12770 if (argc != 3) {
12771 Jim_WrongNumArgs(interp, 2, argv, "script");
12772 return JIM_ERR;
12774 script = JimGetScript(interp, argv[2]);
12775 if (script == NULL)
12776 return JIM_ERR;
12777 Jim_SetResultInt(interp, script->len);
12778 return JIM_OK;
12780 else if (option == OPT_EXPRLEN) {
12781 struct ExprTree *expr;
12783 if (argc != 3) {
12784 Jim_WrongNumArgs(interp, 2, argv, "expression");
12785 return JIM_ERR;
12787 expr = JimGetExpression(interp, argv[2]);
12788 if (expr == NULL)
12789 return JIM_ERR;
12790 Jim_SetResultInt(interp, expr->len);
12791 return JIM_OK;
12793 else if (option == OPT_EXPRBC) {
12794 struct ExprTree *expr;
12796 if (argc != 3) {
12797 Jim_WrongNumArgs(interp, 2, argv, "expression");
12798 return JIM_ERR;
12800 expr = JimGetExpression(interp, argv[2]);
12801 if (expr == NULL)
12802 return JIM_ERR;
12803 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12804 return JIM_OK;
12806 else {
12807 Jim_SetResultString(interp,
12808 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12809 return JIM_ERR;
12811 /* unreached */
12812 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12813 #if !defined(JIM_DEBUG_COMMAND)
12814 Jim_SetResultString(interp, "unsupported", -1);
12815 return JIM_ERR;
12816 #endif
12819 /* [eval] */
12820 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12822 int rc;
12824 if (argc < 2) {
12825 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12826 return JIM_ERR;
12829 if (argc == 2) {
12830 rc = Jim_EvalObj(interp, argv[1]);
12832 else {
12833 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12836 if (rc == JIM_ERR) {
12837 /* eval is "interesting", so add a stack frame here */
12838 interp->addStackTrace++;
12840 return rc;
12843 /* [uplevel] */
12844 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12846 if (argc >= 2) {
12847 int retcode;
12848 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12849 const char *str;
12851 /* Save the old callframe pointer */
12852 savedCallFrame = interp->framePtr;
12854 /* Lookup the target frame pointer */
12855 str = Jim_String(argv[1]);
12856 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12857 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12858 argc--;
12859 argv++;
12861 else {
12862 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12864 if (targetCallFrame == NULL) {
12865 return JIM_ERR;
12867 if (argc < 2) {
12868 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12869 return JIM_ERR;
12871 /* Eval the code in the target callframe. */
12872 interp->framePtr = targetCallFrame;
12873 if (argc == 2) {
12874 retcode = Jim_EvalObj(interp, argv[1]);
12876 else {
12877 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12879 interp->framePtr = savedCallFrame;
12880 return retcode;
12882 else {
12883 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12884 return JIM_ERR;
12888 /* [expr] */
12889 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12891 int retcode;
12893 if (argc == 2) {
12894 retcode = Jim_EvalExpression(interp, argv[1]);
12896 else if (argc > 2) {
12897 Jim_Obj *objPtr;
12899 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12900 Jim_IncrRefCount(objPtr);
12901 retcode = Jim_EvalExpression(interp, objPtr);
12902 Jim_DecrRefCount(interp, objPtr);
12904 else {
12905 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12906 return JIM_ERR;
12908 if (retcode != JIM_OK)
12909 return retcode;
12910 return JIM_OK;
12913 /* [break] */
12914 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12916 if (argc != 1) {
12917 Jim_WrongNumArgs(interp, 1, argv, "");
12918 return JIM_ERR;
12920 return JIM_BREAK;
12923 /* [continue] */
12924 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12926 if (argc != 1) {
12927 Jim_WrongNumArgs(interp, 1, argv, "");
12928 return JIM_ERR;
12930 return JIM_CONTINUE;
12933 /* [return] */
12934 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12936 int i;
12937 Jim_Obj *stackTraceObj = NULL;
12938 Jim_Obj *errorCodeObj = NULL;
12939 int returnCode = JIM_OK;
12940 long level = 1;
12942 for (i = 1; i < argc - 1; i += 2) {
12943 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12944 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12945 return JIM_ERR;
12948 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12949 stackTraceObj = argv[i + 1];
12951 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12952 errorCodeObj = argv[i + 1];
12954 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12955 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12956 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12957 return JIM_ERR;
12960 else {
12961 break;
12965 if (i != argc - 1 && i != argc) {
12966 Jim_WrongNumArgs(interp, 1, argv,
12967 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
12970 /* If a stack trace is supplied and code is error, set the stack trace */
12971 if (stackTraceObj && returnCode == JIM_ERR) {
12972 JimSetStackTrace(interp, stackTraceObj);
12974 /* If an error code list is supplied, set the global $errorCode */
12975 if (errorCodeObj && returnCode == JIM_ERR) {
12976 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
12978 interp->returnCode = returnCode;
12979 interp->returnLevel = level;
12981 if (i == argc - 1) {
12982 Jim_SetResult(interp, argv[i]);
12984 return level == 0 ? returnCode : JIM_RETURN;
12987 /* [tailcall] */
12988 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12990 if (interp->framePtr->level == 0) {
12991 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
12992 return JIM_ERR;
12994 else if (argc >= 2) {
12995 /* Need to resolve the tailcall command in the current context */
12996 Jim_CallFrame *cf = interp->framePtr->parent;
12998 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
12999 if (cmdPtr == NULL) {
13000 return JIM_ERR;
13003 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13005 /* And stash this pre-resolved command */
13006 JimIncrCmdRefCount(cmdPtr);
13007 cf->tailcallCmd = cmdPtr;
13009 /* And stash the command list */
13010 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13012 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13013 Jim_IncrRefCount(cf->tailcallObj);
13015 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13016 return JIM_EVAL;
13018 return JIM_OK;
13021 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13023 Jim_Obj *cmdList;
13024 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13026 /* prefixListObj is a list to which the args need to be appended */
13027 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13028 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13030 return JimEvalObjList(interp, cmdList);
13033 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13035 Jim_Obj *prefixListObj = privData;
13036 Jim_DecrRefCount(interp, prefixListObj);
13039 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13041 Jim_Obj *prefixListObj;
13042 const char *newname;
13044 if (argc < 3) {
13045 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13046 return JIM_ERR;
13049 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13050 Jim_IncrRefCount(prefixListObj);
13051 newname = Jim_String(argv[1]);
13052 if (newname[0] == ':' && newname[1] == ':') {
13053 while (*++newname == ':') {
13057 Jim_SetResult(interp, argv[1]);
13059 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13062 /* [proc] */
13063 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13065 Jim_Cmd *cmd;
13067 if (argc != 4 && argc != 5) {
13068 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13069 return JIM_ERR;
13072 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13073 return JIM_ERR;
13076 if (argc == 4) {
13077 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13079 else {
13080 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13083 if (cmd) {
13084 /* Add the new command */
13085 Jim_Obj *qualifiedCmdNameObj;
13086 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13088 JimCreateCommand(interp, cmdname, cmd);
13090 /* Calculate and set the namespace for this proc */
13091 JimUpdateProcNamespace(interp, cmd, cmdname);
13093 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13095 /* Unlike Tcl, set the name of the proc as the result */
13096 Jim_SetResult(interp, argv[1]);
13097 return JIM_OK;
13099 return JIM_ERR;
13102 /* [local] */
13103 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13105 int retcode;
13107 if (argc < 2) {
13108 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13109 return JIM_ERR;
13112 /* Evaluate the arguments with 'local' in force */
13113 interp->local++;
13114 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13115 interp->local--;
13118 /* If OK, and the result is a proc, add it to the list of local procs */
13119 if (retcode == 0) {
13120 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13122 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13123 return JIM_ERR;
13125 if (interp->framePtr->localCommands == NULL) {
13126 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13127 Jim_InitStack(interp->framePtr->localCommands);
13129 Jim_IncrRefCount(cmdNameObj);
13130 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13133 return retcode;
13136 /* [upcall] */
13137 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13139 if (argc < 2) {
13140 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13141 return JIM_ERR;
13143 else {
13144 int retcode;
13146 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13147 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13148 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13149 return JIM_ERR;
13151 /* OK. Mark this command as being in an upcall */
13152 cmdPtr->u.proc.upcall++;
13153 JimIncrCmdRefCount(cmdPtr);
13155 /* Invoke the command as normal */
13156 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13158 /* No longer in an upcall */
13159 cmdPtr->u.proc.upcall--;
13160 JimDecrCmdRefCount(interp, cmdPtr);
13162 return retcode;
13166 /* [apply] */
13167 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13169 if (argc < 2) {
13170 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13171 return JIM_ERR;
13173 else {
13174 int ret;
13175 Jim_Cmd *cmd;
13176 Jim_Obj *argListObjPtr;
13177 Jim_Obj *bodyObjPtr;
13178 Jim_Obj *nsObj = NULL;
13179 Jim_Obj **nargv;
13181 int len = Jim_ListLength(interp, argv[1]);
13182 if (len != 2 && len != 3) {
13183 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13184 return JIM_ERR;
13187 if (len == 3) {
13188 #ifdef jim_ext_namespace
13189 /* Need to canonicalise the given namespace. */
13190 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13191 #else
13192 Jim_SetResultString(interp, "namespaces not enabled", -1);
13193 return JIM_ERR;
13194 #endif
13196 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13197 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13199 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13201 if (cmd) {
13202 /* Create a new argv array with a dummy argv[0], for error messages */
13203 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13204 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13205 Jim_IncrRefCount(nargv[0]);
13206 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13207 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13208 Jim_DecrRefCount(interp, nargv[0]);
13209 Jim_Free(nargv);
13211 JimDecrCmdRefCount(interp, cmd);
13212 return ret;
13214 return JIM_ERR;
13219 /* [concat] */
13220 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13222 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13223 return JIM_OK;
13226 /* [upvar] */
13227 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13229 int i;
13230 Jim_CallFrame *targetCallFrame;
13232 /* Lookup the target frame pointer */
13233 if (argc > 3 && (argc % 2 == 0)) {
13234 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13235 argc--;
13236 argv++;
13238 else {
13239 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13241 if (targetCallFrame == NULL) {
13242 return JIM_ERR;
13245 /* Check for arity */
13246 if (argc < 3) {
13247 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13248 return JIM_ERR;
13251 /* Now... for every other/local couple: */
13252 for (i = 1; i < argc; i += 2) {
13253 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13254 return JIM_ERR;
13256 return JIM_OK;
13259 /* [global] */
13260 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13262 int i;
13264 if (argc < 2) {
13265 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13266 return JIM_ERR;
13268 /* Link every var to the toplevel having the same name */
13269 if (interp->framePtr->level == 0)
13270 return JIM_OK; /* global at toplevel... */
13271 for (i = 1; i < argc; i++) {
13272 /* global ::blah does nothing */
13273 const char *name = Jim_String(argv[i]);
13274 if (name[0] != ':' || name[1] != ':') {
13275 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13276 return JIM_ERR;
13279 return JIM_OK;
13282 /* does the [string map] operation. On error NULL is returned,
13283 * otherwise a new string object with the result, having refcount = 0,
13284 * is returned. */
13285 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13286 Jim_Obj *objPtr, int nocase)
13288 int numMaps;
13289 const char *str, *noMatchStart = NULL;
13290 int strLen, i;
13291 Jim_Obj *resultObjPtr;
13293 numMaps = Jim_ListLength(interp, mapListObjPtr);
13294 if (numMaps % 2) {
13295 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13296 return NULL;
13299 str = Jim_String(objPtr);
13300 strLen = Jim_Utf8Length(interp, objPtr);
13302 /* Map it */
13303 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13304 while (strLen) {
13305 for (i = 0; i < numMaps; i += 2) {
13306 Jim_Obj *eachObjPtr;
13307 const char *k;
13308 int kl;
13310 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13311 k = Jim_String(eachObjPtr);
13312 kl = Jim_Utf8Length(interp, eachObjPtr);
13314 if (strLen >= kl && kl) {
13315 int rc;
13316 rc = JimStringCompareUtf8(str, kl, k, kl, nocase);
13317 if (rc == 0) {
13318 if (noMatchStart) {
13319 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13320 noMatchStart = NULL;
13322 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13323 str += utf8_index(str, kl);
13324 strLen -= kl;
13325 break;
13329 if (i == numMaps) { /* no match */
13330 int c;
13331 if (noMatchStart == NULL)
13332 noMatchStart = str;
13333 str += utf8_tounicode(str, &c);
13334 strLen--;
13337 if (noMatchStart) {
13338 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13340 return resultObjPtr;
13343 /* [string] */
13344 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13346 int len;
13347 int opt_case = 1;
13348 int option;
13349 static const char * const options[] = {
13350 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13351 "map", "repeat", "reverse", "index", "first", "last", "cat",
13352 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13354 enum
13356 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13357 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13358 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13360 static const char * const nocase_options[] = {
13361 "-nocase", NULL
13363 static const char * const nocase_length_options[] = {
13364 "-nocase", "-length", NULL
13367 if (argc < 2) {
13368 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13369 return JIM_ERR;
13371 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13372 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13373 return Jim_CheckShowCommands(interp, argv[1], options);
13375 switch (option) {
13376 case OPT_LENGTH:
13377 case OPT_BYTELENGTH:
13378 if (argc != 3) {
13379 Jim_WrongNumArgs(interp, 2, argv, "string");
13380 return JIM_ERR;
13382 if (option == OPT_LENGTH) {
13383 len = Jim_Utf8Length(interp, argv[2]);
13385 else {
13386 len = Jim_Length(argv[2]);
13388 Jim_SetResultInt(interp, len);
13389 return JIM_OK;
13391 case OPT_CAT:{
13392 Jim_Obj *objPtr;
13393 if (argc == 3) {
13394 /* optimise the one-arg case */
13395 objPtr = argv[2];
13397 else {
13398 int i;
13400 objPtr = Jim_NewStringObj(interp, "", 0);
13402 for (i = 2; i < argc; i++) {
13403 Jim_AppendObj(interp, objPtr, argv[i]);
13406 Jim_SetResult(interp, objPtr);
13407 return JIM_OK;
13410 case OPT_COMPARE:
13411 case OPT_EQUAL:
13413 /* n is the number of remaining option args */
13414 long opt_length = -1;
13415 int n = argc - 4;
13416 int i = 2;
13417 while (n > 0) {
13418 int subopt;
13419 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13420 JIM_ENUM_ABBREV) != JIM_OK) {
13421 badcompareargs:
13422 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13423 return JIM_ERR;
13425 if (subopt == 0) {
13426 /* -nocase */
13427 opt_case = 0;
13428 n--;
13430 else {
13431 /* -length */
13432 if (n < 2) {
13433 goto badcompareargs;
13435 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13436 return JIM_ERR;
13438 n -= 2;
13441 if (n) {
13442 goto badcompareargs;
13444 argv += argc - 2;
13445 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13446 /* Fast version - [string equal], case sensitive, no length */
13447 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13449 else {
13450 const char *s1 = Jim_String(argv[0]);
13451 int l1 = Jim_Utf8Length(interp, argv[0]);
13452 const char *s2 = Jim_String(argv[1]);
13453 int l2 = Jim_Utf8Length(interp, argv[1]);
13454 if (opt_length >= 0) {
13455 if (l1 > opt_length) {
13456 l1 = opt_length;
13458 if (l2 > opt_length) {
13459 l2 = opt_length;
13462 n = JimStringCompareUtf8(s1, l1, s2, l2, !opt_case);
13463 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13465 return JIM_OK;
13468 case OPT_MATCH:
13469 if (argc != 4 &&
13470 (argc != 5 ||
13471 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13472 JIM_ENUM_ABBREV) != JIM_OK)) {
13473 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13474 return JIM_ERR;
13476 if (opt_case == 0) {
13477 argv++;
13479 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13480 return JIM_OK;
13482 case OPT_MAP:{
13483 Jim_Obj *objPtr;
13485 if (argc != 4 &&
13486 (argc != 5 ||
13487 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13488 JIM_ENUM_ABBREV) != JIM_OK)) {
13489 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13490 return JIM_ERR;
13493 if (opt_case == 0) {
13494 argv++;
13496 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13497 if (objPtr == NULL) {
13498 return JIM_ERR;
13500 Jim_SetResult(interp, objPtr);
13501 return JIM_OK;
13504 case OPT_RANGE:
13505 case OPT_BYTERANGE:{
13506 Jim_Obj *objPtr;
13508 if (argc != 5) {
13509 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13510 return JIM_ERR;
13512 if (option == OPT_RANGE) {
13513 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13515 else
13517 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13520 if (objPtr == NULL) {
13521 return JIM_ERR;
13523 Jim_SetResult(interp, objPtr);
13524 return JIM_OK;
13527 case OPT_REPLACE:{
13528 Jim_Obj *objPtr;
13530 if (argc != 5 && argc != 6) {
13531 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13532 return JIM_ERR;
13534 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13535 if (objPtr == NULL) {
13536 return JIM_ERR;
13538 Jim_SetResult(interp, objPtr);
13539 return JIM_OK;
13543 case OPT_REPEAT:{
13544 Jim_Obj *objPtr;
13545 jim_wide count;
13547 if (argc != 4) {
13548 Jim_WrongNumArgs(interp, 2, argv, "string count");
13549 return JIM_ERR;
13551 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13552 return JIM_ERR;
13554 objPtr = Jim_NewStringObj(interp, "", 0);
13555 if (count > 0) {
13556 while (count--) {
13557 Jim_AppendObj(interp, objPtr, argv[2]);
13560 Jim_SetResult(interp, objPtr);
13561 return JIM_OK;
13564 case OPT_REVERSE:{
13565 char *buf, *p;
13566 const char *str;
13567 int i;
13569 if (argc != 3) {
13570 Jim_WrongNumArgs(interp, 2, argv, "string");
13571 return JIM_ERR;
13574 str = Jim_GetString(argv[2], &len);
13575 buf = Jim_Alloc(len + 1);
13576 p = buf + len;
13577 *p = 0;
13578 for (i = 0; i < len; ) {
13579 int c;
13580 int l = utf8_tounicode(str, &c);
13581 memcpy(p - l, str, l);
13582 p -= l;
13583 i += l;
13584 str += l;
13586 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13587 return JIM_OK;
13590 case OPT_INDEX:{
13591 int idx;
13592 const char *str;
13594 if (argc != 4) {
13595 Jim_WrongNumArgs(interp, 2, argv, "string index");
13596 return JIM_ERR;
13598 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13599 return JIM_ERR;
13601 str = Jim_String(argv[2]);
13602 len = Jim_Utf8Length(interp, argv[2]);
13603 if (idx != INT_MIN && idx != INT_MAX) {
13604 idx = JimRelToAbsIndex(len, idx);
13606 if (idx < 0 || idx >= len || str == NULL) {
13607 Jim_SetResultString(interp, "", 0);
13609 else if (len == Jim_Length(argv[2])) {
13610 /* ASCII optimisation */
13611 Jim_SetResultString(interp, str + idx, 1);
13613 else {
13614 int c;
13615 int i = utf8_index(str, idx);
13616 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13618 return JIM_OK;
13621 case OPT_FIRST:
13622 case OPT_LAST:{
13623 int idx = 0, l1, l2;
13624 const char *s1, *s2;
13626 if (argc != 4 && argc != 5) {
13627 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13628 return JIM_ERR;
13630 s1 = Jim_String(argv[2]);
13631 s2 = Jim_String(argv[3]);
13632 l1 = Jim_Utf8Length(interp, argv[2]);
13633 l2 = Jim_Utf8Length(interp, argv[3]);
13634 if (argc == 5) {
13635 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13636 return JIM_ERR;
13638 idx = JimRelToAbsIndex(l2, idx);
13640 else if (option == OPT_LAST) {
13641 idx = l2;
13643 if (option == OPT_FIRST) {
13644 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13646 else {
13647 #ifdef JIM_UTF8
13648 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13649 #else
13650 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13651 #endif
13653 return JIM_OK;
13656 case OPT_TRIM:
13657 case OPT_TRIMLEFT:
13658 case OPT_TRIMRIGHT:{
13659 Jim_Obj *trimchars;
13661 if (argc != 3 && argc != 4) {
13662 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13663 return JIM_ERR;
13665 trimchars = (argc == 4 ? argv[3] : NULL);
13666 if (option == OPT_TRIM) {
13667 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13669 else if (option == OPT_TRIMLEFT) {
13670 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13672 else if (option == OPT_TRIMRIGHT) {
13673 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13675 return JIM_OK;
13678 case OPT_TOLOWER:
13679 case OPT_TOUPPER:
13680 case OPT_TOTITLE:
13681 if (argc != 3) {
13682 Jim_WrongNumArgs(interp, 2, argv, "string");
13683 return JIM_ERR;
13685 if (option == OPT_TOLOWER) {
13686 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13688 else if (option == OPT_TOUPPER) {
13689 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13691 else {
13692 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13694 return JIM_OK;
13696 case OPT_IS:
13697 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13698 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13700 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13701 return JIM_ERR;
13703 return JIM_OK;
13706 /* [time] */
13707 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13709 long i, count = 1;
13710 jim_wide start, elapsed;
13711 char buf[60];
13712 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13714 if (argc < 2) {
13715 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13716 return JIM_ERR;
13718 if (argc == 3) {
13719 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13720 return JIM_ERR;
13722 if (count < 0)
13723 return JIM_OK;
13724 i = count;
13725 start = JimClock();
13726 while (i-- > 0) {
13727 int retval;
13729 retval = Jim_EvalObj(interp, argv[1]);
13730 if (retval != JIM_OK) {
13731 return retval;
13734 elapsed = JimClock() - start;
13735 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13736 Jim_SetResultString(interp, buf, -1);
13737 return JIM_OK;
13740 /* [exit] */
13741 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13743 long exitCode = 0;
13745 if (argc > 2) {
13746 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13747 return JIM_ERR;
13749 if (argc == 2) {
13750 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13751 return JIM_ERR;
13753 interp->exitCode = exitCode;
13754 return JIM_EXIT;
13757 /* [catch] */
13758 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13760 int exitCode = 0;
13761 int i;
13762 int sig = 0;
13764 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13765 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13766 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13768 /* Reset the error code before catch.
13769 * Note that this is not strictly correct.
13771 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13773 for (i = 1; i < argc - 1; i++) {
13774 const char *arg = Jim_String(argv[i]);
13775 jim_wide option;
13776 int ignore;
13778 /* It's a pity we can't use Jim_GetEnum here :-( */
13779 if (strcmp(arg, "--") == 0) {
13780 i++;
13781 break;
13783 if (*arg != '-') {
13784 break;
13787 if (strncmp(arg, "-no", 3) == 0) {
13788 arg += 3;
13789 ignore = 1;
13791 else {
13792 arg++;
13793 ignore = 0;
13796 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13797 option = -1;
13799 if (option < 0) {
13800 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13802 if (option < 0) {
13803 goto wrongargs;
13806 if (ignore) {
13807 ignore_mask |= ((jim_wide)1 << option);
13809 else {
13810 ignore_mask &= (~((jim_wide)1 << option));
13814 argc -= i;
13815 if (argc < 1 || argc > 3) {
13816 wrongargs:
13817 Jim_WrongNumArgs(interp, 1, argv,
13818 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13819 return JIM_ERR;
13821 argv += i;
13823 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13824 sig++;
13827 interp->signal_level += sig;
13828 if (Jim_CheckSignal(interp)) {
13829 /* If a signal is set, don't even try to execute the body */
13830 exitCode = JIM_SIGNAL;
13832 else {
13833 exitCode = Jim_EvalObj(interp, argv[0]);
13834 /* Don't want any caught error included in a later stack trace */
13835 interp->errorFlag = 0;
13837 interp->signal_level -= sig;
13839 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13840 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13841 /* Not caught, pass it up */
13842 return exitCode;
13845 if (sig && exitCode == JIM_SIGNAL) {
13846 /* Catch the signal at this level */
13847 if (interp->signal_set_result) {
13848 interp->signal_set_result(interp, interp->sigmask);
13850 else {
13851 Jim_SetResultInt(interp, interp->sigmask);
13853 interp->sigmask = 0;
13856 if (argc >= 2) {
13857 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13858 return JIM_ERR;
13860 if (argc == 3) {
13861 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13863 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13864 Jim_ListAppendElement(interp, optListObj,
13865 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13866 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13867 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13868 if (exitCode == JIM_ERR) {
13869 Jim_Obj *errorCode;
13870 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13871 -1));
13872 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13874 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13875 if (errorCode) {
13876 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13877 Jim_ListAppendElement(interp, optListObj, errorCode);
13880 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13881 return JIM_ERR;
13885 Jim_SetResultInt(interp, exitCode);
13886 return JIM_OK;
13889 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13891 /* [ref] */
13892 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13894 if (argc != 3 && argc != 4) {
13895 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13896 return JIM_ERR;
13898 if (argc == 3) {
13899 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13901 else {
13902 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13904 return JIM_OK;
13907 /* [getref] */
13908 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13910 Jim_Reference *refPtr;
13912 if (argc != 2) {
13913 Jim_WrongNumArgs(interp, 1, argv, "reference");
13914 return JIM_ERR;
13916 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13917 return JIM_ERR;
13918 Jim_SetResult(interp, refPtr->objPtr);
13919 return JIM_OK;
13922 /* [setref] */
13923 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13925 Jim_Reference *refPtr;
13927 if (argc != 3) {
13928 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13929 return JIM_ERR;
13931 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13932 return JIM_ERR;
13933 Jim_IncrRefCount(argv[2]);
13934 Jim_DecrRefCount(interp, refPtr->objPtr);
13935 refPtr->objPtr = argv[2];
13936 Jim_SetResult(interp, argv[2]);
13937 return JIM_OK;
13940 /* [collect] */
13941 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13943 if (argc != 1) {
13944 Jim_WrongNumArgs(interp, 1, argv, "");
13945 return JIM_ERR;
13947 Jim_SetResultInt(interp, Jim_Collect(interp));
13949 /* Free all the freed objects. */
13950 while (interp->freeList) {
13951 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13952 Jim_Free(interp->freeList);
13953 interp->freeList = nextObjPtr;
13956 return JIM_OK;
13959 /* [finalize] reference ?newValue? */
13960 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13962 if (argc != 2 && argc != 3) {
13963 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13964 return JIM_ERR;
13966 if (argc == 2) {
13967 Jim_Obj *cmdNamePtr;
13969 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13970 return JIM_ERR;
13971 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13972 Jim_SetResult(interp, cmdNamePtr);
13974 else {
13975 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
13976 return JIM_ERR;
13977 Jim_SetResult(interp, argv[2]);
13979 return JIM_OK;
13982 /* [info references] */
13983 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13985 Jim_Obj *listObjPtr;
13986 Jim_HashTableIterator htiter;
13987 Jim_HashEntry *he;
13989 listObjPtr = Jim_NewListObj(interp, NULL, 0);
13991 JimInitHashTableIterator(&interp->references, &htiter);
13992 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
13993 char buf[JIM_REFERENCE_SPACE + 1];
13994 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
13995 const unsigned long *refId = he->key;
13997 JimFormatReference(buf, refPtr, *refId);
13998 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14000 Jim_SetResult(interp, listObjPtr);
14001 return JIM_OK;
14003 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14005 /* [rename] */
14006 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14008 if (argc != 3) {
14009 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14010 return JIM_ERR;
14013 if (JimValidName(interp, "new procedure", argv[2])) {
14014 return JIM_ERR;
14017 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14020 #define JIM_DICTMATCH_KEYS 0x0001
14021 #define JIM_DICTMATCH_VALUES 0x002
14024 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14025 * return_types should be either or both
14027 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14029 Jim_HashEntry *he;
14030 Jim_Obj *listObjPtr;
14031 Jim_HashTableIterator htiter;
14033 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14034 return JIM_ERR;
14037 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14039 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14040 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14041 if (patternObj) {
14042 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14043 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14044 /* no match */
14045 continue;
14048 if (return_types & JIM_DICTMATCH_KEYS) {
14049 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14051 if (return_types & JIM_DICTMATCH_VALUES) {
14052 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14056 Jim_SetResult(interp, listObjPtr);
14057 return JIM_OK;
14060 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14062 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14063 return -1;
14065 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14069 * Must be called with at least one object.
14070 * Returns the new dictionary, or NULL on error.
14072 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14074 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14075 int i;
14077 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14079 /* Note that we don't optimise the trivial case of a single argument */
14081 for (i = 0; i < objc; i++) {
14082 Jim_HashTable *ht;
14083 Jim_HashTableIterator htiter;
14084 Jim_HashEntry *he;
14086 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14087 Jim_FreeNewObj(interp, objPtr);
14088 return NULL;
14090 ht = objv[i]->internalRep.ptr;
14091 JimInitHashTableIterator(ht, &htiter);
14092 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14093 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14096 return objPtr;
14099 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14101 Jim_HashTable *ht;
14102 unsigned int i;
14103 char buffer[100];
14104 int sum = 0;
14105 int nonzero_count = 0;
14106 Jim_Obj *output;
14107 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14109 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14110 return JIM_ERR;
14113 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14115 /* Note that this uses internal knowledge of the hash table */
14116 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14117 output = Jim_NewStringObj(interp, buffer, -1);
14119 for (i = 0; i < ht->size; i++) {
14120 Jim_HashEntry *he = ht->table[i];
14121 int entries = 0;
14122 while (he) {
14123 entries++;
14124 he = he->next;
14126 if (entries > 9) {
14127 bucket_counts[10]++;
14129 else {
14130 bucket_counts[entries]++;
14132 if (entries) {
14133 sum += entries;
14134 nonzero_count++;
14137 for (i = 0; i < 10; i++) {
14138 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14139 Jim_AppendString(interp, output, buffer, -1);
14141 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14142 Jim_AppendString(interp, output, buffer, -1);
14143 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14144 Jim_AppendString(interp, output, buffer, -1);
14145 Jim_SetResult(interp, output);
14146 return JIM_OK;
14149 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14151 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14153 Jim_AppendString(interp, prefixObj, " ", 1);
14154 Jim_AppendString(interp, prefixObj, subcmd, -1);
14156 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14160 * Implements the [dict with] command
14162 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14164 int i;
14165 Jim_Obj *objPtr;
14166 Jim_Obj *dictObj;
14167 Jim_Obj **dictValues;
14168 int len;
14169 int ret = JIM_OK;
14171 /* Open up the appropriate level of the dictionary */
14172 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14173 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14174 return JIM_ERR;
14176 /* Set the local variables */
14177 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14178 return JIM_ERR;
14180 for (i = 0; i < len; i += 2) {
14181 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14182 Jim_Free(dictValues);
14183 return JIM_ERR;
14187 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14188 if (Jim_Length(scriptObj)) {
14189 ret = Jim_EvalObj(interp, scriptObj);
14191 /* Now if the dictionary still exists, update it based on the local variables */
14192 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14193 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14194 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14195 for (i = 0; i < keyc; i++) {
14196 newkeyv[i] = keyv[i];
14199 for (i = 0; i < len; i += 2) {
14200 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14201 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14202 newkeyv[keyc] = dictValues[i];
14203 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14205 Jim_Free(newkeyv);
14209 Jim_Free(dictValues);
14211 return ret;
14214 /* [dict] */
14215 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14217 Jim_Obj *objPtr;
14218 int types = JIM_DICTMATCH_KEYS;
14219 int option;
14220 static const char * const options[] = {
14221 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14222 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14223 "replace", "update", NULL
14225 enum
14227 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14228 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14229 OPT_REPLACE, OPT_UPDATE,
14232 if (argc < 2) {
14233 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14234 return JIM_ERR;
14237 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14238 return Jim_CheckShowCommands(interp, argv[1], options);
14241 switch (option) {
14242 case OPT_GET:
14243 if (argc < 3) {
14244 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14245 return JIM_ERR;
14247 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14248 JIM_ERRMSG) != JIM_OK) {
14249 return JIM_ERR;
14251 Jim_SetResult(interp, objPtr);
14252 return JIM_OK;
14254 case OPT_SET:
14255 if (argc < 5) {
14256 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14257 return JIM_ERR;
14259 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14261 case OPT_EXISTS:
14262 if (argc < 4) {
14263 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14264 return JIM_ERR;
14266 else {
14267 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14268 if (rc < 0) {
14269 return JIM_ERR;
14271 Jim_SetResultBool(interp, rc == JIM_OK);
14272 return JIM_OK;
14275 case OPT_UNSET:
14276 if (argc < 4) {
14277 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14278 return JIM_ERR;
14280 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14281 return JIM_ERR;
14283 return JIM_OK;
14285 case OPT_VALUES:
14286 types = JIM_DICTMATCH_VALUES;
14287 /* fallthru */
14288 case OPT_KEYS:
14289 if (argc != 3 && argc != 4) {
14290 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14291 return JIM_ERR;
14293 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14295 case OPT_SIZE:
14296 if (argc != 3) {
14297 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14298 return JIM_ERR;
14300 else if (Jim_DictSize(interp, argv[2]) < 0) {
14301 return JIM_ERR;
14303 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14304 return JIM_OK;
14306 case OPT_MERGE:
14307 if (argc == 2) {
14308 return JIM_OK;
14310 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14311 if (objPtr == NULL) {
14312 return JIM_ERR;
14314 Jim_SetResult(interp, objPtr);
14315 return JIM_OK;
14317 case OPT_UPDATE:
14318 if (argc < 6 || argc % 2) {
14319 /* Better error message */
14320 argc = 2;
14322 break;
14324 case OPT_CREATE:
14325 if (argc % 2) {
14326 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14327 return JIM_ERR;
14329 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14330 Jim_SetResult(interp, objPtr);
14331 return JIM_OK;
14333 case OPT_INFO:
14334 if (argc != 3) {
14335 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14336 return JIM_ERR;
14338 return Jim_DictInfo(interp, argv[2]);
14340 case OPT_WITH:
14341 if (argc < 4) {
14342 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14343 return JIM_ERR;
14345 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14347 /* Handle command as an ensemble */
14348 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14351 /* [subst] */
14352 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14354 static const char * const options[] = {
14355 "-nobackslashes", "-nocommands", "-novariables", NULL
14357 enum
14358 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14359 int i;
14360 int flags = JIM_SUBST_FLAG;
14361 Jim_Obj *objPtr;
14363 if (argc < 2) {
14364 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14365 return JIM_ERR;
14367 for (i = 1; i < (argc - 1); i++) {
14368 int option;
14370 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14371 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14372 return JIM_ERR;
14374 switch (option) {
14375 case OPT_NOBACKSLASHES:
14376 flags |= JIM_SUBST_NOESC;
14377 break;
14378 case OPT_NOCOMMANDS:
14379 flags |= JIM_SUBST_NOCMD;
14380 break;
14381 case OPT_NOVARIABLES:
14382 flags |= JIM_SUBST_NOVAR;
14383 break;
14386 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14387 return JIM_ERR;
14389 Jim_SetResult(interp, objPtr);
14390 return JIM_OK;
14393 /* [info] */
14394 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14396 int cmd;
14397 Jim_Obj *objPtr;
14398 int mode = 0;
14400 static const char * const commands[] = {
14401 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14402 "vars", "version", "patchlevel", "complete", "args", "hostname",
14403 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14404 "references", "alias", NULL
14406 enum
14407 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14408 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14409 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14410 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14413 #ifdef jim_ext_namespace
14414 int nons = 0;
14416 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14417 /* This is for internal use only */
14418 argc--;
14419 argv++;
14420 nons = 1;
14422 #endif
14424 if (argc < 2) {
14425 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14426 return JIM_ERR;
14428 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14429 return Jim_CheckShowCommands(interp, argv[1], commands);
14432 /* Test for the most common commands first, just in case it makes a difference */
14433 switch (cmd) {
14434 case INFO_EXISTS:
14435 if (argc != 3) {
14436 Jim_WrongNumArgs(interp, 2, argv, "varName");
14437 return JIM_ERR;
14439 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14440 break;
14442 case INFO_ALIAS:{
14443 Jim_Cmd *cmdPtr;
14445 if (argc != 3) {
14446 Jim_WrongNumArgs(interp, 2, argv, "command");
14447 return JIM_ERR;
14449 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14450 return JIM_ERR;
14452 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14453 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14454 return JIM_ERR;
14456 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14457 return JIM_OK;
14460 case INFO_CHANNELS:
14461 mode++; /* JIM_CMDLIST_CHANNELS */
14462 #ifndef jim_ext_aio
14463 Jim_SetResultString(interp, "aio not enabled", -1);
14464 return JIM_ERR;
14465 #endif
14466 /* fall through */
14467 case INFO_PROCS:
14468 mode++; /* JIM_CMDLIST_PROCS */
14469 /* fall through */
14470 case INFO_COMMANDS:
14471 /* mode 0 => JIM_CMDLIST_COMMANDS */
14472 if (argc != 2 && argc != 3) {
14473 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14474 return JIM_ERR;
14476 #ifdef jim_ext_namespace
14477 if (!nons) {
14478 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14479 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14482 #endif
14483 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14484 break;
14486 case INFO_VARS:
14487 mode++; /* JIM_VARLIST_VARS */
14488 /* fall through */
14489 case INFO_LOCALS:
14490 mode++; /* JIM_VARLIST_LOCALS */
14491 /* fall through */
14492 case INFO_GLOBALS:
14493 /* mode 0 => JIM_VARLIST_GLOBALS */
14494 if (argc != 2 && argc != 3) {
14495 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14496 return JIM_ERR;
14498 #ifdef jim_ext_namespace
14499 if (!nons) {
14500 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14501 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14504 #endif
14505 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14506 break;
14508 case INFO_SCRIPT:
14509 if (argc != 2) {
14510 Jim_WrongNumArgs(interp, 2, argv, "");
14511 return JIM_ERR;
14513 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14514 break;
14516 case INFO_SOURCE:{
14517 jim_wide line;
14518 Jim_Obj *resObjPtr;
14519 Jim_Obj *fileNameObj;
14521 if (argc != 3 && argc != 5) {
14522 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14523 return JIM_ERR;
14525 if (argc == 5) {
14526 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14527 return JIM_ERR;
14529 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14530 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14532 else {
14533 if (argv[2]->typePtr == &sourceObjType) {
14534 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14535 line = argv[2]->internalRep.sourceValue.lineNumber;
14537 else if (argv[2]->typePtr == &scriptObjType) {
14538 ScriptObj *script = JimGetScript(interp, argv[2]);
14539 fileNameObj = script->fileNameObj;
14540 line = script->firstline;
14542 else {
14543 fileNameObj = interp->emptyObj;
14544 line = 1;
14546 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14547 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14548 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14550 Jim_SetResult(interp, resObjPtr);
14551 break;
14554 case INFO_STACKTRACE:
14555 Jim_SetResult(interp, interp->stackTrace);
14556 break;
14558 case INFO_LEVEL:
14559 case INFO_FRAME:
14560 switch (argc) {
14561 case 2:
14562 Jim_SetResultInt(interp, interp->framePtr->level);
14563 break;
14565 case 3:
14566 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14567 return JIM_ERR;
14569 Jim_SetResult(interp, objPtr);
14570 break;
14572 default:
14573 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14574 return JIM_ERR;
14576 break;
14578 case INFO_BODY:
14579 case INFO_STATICS:
14580 case INFO_ARGS:{
14581 Jim_Cmd *cmdPtr;
14583 if (argc != 3) {
14584 Jim_WrongNumArgs(interp, 2, argv, "procname");
14585 return JIM_ERR;
14587 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14588 return JIM_ERR;
14590 if (!cmdPtr->isproc) {
14591 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14592 return JIM_ERR;
14594 switch (cmd) {
14595 case INFO_BODY:
14596 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14597 break;
14598 case INFO_ARGS:
14599 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14600 break;
14601 case INFO_STATICS:
14602 if (cmdPtr->u.proc.staticVars) {
14603 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14604 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14606 break;
14608 break;
14611 case INFO_VERSION:
14612 case INFO_PATCHLEVEL:{
14613 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14615 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14616 Jim_SetResultString(interp, buf, -1);
14617 break;
14620 case INFO_COMPLETE:
14621 if (argc != 3 && argc != 4) {
14622 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14623 return JIM_ERR;
14625 else {
14626 char missing;
14628 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14629 if (missing != ' ' && argc == 4) {
14630 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14633 break;
14635 case INFO_HOSTNAME:
14636 /* Redirect to os.gethostname if it exists */
14637 return Jim_Eval(interp, "os.gethostname");
14639 case INFO_NAMEOFEXECUTABLE:
14640 /* Redirect to Tcl proc */
14641 return Jim_Eval(interp, "{info nameofexecutable}");
14643 case INFO_RETURNCODES:
14644 if (argc == 2) {
14645 int i;
14646 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14648 for (i = 0; jimReturnCodes[i]; i++) {
14649 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14650 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14651 jimReturnCodes[i], -1));
14654 Jim_SetResult(interp, listObjPtr);
14656 else if (argc == 3) {
14657 long code;
14658 const char *name;
14660 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14661 return JIM_ERR;
14663 name = Jim_ReturnCode(code);
14664 if (*name == '?') {
14665 Jim_SetResultInt(interp, code);
14667 else {
14668 Jim_SetResultString(interp, name, -1);
14671 else {
14672 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14673 return JIM_ERR;
14675 break;
14676 case INFO_REFERENCES:
14677 #ifdef JIM_REFERENCES
14678 return JimInfoReferences(interp, argc, argv);
14679 #else
14680 Jim_SetResultString(interp, "not supported", -1);
14681 return JIM_ERR;
14682 #endif
14684 return JIM_OK;
14687 /* [exists] */
14688 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14690 Jim_Obj *objPtr;
14691 int result = 0;
14693 static const char * const options[] = {
14694 "-command", "-proc", "-alias", "-var", NULL
14696 enum
14698 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14700 int option;
14702 if (argc == 2) {
14703 option = OPT_VAR;
14704 objPtr = argv[1];
14706 else if (argc == 3) {
14707 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14708 return JIM_ERR;
14710 objPtr = argv[2];
14712 else {
14713 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14714 return JIM_ERR;
14717 if (option == OPT_VAR) {
14718 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14720 else {
14721 /* Now different kinds of commands */
14722 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14724 if (cmd) {
14725 switch (option) {
14726 case OPT_COMMAND:
14727 result = 1;
14728 break;
14730 case OPT_ALIAS:
14731 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14732 break;
14734 case OPT_PROC:
14735 result = cmd->isproc;
14736 break;
14740 Jim_SetResultBool(interp, result);
14741 return JIM_OK;
14744 /* [split] */
14745 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14747 const char *str, *splitChars, *noMatchStart;
14748 int splitLen, strLen;
14749 Jim_Obj *resObjPtr;
14750 int c;
14751 int len;
14753 if (argc != 2 && argc != 3) {
14754 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14755 return JIM_ERR;
14758 str = Jim_GetString(argv[1], &len);
14759 if (len == 0) {
14760 return JIM_OK;
14762 strLen = Jim_Utf8Length(interp, argv[1]);
14764 /* Init */
14765 if (argc == 2) {
14766 splitChars = " \n\t\r";
14767 splitLen = 4;
14769 else {
14770 splitChars = Jim_String(argv[2]);
14771 splitLen = Jim_Utf8Length(interp, argv[2]);
14774 noMatchStart = str;
14775 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14777 /* Split */
14778 if (splitLen) {
14779 Jim_Obj *objPtr;
14780 while (strLen--) {
14781 const char *sc = splitChars;
14782 int scLen = splitLen;
14783 int sl = utf8_tounicode(str, &c);
14784 while (scLen--) {
14785 int pc;
14786 sc += utf8_tounicode(sc, &pc);
14787 if (c == pc) {
14788 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14789 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14790 noMatchStart = str + sl;
14791 break;
14794 str += sl;
14796 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14797 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14799 else {
14800 /* This handles the special case of splitchars eq {}
14801 * Optimise by sharing common (ASCII) characters
14803 Jim_Obj **commonObj = NULL;
14804 #define NUM_COMMON (128 - 9)
14805 while (strLen--) {
14806 int n = utf8_tounicode(str, &c);
14807 #ifdef JIM_OPTIMIZATION
14808 if (c >= 9 && c < 128) {
14809 /* Common ASCII char. Note that 9 is the tab character */
14810 c -= 9;
14811 if (!commonObj) {
14812 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14813 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14815 if (!commonObj[c]) {
14816 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14818 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14819 str++;
14820 continue;
14822 #endif
14823 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14824 str += n;
14826 Jim_Free(commonObj);
14829 Jim_SetResult(interp, resObjPtr);
14830 return JIM_OK;
14833 /* [join] */
14834 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14836 const char *joinStr;
14837 int joinStrLen;
14839 if (argc != 2 && argc != 3) {
14840 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14841 return JIM_ERR;
14843 /* Init */
14844 if (argc == 2) {
14845 joinStr = " ";
14846 joinStrLen = 1;
14848 else {
14849 joinStr = Jim_GetString(argv[2], &joinStrLen);
14851 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14852 return JIM_OK;
14855 /* [format] */
14856 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14858 Jim_Obj *objPtr;
14860 if (argc < 2) {
14861 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14862 return JIM_ERR;
14864 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14865 if (objPtr == NULL)
14866 return JIM_ERR;
14867 Jim_SetResult(interp, objPtr);
14868 return JIM_OK;
14871 /* [scan] */
14872 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14874 Jim_Obj *listPtr, **outVec;
14875 int outc, i;
14877 if (argc < 3) {
14878 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14879 return JIM_ERR;
14881 if (argv[2]->typePtr != &scanFmtStringObjType)
14882 SetScanFmtFromAny(interp, argv[2]);
14883 if (FormatGetError(argv[2]) != 0) {
14884 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14885 return JIM_ERR;
14887 if (argc > 3) {
14888 int maxPos = FormatGetMaxPos(argv[2]);
14889 int count = FormatGetCnvCount(argv[2]);
14891 if (maxPos > argc - 3) {
14892 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14893 return JIM_ERR;
14895 else if (count > argc - 3) {
14896 Jim_SetResultString(interp, "different numbers of variable names and "
14897 "field specifiers", -1);
14898 return JIM_ERR;
14900 else if (count < argc - 3) {
14901 Jim_SetResultString(interp, "variable is not assigned by any "
14902 "conversion specifiers", -1);
14903 return JIM_ERR;
14906 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14907 if (listPtr == 0)
14908 return JIM_ERR;
14909 if (argc > 3) {
14910 int rc = JIM_OK;
14911 int count = 0;
14913 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14914 int len = Jim_ListLength(interp, listPtr);
14916 if (len != 0) {
14917 JimListGetElements(interp, listPtr, &outc, &outVec);
14918 for (i = 0; i < outc; ++i) {
14919 if (Jim_Length(outVec[i]) > 0) {
14920 ++count;
14921 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14922 rc = JIM_ERR;
14927 Jim_FreeNewObj(interp, listPtr);
14929 else {
14930 count = -1;
14932 if (rc == JIM_OK) {
14933 Jim_SetResultInt(interp, count);
14935 return rc;
14937 else {
14938 if (listPtr == (Jim_Obj *)EOF) {
14939 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14940 return JIM_OK;
14942 Jim_SetResult(interp, listPtr);
14944 return JIM_OK;
14947 /* [error] */
14948 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14950 if (argc != 2 && argc != 3) {
14951 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14952 return JIM_ERR;
14954 Jim_SetResult(interp, argv[1]);
14955 if (argc == 3) {
14956 JimSetStackTrace(interp, argv[2]);
14957 return JIM_ERR;
14959 interp->addStackTrace++;
14960 return JIM_ERR;
14963 /* [lrange] */
14964 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14966 Jim_Obj *objPtr;
14968 if (argc != 4) {
14969 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14970 return JIM_ERR;
14972 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14973 return JIM_ERR;
14974 Jim_SetResult(interp, objPtr);
14975 return JIM_OK;
14978 /* [lrepeat] */
14979 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14981 Jim_Obj *objPtr;
14982 long count;
14984 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14985 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14986 return JIM_ERR;
14989 if (count == 0 || argc == 2) {
14990 return JIM_OK;
14993 argc -= 2;
14994 argv += 2;
14996 objPtr = Jim_NewListObj(interp, argv, argc);
14997 while (--count) {
14998 ListInsertElements(objPtr, -1, argc, argv);
15001 Jim_SetResult(interp, objPtr);
15002 return JIM_OK;
15005 char **Jim_GetEnviron(void)
15007 #if defined(HAVE__NSGETENVIRON)
15008 return *_NSGetEnviron();
15009 #else
15010 #if !defined(NO_ENVIRON_EXTERN)
15011 extern char **environ;
15012 #endif
15014 return environ;
15015 #endif
15018 void Jim_SetEnviron(char **env)
15020 #if defined(HAVE__NSGETENVIRON)
15021 *_NSGetEnviron() = env;
15022 #else
15023 #if !defined(NO_ENVIRON_EXTERN)
15024 extern char **environ;
15025 #endif
15027 environ = env;
15028 #endif
15031 /* [env] */
15032 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15034 const char *key;
15035 const char *val;
15037 if (argc == 1) {
15038 char **e = Jim_GetEnviron();
15040 int i;
15041 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15043 for (i = 0; e[i]; i++) {
15044 const char *equals = strchr(e[i], '=');
15046 if (equals) {
15047 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15048 equals - e[i]));
15049 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15053 Jim_SetResult(interp, listObjPtr);
15054 return JIM_OK;
15057 if (argc < 2) {
15058 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15059 return JIM_ERR;
15061 key = Jim_String(argv[1]);
15062 val = getenv(key);
15063 if (val == NULL) {
15064 if (argc < 3) {
15065 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15066 return JIM_ERR;
15068 val = Jim_String(argv[2]);
15070 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15071 return JIM_OK;
15074 /* [source] */
15075 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15077 int retval;
15079 if (argc != 2) {
15080 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15081 return JIM_ERR;
15083 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15084 if (retval == JIM_RETURN)
15085 return JIM_OK;
15086 return retval;
15089 /* [lreverse] */
15090 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15092 Jim_Obj *revObjPtr, **ele;
15093 int len;
15095 if (argc != 2) {
15096 Jim_WrongNumArgs(interp, 1, argv, "list");
15097 return JIM_ERR;
15099 JimListGetElements(interp, argv[1], &len, &ele);
15100 len--;
15101 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15102 while (len >= 0)
15103 ListAppendElement(revObjPtr, ele[len--]);
15104 Jim_SetResult(interp, revObjPtr);
15105 return JIM_OK;
15108 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15110 jim_wide len;
15112 if (step == 0)
15113 return -1;
15114 if (start == end)
15115 return 0;
15116 else if (step > 0 && start > end)
15117 return -1;
15118 else if (step < 0 && end > start)
15119 return -1;
15120 len = end - start;
15121 if (len < 0)
15122 len = -len; /* abs(len) */
15123 if (step < 0)
15124 step = -step; /* abs(step) */
15125 len = 1 + ((len - 1) / step);
15126 /* We can truncate safely to INT_MAX, the range command
15127 * will always return an error for a such long range
15128 * because Tcl lists can't be so long. */
15129 if (len > INT_MAX)
15130 len = INT_MAX;
15131 return (int)((len < 0) ? -1 : len);
15134 /* [range] */
15135 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15137 jim_wide start = 0, end, step = 1;
15138 int len, i;
15139 Jim_Obj *objPtr;
15141 if (argc < 2 || argc > 4) {
15142 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15143 return JIM_ERR;
15145 if (argc == 2) {
15146 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15147 return JIM_ERR;
15149 else {
15150 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15151 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15152 return JIM_ERR;
15153 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15154 return JIM_ERR;
15156 if ((len = JimRangeLen(start, end, step)) == -1) {
15157 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15158 return JIM_ERR;
15160 objPtr = Jim_NewListObj(interp, NULL, 0);
15161 for (i = 0; i < len; i++)
15162 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15163 Jim_SetResult(interp, objPtr);
15164 return JIM_OK;
15167 /* [rand] */
15168 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15170 jim_wide min = 0, max = 0, len, maxMul;
15172 if (argc < 1 || argc > 3) {
15173 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15174 return JIM_ERR;
15176 if (argc == 1) {
15177 max = JIM_WIDE_MAX;
15178 } else if (argc == 2) {
15179 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15180 return JIM_ERR;
15181 } else if (argc == 3) {
15182 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15183 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15184 return JIM_ERR;
15186 len = max-min;
15187 if (len < 0) {
15188 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15189 return JIM_ERR;
15191 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15192 while (1) {
15193 jim_wide r;
15195 JimRandomBytes(interp, &r, sizeof(jim_wide));
15196 if (r < 0 || r >= maxMul) continue;
15197 r = (len == 0) ? 0 : r%len;
15198 Jim_SetResultInt(interp, min+r);
15199 return JIM_OK;
15203 static const struct {
15204 const char *name;
15205 Jim_CmdProc *cmdProc;
15206 } Jim_CoreCommandsTable[] = {
15207 {"alias", Jim_AliasCoreCommand},
15208 {"set", Jim_SetCoreCommand},
15209 {"unset", Jim_UnsetCoreCommand},
15210 {"puts", Jim_PutsCoreCommand},
15211 {"+", Jim_AddCoreCommand},
15212 {"*", Jim_MulCoreCommand},
15213 {"-", Jim_SubCoreCommand},
15214 {"/", Jim_DivCoreCommand},
15215 {"incr", Jim_IncrCoreCommand},
15216 {"while", Jim_WhileCoreCommand},
15217 {"loop", Jim_LoopCoreCommand},
15218 {"for", Jim_ForCoreCommand},
15219 {"foreach", Jim_ForeachCoreCommand},
15220 {"lmap", Jim_LmapCoreCommand},
15221 {"lassign", Jim_LassignCoreCommand},
15222 {"if", Jim_IfCoreCommand},
15223 {"switch", Jim_SwitchCoreCommand},
15224 {"list", Jim_ListCoreCommand},
15225 {"lindex", Jim_LindexCoreCommand},
15226 {"lset", Jim_LsetCoreCommand},
15227 {"lsearch", Jim_LsearchCoreCommand},
15228 {"llength", Jim_LlengthCoreCommand},
15229 {"lappend", Jim_LappendCoreCommand},
15230 {"linsert", Jim_LinsertCoreCommand},
15231 {"lreplace", Jim_LreplaceCoreCommand},
15232 {"lsort", Jim_LsortCoreCommand},
15233 {"append", Jim_AppendCoreCommand},
15234 {"debug", Jim_DebugCoreCommand},
15235 {"eval", Jim_EvalCoreCommand},
15236 {"uplevel", Jim_UplevelCoreCommand},
15237 {"expr", Jim_ExprCoreCommand},
15238 {"break", Jim_BreakCoreCommand},
15239 {"continue", Jim_ContinueCoreCommand},
15240 {"proc", Jim_ProcCoreCommand},
15241 {"concat", Jim_ConcatCoreCommand},
15242 {"return", Jim_ReturnCoreCommand},
15243 {"upvar", Jim_UpvarCoreCommand},
15244 {"global", Jim_GlobalCoreCommand},
15245 {"string", Jim_StringCoreCommand},
15246 {"time", Jim_TimeCoreCommand},
15247 {"exit", Jim_ExitCoreCommand},
15248 {"catch", Jim_CatchCoreCommand},
15249 #ifdef JIM_REFERENCES
15250 {"ref", Jim_RefCoreCommand},
15251 {"getref", Jim_GetrefCoreCommand},
15252 {"setref", Jim_SetrefCoreCommand},
15253 {"finalize", Jim_FinalizeCoreCommand},
15254 {"collect", Jim_CollectCoreCommand},
15255 #endif
15256 {"rename", Jim_RenameCoreCommand},
15257 {"dict", Jim_DictCoreCommand},
15258 {"subst", Jim_SubstCoreCommand},
15259 {"info", Jim_InfoCoreCommand},
15260 {"exists", Jim_ExistsCoreCommand},
15261 {"split", Jim_SplitCoreCommand},
15262 {"join", Jim_JoinCoreCommand},
15263 {"format", Jim_FormatCoreCommand},
15264 {"scan", Jim_ScanCoreCommand},
15265 {"error", Jim_ErrorCoreCommand},
15266 {"lrange", Jim_LrangeCoreCommand},
15267 {"lrepeat", Jim_LrepeatCoreCommand},
15268 {"env", Jim_EnvCoreCommand},
15269 {"source", Jim_SourceCoreCommand},
15270 {"lreverse", Jim_LreverseCoreCommand},
15271 {"range", Jim_RangeCoreCommand},
15272 {"rand", Jim_RandCoreCommand},
15273 {"tailcall", Jim_TailcallCoreCommand},
15274 {"local", Jim_LocalCoreCommand},
15275 {"upcall", Jim_UpcallCoreCommand},
15276 {"apply", Jim_ApplyCoreCommand},
15277 {NULL, NULL},
15280 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15282 int i = 0;
15284 while (Jim_CoreCommandsTable[i].name != NULL) {
15285 Jim_CreateCommand(interp,
15286 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15287 i++;
15291 /* -----------------------------------------------------------------------------
15292 * Interactive prompt
15293 * ---------------------------------------------------------------------------*/
15294 void Jim_MakeErrorMessage(Jim_Interp *interp)
15296 Jim_Obj *argv[2];
15298 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15299 argv[1] = interp->result;
15301 Jim_EvalObjVector(interp, 2, argv);
15305 * Given a null terminated array of strings, returns an allocated, sorted
15306 * copy of the array.
15308 static char **JimSortStringTable(const char *const *tablePtr)
15310 int count;
15311 char **tablePtrSorted;
15313 /* Find the size of the table */
15314 for (count = 0; tablePtr[count]; count++) {
15317 /* Allocate one extra for the terminating NULL pointer */
15318 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15319 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15320 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15321 tablePtrSorted[count] = NULL;
15323 return tablePtrSorted;
15326 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15327 const char *prefix, const char *const *tablePtr, const char *name)
15329 char **tablePtrSorted;
15330 int i;
15332 if (name == NULL) {
15333 name = "option";
15336 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15337 tablePtrSorted = JimSortStringTable(tablePtr);
15338 for (i = 0; tablePtrSorted[i]; i++) {
15339 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15340 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15342 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15343 if (tablePtrSorted[i + 1]) {
15344 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15347 Jim_Free(tablePtrSorted);
15352 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15353 * and returns JIM_OK.
15355 * Otherwise returns JIM_ERR.
15357 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15359 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15360 int i;
15361 char **tablePtrSorted = JimSortStringTable(tablePtr);
15362 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15363 for (i = 0; tablePtrSorted[i]; i++) {
15364 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15366 Jim_Free(tablePtrSorted);
15367 return JIM_OK;
15369 return JIM_ERR;
15372 /* internal rep is stored in ptrIntvalue
15373 * ptr = tablePtr
15374 * int1 = flags
15375 * int2 = index
15377 static const Jim_ObjType getEnumObjType = {
15378 "get-enum",
15379 NULL,
15380 NULL,
15381 NULL,
15382 JIM_TYPE_REFERENCES
15385 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15386 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15388 const char *bad = "bad ";
15389 const char *const *entryPtr = NULL;
15390 int i;
15391 int match = -1;
15392 int arglen;
15393 const char *arg;
15395 if (objPtr->typePtr == &getEnumObjType) {
15396 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15397 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15398 return JIM_OK;
15402 arg = Jim_GetString(objPtr, &arglen);
15404 *indexPtr = -1;
15406 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15407 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15408 /* Found an exact match */
15409 match = i;
15410 goto found;
15412 if (flags & JIM_ENUM_ABBREV) {
15413 /* Accept an unambiguous abbreviation.
15414 * Note that '-' doesnt' consitute a valid abbreviation
15416 if (strncmp(arg, *entryPtr, arglen) == 0) {
15417 if (*arg == '-' && arglen == 1) {
15418 break;
15420 if (match >= 0) {
15421 bad = "ambiguous ";
15422 goto ambiguous;
15424 match = i;
15429 /* If we had an unambiguous partial match */
15430 if (match >= 0) {
15431 found:
15432 /* Record the match in the object */
15433 Jim_FreeIntRep(interp, objPtr);
15434 objPtr->typePtr = &getEnumObjType;
15435 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15436 objPtr->internalRep.ptrIntValue.int1 = flags;
15437 objPtr->internalRep.ptrIntValue.int2 = match;
15438 /* Return the result */
15439 *indexPtr = match;
15440 return JIM_OK;
15443 ambiguous:
15444 if (flags & JIM_ERRMSG) {
15445 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15447 return JIM_ERR;
15450 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15452 int i;
15454 for (i = 0; i < (int)len; i++) {
15455 if (array[i] && strcmp(array[i], name) == 0) {
15456 return i;
15459 return -1;
15462 int Jim_IsDict(Jim_Obj *objPtr)
15464 return objPtr->typePtr == &dictObjType;
15467 int Jim_IsList(Jim_Obj *objPtr)
15469 return objPtr->typePtr == &listObjType;
15473 * Very simple printf-like formatting, designed for error messages.
15475 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15476 * The resulting string is created and set as the result.
15478 * Each '%s' should correspond to a regular string parameter.
15479 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15480 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15482 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15484 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15486 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15488 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15490 /* Initial space needed */
15491 int len = strlen(format);
15492 int extra = 0;
15493 int n = 0;
15494 const char *params[5];
15495 int nobjparam = 0;
15496 Jim_Obj *objparam[5];
15497 char *buf;
15498 va_list args;
15499 int i;
15501 va_start(args, format);
15503 for (i = 0; i < len && n < 5; i++) {
15504 int l;
15506 if (strncmp(format + i, "%s", 2) == 0) {
15507 params[n] = va_arg(args, char *);
15509 l = strlen(params[n]);
15511 else if (strncmp(format + i, "%#s", 3) == 0) {
15512 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15514 params[n] = Jim_GetString(objPtr, &l);
15515 objparam[nobjparam++] = objPtr;
15516 Jim_IncrRefCount(objPtr);
15518 else {
15519 if (format[i] == '%') {
15520 i++;
15522 continue;
15524 n++;
15525 extra += l;
15528 len += extra;
15529 buf = Jim_Alloc(len + 1);
15530 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15532 va_end(args);
15534 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15536 for (i = 0; i < nobjparam; i++) {
15537 Jim_DecrRefCount(interp, objparam[i]);
15541 /* stubs */
15542 #ifndef jim_ext_package
15543 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15545 return JIM_OK;
15547 #endif
15548 #ifndef jim_ext_aio
15549 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15551 Jim_SetResultString(interp, "aio not enabled", -1);
15552 return NULL;
15554 #endif
15558 * Local Variables: ***
15559 * c-basic-offset: 4 ***
15560 * tab-width: 4 ***
15561 * End: ***