expr: avoid memory leak due to shimmering
[jimtcl.git] / jim.c
blobff7630f5b11d20290014cf50744e94cc579bece5
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 = JimClock();
5448 return collected;
5451 #define JIM_COLLECT_ID_PERIOD 5000000
5452 #define JIM_COLLECT_TIME_PERIOD 300000
5454 void Jim_CollectIfNeeded(Jim_Interp *interp)
5456 unsigned long elapsedId;
5457 jim_wide elapsedTime;
5459 elapsedId = interp->referenceNextId - interp->lastCollectId;
5460 elapsedTime = JimClock() - 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 = JimClock();
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 Jim_IncrRefCount(exprObjPtr); /* Make sure it's shared. */
9265 expr = JimGetExpression(interp, exprObjPtr);
9266 if (!expr) {
9267 retcode = JIM_ERR;
9268 goto done;
9271 #ifdef JIM_OPTIMIZATION
9272 /* Check for one of the following common expressions used by while/for
9274 * CONST
9275 * $a
9276 * !$a
9277 * $a < CONST, $a < $b
9278 * $a <= CONST, $a <= $b
9279 * $a > CONST, $a > $b
9280 * $a >= CONST, $a >= $b
9281 * $a != CONST, $a != $b
9282 * $a == CONST, $a == $b
9285 Jim_Obj *objPtr;
9287 /* STEP 1 -- Check if there are the conditions to run the specialized
9288 * version of while */
9290 switch (expr->len) {
9291 case 1:
9292 objPtr = JimExprIntValOrVar(interp, expr->expr);
9293 if (objPtr) {
9294 Jim_SetResult(interp, objPtr);
9295 goto done;
9297 break;
9299 case 2:
9300 if (expr->expr->type == JIM_EXPROP_NOT) {
9301 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9303 if (objPtr && JimIsWide(objPtr)) {
9304 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9305 goto done;
9308 break;
9310 case 3:
9311 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9312 if (objPtr && JimIsWide(objPtr)) {
9313 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9314 if (objPtr2 && JimIsWide(objPtr2)) {
9315 jim_wide wideValueA = JimWideValue(objPtr);
9316 jim_wide wideValueB = JimWideValue(objPtr2);
9317 int cmpRes;
9318 switch (expr->expr->type) {
9319 case JIM_EXPROP_LT:
9320 cmpRes = wideValueA < wideValueB;
9321 break;
9322 case JIM_EXPROP_LTE:
9323 cmpRes = wideValueA <= wideValueB;
9324 break;
9325 case JIM_EXPROP_GT:
9326 cmpRes = wideValueA > wideValueB;
9327 break;
9328 case JIM_EXPROP_GTE:
9329 cmpRes = wideValueA >= wideValueB;
9330 break;
9331 case JIM_EXPROP_NUMEQ:
9332 cmpRes = wideValueA == wideValueB;
9333 break;
9334 case JIM_EXPROP_NUMNE:
9335 cmpRes = wideValueA != wideValueB;
9336 break;
9337 default:
9338 goto noopt;
9340 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9341 goto done;
9344 break;
9347 noopt:
9348 #endif
9350 /* In order to avoid the internal repr being freed due to
9351 * shimmering of the exprObjPtr's object, we increment the use count
9352 * and keep our own pointer outside the object.
9354 expr->inUse++;
9356 /* Evaluate with the recursive expr engine */
9357 retcode = JimExprEvalTermNode(interp, expr->expr);
9359 /* Now transfer ownership of expr back into the object in case it shimmered away */
9360 Jim_FreeIntRep(interp, exprObjPtr);
9361 exprObjPtr->typePtr = &exprObjType;
9362 Jim_SetIntRepPtr(exprObjPtr, expr);
9364 done:
9365 Jim_DecrRefCount(interp, exprObjPtr);
9367 return retcode;
9370 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9372 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9374 if (retcode == JIM_OK) {
9375 switch (ExprBool(interp, Jim_GetResult(interp))) {
9376 case 0:
9377 *boolPtr = 0;
9378 break;
9380 case 1:
9381 *boolPtr = 1;
9382 break;
9384 case -1:
9385 retcode = JIM_ERR;
9386 break;
9389 return retcode;
9392 /* -----------------------------------------------------------------------------
9393 * ScanFormat String Object
9394 * ---------------------------------------------------------------------------*/
9396 /* This Jim_Obj will held a parsed representation of a format string passed to
9397 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9398 * to be parsed in its entirely first and then, if correct, can be used for
9399 * scanning. To avoid endless re-parsing, the parsed representation will be
9400 * stored in an internal representation and re-used for performance reason. */
9402 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9403 * scanformat string. This part will later be used to extract information
9404 * out from the string to be parsed by Jim_ScanString */
9406 typedef struct ScanFmtPartDescr
9408 const char *arg; /* Specification of a CHARSET conversion */
9409 const char *prefix; /* Prefix to be scanned literally before conversion */
9410 size_t width; /* Maximal width of input to be converted */
9411 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9412 char type; /* Type of conversion (e.g. c, d, f) */
9413 char modifier; /* Modify type (e.g. l - long, h - short */
9414 } ScanFmtPartDescr;
9416 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9417 * string parsed and separated in part descriptions. Furthermore it contains
9418 * the original string representation of the scanformat string to allow for
9419 * fast update of the Jim_Obj's string representation part.
9421 * As an add-on the internal object representation adds some scratch pad area
9422 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9423 * memory for purpose of string scanning.
9425 * The error member points to a static allocated string in case of a mal-
9426 * formed scanformat string or it contains '0' (NULL) in case of a valid
9427 * parse representation.
9429 * The whole memory of the internal representation is allocated as a single
9430 * area of memory that will be internally separated. So freeing and duplicating
9431 * of such an object is cheap */
9433 typedef struct ScanFmtStringObj
9435 jim_wide size; /* Size of internal repr in bytes */
9436 char *stringRep; /* Original string representation */
9437 size_t count; /* Number of ScanFmtPartDescr contained */
9438 size_t convCount; /* Number of conversions that will assign */
9439 size_t maxPos; /* Max position index if XPG3 is used */
9440 const char *error; /* Ptr to error text (NULL if no error */
9441 char *scratch; /* Some scratch pad used by Jim_ScanString */
9442 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9443 } ScanFmtStringObj;
9446 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9447 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9448 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9450 static const Jim_ObjType scanFmtStringObjType = {
9451 "scanformatstring",
9452 FreeScanFmtInternalRep,
9453 DupScanFmtInternalRep,
9454 UpdateStringOfScanFmt,
9455 JIM_TYPE_NONE,
9458 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9460 JIM_NOTUSED(interp);
9461 Jim_Free((char *)objPtr->internalRep.ptr);
9462 objPtr->internalRep.ptr = 0;
9465 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9467 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9468 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9470 JIM_NOTUSED(interp);
9471 memcpy(newVec, srcPtr->internalRep.ptr, size);
9472 dupPtr->internalRep.ptr = newVec;
9473 dupPtr->typePtr = &scanFmtStringObjType;
9476 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9478 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9481 /* SetScanFmtFromAny will parse a given string and create the internal
9482 * representation of the format specification. In case of an error
9483 * the error data member of the internal representation will be set
9484 * to an descriptive error text and the function will be left with
9485 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9486 * specification */
9488 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9490 ScanFmtStringObj *fmtObj;
9491 char *buffer;
9492 int maxCount, i, approxSize, lastPos = -1;
9493 const char *fmt = Jim_String(objPtr);
9494 int maxFmtLen = Jim_Length(objPtr);
9495 const char *fmtEnd = fmt + maxFmtLen;
9496 int curr;
9498 Jim_FreeIntRep(interp, objPtr);
9499 /* Count how many conversions could take place maximally */
9500 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9501 if (fmt[i] == '%')
9502 ++maxCount;
9503 /* Calculate an approximation of the memory necessary */
9504 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9505 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9506 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9507 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9508 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9509 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9510 +1; /* safety byte */
9511 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9512 memset(fmtObj, 0, approxSize);
9513 fmtObj->size = approxSize;
9514 fmtObj->maxPos = 0;
9515 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9516 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9517 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9518 buffer = fmtObj->stringRep + maxFmtLen + 1;
9519 objPtr->internalRep.ptr = fmtObj;
9520 objPtr->typePtr = &scanFmtStringObjType;
9521 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9522 int width = 0, skip;
9523 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9525 fmtObj->count++;
9526 descr->width = 0; /* Assume width unspecified */
9527 /* Overread and store any "literal" prefix */
9528 if (*fmt != '%' || fmt[1] == '%') {
9529 descr->type = 0;
9530 descr->prefix = &buffer[i];
9531 for (; fmt < fmtEnd; ++fmt) {
9532 if (*fmt == '%') {
9533 if (fmt[1] != '%')
9534 break;
9535 ++fmt;
9537 buffer[i++] = *fmt;
9539 buffer[i++] = 0;
9541 /* Skip the conversion introducing '%' sign */
9542 ++fmt;
9543 /* End reached due to non-conversion literal only? */
9544 if (fmt >= fmtEnd)
9545 goto done;
9546 descr->pos = 0; /* Assume "natural" positioning */
9547 if (*fmt == '*') {
9548 descr->pos = -1; /* Okay, conversion will not be assigned */
9549 ++fmt;
9551 else
9552 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9553 /* Check if next token is a number (could be width or pos */
9554 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9555 fmt += skip;
9556 /* Was the number a XPG3 position specifier? */
9557 if (descr->pos != -1 && *fmt == '$') {
9558 int prev;
9560 ++fmt;
9561 descr->pos = width;
9562 width = 0;
9563 /* Look if "natural" postioning and XPG3 one was mixed */
9564 if ((lastPos == 0 && descr->pos > 0)
9565 || (lastPos > 0 && descr->pos == 0)) {
9566 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9567 return JIM_ERR;
9569 /* Look if this position was already used */
9570 for (prev = 0; prev < curr; ++prev) {
9571 if (fmtObj->descr[prev].pos == -1)
9572 continue;
9573 if (fmtObj->descr[prev].pos == descr->pos) {
9574 fmtObj->error =
9575 "variable is assigned by multiple \"%n$\" conversion specifiers";
9576 return JIM_ERR;
9579 if (descr->pos < 0) {
9580 fmtObj->error =
9581 "\"%n$\" conversion specifier is negative";
9582 return JIM_ERR;
9584 /* Try to find a width after the XPG3 specifier */
9585 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9586 descr->width = width;
9587 fmt += skip;
9589 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9590 fmtObj->maxPos = descr->pos;
9592 else {
9593 /* Number was not a XPG3, so it has to be a width */
9594 descr->width = width;
9597 /* If positioning mode was undetermined yet, fix this */
9598 if (lastPos == -1)
9599 lastPos = descr->pos;
9600 /* Handle CHARSET conversion type ... */
9601 if (*fmt == '[') {
9602 int swapped = 1, beg = i, end, j;
9604 descr->type = '[';
9605 descr->arg = &buffer[i];
9606 ++fmt;
9607 if (*fmt == '^')
9608 buffer[i++] = *fmt++;
9609 if (*fmt == ']')
9610 buffer[i++] = *fmt++;
9611 while (*fmt && *fmt != ']')
9612 buffer[i++] = *fmt++;
9613 if (*fmt != ']') {
9614 fmtObj->error = "unmatched [ in format string";
9615 return JIM_ERR;
9617 end = i;
9618 buffer[i++] = 0;
9619 /* In case a range fence was given "backwards", swap it */
9620 while (swapped) {
9621 swapped = 0;
9622 for (j = beg + 1; j < end - 1; ++j) {
9623 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9624 char tmp = buffer[j - 1];
9626 buffer[j - 1] = buffer[j + 1];
9627 buffer[j + 1] = tmp;
9628 swapped = 1;
9633 else {
9634 /* Remember any valid modifier if given */
9635 if (fmt < fmtEnd && strchr("hlL", *fmt))
9636 descr->modifier = tolower((int)*fmt++);
9638 if (fmt >= fmtEnd) {
9639 fmtObj->error = "missing scan conversion character";
9640 return JIM_ERR;
9643 descr->type = *fmt;
9644 if (strchr("efgcsndoxui", *fmt) == 0) {
9645 fmtObj->error = "bad scan conversion character";
9646 return JIM_ERR;
9648 else if (*fmt == 'c' && descr->width != 0) {
9649 fmtObj->error = "field width may not be specified in %c " "conversion";
9650 return JIM_ERR;
9652 else if (*fmt == 'u' && descr->modifier == 'l') {
9653 fmtObj->error = "unsigned wide not supported";
9654 return JIM_ERR;
9657 curr++;
9659 done:
9660 return JIM_OK;
9663 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9665 #define FormatGetCnvCount(_fo_) \
9666 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9667 #define FormatGetMaxPos(_fo_) \
9668 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9669 #define FormatGetError(_fo_) \
9670 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9672 /* JimScanAString is used to scan an unspecified string that ends with
9673 * next WS, or a string that is specified via a charset.
9676 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9678 char *buffer = Jim_StrDup(str);
9679 char *p = buffer;
9681 while (*str) {
9682 int c;
9683 int n;
9685 if (!sdescr && isspace(UCHAR(*str)))
9686 break; /* EOS via WS if unspecified */
9688 n = utf8_tounicode(str, &c);
9689 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9690 break;
9691 while (n--)
9692 *p++ = *str++;
9694 *p = 0;
9695 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9698 /* ScanOneEntry will scan one entry out of the string passed as argument.
9699 * It use the sscanf() function for this task. After extracting and
9700 * converting of the value, the count of scanned characters will be
9701 * returned of -1 in case of no conversion tool place and string was
9702 * already scanned thru */
9704 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9705 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9707 const char *tok;
9708 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9709 size_t scanned = 0;
9710 size_t anchor = pos;
9711 int i;
9712 Jim_Obj *tmpObj = NULL;
9714 /* First pessimistically assume, we will not scan anything :-) */
9715 *valObjPtr = 0;
9716 if (descr->prefix) {
9717 /* There was a prefix given before the conversion, skip it and adjust
9718 * the string-to-be-parsed accordingly */
9719 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9720 /* If prefix require, skip WS */
9721 if (isspace(UCHAR(descr->prefix[i])))
9722 while (pos < strLen && isspace(UCHAR(str[pos])))
9723 ++pos;
9724 else if (descr->prefix[i] != str[pos])
9725 break; /* Prefix do not match here, leave the loop */
9726 else
9727 ++pos; /* Prefix matched so far, next round */
9729 if (pos >= strLen) {
9730 return -1; /* All of str consumed: EOF condition */
9732 else if (descr->prefix[i] != 0)
9733 return 0; /* Not whole prefix consumed, no conversion possible */
9735 /* For all but following conversion, skip leading WS */
9736 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9737 while (isspace(UCHAR(str[pos])))
9738 ++pos;
9739 /* Determine how much skipped/scanned so far */
9740 scanned = pos - anchor;
9742 /* %c is a special, simple case. no width */
9743 if (descr->type == 'n') {
9744 /* Return pseudo conversion means: how much scanned so far? */
9745 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9747 else if (pos >= strLen) {
9748 /* Cannot scan anything, as str is totally consumed */
9749 return -1;
9751 else if (descr->type == 'c') {
9752 int c;
9753 scanned += utf8_tounicode(&str[pos], &c);
9754 *valObjPtr = Jim_NewIntObj(interp, c);
9755 return scanned;
9757 else {
9758 /* Processing of conversions follows ... */
9759 if (descr->width > 0) {
9760 /* Do not try to scan as fas as possible but only the given width.
9761 * To ensure this, we copy the part that should be scanned. */
9762 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9763 size_t tLen = descr->width > sLen ? sLen : descr->width;
9765 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9766 tok = tmpObj->bytes;
9768 else {
9769 /* As no width was given, simply refer to the original string */
9770 tok = &str[pos];
9772 switch (descr->type) {
9773 case 'd':
9774 case 'o':
9775 case 'x':
9776 case 'u':
9777 case 'i':{
9778 char *endp; /* Position where the number finished */
9779 jim_wide w;
9781 int base = descr->type == 'o' ? 8
9782 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9784 /* Try to scan a number with the given base */
9785 if (base == 0) {
9786 w = jim_strtoull(tok, &endp);
9788 else {
9789 w = strtoull(tok, &endp, base);
9792 if (endp != tok) {
9793 /* There was some number sucessfully scanned! */
9794 *valObjPtr = Jim_NewIntObj(interp, w);
9796 /* Adjust the number-of-chars scanned so far */
9797 scanned += endp - tok;
9799 else {
9800 /* Nothing was scanned. We have to determine if this
9801 * happened due to e.g. prefix mismatch or input str
9802 * exhausted */
9803 scanned = *tok ? 0 : -1;
9805 break;
9807 case 's':
9808 case '[':{
9809 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9810 scanned += Jim_Length(*valObjPtr);
9811 break;
9813 case 'e':
9814 case 'f':
9815 case 'g':{
9816 char *endp;
9817 double value = strtod(tok, &endp);
9819 if (endp != tok) {
9820 /* There was some number sucessfully scanned! */
9821 *valObjPtr = Jim_NewDoubleObj(interp, value);
9822 /* Adjust the number-of-chars scanned so far */
9823 scanned += endp - tok;
9825 else {
9826 /* Nothing was scanned. We have to determine if this
9827 * happened due to e.g. prefix mismatch or input str
9828 * exhausted */
9829 scanned = *tok ? 0 : -1;
9831 break;
9834 /* If a substring was allocated (due to pre-defined width) do not
9835 * forget to free it */
9836 if (tmpObj) {
9837 Jim_FreeNewObj(interp, tmpObj);
9840 return scanned;
9843 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9844 * string and returns all converted (and not ignored) values in a list back
9845 * to the caller. If an error occured, a NULL pointer will be returned */
9847 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9849 size_t i, pos;
9850 int scanned = 1;
9851 const char *str = Jim_String(strObjPtr);
9852 int strLen = Jim_Utf8Length(interp, strObjPtr);
9853 Jim_Obj *resultList = 0;
9854 Jim_Obj **resultVec = 0;
9855 int resultc;
9856 Jim_Obj *emptyStr = 0;
9857 ScanFmtStringObj *fmtObj;
9859 /* This should never happen. The format object should already be of the correct type */
9860 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9862 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9863 /* Check if format specification was valid */
9864 if (fmtObj->error != 0) {
9865 if (flags & JIM_ERRMSG)
9866 Jim_SetResultString(interp, fmtObj->error, -1);
9867 return 0;
9869 /* Allocate a new "shared" empty string for all unassigned conversions */
9870 emptyStr = Jim_NewEmptyStringObj(interp);
9871 Jim_IncrRefCount(emptyStr);
9872 /* Create a list and fill it with empty strings up to max specified XPG3 */
9873 resultList = Jim_NewListObj(interp, NULL, 0);
9874 if (fmtObj->maxPos > 0) {
9875 for (i = 0; i < fmtObj->maxPos; ++i)
9876 Jim_ListAppendElement(interp, resultList, emptyStr);
9877 JimListGetElements(interp, resultList, &resultc, &resultVec);
9879 /* Now handle every partial format description */
9880 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9881 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9882 Jim_Obj *value = 0;
9884 /* Only last type may be "literal" w/o conversion - skip it! */
9885 if (descr->type == 0)
9886 continue;
9887 /* As long as any conversion could be done, we will proceed */
9888 if (scanned > 0)
9889 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9890 /* In case our first try results in EOF, we will leave */
9891 if (scanned == -1 && i == 0)
9892 goto eof;
9893 /* Advance next pos-to-be-scanned for the amount scanned already */
9894 pos += scanned;
9896 /* value == 0 means no conversion took place so take empty string */
9897 if (value == 0)
9898 value = Jim_NewEmptyStringObj(interp);
9899 /* If value is a non-assignable one, skip it */
9900 if (descr->pos == -1) {
9901 Jim_FreeNewObj(interp, value);
9903 else if (descr->pos == 0)
9904 /* Otherwise append it to the result list if no XPG3 was given */
9905 Jim_ListAppendElement(interp, resultList, value);
9906 else if (resultVec[descr->pos - 1] == emptyStr) {
9907 /* But due to given XPG3, put the value into the corr. slot */
9908 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9909 Jim_IncrRefCount(value);
9910 resultVec[descr->pos - 1] = value;
9912 else {
9913 /* Otherwise, the slot was already used - free obj and ERROR */
9914 Jim_FreeNewObj(interp, value);
9915 goto err;
9918 Jim_DecrRefCount(interp, emptyStr);
9919 return resultList;
9920 eof:
9921 Jim_DecrRefCount(interp, emptyStr);
9922 Jim_FreeNewObj(interp, resultList);
9923 return (Jim_Obj *)EOF;
9924 err:
9925 Jim_DecrRefCount(interp, emptyStr);
9926 Jim_FreeNewObj(interp, resultList);
9927 return 0;
9930 /* -----------------------------------------------------------------------------
9931 * Pseudo Random Number Generation
9932 * ---------------------------------------------------------------------------*/
9933 /* Initialize the sbox with the numbers from 0 to 255 */
9934 static void JimPrngInit(Jim_Interp *interp)
9936 #define PRNG_SEED_SIZE 256
9937 int i;
9938 unsigned int *seed;
9939 time_t t = time(NULL);
9941 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9943 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9944 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9945 seed[i] = (rand() ^ t ^ clock());
9947 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9948 Jim_Free(seed);
9951 /* Generates N bytes of random data */
9952 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9954 Jim_PrngState *prng;
9955 unsigned char *destByte = (unsigned char *)dest;
9956 unsigned int si, sj, x;
9958 /* initialization, only needed the first time */
9959 if (interp->prngState == NULL)
9960 JimPrngInit(interp);
9961 prng = interp->prngState;
9962 /* generates 'len' bytes of pseudo-random numbers */
9963 for (x = 0; x < len; x++) {
9964 prng->i = (prng->i + 1) & 0xff;
9965 si = prng->sbox[prng->i];
9966 prng->j = (prng->j + si) & 0xff;
9967 sj = prng->sbox[prng->j];
9968 prng->sbox[prng->i] = sj;
9969 prng->sbox[prng->j] = si;
9970 *destByte++ = prng->sbox[(si + sj) & 0xff];
9974 /* Re-seed the generator with user-provided bytes */
9975 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
9977 int i;
9978 Jim_PrngState *prng;
9980 /* initialization, only needed the first time */
9981 if (interp->prngState == NULL)
9982 JimPrngInit(interp);
9983 prng = interp->prngState;
9985 /* Set the sbox[i] with i */
9986 for (i = 0; i < 256; i++)
9987 prng->sbox[i] = i;
9988 /* Now use the seed to perform a random permutation of the sbox */
9989 for (i = 0; i < seedLen; i++) {
9990 unsigned char t;
9992 t = prng->sbox[i & 0xFF];
9993 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
9994 prng->sbox[seed[i]] = t;
9996 prng->i = prng->j = 0;
9998 /* discard at least the first 256 bytes of stream.
9999 * borrow the seed buffer for this
10001 for (i = 0; i < 256; i += seedLen) {
10002 JimRandomBytes(interp, seed, seedLen);
10006 /* [incr] */
10007 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10009 jim_wide wideValue, increment = 1;
10010 Jim_Obj *intObjPtr;
10012 if (argc != 2 && argc != 3) {
10013 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10014 return JIM_ERR;
10016 if (argc == 3) {
10017 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10018 return JIM_ERR;
10020 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10021 if (!intObjPtr) {
10022 /* Set missing variable to 0 */
10023 wideValue = 0;
10025 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10026 return JIM_ERR;
10028 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10029 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10030 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10031 Jim_FreeNewObj(interp, intObjPtr);
10032 return JIM_ERR;
10035 else {
10036 /* Can do it the quick way */
10037 Jim_InvalidateStringRep(intObjPtr);
10038 JimWideValue(intObjPtr) = wideValue + increment;
10040 /* The following step is required in order to invalidate the
10041 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10042 if (argv[1]->typePtr != &variableObjType) {
10043 /* Note that this can't fail since GetVariable already succeeded */
10044 Jim_SetVariable(interp, argv[1], intObjPtr);
10047 Jim_SetResult(interp, intObjPtr);
10048 return JIM_OK;
10052 /* -----------------------------------------------------------------------------
10053 * Eval
10054 * ---------------------------------------------------------------------------*/
10055 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10056 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10058 /* Handle calls to the [unknown] command */
10059 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10061 int retcode;
10063 /* If JimUnknown() is recursively called too many times...
10064 * done here
10066 if (interp->unknown_called > 50) {
10067 return JIM_ERR;
10070 /* The object interp->unknown just contains
10071 * the "unknown" string, it is used in order to
10072 * avoid to lookup the unknown command every time
10073 * but instead to cache the result. */
10075 /* If the [unknown] command does not exist ... */
10076 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10077 return JIM_ERR;
10079 interp->unknown_called++;
10080 /* XXX: Are we losing fileNameObj and linenr? */
10081 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10082 interp->unknown_called--;
10084 return retcode;
10087 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10089 int retcode;
10090 Jim_Cmd *cmdPtr;
10091 void *prevPrivData;
10092 Jim_Obj *tailcallObj = NULL;
10094 #if 0
10095 printf("invoke");
10096 int j;
10097 for (j = 0; j < objc; j++) {
10098 printf(" '%s'", Jim_String(objv[j]));
10100 printf("\n");
10101 #endif
10103 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10104 if (cmdPtr == NULL) {
10105 return JimUnknown(interp, objc, objv);
10107 JimIncrCmdRefCount(cmdPtr);
10109 if (interp->evalDepth == interp->maxEvalDepth) {
10110 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10111 retcode = JIM_ERR;
10112 goto out;
10114 interp->evalDepth++;
10115 prevPrivData = interp->cmdPrivData;
10117 tailcall:
10119 /* Call it -- Make sure result is an empty object. */
10120 Jim_SetEmptyResult(interp);
10121 if (cmdPtr->isproc) {
10122 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10124 /* Handle the JIM_RETURN return code */
10125 if (retcode == JIM_RETURN) {
10126 if (--interp->returnLevel <= 0) {
10127 retcode = interp->returnCode;
10128 interp->returnCode = JIM_OK;
10129 interp->returnLevel = 0;
10132 else if (retcode == JIM_ERR) {
10133 interp->addStackTrace++;
10134 Jim_DecrRefCount(interp, interp->errorProc);
10135 interp->errorProc = objv[0];
10136 Jim_IncrRefCount(interp->errorProc);
10139 else {
10140 interp->cmdPrivData = cmdPtr->u.native.privData;
10141 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10144 if (tailcallObj) {
10145 /* clean up previous tailcall if we were invoking one */
10146 Jim_DecrRefCount(interp, tailcallObj);
10147 tailcallObj = NULL;
10150 /* If a tailcall is returned for this frame, loop to invoke the new command */
10151 if (retcode == JIM_EVAL && interp->framePtr->tailcallObj) {
10152 JimDecrCmdRefCount(interp, cmdPtr);
10154 /* Replace the current command with the new tailcall command */
10155 cmdPtr = interp->framePtr->tailcallCmd;
10156 interp->framePtr->tailcallCmd = NULL;
10157 tailcallObj = interp->framePtr->tailcallObj;
10158 interp->framePtr->tailcallObj = NULL;
10159 /* We can access the internal rep here because the object can only
10160 * be constructed by the tailcall command
10162 objc = tailcallObj->internalRep.listValue.len;
10163 objv = tailcallObj->internalRep.listValue.ele;
10164 goto tailcall;
10167 interp->cmdPrivData = prevPrivData;
10168 interp->evalDepth--;
10170 out:
10171 JimDecrCmdRefCount(interp, cmdPtr);
10173 if (interp->framePtr->tailcallObj) {
10174 /* We might have skipped invoking a tailcall, perhaps because of an error
10175 * in defer handling so cleanup now
10177 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10178 Jim_DecrRefCount(interp, interp->framePtr->tailcallObj);
10179 interp->framePtr->tailcallCmd = NULL;
10180 interp->framePtr->tailcallObj = NULL;
10183 return retcode;
10186 /* Eval the object vector 'objv' composed of 'objc' elements.
10187 * Every element is used as single argument.
10188 * Jim_EvalObj() will call this function every time its object
10189 * argument is of "list" type, with no string representation.
10191 * This is possible because the string representation of a
10192 * list object generated by the UpdateStringOfList is made
10193 * in a way that ensures that every list element is a different
10194 * command argument. */
10195 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10197 int i, retcode;
10199 /* Incr refcount of arguments. */
10200 for (i = 0; i < objc; i++)
10201 Jim_IncrRefCount(objv[i]);
10203 retcode = JimInvokeCommand(interp, objc, objv);
10205 /* Decr refcount of arguments and return the retcode */
10206 for (i = 0; i < objc; i++)
10207 Jim_DecrRefCount(interp, objv[i]);
10209 return retcode;
10213 * Invokes 'prefix' as a command with the objv array as arguments.
10215 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10217 int ret;
10218 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10220 nargv[0] = prefix;
10221 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10222 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10223 Jim_Free(nargv);
10224 return ret;
10227 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10229 if (!interp->errorFlag) {
10230 /* This is the first error, so save the file/line information and reset the stack */
10231 interp->errorFlag = 1;
10232 Jim_IncrRefCount(script->fileNameObj);
10233 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10234 interp->errorFileNameObj = script->fileNameObj;
10235 interp->errorLine = script->linenr;
10237 JimResetStackTrace(interp);
10238 /* Always add a level where the error first occurs */
10239 interp->addStackTrace++;
10242 /* Now if this is an "interesting" level, add it to the stack trace */
10243 if (interp->addStackTrace > 0) {
10244 /* Add the stack info for the current level */
10246 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10248 /* Note: if we didn't have a filename for this level,
10249 * don't clear the addStackTrace flag
10250 * so we can pick it up at the next level
10252 if (Jim_Length(script->fileNameObj)) {
10253 interp->addStackTrace = 0;
10256 Jim_DecrRefCount(interp, interp->errorProc);
10257 interp->errorProc = interp->emptyObj;
10258 Jim_IncrRefCount(interp->errorProc);
10262 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10264 Jim_Obj *objPtr;
10265 int ret = JIM_ERR;
10267 switch (token->type) {
10268 case JIM_TT_STR:
10269 case JIM_TT_ESC:
10270 objPtr = token->objPtr;
10271 break;
10272 case JIM_TT_VAR:
10273 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10274 break;
10275 case JIM_TT_DICTSUGAR:
10276 objPtr = JimExpandDictSugar(interp, token->objPtr);
10277 break;
10278 case JIM_TT_EXPRSUGAR:
10279 ret = Jim_EvalExpression(interp, token->objPtr);
10280 if (ret == JIM_OK) {
10281 objPtr = Jim_GetResult(interp);
10283 else {
10284 objPtr = NULL;
10286 break;
10287 case JIM_TT_CMD:
10288 ret = Jim_EvalObj(interp, token->objPtr);
10289 if (ret == JIM_OK || ret == JIM_RETURN) {
10290 objPtr = interp->result;
10291 } else {
10292 /* includes JIM_BREAK, JIM_CONTINUE */
10293 objPtr = NULL;
10295 break;
10296 default:
10297 JimPanic((1,
10298 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10299 objPtr = NULL;
10300 break;
10302 if (objPtr) {
10303 *objPtrPtr = objPtr;
10304 return JIM_OK;
10306 return ret;
10309 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10310 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10311 * The returned object has refcount = 0.
10313 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10315 int totlen = 0, i;
10316 Jim_Obj **intv;
10317 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10318 Jim_Obj *objPtr;
10319 char *s;
10321 if (tokens <= JIM_EVAL_SINTV_LEN)
10322 intv = sintv;
10323 else
10324 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10326 /* Compute every token forming the argument
10327 * in the intv objects vector. */
10328 for (i = 0; i < tokens; i++) {
10329 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10330 case JIM_OK:
10331 case JIM_RETURN:
10332 break;
10333 case JIM_BREAK:
10334 if (flags & JIM_SUBST_FLAG) {
10335 /* Stop here */
10336 tokens = i;
10337 continue;
10339 /* XXX: Should probably set an error about break outside loop */
10340 /* fall through to error */
10341 case JIM_CONTINUE:
10342 if (flags & JIM_SUBST_FLAG) {
10343 intv[i] = NULL;
10344 continue;
10346 /* XXX: Ditto continue outside loop */
10347 /* fall through to error */
10348 default:
10349 while (i--) {
10350 Jim_DecrRefCount(interp, intv[i]);
10352 if (intv != sintv) {
10353 Jim_Free(intv);
10355 return NULL;
10357 Jim_IncrRefCount(intv[i]);
10358 Jim_String(intv[i]);
10359 totlen += intv[i]->length;
10362 /* Fast path return for a single token */
10363 if (tokens == 1 && intv[0] && intv == sintv) {
10364 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10365 intv[0]->refCount--;
10366 return intv[0];
10369 /* Concatenate every token in an unique
10370 * object. */
10371 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10373 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10374 && token[2].type == JIM_TT_VAR) {
10375 /* May be able to do fast interpolated object -> dictSubst */
10376 objPtr->typePtr = &interpolatedObjType;
10377 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10378 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10379 Jim_IncrRefCount(intv[2]);
10381 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10382 /* The first interpolated token is source, so preserve the source info */
10383 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10387 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10388 objPtr->length = totlen;
10389 for (i = 0; i < tokens; i++) {
10390 if (intv[i]) {
10391 memcpy(s, intv[i]->bytes, intv[i]->length);
10392 s += intv[i]->length;
10393 Jim_DecrRefCount(interp, intv[i]);
10396 objPtr->bytes[totlen] = '\0';
10397 /* Free the intv vector if not static. */
10398 if (intv != sintv) {
10399 Jim_Free(intv);
10402 return objPtr;
10406 /* listPtr *must* be a list.
10407 * The contents of the list is evaluated with the first element as the command and
10408 * the remaining elements as the arguments.
10410 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10412 int retcode = JIM_OK;
10414 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10416 if (listPtr->internalRep.listValue.len) {
10417 Jim_IncrRefCount(listPtr);
10418 retcode = JimInvokeCommand(interp,
10419 listPtr->internalRep.listValue.len,
10420 listPtr->internalRep.listValue.ele);
10421 Jim_DecrRefCount(interp, listPtr);
10423 return retcode;
10426 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10428 SetListFromAny(interp, listPtr);
10429 return JimEvalObjList(interp, listPtr);
10432 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10434 int i;
10435 ScriptObj *script;
10436 ScriptToken *token;
10437 int retcode = JIM_OK;
10438 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10439 Jim_Obj *prevScriptObj;
10441 /* If the object is of type "list", with no string rep we can call
10442 * a specialized version of Jim_EvalObj() */
10443 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10444 return JimEvalObjList(interp, scriptObjPtr);
10447 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10448 script = JimGetScript(interp, scriptObjPtr);
10449 if (!JimScriptValid(interp, script)) {
10450 Jim_DecrRefCount(interp, scriptObjPtr);
10451 return JIM_ERR;
10454 /* Reset the interpreter result. This is useful to
10455 * return the empty result in the case of empty program. */
10456 Jim_SetEmptyResult(interp);
10458 token = script->token;
10460 #ifdef JIM_OPTIMIZATION
10461 /* Check for one of the following common scripts used by for, while
10463 * {}
10464 * incr a
10466 if (script->len == 0) {
10467 Jim_DecrRefCount(interp, scriptObjPtr);
10468 return JIM_OK;
10470 if (script->len == 3
10471 && token[1].objPtr->typePtr == &commandObjType
10472 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10473 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10474 && token[2].objPtr->typePtr == &variableObjType) {
10476 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10478 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10479 JimWideValue(objPtr)++;
10480 Jim_InvalidateStringRep(objPtr);
10481 Jim_DecrRefCount(interp, scriptObjPtr);
10482 Jim_SetResult(interp, objPtr);
10483 return JIM_OK;
10486 #endif
10488 /* Now we have to make sure the internal repr will not be
10489 * freed on shimmering.
10491 * Think for example to this:
10493 * set x {llength $x; ... some more code ...}; eval $x
10495 * In order to preserve the internal rep, we increment the
10496 * inUse field of the script internal rep structure. */
10497 script->inUse++;
10499 /* Stash the current script */
10500 prevScriptObj = interp->currentScriptObj;
10501 interp->currentScriptObj = scriptObjPtr;
10503 interp->errorFlag = 0;
10504 argv = sargv;
10506 /* Execute every command sequentially until the end of the script
10507 * or an error occurs.
10509 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10510 int argc;
10511 int j;
10513 /* First token of the line is always JIM_TT_LINE */
10514 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10515 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10517 /* Allocate the arguments vector if required */
10518 if (argc > JIM_EVAL_SARGV_LEN)
10519 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10521 /* Skip the JIM_TT_LINE token */
10522 i++;
10524 /* Populate the arguments objects.
10525 * If an error occurs, retcode will be set and
10526 * 'j' will be set to the number of args expanded
10528 for (j = 0; j < argc; j++) {
10529 long wordtokens = 1;
10530 int expand = 0;
10531 Jim_Obj *wordObjPtr = NULL;
10533 if (token[i].type == JIM_TT_WORD) {
10534 wordtokens = JimWideValue(token[i++].objPtr);
10535 if (wordtokens < 0) {
10536 expand = 1;
10537 wordtokens = -wordtokens;
10541 if (wordtokens == 1) {
10542 /* Fast path if the token does not
10543 * need interpolation */
10545 switch (token[i].type) {
10546 case JIM_TT_ESC:
10547 case JIM_TT_STR:
10548 wordObjPtr = token[i].objPtr;
10549 break;
10550 case JIM_TT_VAR:
10551 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10552 break;
10553 case JIM_TT_EXPRSUGAR:
10554 retcode = Jim_EvalExpression(interp, token[i].objPtr);
10555 if (retcode == JIM_OK) {
10556 wordObjPtr = Jim_GetResult(interp);
10558 else {
10559 wordObjPtr = NULL;
10561 break;
10562 case JIM_TT_DICTSUGAR:
10563 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10564 break;
10565 case JIM_TT_CMD:
10566 retcode = Jim_EvalObj(interp, token[i].objPtr);
10567 if (retcode == JIM_OK) {
10568 wordObjPtr = Jim_GetResult(interp);
10570 break;
10571 default:
10572 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10575 else {
10576 /* For interpolation we call a helper
10577 * function to do the work for us. */
10578 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10581 if (!wordObjPtr) {
10582 if (retcode == JIM_OK) {
10583 retcode = JIM_ERR;
10585 break;
10588 Jim_IncrRefCount(wordObjPtr);
10589 i += wordtokens;
10591 if (!expand) {
10592 argv[j] = wordObjPtr;
10594 else {
10595 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10596 int len = Jim_ListLength(interp, wordObjPtr);
10597 int newargc = argc + len - 1;
10598 int k;
10600 if (len > 1) {
10601 if (argv == sargv) {
10602 if (newargc > JIM_EVAL_SARGV_LEN) {
10603 argv = Jim_Alloc(sizeof(*argv) * newargc);
10604 memcpy(argv, sargv, sizeof(*argv) * j);
10607 else {
10608 /* Need to realloc to make room for (len - 1) more entries */
10609 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10613 /* Now copy in the expanded version */
10614 for (k = 0; k < len; k++) {
10615 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10616 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10619 /* The original object reference is no longer needed,
10620 * after the expansion it is no longer present on
10621 * the argument vector, but the single elements are
10622 * in its place. */
10623 Jim_DecrRefCount(interp, wordObjPtr);
10625 /* And update the indexes */
10626 j--;
10627 argc += len - 1;
10631 if (retcode == JIM_OK && argc) {
10632 /* Invoke the command */
10633 retcode = JimInvokeCommand(interp, argc, argv);
10634 /* Check for a signal after each command */
10635 if (Jim_CheckSignal(interp)) {
10636 retcode = JIM_SIGNAL;
10640 /* Finished with the command, so decrement ref counts of each argument */
10641 while (j-- > 0) {
10642 Jim_DecrRefCount(interp, argv[j]);
10645 if (argv != sargv) {
10646 Jim_Free(argv);
10647 argv = sargv;
10651 /* Possibly add to the error stack trace */
10652 if (retcode == JIM_ERR) {
10653 JimAddErrorToStack(interp, script);
10655 /* Propagate the addStackTrace value through 'return -code error' */
10656 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10657 /* No need to add stack trace */
10658 interp->addStackTrace = 0;
10661 /* Restore the current script */
10662 interp->currentScriptObj = prevScriptObj;
10664 /* Note that we don't have to decrement inUse, because the
10665 * following code transfers our use of the reference again to
10666 * the script object. */
10667 Jim_FreeIntRep(interp, scriptObjPtr);
10668 scriptObjPtr->typePtr = &scriptObjType;
10669 Jim_SetIntRepPtr(scriptObjPtr, script);
10670 Jim_DecrRefCount(interp, scriptObjPtr);
10672 return retcode;
10675 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10677 int retcode;
10678 /* If argObjPtr begins with '&', do an automatic upvar */
10679 const char *varname = Jim_String(argNameObj);
10680 if (*varname == '&') {
10681 /* First check that the target variable exists */
10682 Jim_Obj *objPtr;
10683 Jim_CallFrame *savedCallFrame = interp->framePtr;
10685 interp->framePtr = interp->framePtr->parent;
10686 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10687 interp->framePtr = savedCallFrame;
10688 if (!objPtr) {
10689 return JIM_ERR;
10692 /* It exists, so perform the binding. */
10693 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10694 Jim_IncrRefCount(objPtr);
10695 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10696 Jim_DecrRefCount(interp, objPtr);
10698 else {
10699 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10701 return retcode;
10705 * Sets the interp result to be an error message indicating the required proc args.
10707 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10709 /* Create a nice error message, consistent with Tcl 8.5 */
10710 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10711 int i;
10713 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10714 Jim_AppendString(interp, argmsg, " ", 1);
10716 if (i == cmd->u.proc.argsPos) {
10717 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10718 /* Renamed args */
10719 Jim_AppendString(interp, argmsg, "?", 1);
10720 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10721 Jim_AppendString(interp, argmsg, " ...?", -1);
10723 else {
10724 /* We have plain args */
10725 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10728 else {
10729 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10730 Jim_AppendString(interp, argmsg, "?", 1);
10731 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10732 Jim_AppendString(interp, argmsg, "?", 1);
10734 else {
10735 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10736 if (*arg == '&') {
10737 arg++;
10739 Jim_AppendString(interp, argmsg, arg, -1);
10743 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10746 #ifdef jim_ext_namespace
10748 * [namespace eval]
10750 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10752 Jim_CallFrame *callFramePtr;
10753 int retcode;
10755 /* Create a new callframe */
10756 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10757 callFramePtr->argv = &interp->emptyObj;
10758 callFramePtr->argc = 0;
10759 callFramePtr->procArgsObjPtr = NULL;
10760 callFramePtr->procBodyObjPtr = scriptObj;
10761 callFramePtr->staticVars = NULL;
10762 callFramePtr->fileNameObj = interp->emptyObj;
10763 callFramePtr->line = 0;
10764 Jim_IncrRefCount(scriptObj);
10765 interp->framePtr = callFramePtr;
10767 /* Check if there are too nested calls */
10768 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10769 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10770 retcode = JIM_ERR;
10772 else {
10773 /* Eval the body */
10774 retcode = Jim_EvalObj(interp, scriptObj);
10777 /* Destroy the callframe */
10778 interp->framePtr = interp->framePtr->parent;
10779 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10781 return retcode;
10783 #endif
10785 /* Call a procedure implemented in Tcl.
10786 * It's possible to speed-up a lot this function, currently
10787 * the callframes are not cached, but allocated and
10788 * destroied every time. What is expecially costly is
10789 * to create/destroy the local vars hash table every time.
10791 * This can be fixed just implementing callframes caching
10792 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10793 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10795 Jim_CallFrame *callFramePtr;
10796 int i, d, retcode, optargs;
10797 ScriptObj *script;
10799 /* Check arity */
10800 if (argc - 1 < cmd->u.proc.reqArity ||
10801 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10802 JimSetProcWrongArgs(interp, argv[0], cmd);
10803 return JIM_ERR;
10806 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10807 /* Optimise for procedure with no body - useful for optional debugging */
10808 return JIM_OK;
10811 /* Check if there are too nested calls */
10812 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10813 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10814 return JIM_ERR;
10817 /* Create a new callframe */
10818 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10819 callFramePtr->argv = argv;
10820 callFramePtr->argc = argc;
10821 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10822 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10823 callFramePtr->staticVars = cmd->u.proc.staticVars;
10825 /* Remember where we were called from. */
10826 script = JimGetScript(interp, interp->currentScriptObj);
10827 callFramePtr->fileNameObj = script->fileNameObj;
10828 callFramePtr->line = script->linenr;
10830 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10831 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10832 interp->framePtr = callFramePtr;
10834 /* How many optional args are available */
10835 optargs = (argc - 1 - cmd->u.proc.reqArity);
10837 /* Step 'i' along the actual args, and step 'd' along the formal args */
10838 i = 1;
10839 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10840 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10841 if (d == cmd->u.proc.argsPos) {
10842 /* assign $args */
10843 Jim_Obj *listObjPtr;
10844 int argsLen = 0;
10845 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10846 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10848 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10850 /* It is possible to rename args. */
10851 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10852 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10854 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10855 if (retcode != JIM_OK) {
10856 goto badargset;
10859 i += argsLen;
10860 continue;
10863 /* Optional or required? */
10864 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10865 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10867 else {
10868 /* Ran out, so use the default */
10869 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10871 if (retcode != JIM_OK) {
10872 goto badargset;
10876 /* Eval the body */
10877 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10879 badargset:
10881 /* Invoke $jim::defer then destroy the callframe */
10882 retcode = JimInvokeDefer(interp, retcode);
10883 interp->framePtr = interp->framePtr->parent;
10884 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10886 return retcode;
10889 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10891 int retval;
10892 Jim_Obj *scriptObjPtr;
10894 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10895 Jim_IncrRefCount(scriptObjPtr);
10897 if (filename) {
10898 Jim_Obj *prevScriptObj;
10900 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10902 prevScriptObj = interp->currentScriptObj;
10903 interp->currentScriptObj = scriptObjPtr;
10905 retval = Jim_EvalObj(interp, scriptObjPtr);
10907 interp->currentScriptObj = prevScriptObj;
10909 else {
10910 retval = Jim_EvalObj(interp, scriptObjPtr);
10912 Jim_DecrRefCount(interp, scriptObjPtr);
10913 return retval;
10916 int Jim_Eval(Jim_Interp *interp, const char *script)
10918 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10921 /* Execute script in the scope of the global level */
10922 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10924 int retval;
10925 Jim_CallFrame *savedFramePtr = interp->framePtr;
10927 interp->framePtr = interp->topFramePtr;
10928 retval = Jim_Eval(interp, script);
10929 interp->framePtr = savedFramePtr;
10931 return retval;
10934 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10936 int retval;
10937 Jim_CallFrame *savedFramePtr = interp->framePtr;
10939 interp->framePtr = interp->topFramePtr;
10940 retval = Jim_EvalFile(interp, filename);
10941 interp->framePtr = savedFramePtr;
10943 return retval;
10946 #include <sys/stat.h>
10948 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10950 FILE *fp;
10951 char *buf;
10952 Jim_Obj *scriptObjPtr;
10953 Jim_Obj *prevScriptObj;
10954 struct stat sb;
10955 int retcode;
10956 int readlen;
10958 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10959 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10960 return JIM_ERR;
10962 if (sb.st_size == 0) {
10963 fclose(fp);
10964 return JIM_OK;
10967 buf = Jim_Alloc(sb.st_size + 1);
10968 readlen = fread(buf, 1, sb.st_size, fp);
10969 if (ferror(fp)) {
10970 fclose(fp);
10971 Jim_Free(buf);
10972 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10973 return JIM_ERR;
10975 fclose(fp);
10976 buf[readlen] = 0;
10978 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10979 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
10980 Jim_IncrRefCount(scriptObjPtr);
10982 prevScriptObj = interp->currentScriptObj;
10983 interp->currentScriptObj = scriptObjPtr;
10985 retcode = Jim_EvalObj(interp, scriptObjPtr);
10987 /* Handle the JIM_RETURN return code */
10988 if (retcode == JIM_RETURN) {
10989 if (--interp->returnLevel <= 0) {
10990 retcode = interp->returnCode;
10991 interp->returnCode = JIM_OK;
10992 interp->returnLevel = 0;
10995 if (retcode == JIM_ERR) {
10996 /* EvalFile changes context, so add a stack frame here */
10997 interp->addStackTrace++;
11000 interp->currentScriptObj = prevScriptObj;
11002 Jim_DecrRefCount(interp, scriptObjPtr);
11004 return retcode;
11007 /* -----------------------------------------------------------------------------
11008 * Subst
11009 * ---------------------------------------------------------------------------*/
11010 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11012 pc->tstart = pc->p;
11013 pc->tline = pc->linenr;
11015 if (pc->len == 0) {
11016 pc->tend = pc->p;
11017 pc->tt = JIM_TT_EOL;
11018 pc->eof = 1;
11019 return;
11021 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11022 JimParseCmd(pc);
11023 return;
11025 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11026 if (JimParseVar(pc) == JIM_OK) {
11027 return;
11029 /* Not a var, so treat as a string */
11030 pc->tstart = pc->p;
11031 flags |= JIM_SUBST_NOVAR;
11033 while (pc->len) {
11034 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11035 break;
11037 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11038 break;
11040 if (*pc->p == '\\' && pc->len > 1) {
11041 pc->p++;
11042 pc->len--;
11044 pc->p++;
11045 pc->len--;
11047 pc->tend = pc->p - 1;
11048 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11051 /* The subst object type reuses most of the data structures and functions
11052 * of the script object. Script's data structures are a bit more complex
11053 * for what is needed for [subst]itution tasks, but the reuse helps to
11054 * deal with a single data structure at the cost of some more memory
11055 * usage for substitutions. */
11057 /* This method takes the string representation of an object
11058 * as a Tcl string where to perform [subst]itution, and generates
11059 * the pre-parsed internal representation. */
11060 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11062 int scriptTextLen;
11063 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11064 struct JimParserCtx parser;
11065 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11066 ParseTokenList tokenlist;
11068 /* Initially parse the subst into tokens (in tokenlist) */
11069 ScriptTokenListInit(&tokenlist);
11071 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11072 while (1) {
11073 JimParseSubst(&parser, flags);
11074 if (parser.eof) {
11075 /* Note that subst doesn't need the EOL token */
11076 break;
11078 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11079 parser.tline);
11082 /* Create the "real" subst/script tokens from the initial token list */
11083 script->inUse = 1;
11084 script->substFlags = flags;
11085 script->fileNameObj = interp->emptyObj;
11086 Jim_IncrRefCount(script->fileNameObj);
11087 SubstObjAddTokens(interp, script, &tokenlist);
11089 /* No longer need the token list */
11090 ScriptTokenListFree(&tokenlist);
11092 #ifdef DEBUG_SHOW_SUBST
11094 int i;
11096 printf("==== Subst ====\n");
11097 for (i = 0; i < script->len; i++) {
11098 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11099 Jim_String(script->token[i].objPtr));
11102 #endif
11104 /* Free the old internal rep and set the new one. */
11105 Jim_FreeIntRep(interp, objPtr);
11106 Jim_SetIntRepPtr(objPtr, script);
11107 objPtr->typePtr = &scriptObjType;
11108 return JIM_OK;
11111 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11113 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11114 SetSubstFromAny(interp, objPtr, flags);
11115 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11118 /* Performs commands,variables,blackslashes substitution,
11119 * storing the result object (with refcount 0) into
11120 * resObjPtrPtr. */
11121 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11123 ScriptObj *script;
11125 JimPanic((substObjPtr->refCount == 0, "Jim_SubstObj() called with zero refcount object"));
11127 script = Jim_GetSubst(interp, substObjPtr, flags);
11129 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11130 /* In order to preserve the internal rep, we increment the
11131 * inUse field of the script internal rep structure. */
11132 script->inUse++;
11134 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11136 script->inUse--;
11137 Jim_DecrRefCount(interp, substObjPtr);
11138 if (*resObjPtrPtr == NULL) {
11139 return JIM_ERR;
11141 return JIM_OK;
11144 /* -----------------------------------------------------------------------------
11145 * Core commands utility functions
11146 * ---------------------------------------------------------------------------*/
11147 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11149 Jim_Obj *objPtr;
11150 Jim_Obj *listObjPtr;
11152 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11154 listObjPtr = Jim_NewListObj(interp, argv, argc);
11156 if (msg && *msg) {
11157 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11159 Jim_IncrRefCount(listObjPtr);
11160 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11161 Jim_DecrRefCount(interp, listObjPtr);
11163 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11167 * May add the key and/or value to the list.
11169 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11170 Jim_HashEntry *he, int type);
11172 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11175 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11176 * invoke the callback to add entries to a list.
11177 * Returns the list.
11179 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11180 JimHashtableIteratorCallbackType *callback, int type)
11182 Jim_HashEntry *he;
11183 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11185 /* Check for the non-pattern case. We can do this much more efficiently. */
11186 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11187 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11188 if (he) {
11189 callback(interp, listObjPtr, he, type);
11192 else {
11193 Jim_HashTableIterator htiter;
11194 JimInitHashTableIterator(ht, &htiter);
11195 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11196 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11197 callback(interp, listObjPtr, he, type);
11201 return listObjPtr;
11204 /* Keep these in order */
11205 #define JIM_CMDLIST_COMMANDS 0
11206 #define JIM_CMDLIST_PROCS 1
11207 #define JIM_CMDLIST_CHANNELS 2
11210 * Adds matching command names (procs, channels) to the list.
11212 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11213 Jim_HashEntry *he, int type)
11215 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11216 Jim_Obj *objPtr;
11218 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11219 /* not a proc */
11220 return;
11223 objPtr = Jim_NewStringObj(interp, he->key, -1);
11224 Jim_IncrRefCount(objPtr);
11226 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11227 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11229 Jim_DecrRefCount(interp, objPtr);
11232 /* type is JIM_CMDLIST_xxx */
11233 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11235 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11238 /* Keep these in order */
11239 #define JIM_VARLIST_GLOBALS 0
11240 #define JIM_VARLIST_LOCALS 1
11241 #define JIM_VARLIST_VARS 2
11243 #define JIM_VARLIST_VALUES 0x1000
11246 * Adds matching variable names to the list.
11248 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11249 Jim_HashEntry *he, int type)
11251 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11253 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11254 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11255 if (type & JIM_VARLIST_VALUES) {
11256 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11261 /* mode is JIM_VARLIST_xxx */
11262 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11264 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11265 /* For [info locals], if we are at top level an emtpy list
11266 * is returned. I don't agree, but we aim at compatibility (SS) */
11267 return interp->emptyObj;
11269 else {
11270 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11271 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11275 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11276 Jim_Obj **objPtrPtr, int info_level_cmd)
11278 Jim_CallFrame *targetCallFrame;
11280 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11281 if (targetCallFrame == NULL) {
11282 return JIM_ERR;
11284 /* No proc call at toplevel callframe */
11285 if (targetCallFrame == interp->topFramePtr) {
11286 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11287 return JIM_ERR;
11289 if (info_level_cmd) {
11290 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11292 else {
11293 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11295 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11296 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11297 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11298 *objPtrPtr = listObj;
11300 return JIM_OK;
11303 /* -----------------------------------------------------------------------------
11304 * Core commands
11305 * ---------------------------------------------------------------------------*/
11307 /* fake [puts] -- not the real puts, just for debugging. */
11308 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11310 if (argc != 2 && argc != 3) {
11311 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11312 return JIM_ERR;
11314 if (argc == 3) {
11315 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11316 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11317 return JIM_ERR;
11319 else {
11320 fputs(Jim_String(argv[2]), stdout);
11323 else {
11324 puts(Jim_String(argv[1]));
11326 return JIM_OK;
11329 /* Helper for [+] and [*] */
11330 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11332 jim_wide wideValue, res;
11333 double doubleValue, doubleRes;
11334 int i;
11336 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11338 for (i = 1; i < argc; i++) {
11339 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11340 goto trydouble;
11341 if (op == JIM_EXPROP_ADD)
11342 res += wideValue;
11343 else
11344 res *= wideValue;
11346 Jim_SetResultInt(interp, res);
11347 return JIM_OK;
11348 trydouble:
11349 doubleRes = (double)res;
11350 for (; i < argc; i++) {
11351 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11352 return JIM_ERR;
11353 if (op == JIM_EXPROP_ADD)
11354 doubleRes += doubleValue;
11355 else
11356 doubleRes *= doubleValue;
11358 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11359 return JIM_OK;
11362 /* Helper for [-] and [/] */
11363 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11365 jim_wide wideValue, res = 0;
11366 double doubleValue, doubleRes = 0;
11367 int i = 2;
11369 if (argc < 2) {
11370 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11371 return JIM_ERR;
11373 else if (argc == 2) {
11374 /* The arity = 2 case is different. For [- x] returns -x,
11375 * while [/ x] returns 1/x. */
11376 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11377 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11378 return JIM_ERR;
11380 else {
11381 if (op == JIM_EXPROP_SUB)
11382 doubleRes = -doubleValue;
11383 else
11384 doubleRes = 1.0 / doubleValue;
11385 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11386 return JIM_OK;
11389 if (op == JIM_EXPROP_SUB) {
11390 res = -wideValue;
11391 Jim_SetResultInt(interp, res);
11393 else {
11394 doubleRes = 1.0 / wideValue;
11395 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11397 return JIM_OK;
11399 else {
11400 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11401 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11402 != JIM_OK) {
11403 return JIM_ERR;
11405 else {
11406 goto trydouble;
11410 for (i = 2; i < argc; i++) {
11411 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11412 doubleRes = (double)res;
11413 goto trydouble;
11415 if (op == JIM_EXPROP_SUB)
11416 res -= wideValue;
11417 else {
11418 if (wideValue == 0) {
11419 Jim_SetResultString(interp, "Division by zero", -1);
11420 return JIM_ERR;
11422 res /= wideValue;
11425 Jim_SetResultInt(interp, res);
11426 return JIM_OK;
11427 trydouble:
11428 for (; i < argc; i++) {
11429 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11430 return JIM_ERR;
11431 if (op == JIM_EXPROP_SUB)
11432 doubleRes -= doubleValue;
11433 else
11434 doubleRes /= doubleValue;
11436 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11437 return JIM_OK;
11441 /* [+] */
11442 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11444 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11447 /* [*] */
11448 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11450 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11453 /* [-] */
11454 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11456 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11459 /* [/] */
11460 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11462 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11465 /* [set] */
11466 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11468 if (argc != 2 && argc != 3) {
11469 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11470 return JIM_ERR;
11472 if (argc == 2) {
11473 Jim_Obj *objPtr;
11475 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11476 if (!objPtr)
11477 return JIM_ERR;
11478 Jim_SetResult(interp, objPtr);
11479 return JIM_OK;
11481 /* argc == 3 case. */
11482 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11483 return JIM_ERR;
11484 Jim_SetResult(interp, argv[2]);
11485 return JIM_OK;
11488 /* [unset]
11490 * unset ?-nocomplain? ?--? ?varName ...?
11492 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11494 int i = 1;
11495 int complain = 1;
11497 while (i < argc) {
11498 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11499 i++;
11500 break;
11502 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11503 complain = 0;
11504 i++;
11505 continue;
11507 break;
11510 while (i < argc) {
11511 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11512 && complain) {
11513 return JIM_ERR;
11515 i++;
11517 return JIM_OK;
11520 /* [while] */
11521 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11523 if (argc != 3) {
11524 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11525 return JIM_ERR;
11528 /* The general purpose implementation of while starts here */
11529 while (1) {
11530 int boolean, retval;
11532 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11533 return retval;
11534 if (!boolean)
11535 break;
11537 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11538 switch (retval) {
11539 case JIM_BREAK:
11540 goto out;
11541 break;
11542 case JIM_CONTINUE:
11543 continue;
11544 break;
11545 default:
11546 return retval;
11550 out:
11551 Jim_SetEmptyResult(interp);
11552 return JIM_OK;
11555 /* [for] */
11556 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11558 int retval;
11559 int boolean = 1;
11560 Jim_Obj *varNamePtr = NULL;
11561 Jim_Obj *stopVarNamePtr = NULL;
11563 if (argc != 5) {
11564 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11565 return JIM_ERR;
11568 /* Do the initialisation */
11569 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11570 return retval;
11573 /* And do the first test now. Better for optimisation
11574 * if we can do next/test at the bottom of the loop
11576 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11578 /* Ready to do the body as follows:
11579 * while (1) {
11580 * body // check retcode
11581 * next // check retcode
11582 * test // check retcode/test bool
11586 #ifdef JIM_OPTIMIZATION
11587 /* Check if the for is on the form:
11588 * for ... {$i < CONST} {incr i}
11589 * for ... {$i < $j} {incr i}
11591 if (retval == JIM_OK && boolean) {
11592 ScriptObj *incrScript;
11593 struct ExprTree *expr;
11594 jim_wide stop, currentVal;
11595 Jim_Obj *objPtr;
11596 int cmpOffset;
11598 /* Do it only if there aren't shared arguments */
11599 expr = JimGetExpression(interp, argv[2]);
11600 incrScript = JimGetScript(interp, argv[3]);
11602 /* Ensure proper lengths to start */
11603 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11604 goto evalstart;
11606 /* Ensure proper token types. */
11607 if (incrScript->token[1].type != JIM_TT_ESC) {
11608 goto evalstart;
11611 if (expr->expr->type == JIM_EXPROP_LT) {
11612 cmpOffset = 0;
11614 else if (expr->expr->type == JIM_EXPROP_LTE) {
11615 cmpOffset = 1;
11617 else {
11618 goto evalstart;
11621 if (expr->expr->left->type != JIM_TT_VAR) {
11622 goto evalstart;
11625 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11626 goto evalstart;
11629 /* Update command must be incr */
11630 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11631 goto evalstart;
11634 /* incr, expression must be about the same variable */
11635 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11636 goto evalstart;
11639 /* Get the stop condition (must be a variable or integer) */
11640 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11641 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11642 goto evalstart;
11645 else {
11646 stopVarNamePtr = expr->expr->right->objPtr;
11647 Jim_IncrRefCount(stopVarNamePtr);
11648 /* Keep the compiler happy */
11649 stop = 0;
11652 /* Initialization */
11653 varNamePtr = expr->expr->left->objPtr;
11654 Jim_IncrRefCount(varNamePtr);
11656 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11657 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11658 goto testcond;
11661 /* --- OPTIMIZED FOR --- */
11662 while (retval == JIM_OK) {
11663 /* === Check condition === */
11664 /* Note that currentVal is already set here */
11666 /* Immediate or Variable? get the 'stop' value if the latter. */
11667 if (stopVarNamePtr) {
11668 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11669 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11670 goto testcond;
11674 if (currentVal >= stop + cmpOffset) {
11675 break;
11678 /* Eval body */
11679 retval = Jim_EvalObj(interp, argv[4]);
11680 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11681 retval = JIM_OK;
11683 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11685 /* Increment */
11686 if (objPtr == NULL) {
11687 retval = JIM_ERR;
11688 goto out;
11690 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11691 currentVal = ++JimWideValue(objPtr);
11692 Jim_InvalidateStringRep(objPtr);
11694 else {
11695 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11696 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11697 ++currentVal)) != JIM_OK) {
11698 goto evalnext;
11703 goto out;
11705 evalstart:
11706 #endif
11708 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11709 /* Body */
11710 retval = Jim_EvalObj(interp, argv[4]);
11712 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11713 /* increment */
11714 JIM_IF_OPTIM(evalnext:)
11715 retval = Jim_EvalObj(interp, argv[3]);
11716 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11717 /* test */
11718 JIM_IF_OPTIM(testcond:)
11719 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11723 JIM_IF_OPTIM(out:)
11724 if (stopVarNamePtr) {
11725 Jim_DecrRefCount(interp, stopVarNamePtr);
11727 if (varNamePtr) {
11728 Jim_DecrRefCount(interp, varNamePtr);
11731 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11732 Jim_SetEmptyResult(interp);
11733 return JIM_OK;
11736 return retval;
11739 /* [loop] */
11740 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11742 int retval;
11743 jim_wide i;
11744 jim_wide limit;
11745 jim_wide incr = 1;
11746 Jim_Obj *bodyObjPtr;
11748 if (argc != 5 && argc != 6) {
11749 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11750 return JIM_ERR;
11753 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11754 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11755 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11756 return JIM_ERR;
11758 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11760 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11762 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11763 retval = Jim_EvalObj(interp, bodyObjPtr);
11764 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11765 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11767 retval = JIM_OK;
11769 /* Increment */
11770 i += incr;
11772 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11773 if (argv[1]->typePtr != &variableObjType) {
11774 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11775 return JIM_ERR;
11778 JimWideValue(objPtr) = i;
11779 Jim_InvalidateStringRep(objPtr);
11781 /* The following step is required in order to invalidate the
11782 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11783 if (argv[1]->typePtr != &variableObjType) {
11784 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11785 retval = JIM_ERR;
11786 break;
11790 else {
11791 objPtr = Jim_NewIntObj(interp, i);
11792 retval = Jim_SetVariable(interp, argv[1], objPtr);
11793 if (retval != JIM_OK) {
11794 Jim_FreeNewObj(interp, objPtr);
11800 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11801 Jim_SetEmptyResult(interp);
11802 return JIM_OK;
11804 return retval;
11807 /* List iterators make it easy to iterate over a list.
11808 * At some point iterators will be expanded to support generators.
11810 typedef struct {
11811 Jim_Obj *objPtr;
11812 int idx;
11813 } Jim_ListIter;
11816 * Initialise the iterator at the start of the list.
11818 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11820 iter->objPtr = objPtr;
11821 iter->idx = 0;
11825 * Returns the next object from the list, or NULL on end-of-list.
11827 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11829 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11830 return NULL;
11832 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11836 * Returns 1 if end-of-list has been reached.
11838 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11840 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11843 /* foreach + lmap implementation. */
11844 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11846 int result = JIM_OK;
11847 int i, numargs;
11848 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11849 Jim_ListIter *iters;
11850 Jim_Obj *script;
11851 Jim_Obj *resultObj;
11853 if (argc < 4 || argc % 2 != 0) {
11854 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11855 return JIM_ERR;
11857 script = argv[argc - 1]; /* Last argument is a script */
11858 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11860 if (numargs == 2) {
11861 iters = twoiters;
11863 else {
11864 iters = Jim_Alloc(numargs * sizeof(*iters));
11866 for (i = 0; i < numargs; i++) {
11867 JimListIterInit(&iters[i], argv[i + 1]);
11868 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11869 result = JIM_ERR;
11872 if (result != JIM_OK) {
11873 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11874 goto empty_varlist;
11877 if (doMap) {
11878 resultObj = Jim_NewListObj(interp, NULL, 0);
11880 else {
11881 resultObj = interp->emptyObj;
11883 Jim_IncrRefCount(resultObj);
11885 while (1) {
11886 /* Have we expired all lists? */
11887 for (i = 0; i < numargs; i += 2) {
11888 if (!JimListIterDone(interp, &iters[i + 1])) {
11889 break;
11892 if (i == numargs) {
11893 /* All done */
11894 break;
11897 /* For each list */
11898 for (i = 0; i < numargs; i += 2) {
11899 Jim_Obj *varName;
11901 /* foreach var */
11902 JimListIterInit(&iters[i], argv[i + 1]);
11903 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11904 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11905 if (!valObj) {
11906 /* Ran out, so store the empty string */
11907 valObj = interp->emptyObj;
11909 /* Avoid shimmering */
11910 Jim_IncrRefCount(valObj);
11911 result = Jim_SetVariable(interp, varName, valObj);
11912 Jim_DecrRefCount(interp, valObj);
11913 if (result != JIM_OK) {
11914 goto err;
11918 switch (result = Jim_EvalObj(interp, script)) {
11919 case JIM_OK:
11920 if (doMap) {
11921 Jim_ListAppendElement(interp, resultObj, interp->result);
11923 break;
11924 case JIM_CONTINUE:
11925 break;
11926 case JIM_BREAK:
11927 goto out;
11928 default:
11929 goto err;
11932 out:
11933 result = JIM_OK;
11934 Jim_SetResult(interp, resultObj);
11935 err:
11936 Jim_DecrRefCount(interp, resultObj);
11937 empty_varlist:
11938 if (numargs > 2) {
11939 Jim_Free(iters);
11941 return result;
11944 /* [foreach] */
11945 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11947 return JimForeachMapHelper(interp, argc, argv, 0);
11950 /* [lmap] */
11951 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11953 return JimForeachMapHelper(interp, argc, argv, 1);
11956 /* [lassign] */
11957 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11959 int result = JIM_ERR;
11960 int i;
11961 Jim_ListIter iter;
11962 Jim_Obj *resultObj;
11964 if (argc < 2) {
11965 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11966 return JIM_ERR;
11969 JimListIterInit(&iter, argv[1]);
11971 for (i = 2; i < argc; i++) {
11972 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11973 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11974 if (result != JIM_OK) {
11975 return result;
11979 resultObj = Jim_NewListObj(interp, NULL, 0);
11980 while (!JimListIterDone(interp, &iter)) {
11981 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
11984 Jim_SetResult(interp, resultObj);
11986 return JIM_OK;
11989 /* [if] */
11990 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11992 int boolean, retval, current = 1, falsebody = 0;
11994 if (argc >= 3) {
11995 while (1) {
11996 /* Far not enough arguments given! */
11997 if (current >= argc)
11998 goto err;
11999 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12000 != JIM_OK)
12001 return retval;
12002 /* There lacks something, isn't it? */
12003 if (current >= argc)
12004 goto err;
12005 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12006 current++;
12007 /* Tsk tsk, no then-clause? */
12008 if (current >= argc)
12009 goto err;
12010 if (boolean)
12011 return Jim_EvalObj(interp, argv[current]);
12012 /* Ok: no else-clause follows */
12013 if (++current >= argc) {
12014 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12015 return JIM_OK;
12017 falsebody = current++;
12018 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12019 /* IIICKS - else-clause isn't last cmd? */
12020 if (current != argc - 1)
12021 goto err;
12022 return Jim_EvalObj(interp, argv[current]);
12024 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12025 /* Ok: elseif follows meaning all the stuff
12026 * again (how boring...) */
12027 continue;
12028 /* OOPS - else-clause is not last cmd? */
12029 else if (falsebody != argc - 1)
12030 goto err;
12031 return Jim_EvalObj(interp, argv[falsebody]);
12033 return JIM_OK;
12035 err:
12036 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12037 return JIM_ERR;
12041 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12042 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12043 Jim_Obj *stringObj, int nocase)
12045 Jim_Obj *parms[4];
12046 int argc = 0;
12047 long eq;
12048 int rc;
12050 parms[argc++] = commandObj;
12051 if (nocase) {
12052 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12054 parms[argc++] = patternObj;
12055 parms[argc++] = stringObj;
12057 rc = Jim_EvalObjVector(interp, argc, parms);
12059 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12060 eq = -rc;
12063 return eq;
12066 /* [switch] */
12067 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12069 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12070 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12071 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12072 Jim_Obj **caseList;
12074 if (argc < 3) {
12075 wrongnumargs:
12076 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12077 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12078 return JIM_ERR;
12080 for (opt = 1; opt < argc; ++opt) {
12081 const char *option = Jim_String(argv[opt]);
12083 if (*option != '-')
12084 break;
12085 else if (strncmp(option, "--", 2) == 0) {
12086 ++opt;
12087 break;
12089 else if (strncmp(option, "-exact", 2) == 0)
12090 matchOpt = SWITCH_EXACT;
12091 else if (strncmp(option, "-glob", 2) == 0)
12092 matchOpt = SWITCH_GLOB;
12093 else if (strncmp(option, "-regexp", 2) == 0)
12094 matchOpt = SWITCH_RE;
12095 else if (strncmp(option, "-command", 2) == 0) {
12096 matchOpt = SWITCH_CMD;
12097 if ((argc - opt) < 2)
12098 goto wrongnumargs;
12099 command = argv[++opt];
12101 else {
12102 Jim_SetResultFormatted(interp,
12103 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12104 argv[opt]);
12105 return JIM_ERR;
12107 if ((argc - opt) < 2)
12108 goto wrongnumargs;
12110 strObj = argv[opt++];
12111 patCount = argc - opt;
12112 if (patCount == 1) {
12113 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12115 else
12116 caseList = (Jim_Obj **)&argv[opt];
12117 if (patCount == 0 || patCount % 2 != 0)
12118 goto wrongnumargs;
12119 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12120 Jim_Obj *patObj = caseList[i];
12122 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12123 || i < (patCount - 2)) {
12124 switch (matchOpt) {
12125 case SWITCH_EXACT:
12126 if (Jim_StringEqObj(strObj, patObj))
12127 scriptObj = caseList[i + 1];
12128 break;
12129 case SWITCH_GLOB:
12130 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12131 scriptObj = caseList[i + 1];
12132 break;
12133 case SWITCH_RE:
12134 command = Jim_NewStringObj(interp, "regexp", -1);
12135 /* Fall thru intentionally */
12136 case SWITCH_CMD:{
12137 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12139 /* After the execution of a command we need to
12140 * make sure to reconvert the object into a list
12141 * again. Only for the single-list style [switch]. */
12142 if (argc - opt == 1) {
12143 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12145 /* command is here already decref'd */
12146 if (rc < 0) {
12147 return -rc;
12149 if (rc)
12150 scriptObj = caseList[i + 1];
12151 break;
12155 else {
12156 scriptObj = caseList[i + 1];
12159 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12160 scriptObj = caseList[i + 1];
12161 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12162 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12163 return JIM_ERR;
12165 Jim_SetEmptyResult(interp);
12166 if (scriptObj) {
12167 return Jim_EvalObj(interp, scriptObj);
12169 return JIM_OK;
12172 /* [list] */
12173 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12175 Jim_Obj *listObjPtr;
12177 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12178 Jim_SetResult(interp, listObjPtr);
12179 return JIM_OK;
12182 /* [lindex] */
12183 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12185 Jim_Obj *objPtr, *listObjPtr;
12186 int i;
12187 int idx;
12189 if (argc < 2) {
12190 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12191 return JIM_ERR;
12193 objPtr = argv[1];
12194 Jim_IncrRefCount(objPtr);
12195 for (i = 2; i < argc; i++) {
12196 listObjPtr = objPtr;
12197 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12198 Jim_DecrRefCount(interp, listObjPtr);
12199 return JIM_ERR;
12201 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12202 /* Returns an empty object if the index
12203 * is out of range. */
12204 Jim_DecrRefCount(interp, listObjPtr);
12205 Jim_SetEmptyResult(interp);
12206 return JIM_OK;
12208 Jim_IncrRefCount(objPtr);
12209 Jim_DecrRefCount(interp, listObjPtr);
12211 Jim_SetResult(interp, objPtr);
12212 Jim_DecrRefCount(interp, objPtr);
12213 return JIM_OK;
12216 /* [llength] */
12217 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12219 if (argc != 2) {
12220 Jim_WrongNumArgs(interp, 1, argv, "list");
12221 return JIM_ERR;
12223 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12224 return JIM_OK;
12227 /* [lsearch] */
12228 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12230 static const char * const options[] = {
12231 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12232 NULL
12234 enum
12235 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12236 OPT_COMMAND };
12237 int i;
12238 int opt_bool = 0;
12239 int opt_not = 0;
12240 int opt_nocase = 0;
12241 int opt_all = 0;
12242 int opt_inline = 0;
12243 int opt_match = OPT_EXACT;
12244 int listlen;
12245 int rc = JIM_OK;
12246 Jim_Obj *listObjPtr = NULL;
12247 Jim_Obj *commandObj = NULL;
12249 if (argc < 3) {
12250 wrongargs:
12251 Jim_WrongNumArgs(interp, 1, argv,
12252 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12253 return JIM_ERR;
12256 for (i = 1; i < argc - 2; i++) {
12257 int option;
12259 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12260 return JIM_ERR;
12262 switch (option) {
12263 case OPT_BOOL:
12264 opt_bool = 1;
12265 opt_inline = 0;
12266 break;
12267 case OPT_NOT:
12268 opt_not = 1;
12269 break;
12270 case OPT_NOCASE:
12271 opt_nocase = 1;
12272 break;
12273 case OPT_INLINE:
12274 opt_inline = 1;
12275 opt_bool = 0;
12276 break;
12277 case OPT_ALL:
12278 opt_all = 1;
12279 break;
12280 case OPT_COMMAND:
12281 if (i >= argc - 2) {
12282 goto wrongargs;
12284 commandObj = argv[++i];
12285 /* fallthru */
12286 case OPT_EXACT:
12287 case OPT_GLOB:
12288 case OPT_REGEXP:
12289 opt_match = option;
12290 break;
12294 argv += i;
12296 if (opt_all) {
12297 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12299 if (opt_match == OPT_REGEXP) {
12300 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12302 if (commandObj) {
12303 Jim_IncrRefCount(commandObj);
12306 listlen = Jim_ListLength(interp, argv[0]);
12307 for (i = 0; i < listlen; i++) {
12308 int eq = 0;
12309 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12311 switch (opt_match) {
12312 case OPT_EXACT:
12313 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12314 break;
12316 case OPT_GLOB:
12317 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12318 break;
12320 case OPT_REGEXP:
12321 case OPT_COMMAND:
12322 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12323 if (eq < 0) {
12324 if (listObjPtr) {
12325 Jim_FreeNewObj(interp, listObjPtr);
12327 rc = JIM_ERR;
12328 goto done;
12330 break;
12333 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12334 if (!eq && opt_bool && opt_not && !opt_all) {
12335 continue;
12338 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12339 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12340 Jim_Obj *resultObj;
12342 if (opt_bool) {
12343 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12345 else if (!opt_inline) {
12346 resultObj = Jim_NewIntObj(interp, i);
12348 else {
12349 resultObj = objPtr;
12352 if (opt_all) {
12353 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12355 else {
12356 Jim_SetResult(interp, resultObj);
12357 goto done;
12362 if (opt_all) {
12363 Jim_SetResult(interp, listObjPtr);
12365 else {
12366 /* No match */
12367 if (opt_bool) {
12368 Jim_SetResultBool(interp, opt_not);
12370 else if (!opt_inline) {
12371 Jim_SetResultInt(interp, -1);
12375 done:
12376 if (commandObj) {
12377 Jim_DecrRefCount(interp, commandObj);
12379 return rc;
12382 /* [lappend] */
12383 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12385 Jim_Obj *listObjPtr;
12386 int new_obj = 0;
12387 int i;
12389 if (argc < 2) {
12390 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12391 return JIM_ERR;
12393 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12394 if (!listObjPtr) {
12395 /* Create the list if it does not exist */
12396 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12397 new_obj = 1;
12399 else if (Jim_IsShared(listObjPtr)) {
12400 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12401 new_obj = 1;
12403 for (i = 2; i < argc; i++)
12404 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12405 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12406 if (new_obj)
12407 Jim_FreeNewObj(interp, listObjPtr);
12408 return JIM_ERR;
12410 Jim_SetResult(interp, listObjPtr);
12411 return JIM_OK;
12414 /* [linsert] */
12415 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12417 int idx, len;
12418 Jim_Obj *listPtr;
12420 if (argc < 3) {
12421 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12422 return JIM_ERR;
12424 listPtr = argv[1];
12425 if (Jim_IsShared(listPtr))
12426 listPtr = Jim_DuplicateObj(interp, listPtr);
12427 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12428 goto err;
12429 len = Jim_ListLength(interp, listPtr);
12430 if (idx >= len)
12431 idx = len;
12432 else if (idx < 0)
12433 idx = len + idx + 1;
12434 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12435 Jim_SetResult(interp, listPtr);
12436 return JIM_OK;
12437 err:
12438 if (listPtr != argv[1]) {
12439 Jim_FreeNewObj(interp, listPtr);
12441 return JIM_ERR;
12444 /* [lreplace] */
12445 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12447 int first, last, len, rangeLen;
12448 Jim_Obj *listObj;
12449 Jim_Obj *newListObj;
12451 if (argc < 4) {
12452 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12453 return JIM_ERR;
12455 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12456 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12457 return JIM_ERR;
12460 listObj = argv[1];
12461 len = Jim_ListLength(interp, listObj);
12463 first = JimRelToAbsIndex(len, first);
12464 last = JimRelToAbsIndex(len, last);
12465 JimRelToAbsRange(len, &first, &last, &rangeLen);
12467 /* Now construct a new list which consists of:
12468 * <elements before first> <supplied elements> <elements after last>
12471 /* Trying to replace past the end of the list means end of list
12472 * See TIP #505
12474 if (first > len) {
12475 first = len;
12478 /* Add the first set of elements */
12479 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12481 /* Add supplied elements */
12482 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12484 /* Add the remaining elements */
12485 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12487 Jim_SetResult(interp, newListObj);
12488 return JIM_OK;
12491 /* [lset] */
12492 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12494 if (argc < 3) {
12495 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12496 return JIM_ERR;
12498 else if (argc == 3) {
12499 /* With no indexes, simply implements [set] */
12500 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12501 return JIM_ERR;
12502 Jim_SetResult(interp, argv[2]);
12503 return JIM_OK;
12505 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12508 /* [lsort] */
12509 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12511 static const char * const options[] = {
12512 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12514 enum
12515 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12516 Jim_Obj *resObj;
12517 int i;
12518 int retCode;
12519 int shared;
12521 struct lsort_info info;
12523 if (argc < 2) {
12524 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12525 return JIM_ERR;
12528 info.type = JIM_LSORT_ASCII;
12529 info.order = 1;
12530 info.indexed = 0;
12531 info.unique = 0;
12532 info.command = NULL;
12533 info.interp = interp;
12535 for (i = 1; i < (argc - 1); i++) {
12536 int option;
12538 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12539 != JIM_OK)
12540 return JIM_ERR;
12541 switch (option) {
12542 case OPT_ASCII:
12543 info.type = JIM_LSORT_ASCII;
12544 break;
12545 case OPT_NOCASE:
12546 info.type = JIM_LSORT_NOCASE;
12547 break;
12548 case OPT_INTEGER:
12549 info.type = JIM_LSORT_INTEGER;
12550 break;
12551 case OPT_REAL:
12552 info.type = JIM_LSORT_REAL;
12553 break;
12554 case OPT_INCREASING:
12555 info.order = 1;
12556 break;
12557 case OPT_DECREASING:
12558 info.order = -1;
12559 break;
12560 case OPT_UNIQUE:
12561 info.unique = 1;
12562 break;
12563 case OPT_COMMAND:
12564 if (i >= (argc - 2)) {
12565 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12566 return JIM_ERR;
12568 info.type = JIM_LSORT_COMMAND;
12569 info.command = argv[i + 1];
12570 i++;
12571 break;
12572 case OPT_INDEX:
12573 if (i >= (argc - 2)) {
12574 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12575 return JIM_ERR;
12577 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12578 return JIM_ERR;
12580 info.indexed = 1;
12581 i++;
12582 break;
12585 resObj = argv[argc - 1];
12586 if ((shared = Jim_IsShared(resObj)))
12587 resObj = Jim_DuplicateObj(interp, resObj);
12588 retCode = ListSortElements(interp, resObj, &info);
12589 if (retCode == JIM_OK) {
12590 Jim_SetResult(interp, resObj);
12592 else if (shared) {
12593 Jim_FreeNewObj(interp, resObj);
12595 return retCode;
12598 /* [append] */
12599 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12601 Jim_Obj *stringObjPtr;
12602 int i;
12604 if (argc < 2) {
12605 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12606 return JIM_ERR;
12608 if (argc == 2) {
12609 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12610 if (!stringObjPtr)
12611 return JIM_ERR;
12613 else {
12614 int new_obj = 0;
12615 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12616 if (!stringObjPtr) {
12617 /* Create the string if it doesn't exist */
12618 stringObjPtr = Jim_NewEmptyStringObj(interp);
12619 new_obj = 1;
12621 else if (Jim_IsShared(stringObjPtr)) {
12622 new_obj = 1;
12623 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12625 for (i = 2; i < argc; i++) {
12626 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12628 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12629 if (new_obj) {
12630 Jim_FreeNewObj(interp, stringObjPtr);
12632 return JIM_ERR;
12635 Jim_SetResult(interp, stringObjPtr);
12636 return JIM_OK;
12639 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12641 * Returns a zero-refcount list describing the expression at 'node'
12643 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12645 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12647 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12648 if (TOKEN_IS_EXPR_OP(node->type)) {
12649 if (node->left) {
12650 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12652 if (node->right) {
12653 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12655 if (node->ternary) {
12656 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12659 else {
12660 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12662 return listObjPtr;
12664 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12666 /* [debug] */
12667 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12669 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12670 static const char * const options[] = {
12671 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12672 "exprbc", "show",
12673 NULL
12675 enum
12677 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12678 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12680 int option;
12682 if (argc < 2) {
12683 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12684 return JIM_ERR;
12686 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12687 return Jim_CheckShowCommands(interp, argv[1], options);
12688 if (option == OPT_REFCOUNT) {
12689 if (argc != 3) {
12690 Jim_WrongNumArgs(interp, 2, argv, "object");
12691 return JIM_ERR;
12693 Jim_SetResultInt(interp, argv[2]->refCount);
12694 return JIM_OK;
12696 else if (option == OPT_OBJCOUNT) {
12697 int freeobj = 0, liveobj = 0;
12698 char buf[256];
12699 Jim_Obj *objPtr;
12701 if (argc != 2) {
12702 Jim_WrongNumArgs(interp, 2, argv, "");
12703 return JIM_ERR;
12705 /* Count the number of free objects. */
12706 objPtr = interp->freeList;
12707 while (objPtr) {
12708 freeobj++;
12709 objPtr = objPtr->nextObjPtr;
12711 /* Count the number of live objects. */
12712 objPtr = interp->liveList;
12713 while (objPtr) {
12714 liveobj++;
12715 objPtr = objPtr->nextObjPtr;
12717 /* Set the result string and return. */
12718 sprintf(buf, "free %d used %d", freeobj, liveobj);
12719 Jim_SetResultString(interp, buf, -1);
12720 return JIM_OK;
12722 else if (option == OPT_OBJECTS) {
12723 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12725 /* Count the number of live objects. */
12726 objPtr = interp->liveList;
12727 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12728 while (objPtr) {
12729 char buf[128];
12730 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12732 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12733 sprintf(buf, "%p", objPtr);
12734 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12735 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12736 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12737 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12738 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12739 objPtr = objPtr->nextObjPtr;
12741 Jim_SetResult(interp, listObjPtr);
12742 return JIM_OK;
12744 else if (option == OPT_INVSTR) {
12745 Jim_Obj *objPtr;
12747 if (argc != 3) {
12748 Jim_WrongNumArgs(interp, 2, argv, "object");
12749 return JIM_ERR;
12751 objPtr = argv[2];
12752 if (objPtr->typePtr != NULL)
12753 Jim_InvalidateStringRep(objPtr);
12754 Jim_SetEmptyResult(interp);
12755 return JIM_OK;
12757 else if (option == OPT_SHOW) {
12758 const char *s;
12759 int len, charlen;
12761 if (argc != 3) {
12762 Jim_WrongNumArgs(interp, 2, argv, "object");
12763 return JIM_ERR;
12765 s = Jim_GetString(argv[2], &len);
12766 #ifdef JIM_UTF8
12767 charlen = utf8_strlen(s, len);
12768 #else
12769 charlen = len;
12770 #endif
12771 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12772 printf("chars (%d): <<%s>>\n", charlen, s);
12773 printf("bytes (%d):", len);
12774 while (len--) {
12775 printf(" %02x", (unsigned char)*s++);
12777 printf("\n");
12778 return JIM_OK;
12780 else if (option == OPT_SCRIPTLEN) {
12781 ScriptObj *script;
12783 if (argc != 3) {
12784 Jim_WrongNumArgs(interp, 2, argv, "script");
12785 return JIM_ERR;
12787 script = JimGetScript(interp, argv[2]);
12788 if (script == NULL)
12789 return JIM_ERR;
12790 Jim_SetResultInt(interp, script->len);
12791 return JIM_OK;
12793 else if (option == OPT_EXPRLEN) {
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_SetResultInt(interp, expr->len);
12804 return JIM_OK;
12806 else if (option == OPT_EXPRBC) {
12807 struct ExprTree *expr;
12809 if (argc != 3) {
12810 Jim_WrongNumArgs(interp, 2, argv, "expression");
12811 return JIM_ERR;
12813 expr = JimGetExpression(interp, argv[2]);
12814 if (expr == NULL)
12815 return JIM_ERR;
12816 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12817 return JIM_OK;
12819 else {
12820 Jim_SetResultString(interp,
12821 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12822 return JIM_ERR;
12824 /* unreached */
12825 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12826 #if !defined(JIM_DEBUG_COMMAND)
12827 Jim_SetResultString(interp, "unsupported", -1);
12828 return JIM_ERR;
12829 #endif
12832 /* [eval] */
12833 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12835 int rc;
12837 if (argc < 2) {
12838 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12839 return JIM_ERR;
12842 if (argc == 2) {
12843 rc = Jim_EvalObj(interp, argv[1]);
12845 else {
12846 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12849 if (rc == JIM_ERR) {
12850 /* eval is "interesting", so add a stack frame here */
12851 interp->addStackTrace++;
12853 return rc;
12856 /* [uplevel] */
12857 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12859 if (argc >= 2) {
12860 int retcode;
12861 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12862 const char *str;
12864 /* Save the old callframe pointer */
12865 savedCallFrame = interp->framePtr;
12867 /* Lookup the target frame pointer */
12868 str = Jim_String(argv[1]);
12869 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12870 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12871 argc--;
12872 argv++;
12874 else {
12875 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12877 if (targetCallFrame == NULL) {
12878 return JIM_ERR;
12880 if (argc < 2) {
12881 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12882 return JIM_ERR;
12884 /* Eval the code in the target callframe. */
12885 interp->framePtr = targetCallFrame;
12886 if (argc == 2) {
12887 retcode = Jim_EvalObj(interp, argv[1]);
12889 else {
12890 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12892 interp->framePtr = savedCallFrame;
12893 return retcode;
12895 else {
12896 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12897 return JIM_ERR;
12901 /* [expr] */
12902 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12904 int retcode;
12906 if (argc == 2) {
12907 retcode = Jim_EvalExpression(interp, argv[1]);
12909 else if (argc > 2) {
12910 Jim_Obj *objPtr;
12912 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12913 Jim_IncrRefCount(objPtr);
12914 retcode = Jim_EvalExpression(interp, objPtr);
12915 Jim_DecrRefCount(interp, objPtr);
12917 else {
12918 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12919 return JIM_ERR;
12921 if (retcode != JIM_OK)
12922 return retcode;
12923 return JIM_OK;
12926 /* [break] */
12927 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12929 if (argc != 1) {
12930 Jim_WrongNumArgs(interp, 1, argv, "");
12931 return JIM_ERR;
12933 return JIM_BREAK;
12936 /* [continue] */
12937 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12939 if (argc != 1) {
12940 Jim_WrongNumArgs(interp, 1, argv, "");
12941 return JIM_ERR;
12943 return JIM_CONTINUE;
12946 /* [return] */
12947 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12949 int i;
12950 Jim_Obj *stackTraceObj = NULL;
12951 Jim_Obj *errorCodeObj = NULL;
12952 int returnCode = JIM_OK;
12953 long level = 1;
12955 for (i = 1; i < argc - 1; i += 2) {
12956 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12957 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12958 return JIM_ERR;
12961 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12962 stackTraceObj = argv[i + 1];
12964 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12965 errorCodeObj = argv[i + 1];
12967 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12968 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12969 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12970 return JIM_ERR;
12973 else {
12974 break;
12978 if (i != argc - 1 && i != argc) {
12979 Jim_WrongNumArgs(interp, 1, argv,
12980 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
12983 /* If a stack trace is supplied and code is error, set the stack trace */
12984 if (stackTraceObj && returnCode == JIM_ERR) {
12985 JimSetStackTrace(interp, stackTraceObj);
12987 /* If an error code list is supplied, set the global $errorCode */
12988 if (errorCodeObj && returnCode == JIM_ERR) {
12989 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
12991 interp->returnCode = returnCode;
12992 interp->returnLevel = level;
12994 if (i == argc - 1) {
12995 Jim_SetResult(interp, argv[i]);
12997 return level == 0 ? returnCode : JIM_RETURN;
13000 /* [tailcall] */
13001 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13003 if (interp->framePtr->level == 0) {
13004 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13005 return JIM_ERR;
13007 else if (argc >= 2) {
13008 /* Need to resolve the tailcall command in the current context */
13009 Jim_CallFrame *cf = interp->framePtr->parent;
13011 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13012 if (cmdPtr == NULL) {
13013 return JIM_ERR;
13016 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13018 /* And stash this pre-resolved command */
13019 JimIncrCmdRefCount(cmdPtr);
13020 cf->tailcallCmd = cmdPtr;
13022 /* And stash the command list */
13023 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13025 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13026 Jim_IncrRefCount(cf->tailcallObj);
13028 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13029 return JIM_EVAL;
13031 return JIM_OK;
13034 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13036 Jim_Obj *cmdList;
13037 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13039 /* prefixListObj is a list to which the args need to be appended */
13040 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13041 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13043 return JimEvalObjList(interp, cmdList);
13046 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13048 Jim_Obj *prefixListObj = privData;
13049 Jim_DecrRefCount(interp, prefixListObj);
13052 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13054 Jim_Obj *prefixListObj;
13055 const char *newname;
13057 if (argc < 3) {
13058 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13059 return JIM_ERR;
13062 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13063 Jim_IncrRefCount(prefixListObj);
13064 newname = Jim_String(argv[1]);
13065 if (newname[0] == ':' && newname[1] == ':') {
13066 while (*++newname == ':') {
13070 Jim_SetResult(interp, argv[1]);
13072 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13075 /* [proc] */
13076 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13078 Jim_Cmd *cmd;
13080 if (argc != 4 && argc != 5) {
13081 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13082 return JIM_ERR;
13085 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13086 return JIM_ERR;
13089 if (argc == 4) {
13090 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13092 else {
13093 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13096 if (cmd) {
13097 /* Add the new command */
13098 Jim_Obj *qualifiedCmdNameObj;
13099 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13101 JimCreateCommand(interp, cmdname, cmd);
13103 /* Calculate and set the namespace for this proc */
13104 JimUpdateProcNamespace(interp, cmd, cmdname);
13106 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13108 /* Unlike Tcl, set the name of the proc as the result */
13109 Jim_SetResult(interp, argv[1]);
13110 return JIM_OK;
13112 return JIM_ERR;
13115 /* [local] */
13116 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13118 int retcode;
13120 if (argc < 2) {
13121 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13122 return JIM_ERR;
13125 /* Evaluate the arguments with 'local' in force */
13126 interp->local++;
13127 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13128 interp->local--;
13131 /* If OK, and the result is a proc, add it to the list of local procs */
13132 if (retcode == 0) {
13133 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13135 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13136 return JIM_ERR;
13138 if (interp->framePtr->localCommands == NULL) {
13139 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13140 Jim_InitStack(interp->framePtr->localCommands);
13142 Jim_IncrRefCount(cmdNameObj);
13143 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13146 return retcode;
13149 /* [upcall] */
13150 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13152 if (argc < 2) {
13153 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13154 return JIM_ERR;
13156 else {
13157 int retcode;
13159 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13160 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13161 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13162 return JIM_ERR;
13164 /* OK. Mark this command as being in an upcall */
13165 cmdPtr->u.proc.upcall++;
13166 JimIncrCmdRefCount(cmdPtr);
13168 /* Invoke the command as normal */
13169 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13171 /* No longer in an upcall */
13172 cmdPtr->u.proc.upcall--;
13173 JimDecrCmdRefCount(interp, cmdPtr);
13175 return retcode;
13179 /* [apply] */
13180 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13182 if (argc < 2) {
13183 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13184 return JIM_ERR;
13186 else {
13187 int ret;
13188 Jim_Cmd *cmd;
13189 Jim_Obj *argListObjPtr;
13190 Jim_Obj *bodyObjPtr;
13191 Jim_Obj *nsObj = NULL;
13192 Jim_Obj **nargv;
13194 int len = Jim_ListLength(interp, argv[1]);
13195 if (len != 2 && len != 3) {
13196 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13197 return JIM_ERR;
13200 if (len == 3) {
13201 #ifdef jim_ext_namespace
13202 /* Need to canonicalise the given namespace. */
13203 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13204 #else
13205 Jim_SetResultString(interp, "namespaces not enabled", -1);
13206 return JIM_ERR;
13207 #endif
13209 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13210 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13212 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13214 if (cmd) {
13215 /* Create a new argv array with a dummy argv[0], for error messages */
13216 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13217 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13218 Jim_IncrRefCount(nargv[0]);
13219 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13220 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13221 Jim_DecrRefCount(interp, nargv[0]);
13222 Jim_Free(nargv);
13224 JimDecrCmdRefCount(interp, cmd);
13225 return ret;
13227 return JIM_ERR;
13232 /* [concat] */
13233 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13235 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13236 return JIM_OK;
13239 /* [upvar] */
13240 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13242 int i;
13243 Jim_CallFrame *targetCallFrame;
13245 /* Lookup the target frame pointer */
13246 if (argc > 3 && (argc % 2 == 0)) {
13247 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13248 argc--;
13249 argv++;
13251 else {
13252 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13254 if (targetCallFrame == NULL) {
13255 return JIM_ERR;
13258 /* Check for arity */
13259 if (argc < 3) {
13260 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13261 return JIM_ERR;
13264 /* Now... for every other/local couple: */
13265 for (i = 1; i < argc; i += 2) {
13266 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13267 return JIM_ERR;
13269 return JIM_OK;
13272 /* [global] */
13273 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13275 int i;
13277 if (argc < 2) {
13278 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13279 return JIM_ERR;
13281 /* Link every var to the toplevel having the same name */
13282 if (interp->framePtr->level == 0)
13283 return JIM_OK; /* global at toplevel... */
13284 for (i = 1; i < argc; i++) {
13285 /* global ::blah does nothing */
13286 const char *name = Jim_String(argv[i]);
13287 if (name[0] != ':' || name[1] != ':') {
13288 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13289 return JIM_ERR;
13292 return JIM_OK;
13295 /* does the [string map] operation. On error NULL is returned,
13296 * otherwise a new string object with the result, having refcount = 0,
13297 * is returned. */
13298 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13299 Jim_Obj *objPtr, int nocase)
13301 int numMaps;
13302 const char *str, *noMatchStart = NULL;
13303 int strLen, i;
13304 Jim_Obj *resultObjPtr;
13306 numMaps = Jim_ListLength(interp, mapListObjPtr);
13307 if (numMaps % 2) {
13308 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13309 return NULL;
13312 str = Jim_String(objPtr);
13313 strLen = Jim_Utf8Length(interp, objPtr);
13315 /* Map it */
13316 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13317 while (strLen) {
13318 for (i = 0; i < numMaps; i += 2) {
13319 Jim_Obj *eachObjPtr;
13320 const char *k;
13321 int kl;
13323 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13324 k = Jim_String(eachObjPtr);
13325 kl = Jim_Utf8Length(interp, eachObjPtr);
13327 if (strLen >= kl && kl) {
13328 int rc;
13329 rc = JimStringCompareUtf8(str, kl, k, kl, nocase);
13330 if (rc == 0) {
13331 if (noMatchStart) {
13332 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13333 noMatchStart = NULL;
13335 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13336 str += utf8_index(str, kl);
13337 strLen -= kl;
13338 break;
13342 if (i == numMaps) { /* no match */
13343 int c;
13344 if (noMatchStart == NULL)
13345 noMatchStart = str;
13346 str += utf8_tounicode(str, &c);
13347 strLen--;
13350 if (noMatchStart) {
13351 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13353 return resultObjPtr;
13356 /* [string] */
13357 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13359 int len;
13360 int opt_case = 1;
13361 int option;
13362 static const char * const options[] = {
13363 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13364 "map", "repeat", "reverse", "index", "first", "last", "cat",
13365 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13367 enum
13369 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13370 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13371 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13373 static const char * const nocase_options[] = {
13374 "-nocase", NULL
13376 static const char * const nocase_length_options[] = {
13377 "-nocase", "-length", NULL
13380 if (argc < 2) {
13381 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13382 return JIM_ERR;
13384 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13385 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13386 return Jim_CheckShowCommands(interp, argv[1], options);
13388 switch (option) {
13389 case OPT_LENGTH:
13390 case OPT_BYTELENGTH:
13391 if (argc != 3) {
13392 Jim_WrongNumArgs(interp, 2, argv, "string");
13393 return JIM_ERR;
13395 if (option == OPT_LENGTH) {
13396 len = Jim_Utf8Length(interp, argv[2]);
13398 else {
13399 len = Jim_Length(argv[2]);
13401 Jim_SetResultInt(interp, len);
13402 return JIM_OK;
13404 case OPT_CAT:{
13405 Jim_Obj *objPtr;
13406 if (argc == 3) {
13407 /* optimise the one-arg case */
13408 objPtr = argv[2];
13410 else {
13411 int i;
13413 objPtr = Jim_NewStringObj(interp, "", 0);
13415 for (i = 2; i < argc; i++) {
13416 Jim_AppendObj(interp, objPtr, argv[i]);
13419 Jim_SetResult(interp, objPtr);
13420 return JIM_OK;
13423 case OPT_COMPARE:
13424 case OPT_EQUAL:
13426 /* n is the number of remaining option args */
13427 long opt_length = -1;
13428 int n = argc - 4;
13429 int i = 2;
13430 while (n > 0) {
13431 int subopt;
13432 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13433 JIM_ENUM_ABBREV) != JIM_OK) {
13434 badcompareargs:
13435 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13436 return JIM_ERR;
13438 if (subopt == 0) {
13439 /* -nocase */
13440 opt_case = 0;
13441 n--;
13443 else {
13444 /* -length */
13445 if (n < 2) {
13446 goto badcompareargs;
13448 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13449 return JIM_ERR;
13451 n -= 2;
13454 if (n) {
13455 goto badcompareargs;
13457 argv += argc - 2;
13458 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13459 /* Fast version - [string equal], case sensitive, no length */
13460 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13462 else {
13463 const char *s1 = Jim_String(argv[0]);
13464 int l1 = Jim_Utf8Length(interp, argv[0]);
13465 const char *s2 = Jim_String(argv[1]);
13466 int l2 = Jim_Utf8Length(interp, argv[1]);
13467 if (opt_length >= 0) {
13468 if (l1 > opt_length) {
13469 l1 = opt_length;
13471 if (l2 > opt_length) {
13472 l2 = opt_length;
13475 n = JimStringCompareUtf8(s1, l1, s2, l2, !opt_case);
13476 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13478 return JIM_OK;
13481 case OPT_MATCH:
13482 if (argc != 4 &&
13483 (argc != 5 ||
13484 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13485 JIM_ENUM_ABBREV) != JIM_OK)) {
13486 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13487 return JIM_ERR;
13489 if (opt_case == 0) {
13490 argv++;
13492 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13493 return JIM_OK;
13495 case OPT_MAP:{
13496 Jim_Obj *objPtr;
13498 if (argc != 4 &&
13499 (argc != 5 ||
13500 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13501 JIM_ENUM_ABBREV) != JIM_OK)) {
13502 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13503 return JIM_ERR;
13506 if (opt_case == 0) {
13507 argv++;
13509 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13510 if (objPtr == NULL) {
13511 return JIM_ERR;
13513 Jim_SetResult(interp, objPtr);
13514 return JIM_OK;
13517 case OPT_RANGE:
13518 case OPT_BYTERANGE:{
13519 Jim_Obj *objPtr;
13521 if (argc != 5) {
13522 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13523 return JIM_ERR;
13525 if (option == OPT_RANGE) {
13526 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13528 else
13530 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13533 if (objPtr == NULL) {
13534 return JIM_ERR;
13536 Jim_SetResult(interp, objPtr);
13537 return JIM_OK;
13540 case OPT_REPLACE:{
13541 Jim_Obj *objPtr;
13543 if (argc != 5 && argc != 6) {
13544 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13545 return JIM_ERR;
13547 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13548 if (objPtr == NULL) {
13549 return JIM_ERR;
13551 Jim_SetResult(interp, objPtr);
13552 return JIM_OK;
13556 case OPT_REPEAT:{
13557 Jim_Obj *objPtr;
13558 jim_wide count;
13560 if (argc != 4) {
13561 Jim_WrongNumArgs(interp, 2, argv, "string count");
13562 return JIM_ERR;
13564 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13565 return JIM_ERR;
13567 objPtr = Jim_NewStringObj(interp, "", 0);
13568 if (count > 0) {
13569 while (count--) {
13570 Jim_AppendObj(interp, objPtr, argv[2]);
13573 Jim_SetResult(interp, objPtr);
13574 return JIM_OK;
13577 case OPT_REVERSE:{
13578 char *buf, *p;
13579 const char *str;
13580 int i;
13582 if (argc != 3) {
13583 Jim_WrongNumArgs(interp, 2, argv, "string");
13584 return JIM_ERR;
13587 str = Jim_GetString(argv[2], &len);
13588 buf = Jim_Alloc(len + 1);
13589 p = buf + len;
13590 *p = 0;
13591 for (i = 0; i < len; ) {
13592 int c;
13593 int l = utf8_tounicode(str, &c);
13594 memcpy(p - l, str, l);
13595 p -= l;
13596 i += l;
13597 str += l;
13599 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13600 return JIM_OK;
13603 case OPT_INDEX:{
13604 int idx;
13605 const char *str;
13607 if (argc != 4) {
13608 Jim_WrongNumArgs(interp, 2, argv, "string index");
13609 return JIM_ERR;
13611 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13612 return JIM_ERR;
13614 str = Jim_String(argv[2]);
13615 len = Jim_Utf8Length(interp, argv[2]);
13616 if (idx != INT_MIN && idx != INT_MAX) {
13617 idx = JimRelToAbsIndex(len, idx);
13619 if (idx < 0 || idx >= len || str == NULL) {
13620 Jim_SetResultString(interp, "", 0);
13622 else if (len == Jim_Length(argv[2])) {
13623 /* ASCII optimisation */
13624 Jim_SetResultString(interp, str + idx, 1);
13626 else {
13627 int c;
13628 int i = utf8_index(str, idx);
13629 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13631 return JIM_OK;
13634 case OPT_FIRST:
13635 case OPT_LAST:{
13636 int idx = 0, l1, l2;
13637 const char *s1, *s2;
13639 if (argc != 4 && argc != 5) {
13640 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13641 return JIM_ERR;
13643 s1 = Jim_String(argv[2]);
13644 s2 = Jim_String(argv[3]);
13645 l1 = Jim_Utf8Length(interp, argv[2]);
13646 l2 = Jim_Utf8Length(interp, argv[3]);
13647 if (argc == 5) {
13648 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13649 return JIM_ERR;
13651 idx = JimRelToAbsIndex(l2, idx);
13653 else if (option == OPT_LAST) {
13654 idx = l2;
13656 if (option == OPT_FIRST) {
13657 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13659 else {
13660 #ifdef JIM_UTF8
13661 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13662 #else
13663 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13664 #endif
13666 return JIM_OK;
13669 case OPT_TRIM:
13670 case OPT_TRIMLEFT:
13671 case OPT_TRIMRIGHT:{
13672 Jim_Obj *trimchars;
13674 if (argc != 3 && argc != 4) {
13675 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13676 return JIM_ERR;
13678 trimchars = (argc == 4 ? argv[3] : NULL);
13679 if (option == OPT_TRIM) {
13680 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13682 else if (option == OPT_TRIMLEFT) {
13683 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13685 else if (option == OPT_TRIMRIGHT) {
13686 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13688 return JIM_OK;
13691 case OPT_TOLOWER:
13692 case OPT_TOUPPER:
13693 case OPT_TOTITLE:
13694 if (argc != 3) {
13695 Jim_WrongNumArgs(interp, 2, argv, "string");
13696 return JIM_ERR;
13698 if (option == OPT_TOLOWER) {
13699 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13701 else if (option == OPT_TOUPPER) {
13702 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13704 else {
13705 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13707 return JIM_OK;
13709 case OPT_IS:
13710 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13711 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13713 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13714 return JIM_ERR;
13716 return JIM_OK;
13719 /* [time] */
13720 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13722 long i, count = 1;
13723 jim_wide start, elapsed;
13724 char buf[60];
13725 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13727 if (argc < 2) {
13728 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13729 return JIM_ERR;
13731 if (argc == 3) {
13732 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13733 return JIM_ERR;
13735 if (count < 0)
13736 return JIM_OK;
13737 i = count;
13738 start = JimClock();
13739 while (i-- > 0) {
13740 int retval;
13742 retval = Jim_EvalObj(interp, argv[1]);
13743 if (retval != JIM_OK) {
13744 return retval;
13747 elapsed = JimClock() - start;
13748 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13749 Jim_SetResultString(interp, buf, -1);
13750 return JIM_OK;
13753 /* [exit] */
13754 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13756 long exitCode = 0;
13758 if (argc > 2) {
13759 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13760 return JIM_ERR;
13762 if (argc == 2) {
13763 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13764 return JIM_ERR;
13766 interp->exitCode = exitCode;
13767 return JIM_EXIT;
13770 /* [catch] */
13771 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13773 int exitCode = 0;
13774 int i;
13775 int sig = 0;
13777 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13778 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13779 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13781 /* Reset the error code before catch.
13782 * Note that this is not strictly correct.
13784 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13786 for (i = 1; i < argc - 1; i++) {
13787 const char *arg = Jim_String(argv[i]);
13788 jim_wide option;
13789 int ignore;
13791 /* It's a pity we can't use Jim_GetEnum here :-( */
13792 if (strcmp(arg, "--") == 0) {
13793 i++;
13794 break;
13796 if (*arg != '-') {
13797 break;
13800 if (strncmp(arg, "-no", 3) == 0) {
13801 arg += 3;
13802 ignore = 1;
13804 else {
13805 arg++;
13806 ignore = 0;
13809 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13810 option = -1;
13812 if (option < 0) {
13813 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13815 if (option < 0) {
13816 goto wrongargs;
13819 if (ignore) {
13820 ignore_mask |= ((jim_wide)1 << option);
13822 else {
13823 ignore_mask &= (~((jim_wide)1 << option));
13827 argc -= i;
13828 if (argc < 1 || argc > 3) {
13829 wrongargs:
13830 Jim_WrongNumArgs(interp, 1, argv,
13831 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13832 return JIM_ERR;
13834 argv += i;
13836 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13837 sig++;
13840 interp->signal_level += sig;
13841 if (Jim_CheckSignal(interp)) {
13842 /* If a signal is set, don't even try to execute the body */
13843 exitCode = JIM_SIGNAL;
13845 else {
13846 exitCode = Jim_EvalObj(interp, argv[0]);
13847 /* Don't want any caught error included in a later stack trace */
13848 interp->errorFlag = 0;
13850 interp->signal_level -= sig;
13852 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13853 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13854 /* Not caught, pass it up */
13855 return exitCode;
13858 if (sig && exitCode == JIM_SIGNAL) {
13859 /* Catch the signal at this level */
13860 if (interp->signal_set_result) {
13861 interp->signal_set_result(interp, interp->sigmask);
13863 else {
13864 Jim_SetResultInt(interp, interp->sigmask);
13866 interp->sigmask = 0;
13869 if (argc >= 2) {
13870 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13871 return JIM_ERR;
13873 if (argc == 3) {
13874 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13876 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13877 Jim_ListAppendElement(interp, optListObj,
13878 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13879 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13880 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13881 if (exitCode == JIM_ERR) {
13882 Jim_Obj *errorCode;
13883 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13884 -1));
13885 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13887 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13888 if (errorCode) {
13889 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13890 Jim_ListAppendElement(interp, optListObj, errorCode);
13893 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13894 return JIM_ERR;
13898 Jim_SetResultInt(interp, exitCode);
13899 return JIM_OK;
13902 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13904 /* [ref] */
13905 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13907 if (argc != 3 && argc != 4) {
13908 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13909 return JIM_ERR;
13911 if (argc == 3) {
13912 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13914 else {
13915 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13917 return JIM_OK;
13920 /* [getref] */
13921 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13923 Jim_Reference *refPtr;
13925 if (argc != 2) {
13926 Jim_WrongNumArgs(interp, 1, argv, "reference");
13927 return JIM_ERR;
13929 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13930 return JIM_ERR;
13931 Jim_SetResult(interp, refPtr->objPtr);
13932 return JIM_OK;
13935 /* [setref] */
13936 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13938 Jim_Reference *refPtr;
13940 if (argc != 3) {
13941 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13942 return JIM_ERR;
13944 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13945 return JIM_ERR;
13946 Jim_IncrRefCount(argv[2]);
13947 Jim_DecrRefCount(interp, refPtr->objPtr);
13948 refPtr->objPtr = argv[2];
13949 Jim_SetResult(interp, argv[2]);
13950 return JIM_OK;
13953 /* [collect] */
13954 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13956 if (argc != 1) {
13957 Jim_WrongNumArgs(interp, 1, argv, "");
13958 return JIM_ERR;
13960 Jim_SetResultInt(interp, Jim_Collect(interp));
13962 /* Free all the freed objects. */
13963 while (interp->freeList) {
13964 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13965 Jim_Free(interp->freeList);
13966 interp->freeList = nextObjPtr;
13969 return JIM_OK;
13972 /* [finalize] reference ?newValue? */
13973 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13975 if (argc != 2 && argc != 3) {
13976 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13977 return JIM_ERR;
13979 if (argc == 2) {
13980 Jim_Obj *cmdNamePtr;
13982 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13983 return JIM_ERR;
13984 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13985 Jim_SetResult(interp, cmdNamePtr);
13987 else {
13988 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
13989 return JIM_ERR;
13990 Jim_SetResult(interp, argv[2]);
13992 return JIM_OK;
13995 /* [info references] */
13996 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13998 Jim_Obj *listObjPtr;
13999 Jim_HashTableIterator htiter;
14000 Jim_HashEntry *he;
14002 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14004 JimInitHashTableIterator(&interp->references, &htiter);
14005 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14006 char buf[JIM_REFERENCE_SPACE + 1];
14007 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14008 const unsigned long *refId = he->key;
14010 JimFormatReference(buf, refPtr, *refId);
14011 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14013 Jim_SetResult(interp, listObjPtr);
14014 return JIM_OK;
14016 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14018 /* [rename] */
14019 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14021 if (argc != 3) {
14022 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14023 return JIM_ERR;
14026 if (JimValidName(interp, "new procedure", argv[2])) {
14027 return JIM_ERR;
14030 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14033 #define JIM_DICTMATCH_KEYS 0x0001
14034 #define JIM_DICTMATCH_VALUES 0x002
14037 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14038 * return_types should be either or both
14040 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14042 Jim_HashEntry *he;
14043 Jim_Obj *listObjPtr;
14044 Jim_HashTableIterator htiter;
14046 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14047 return JIM_ERR;
14050 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14052 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14053 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14054 if (patternObj) {
14055 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14056 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14057 /* no match */
14058 continue;
14061 if (return_types & JIM_DICTMATCH_KEYS) {
14062 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14064 if (return_types & JIM_DICTMATCH_VALUES) {
14065 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14069 Jim_SetResult(interp, listObjPtr);
14070 return JIM_OK;
14073 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14075 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14076 return -1;
14078 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14082 * Must be called with at least one object.
14083 * Returns the new dictionary, or NULL on error.
14085 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14087 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14088 int i;
14090 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14092 /* Note that we don't optimise the trivial case of a single argument */
14094 for (i = 0; i < objc; i++) {
14095 Jim_HashTable *ht;
14096 Jim_HashTableIterator htiter;
14097 Jim_HashEntry *he;
14099 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14100 Jim_FreeNewObj(interp, objPtr);
14101 return NULL;
14103 ht = objv[i]->internalRep.ptr;
14104 JimInitHashTableIterator(ht, &htiter);
14105 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14106 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14109 return objPtr;
14112 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14114 Jim_HashTable *ht;
14115 unsigned int i;
14116 char buffer[100];
14117 int sum = 0;
14118 int nonzero_count = 0;
14119 Jim_Obj *output;
14120 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14122 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14123 return JIM_ERR;
14126 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14128 /* Note that this uses internal knowledge of the hash table */
14129 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14130 output = Jim_NewStringObj(interp, buffer, -1);
14132 for (i = 0; i < ht->size; i++) {
14133 Jim_HashEntry *he = ht->table[i];
14134 int entries = 0;
14135 while (he) {
14136 entries++;
14137 he = he->next;
14139 if (entries > 9) {
14140 bucket_counts[10]++;
14142 else {
14143 bucket_counts[entries]++;
14145 if (entries) {
14146 sum += entries;
14147 nonzero_count++;
14150 for (i = 0; i < 10; i++) {
14151 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14152 Jim_AppendString(interp, output, buffer, -1);
14154 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14155 Jim_AppendString(interp, output, buffer, -1);
14156 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14157 Jim_AppendString(interp, output, buffer, -1);
14158 Jim_SetResult(interp, output);
14159 return JIM_OK;
14162 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14164 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14166 Jim_AppendString(interp, prefixObj, " ", 1);
14167 Jim_AppendString(interp, prefixObj, subcmd, -1);
14169 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14173 * Implements the [dict with] command
14175 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14177 int i;
14178 Jim_Obj *objPtr;
14179 Jim_Obj *dictObj;
14180 Jim_Obj **dictValues;
14181 int len;
14182 int ret = JIM_OK;
14184 /* Open up the appropriate level of the dictionary */
14185 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14186 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14187 return JIM_ERR;
14189 /* Set the local variables */
14190 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14191 return JIM_ERR;
14193 for (i = 0; i < len; i += 2) {
14194 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14195 Jim_Free(dictValues);
14196 return JIM_ERR;
14200 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14201 if (Jim_Length(scriptObj)) {
14202 ret = Jim_EvalObj(interp, scriptObj);
14204 /* Now if the dictionary still exists, update it based on the local variables */
14205 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14206 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14207 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14208 for (i = 0; i < keyc; i++) {
14209 newkeyv[i] = keyv[i];
14212 for (i = 0; i < len; i += 2) {
14213 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14214 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14215 newkeyv[keyc] = dictValues[i];
14216 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14218 Jim_Free(newkeyv);
14222 Jim_Free(dictValues);
14224 return ret;
14227 /* [dict] */
14228 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14230 Jim_Obj *objPtr;
14231 int types = JIM_DICTMATCH_KEYS;
14232 int option;
14233 static const char * const options[] = {
14234 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14235 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14236 "replace", "update", NULL
14238 enum
14240 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14241 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14242 OPT_REPLACE, OPT_UPDATE,
14245 if (argc < 2) {
14246 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14247 return JIM_ERR;
14250 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14251 return Jim_CheckShowCommands(interp, argv[1], options);
14254 switch (option) {
14255 case OPT_GET:
14256 if (argc < 3) {
14257 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14258 return JIM_ERR;
14260 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14261 JIM_ERRMSG) != JIM_OK) {
14262 return JIM_ERR;
14264 Jim_SetResult(interp, objPtr);
14265 return JIM_OK;
14267 case OPT_SET:
14268 if (argc < 5) {
14269 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14270 return JIM_ERR;
14272 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14274 case OPT_EXISTS:
14275 if (argc < 4) {
14276 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14277 return JIM_ERR;
14279 else {
14280 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14281 if (rc < 0) {
14282 return JIM_ERR;
14284 Jim_SetResultBool(interp, rc == JIM_OK);
14285 return JIM_OK;
14288 case OPT_UNSET:
14289 if (argc < 4) {
14290 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14291 return JIM_ERR;
14293 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14294 return JIM_ERR;
14296 return JIM_OK;
14298 case OPT_VALUES:
14299 types = JIM_DICTMATCH_VALUES;
14300 /* fallthru */
14301 case OPT_KEYS:
14302 if (argc != 3 && argc != 4) {
14303 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14304 return JIM_ERR;
14306 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14308 case OPT_SIZE:
14309 if (argc != 3) {
14310 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14311 return JIM_ERR;
14313 else if (Jim_DictSize(interp, argv[2]) < 0) {
14314 return JIM_ERR;
14316 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14317 return JIM_OK;
14319 case OPT_MERGE:
14320 if (argc == 2) {
14321 return JIM_OK;
14323 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14324 if (objPtr == NULL) {
14325 return JIM_ERR;
14327 Jim_SetResult(interp, objPtr);
14328 return JIM_OK;
14330 case OPT_UPDATE:
14331 if (argc < 6 || argc % 2) {
14332 /* Better error message */
14333 argc = 2;
14335 break;
14337 case OPT_CREATE:
14338 if (argc % 2) {
14339 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14340 return JIM_ERR;
14342 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14343 Jim_SetResult(interp, objPtr);
14344 return JIM_OK;
14346 case OPT_INFO:
14347 if (argc != 3) {
14348 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14349 return JIM_ERR;
14351 return Jim_DictInfo(interp, argv[2]);
14353 case OPT_WITH:
14354 if (argc < 4) {
14355 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14356 return JIM_ERR;
14358 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14360 /* Handle command as an ensemble */
14361 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14364 /* [subst] */
14365 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14367 static const char * const options[] = {
14368 "-nobackslashes", "-nocommands", "-novariables", NULL
14370 enum
14371 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14372 int i;
14373 int flags = JIM_SUBST_FLAG;
14374 Jim_Obj *objPtr;
14376 if (argc < 2) {
14377 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14378 return JIM_ERR;
14380 for (i = 1; i < (argc - 1); i++) {
14381 int option;
14383 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14384 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14385 return JIM_ERR;
14387 switch (option) {
14388 case OPT_NOBACKSLASHES:
14389 flags |= JIM_SUBST_NOESC;
14390 break;
14391 case OPT_NOCOMMANDS:
14392 flags |= JIM_SUBST_NOCMD;
14393 break;
14394 case OPT_NOVARIABLES:
14395 flags |= JIM_SUBST_NOVAR;
14396 break;
14399 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14400 return JIM_ERR;
14402 Jim_SetResult(interp, objPtr);
14403 return JIM_OK;
14406 /* [info] */
14407 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14409 int cmd;
14410 Jim_Obj *objPtr;
14411 int mode = 0;
14413 static const char * const commands[] = {
14414 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14415 "vars", "version", "patchlevel", "complete", "args", "hostname",
14416 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14417 "references", "alias", NULL
14419 enum
14420 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14421 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14422 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14423 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14426 #ifdef jim_ext_namespace
14427 int nons = 0;
14429 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14430 /* This is for internal use only */
14431 argc--;
14432 argv++;
14433 nons = 1;
14435 #endif
14437 if (argc < 2) {
14438 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14439 return JIM_ERR;
14441 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14442 return Jim_CheckShowCommands(interp, argv[1], commands);
14445 /* Test for the most common commands first, just in case it makes a difference */
14446 switch (cmd) {
14447 case INFO_EXISTS:
14448 if (argc != 3) {
14449 Jim_WrongNumArgs(interp, 2, argv, "varName");
14450 return JIM_ERR;
14452 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14453 break;
14455 case INFO_ALIAS:{
14456 Jim_Cmd *cmdPtr;
14458 if (argc != 3) {
14459 Jim_WrongNumArgs(interp, 2, argv, "command");
14460 return JIM_ERR;
14462 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14463 return JIM_ERR;
14465 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14466 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14467 return JIM_ERR;
14469 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14470 return JIM_OK;
14473 case INFO_CHANNELS:
14474 mode++; /* JIM_CMDLIST_CHANNELS */
14475 #ifndef jim_ext_aio
14476 Jim_SetResultString(interp, "aio not enabled", -1);
14477 return JIM_ERR;
14478 #endif
14479 /* fall through */
14480 case INFO_PROCS:
14481 mode++; /* JIM_CMDLIST_PROCS */
14482 /* fall through */
14483 case INFO_COMMANDS:
14484 /* mode 0 => JIM_CMDLIST_COMMANDS */
14485 if (argc != 2 && argc != 3) {
14486 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14487 return JIM_ERR;
14489 #ifdef jim_ext_namespace
14490 if (!nons) {
14491 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14492 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14495 #endif
14496 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14497 break;
14499 case INFO_VARS:
14500 mode++; /* JIM_VARLIST_VARS */
14501 /* fall through */
14502 case INFO_LOCALS:
14503 mode++; /* JIM_VARLIST_LOCALS */
14504 /* fall through */
14505 case INFO_GLOBALS:
14506 /* mode 0 => JIM_VARLIST_GLOBALS */
14507 if (argc != 2 && argc != 3) {
14508 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14509 return JIM_ERR;
14511 #ifdef jim_ext_namespace
14512 if (!nons) {
14513 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14514 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14517 #endif
14518 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14519 break;
14521 case INFO_SCRIPT:
14522 if (argc != 2) {
14523 Jim_WrongNumArgs(interp, 2, argv, "");
14524 return JIM_ERR;
14526 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14527 break;
14529 case INFO_SOURCE:{
14530 jim_wide line;
14531 Jim_Obj *resObjPtr;
14532 Jim_Obj *fileNameObj;
14534 if (argc != 3 && argc != 5) {
14535 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14536 return JIM_ERR;
14538 if (argc == 5) {
14539 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14540 return JIM_ERR;
14542 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14543 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14545 else {
14546 if (argv[2]->typePtr == &sourceObjType) {
14547 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14548 line = argv[2]->internalRep.sourceValue.lineNumber;
14550 else if (argv[2]->typePtr == &scriptObjType) {
14551 ScriptObj *script = JimGetScript(interp, argv[2]);
14552 fileNameObj = script->fileNameObj;
14553 line = script->firstline;
14555 else {
14556 fileNameObj = interp->emptyObj;
14557 line = 1;
14559 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14560 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14561 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14563 Jim_SetResult(interp, resObjPtr);
14564 break;
14567 case INFO_STACKTRACE:
14568 Jim_SetResult(interp, interp->stackTrace);
14569 break;
14571 case INFO_LEVEL:
14572 case INFO_FRAME:
14573 switch (argc) {
14574 case 2:
14575 Jim_SetResultInt(interp, interp->framePtr->level);
14576 break;
14578 case 3:
14579 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14580 return JIM_ERR;
14582 Jim_SetResult(interp, objPtr);
14583 break;
14585 default:
14586 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14587 return JIM_ERR;
14589 break;
14591 case INFO_BODY:
14592 case INFO_STATICS:
14593 case INFO_ARGS:{
14594 Jim_Cmd *cmdPtr;
14596 if (argc != 3) {
14597 Jim_WrongNumArgs(interp, 2, argv, "procname");
14598 return JIM_ERR;
14600 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14601 return JIM_ERR;
14603 if (!cmdPtr->isproc) {
14604 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14605 return JIM_ERR;
14607 switch (cmd) {
14608 case INFO_BODY:
14609 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14610 break;
14611 case INFO_ARGS:
14612 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14613 break;
14614 case INFO_STATICS:
14615 if (cmdPtr->u.proc.staticVars) {
14616 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14617 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14619 break;
14621 break;
14624 case INFO_VERSION:
14625 case INFO_PATCHLEVEL:{
14626 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14628 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14629 Jim_SetResultString(interp, buf, -1);
14630 break;
14633 case INFO_COMPLETE:
14634 if (argc != 3 && argc != 4) {
14635 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14636 return JIM_ERR;
14638 else {
14639 char missing;
14641 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14642 if (missing != ' ' && argc == 4) {
14643 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14646 break;
14648 case INFO_HOSTNAME:
14649 /* Redirect to os.gethostname if it exists */
14650 return Jim_Eval(interp, "os.gethostname");
14652 case INFO_NAMEOFEXECUTABLE:
14653 /* Redirect to Tcl proc */
14654 return Jim_Eval(interp, "{info nameofexecutable}");
14656 case INFO_RETURNCODES:
14657 if (argc == 2) {
14658 int i;
14659 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14661 for (i = 0; jimReturnCodes[i]; i++) {
14662 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14663 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14664 jimReturnCodes[i], -1));
14667 Jim_SetResult(interp, listObjPtr);
14669 else if (argc == 3) {
14670 long code;
14671 const char *name;
14673 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14674 return JIM_ERR;
14676 name = Jim_ReturnCode(code);
14677 if (*name == '?') {
14678 Jim_SetResultInt(interp, code);
14680 else {
14681 Jim_SetResultString(interp, name, -1);
14684 else {
14685 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14686 return JIM_ERR;
14688 break;
14689 case INFO_REFERENCES:
14690 #ifdef JIM_REFERENCES
14691 return JimInfoReferences(interp, argc, argv);
14692 #else
14693 Jim_SetResultString(interp, "not supported", -1);
14694 return JIM_ERR;
14695 #endif
14697 return JIM_OK;
14700 /* [exists] */
14701 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14703 Jim_Obj *objPtr;
14704 int result = 0;
14706 static const char * const options[] = {
14707 "-command", "-proc", "-alias", "-var", NULL
14709 enum
14711 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14713 int option;
14715 if (argc == 2) {
14716 option = OPT_VAR;
14717 objPtr = argv[1];
14719 else if (argc == 3) {
14720 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14721 return JIM_ERR;
14723 objPtr = argv[2];
14725 else {
14726 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14727 return JIM_ERR;
14730 if (option == OPT_VAR) {
14731 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14733 else {
14734 /* Now different kinds of commands */
14735 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14737 if (cmd) {
14738 switch (option) {
14739 case OPT_COMMAND:
14740 result = 1;
14741 break;
14743 case OPT_ALIAS:
14744 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14745 break;
14747 case OPT_PROC:
14748 result = cmd->isproc;
14749 break;
14753 Jim_SetResultBool(interp, result);
14754 return JIM_OK;
14757 /* [split] */
14758 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14760 const char *str, *splitChars, *noMatchStart;
14761 int splitLen, strLen;
14762 Jim_Obj *resObjPtr;
14763 int c;
14764 int len;
14766 if (argc != 2 && argc != 3) {
14767 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14768 return JIM_ERR;
14771 str = Jim_GetString(argv[1], &len);
14772 if (len == 0) {
14773 return JIM_OK;
14775 strLen = Jim_Utf8Length(interp, argv[1]);
14777 /* Init */
14778 if (argc == 2) {
14779 splitChars = " \n\t\r";
14780 splitLen = 4;
14782 else {
14783 splitChars = Jim_String(argv[2]);
14784 splitLen = Jim_Utf8Length(interp, argv[2]);
14787 noMatchStart = str;
14788 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14790 /* Split */
14791 if (splitLen) {
14792 Jim_Obj *objPtr;
14793 while (strLen--) {
14794 const char *sc = splitChars;
14795 int scLen = splitLen;
14796 int sl = utf8_tounicode(str, &c);
14797 while (scLen--) {
14798 int pc;
14799 sc += utf8_tounicode(sc, &pc);
14800 if (c == pc) {
14801 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14802 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14803 noMatchStart = str + sl;
14804 break;
14807 str += sl;
14809 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14810 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14812 else {
14813 /* This handles the special case of splitchars eq {}
14814 * Optimise by sharing common (ASCII) characters
14816 Jim_Obj **commonObj = NULL;
14817 #define NUM_COMMON (128 - 9)
14818 while (strLen--) {
14819 int n = utf8_tounicode(str, &c);
14820 #ifdef JIM_OPTIMIZATION
14821 if (c >= 9 && c < 128) {
14822 /* Common ASCII char. Note that 9 is the tab character */
14823 c -= 9;
14824 if (!commonObj) {
14825 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14826 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14828 if (!commonObj[c]) {
14829 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14831 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14832 str++;
14833 continue;
14835 #endif
14836 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14837 str += n;
14839 Jim_Free(commonObj);
14842 Jim_SetResult(interp, resObjPtr);
14843 return JIM_OK;
14846 /* [join] */
14847 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14849 const char *joinStr;
14850 int joinStrLen;
14852 if (argc != 2 && argc != 3) {
14853 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14854 return JIM_ERR;
14856 /* Init */
14857 if (argc == 2) {
14858 joinStr = " ";
14859 joinStrLen = 1;
14861 else {
14862 joinStr = Jim_GetString(argv[2], &joinStrLen);
14864 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14865 return JIM_OK;
14868 /* [format] */
14869 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14871 Jim_Obj *objPtr;
14873 if (argc < 2) {
14874 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14875 return JIM_ERR;
14877 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14878 if (objPtr == NULL)
14879 return JIM_ERR;
14880 Jim_SetResult(interp, objPtr);
14881 return JIM_OK;
14884 /* [scan] */
14885 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14887 Jim_Obj *listPtr, **outVec;
14888 int outc, i;
14890 if (argc < 3) {
14891 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14892 return JIM_ERR;
14894 if (argv[2]->typePtr != &scanFmtStringObjType)
14895 SetScanFmtFromAny(interp, argv[2]);
14896 if (FormatGetError(argv[2]) != 0) {
14897 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14898 return JIM_ERR;
14900 if (argc > 3) {
14901 int maxPos = FormatGetMaxPos(argv[2]);
14902 int count = FormatGetCnvCount(argv[2]);
14904 if (maxPos > argc - 3) {
14905 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14906 return JIM_ERR;
14908 else if (count > argc - 3) {
14909 Jim_SetResultString(interp, "different numbers of variable names and "
14910 "field specifiers", -1);
14911 return JIM_ERR;
14913 else if (count < argc - 3) {
14914 Jim_SetResultString(interp, "variable is not assigned by any "
14915 "conversion specifiers", -1);
14916 return JIM_ERR;
14919 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14920 if (listPtr == 0)
14921 return JIM_ERR;
14922 if (argc > 3) {
14923 int rc = JIM_OK;
14924 int count = 0;
14926 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14927 int len = Jim_ListLength(interp, listPtr);
14929 if (len != 0) {
14930 JimListGetElements(interp, listPtr, &outc, &outVec);
14931 for (i = 0; i < outc; ++i) {
14932 if (Jim_Length(outVec[i]) > 0) {
14933 ++count;
14934 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14935 rc = JIM_ERR;
14940 Jim_FreeNewObj(interp, listPtr);
14942 else {
14943 count = -1;
14945 if (rc == JIM_OK) {
14946 Jim_SetResultInt(interp, count);
14948 return rc;
14950 else {
14951 if (listPtr == (Jim_Obj *)EOF) {
14952 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14953 return JIM_OK;
14955 Jim_SetResult(interp, listPtr);
14957 return JIM_OK;
14960 /* [error] */
14961 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14963 if (argc != 2 && argc != 3) {
14964 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14965 return JIM_ERR;
14967 Jim_SetResult(interp, argv[1]);
14968 if (argc == 3) {
14969 JimSetStackTrace(interp, argv[2]);
14970 return JIM_ERR;
14972 interp->addStackTrace++;
14973 return JIM_ERR;
14976 /* [lrange] */
14977 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14979 Jim_Obj *objPtr;
14981 if (argc != 4) {
14982 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14983 return JIM_ERR;
14985 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14986 return JIM_ERR;
14987 Jim_SetResult(interp, objPtr);
14988 return JIM_OK;
14991 /* [lrepeat] */
14992 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14994 Jim_Obj *objPtr;
14995 long count;
14997 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14998 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14999 return JIM_ERR;
15002 if (count == 0 || argc == 2) {
15003 return JIM_OK;
15006 argc -= 2;
15007 argv += 2;
15009 objPtr = Jim_NewListObj(interp, argv, argc);
15010 while (--count) {
15011 ListInsertElements(objPtr, -1, argc, argv);
15014 Jim_SetResult(interp, objPtr);
15015 return JIM_OK;
15018 char **Jim_GetEnviron(void)
15020 #if defined(HAVE__NSGETENVIRON)
15021 return *_NSGetEnviron();
15022 #else
15023 #if !defined(NO_ENVIRON_EXTERN)
15024 extern char **environ;
15025 #endif
15027 return environ;
15028 #endif
15031 void Jim_SetEnviron(char **env)
15033 #if defined(HAVE__NSGETENVIRON)
15034 *_NSGetEnviron() = env;
15035 #else
15036 #if !defined(NO_ENVIRON_EXTERN)
15037 extern char **environ;
15038 #endif
15040 environ = env;
15041 #endif
15044 /* [env] */
15045 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15047 const char *key;
15048 const char *val;
15050 if (argc == 1) {
15051 char **e = Jim_GetEnviron();
15053 int i;
15054 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15056 for (i = 0; e[i]; i++) {
15057 const char *equals = strchr(e[i], '=');
15059 if (equals) {
15060 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15061 equals - e[i]));
15062 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15066 Jim_SetResult(interp, listObjPtr);
15067 return JIM_OK;
15070 if (argc < 2) {
15071 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15072 return JIM_ERR;
15074 key = Jim_String(argv[1]);
15075 val = getenv(key);
15076 if (val == NULL) {
15077 if (argc < 3) {
15078 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15079 return JIM_ERR;
15081 val = Jim_String(argv[2]);
15083 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15084 return JIM_OK;
15087 /* [source] */
15088 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15090 int retval;
15092 if (argc != 2) {
15093 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15094 return JIM_ERR;
15096 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15097 if (retval == JIM_RETURN)
15098 return JIM_OK;
15099 return retval;
15102 /* [lreverse] */
15103 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15105 Jim_Obj *revObjPtr, **ele;
15106 int len;
15108 if (argc != 2) {
15109 Jim_WrongNumArgs(interp, 1, argv, "list");
15110 return JIM_ERR;
15112 JimListGetElements(interp, argv[1], &len, &ele);
15113 len--;
15114 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15115 while (len >= 0)
15116 ListAppendElement(revObjPtr, ele[len--]);
15117 Jim_SetResult(interp, revObjPtr);
15118 return JIM_OK;
15121 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15123 jim_wide len;
15125 if (step == 0)
15126 return -1;
15127 if (start == end)
15128 return 0;
15129 else if (step > 0 && start > end)
15130 return -1;
15131 else if (step < 0 && end > start)
15132 return -1;
15133 len = end - start;
15134 if (len < 0)
15135 len = -len; /* abs(len) */
15136 if (step < 0)
15137 step = -step; /* abs(step) */
15138 len = 1 + ((len - 1) / step);
15139 /* We can truncate safely to INT_MAX, the range command
15140 * will always return an error for a such long range
15141 * because Tcl lists can't be so long. */
15142 if (len > INT_MAX)
15143 len = INT_MAX;
15144 return (int)((len < 0) ? -1 : len);
15147 /* [range] */
15148 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15150 jim_wide start = 0, end, step = 1;
15151 int len, i;
15152 Jim_Obj *objPtr;
15154 if (argc < 2 || argc > 4) {
15155 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15156 return JIM_ERR;
15158 if (argc == 2) {
15159 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15160 return JIM_ERR;
15162 else {
15163 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15164 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15165 return JIM_ERR;
15166 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15167 return JIM_ERR;
15169 if ((len = JimRangeLen(start, end, step)) == -1) {
15170 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15171 return JIM_ERR;
15173 objPtr = Jim_NewListObj(interp, NULL, 0);
15174 for (i = 0; i < len; i++)
15175 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15176 Jim_SetResult(interp, objPtr);
15177 return JIM_OK;
15180 /* [rand] */
15181 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15183 jim_wide min = 0, max = 0, len, maxMul;
15185 if (argc < 1 || argc > 3) {
15186 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15187 return JIM_ERR;
15189 if (argc == 1) {
15190 max = JIM_WIDE_MAX;
15191 } else if (argc == 2) {
15192 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15193 return JIM_ERR;
15194 } else if (argc == 3) {
15195 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15196 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15197 return JIM_ERR;
15199 len = max-min;
15200 if (len < 0) {
15201 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15202 return JIM_ERR;
15204 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15205 while (1) {
15206 jim_wide r;
15208 JimRandomBytes(interp, &r, sizeof(jim_wide));
15209 if (r < 0 || r >= maxMul) continue;
15210 r = (len == 0) ? 0 : r%len;
15211 Jim_SetResultInt(interp, min+r);
15212 return JIM_OK;
15216 static const struct {
15217 const char *name;
15218 Jim_CmdProc *cmdProc;
15219 } Jim_CoreCommandsTable[] = {
15220 {"alias", Jim_AliasCoreCommand},
15221 {"set", Jim_SetCoreCommand},
15222 {"unset", Jim_UnsetCoreCommand},
15223 {"puts", Jim_PutsCoreCommand},
15224 {"+", Jim_AddCoreCommand},
15225 {"*", Jim_MulCoreCommand},
15226 {"-", Jim_SubCoreCommand},
15227 {"/", Jim_DivCoreCommand},
15228 {"incr", Jim_IncrCoreCommand},
15229 {"while", Jim_WhileCoreCommand},
15230 {"loop", Jim_LoopCoreCommand},
15231 {"for", Jim_ForCoreCommand},
15232 {"foreach", Jim_ForeachCoreCommand},
15233 {"lmap", Jim_LmapCoreCommand},
15234 {"lassign", Jim_LassignCoreCommand},
15235 {"if", Jim_IfCoreCommand},
15236 {"switch", Jim_SwitchCoreCommand},
15237 {"list", Jim_ListCoreCommand},
15238 {"lindex", Jim_LindexCoreCommand},
15239 {"lset", Jim_LsetCoreCommand},
15240 {"lsearch", Jim_LsearchCoreCommand},
15241 {"llength", Jim_LlengthCoreCommand},
15242 {"lappend", Jim_LappendCoreCommand},
15243 {"linsert", Jim_LinsertCoreCommand},
15244 {"lreplace", Jim_LreplaceCoreCommand},
15245 {"lsort", Jim_LsortCoreCommand},
15246 {"append", Jim_AppendCoreCommand},
15247 {"debug", Jim_DebugCoreCommand},
15248 {"eval", Jim_EvalCoreCommand},
15249 {"uplevel", Jim_UplevelCoreCommand},
15250 {"expr", Jim_ExprCoreCommand},
15251 {"break", Jim_BreakCoreCommand},
15252 {"continue", Jim_ContinueCoreCommand},
15253 {"proc", Jim_ProcCoreCommand},
15254 {"concat", Jim_ConcatCoreCommand},
15255 {"return", Jim_ReturnCoreCommand},
15256 {"upvar", Jim_UpvarCoreCommand},
15257 {"global", Jim_GlobalCoreCommand},
15258 {"string", Jim_StringCoreCommand},
15259 {"time", Jim_TimeCoreCommand},
15260 {"exit", Jim_ExitCoreCommand},
15261 {"catch", Jim_CatchCoreCommand},
15262 #ifdef JIM_REFERENCES
15263 {"ref", Jim_RefCoreCommand},
15264 {"getref", Jim_GetrefCoreCommand},
15265 {"setref", Jim_SetrefCoreCommand},
15266 {"finalize", Jim_FinalizeCoreCommand},
15267 {"collect", Jim_CollectCoreCommand},
15268 #endif
15269 {"rename", Jim_RenameCoreCommand},
15270 {"dict", Jim_DictCoreCommand},
15271 {"subst", Jim_SubstCoreCommand},
15272 {"info", Jim_InfoCoreCommand},
15273 {"exists", Jim_ExistsCoreCommand},
15274 {"split", Jim_SplitCoreCommand},
15275 {"join", Jim_JoinCoreCommand},
15276 {"format", Jim_FormatCoreCommand},
15277 {"scan", Jim_ScanCoreCommand},
15278 {"error", Jim_ErrorCoreCommand},
15279 {"lrange", Jim_LrangeCoreCommand},
15280 {"lrepeat", Jim_LrepeatCoreCommand},
15281 {"env", Jim_EnvCoreCommand},
15282 {"source", Jim_SourceCoreCommand},
15283 {"lreverse", Jim_LreverseCoreCommand},
15284 {"range", Jim_RangeCoreCommand},
15285 {"rand", Jim_RandCoreCommand},
15286 {"tailcall", Jim_TailcallCoreCommand},
15287 {"local", Jim_LocalCoreCommand},
15288 {"upcall", Jim_UpcallCoreCommand},
15289 {"apply", Jim_ApplyCoreCommand},
15290 {NULL, NULL},
15293 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15295 int i = 0;
15297 while (Jim_CoreCommandsTable[i].name != NULL) {
15298 Jim_CreateCommand(interp,
15299 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15300 i++;
15304 /* -----------------------------------------------------------------------------
15305 * Interactive prompt
15306 * ---------------------------------------------------------------------------*/
15307 void Jim_MakeErrorMessage(Jim_Interp *interp)
15309 Jim_Obj *argv[2];
15311 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15312 argv[1] = interp->result;
15314 Jim_EvalObjVector(interp, 2, argv);
15318 * Given a null terminated array of strings, returns an allocated, sorted
15319 * copy of the array.
15321 static char **JimSortStringTable(const char *const *tablePtr)
15323 int count;
15324 char **tablePtrSorted;
15326 /* Find the size of the table */
15327 for (count = 0; tablePtr[count]; count++) {
15330 /* Allocate one extra for the terminating NULL pointer */
15331 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15332 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15333 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15334 tablePtrSorted[count] = NULL;
15336 return tablePtrSorted;
15339 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15340 const char *prefix, const char *const *tablePtr, const char *name)
15342 char **tablePtrSorted;
15343 int i;
15345 if (name == NULL) {
15346 name = "option";
15349 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15350 tablePtrSorted = JimSortStringTable(tablePtr);
15351 for (i = 0; tablePtrSorted[i]; i++) {
15352 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15353 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15355 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15356 if (tablePtrSorted[i + 1]) {
15357 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15360 Jim_Free(tablePtrSorted);
15365 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15366 * and returns JIM_OK.
15368 * Otherwise returns JIM_ERR.
15370 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15372 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15373 int i;
15374 char **tablePtrSorted = JimSortStringTable(tablePtr);
15375 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15376 for (i = 0; tablePtrSorted[i]; i++) {
15377 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15379 Jim_Free(tablePtrSorted);
15380 return JIM_OK;
15382 return JIM_ERR;
15385 /* internal rep is stored in ptrIntvalue
15386 * ptr = tablePtr
15387 * int1 = flags
15388 * int2 = index
15390 static const Jim_ObjType getEnumObjType = {
15391 "get-enum",
15392 NULL,
15393 NULL,
15394 NULL,
15395 JIM_TYPE_REFERENCES
15398 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15399 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15401 const char *bad = "bad ";
15402 const char *const *entryPtr = NULL;
15403 int i;
15404 int match = -1;
15405 int arglen;
15406 const char *arg;
15408 if (objPtr->typePtr == &getEnumObjType) {
15409 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15410 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15411 return JIM_OK;
15415 arg = Jim_GetString(objPtr, &arglen);
15417 *indexPtr = -1;
15419 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15420 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15421 /* Found an exact match */
15422 match = i;
15423 goto found;
15425 if (flags & JIM_ENUM_ABBREV) {
15426 /* Accept an unambiguous abbreviation.
15427 * Note that '-' doesnt' consitute a valid abbreviation
15429 if (strncmp(arg, *entryPtr, arglen) == 0) {
15430 if (*arg == '-' && arglen == 1) {
15431 break;
15433 if (match >= 0) {
15434 bad = "ambiguous ";
15435 goto ambiguous;
15437 match = i;
15442 /* If we had an unambiguous partial match */
15443 if (match >= 0) {
15444 found:
15445 /* Record the match in the object */
15446 Jim_FreeIntRep(interp, objPtr);
15447 objPtr->typePtr = &getEnumObjType;
15448 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15449 objPtr->internalRep.ptrIntValue.int1 = flags;
15450 objPtr->internalRep.ptrIntValue.int2 = match;
15451 /* Return the result */
15452 *indexPtr = match;
15453 return JIM_OK;
15456 ambiguous:
15457 if (flags & JIM_ERRMSG) {
15458 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15460 return JIM_ERR;
15463 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15465 int i;
15467 for (i = 0; i < (int)len; i++) {
15468 if (array[i] && strcmp(array[i], name) == 0) {
15469 return i;
15472 return -1;
15475 int Jim_IsDict(Jim_Obj *objPtr)
15477 return objPtr->typePtr == &dictObjType;
15480 int Jim_IsList(Jim_Obj *objPtr)
15482 return objPtr->typePtr == &listObjType;
15486 * Very simple printf-like formatting, designed for error messages.
15488 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15489 * The resulting string is created and set as the result.
15491 * Each '%s' should correspond to a regular string parameter.
15492 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15493 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15495 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15497 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15499 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15501 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15503 /* Initial space needed */
15504 int len = strlen(format);
15505 int extra = 0;
15506 int n = 0;
15507 const char *params[5];
15508 int nobjparam = 0;
15509 Jim_Obj *objparam[5];
15510 char *buf;
15511 va_list args;
15512 int i;
15514 va_start(args, format);
15516 for (i = 0; i < len && n < 5; i++) {
15517 int l;
15519 if (strncmp(format + i, "%s", 2) == 0) {
15520 params[n] = va_arg(args, char *);
15522 l = strlen(params[n]);
15524 else if (strncmp(format + i, "%#s", 3) == 0) {
15525 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15527 params[n] = Jim_GetString(objPtr, &l);
15528 objparam[nobjparam++] = objPtr;
15529 Jim_IncrRefCount(objPtr);
15531 else {
15532 if (format[i] == '%') {
15533 i++;
15535 continue;
15537 n++;
15538 extra += l;
15541 len += extra;
15542 buf = Jim_Alloc(len + 1);
15543 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15545 va_end(args);
15547 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15549 for (i = 0; i < nobjparam; i++) {
15550 Jim_DecrRefCount(interp, objparam[i]);
15554 /* stubs */
15555 #ifndef jim_ext_package
15556 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15558 return JIM_OK;
15560 #endif
15561 #ifndef jim_ext_aio
15562 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15564 Jim_SetResultString(interp, "aio not enabled", -1);
15565 return NULL;
15567 #endif
15571 * Local Variables: ***
15572 * c-basic-offset: 4 ***
15573 * tab-width: 4 ***
15574 * End: ***