tests: socket.test check for ipv6 support
[jimtcl.git] / jim.c
blobbbdb6fef58c8913cecfef37ce7a2d22b7d72099b
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 if (pc->missing.ch == '"') {
1493 return;
1495 continue;
1497 break;
1499 case '{':
1500 JimParseSubBrace(pc);
1501 startofword = 0;
1502 continue;
1504 case '\n':
1505 pc->linenr++;
1506 break;
1508 startofword = isspace(UCHAR(*pc->p));
1509 pc->p++;
1510 pc->len--;
1512 pc->missing.ch = '[';
1513 pc->missing.line = line;
1514 pc->tend = pc->p - 1;
1517 static int JimParseBrace(struct JimParserCtx *pc)
1519 pc->tstart = pc->p + 1;
1520 pc->tline = pc->linenr;
1521 pc->tt = JIM_TT_STR;
1522 JimParseSubBrace(pc);
1523 return JIM_OK;
1526 static int JimParseCmd(struct JimParserCtx *pc)
1528 pc->tstart = pc->p + 1;
1529 pc->tline = pc->linenr;
1530 pc->tt = JIM_TT_CMD;
1531 JimParseSubCmd(pc);
1532 return JIM_OK;
1535 static int JimParseQuote(struct JimParserCtx *pc)
1537 pc->tstart = pc->p + 1;
1538 pc->tline = pc->linenr;
1539 pc->tt = JimParseSubQuote(pc);
1540 return JIM_OK;
1543 static int JimParseVar(struct JimParserCtx *pc)
1545 /* skip the $ */
1546 pc->p++;
1547 pc->len--;
1549 #ifdef EXPRSUGAR_BRACKET
1550 if (*pc->p == '[') {
1551 /* Parse $[...] expr shorthand syntax */
1552 JimParseCmd(pc);
1553 pc->tt = JIM_TT_EXPRSUGAR;
1554 return JIM_OK;
1556 #endif
1558 pc->tstart = pc->p;
1559 pc->tt = JIM_TT_VAR;
1560 pc->tline = pc->linenr;
1562 if (*pc->p == '{') {
1563 pc->tstart = ++pc->p;
1564 pc->len--;
1566 while (pc->len && *pc->p != '}') {
1567 if (*pc->p == '\n') {
1568 pc->linenr++;
1570 pc->p++;
1571 pc->len--;
1573 pc->tend = pc->p - 1;
1574 if (pc->len) {
1575 pc->p++;
1576 pc->len--;
1579 else {
1580 while (1) {
1581 /* Skip double colon, but not single colon! */
1582 if (pc->p[0] == ':' && pc->p[1] == ':') {
1583 while (*pc->p == ':') {
1584 pc->p++;
1585 pc->len--;
1587 continue;
1589 /* Note that any char >= 0x80 must be part of a utf-8 char.
1590 * We consider all unicode points outside of ASCII as letters
1592 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1593 pc->p++;
1594 pc->len--;
1595 continue;
1597 break;
1599 /* Parse [dict get] syntax sugar. */
1600 if (*pc->p == '(') {
1601 int count = 1;
1602 const char *paren = NULL;
1604 pc->tt = JIM_TT_DICTSUGAR;
1606 while (count && pc->len) {
1607 pc->p++;
1608 pc->len--;
1609 if (*pc->p == '\\' && pc->len >= 1) {
1610 pc->p++;
1611 pc->len--;
1613 else if (*pc->p == '(') {
1614 count++;
1616 else if (*pc->p == ')') {
1617 paren = pc->p;
1618 count--;
1621 if (count == 0) {
1622 pc->p++;
1623 pc->len--;
1625 else if (paren) {
1626 /* Did not find a matching paren. Back up */
1627 paren++;
1628 pc->len += (pc->p - paren);
1629 pc->p = paren;
1631 #ifndef EXPRSUGAR_BRACKET
1632 if (*pc->tstart == '(') {
1633 pc->tt = JIM_TT_EXPRSUGAR;
1635 #endif
1637 pc->tend = pc->p - 1;
1639 /* Check if we parsed just the '$' character.
1640 * That's not a variable so an error is returned
1641 * to tell the state machine to consider this '$' just
1642 * a string. */
1643 if (pc->tstart == pc->p) {
1644 pc->p--;
1645 pc->len++;
1646 return JIM_ERR;
1648 return JIM_OK;
1651 static int JimParseStr(struct JimParserCtx *pc)
1653 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1654 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1655 /* Starting a new word */
1656 if (*pc->p == '{') {
1657 return JimParseBrace(pc);
1659 if (*pc->p == '"') {
1660 pc->inquote = 1;
1661 pc->p++;
1662 pc->len--;
1663 /* In case the end quote is missing */
1664 pc->missing.line = pc->tline;
1667 pc->tstart = pc->p;
1668 pc->tline = pc->linenr;
1669 while (1) {
1670 if (pc->len == 0) {
1671 if (pc->inquote) {
1672 pc->missing.ch = '"';
1674 pc->tend = pc->p - 1;
1675 pc->tt = JIM_TT_ESC;
1676 return JIM_OK;
1678 switch (*pc->p) {
1679 case '\\':
1680 if (!pc->inquote && *(pc->p + 1) == '\n') {
1681 pc->tend = pc->p - 1;
1682 pc->tt = JIM_TT_ESC;
1683 return JIM_OK;
1685 if (pc->len >= 2) {
1686 if (*(pc->p + 1) == '\n') {
1687 pc->linenr++;
1689 pc->p++;
1690 pc->len--;
1692 else if (pc->len == 1) {
1693 /* End of script with trailing backslash */
1694 pc->missing.ch = '\\';
1696 break;
1697 case '(':
1698 /* If the following token is not '$' just keep going */
1699 if (pc->len > 1 && pc->p[1] != '$') {
1700 break;
1702 /* fall through */
1703 case ')':
1704 /* Only need a separate ')' token if the previous was a var */
1705 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1706 if (pc->p == pc->tstart) {
1707 /* At the start of the token, so just return this char */
1708 pc->p++;
1709 pc->len--;
1711 pc->tend = pc->p - 1;
1712 pc->tt = JIM_TT_ESC;
1713 return JIM_OK;
1715 break;
1717 case '$':
1718 case '[':
1719 pc->tend = pc->p - 1;
1720 pc->tt = JIM_TT_ESC;
1721 return JIM_OK;
1722 case ' ':
1723 case '\t':
1724 case '\n':
1725 case '\r':
1726 case '\f':
1727 case ';':
1728 if (!pc->inquote) {
1729 pc->tend = pc->p - 1;
1730 pc->tt = JIM_TT_ESC;
1731 return JIM_OK;
1733 else if (*pc->p == '\n') {
1734 pc->linenr++;
1736 break;
1737 case '"':
1738 if (pc->inquote) {
1739 pc->tend = pc->p - 1;
1740 pc->tt = JIM_TT_ESC;
1741 pc->p++;
1742 pc->len--;
1743 pc->inquote = 0;
1744 return JIM_OK;
1746 break;
1748 pc->p++;
1749 pc->len--;
1751 return JIM_OK; /* unreached */
1754 static int JimParseComment(struct JimParserCtx *pc)
1756 while (*pc->p) {
1757 if (*pc->p == '\\') {
1758 pc->p++;
1759 pc->len--;
1760 if (pc->len == 0) {
1761 pc->missing.ch = '\\';
1762 return JIM_OK;
1764 if (*pc->p == '\n') {
1765 pc->linenr++;
1768 else if (*pc->p == '\n') {
1769 pc->p++;
1770 pc->len--;
1771 pc->linenr++;
1772 break;
1774 pc->p++;
1775 pc->len--;
1777 return JIM_OK;
1780 /* xdigitval and odigitval are helper functions for JimEscape() */
1781 static int xdigitval(int c)
1783 if (c >= '0' && c <= '9')
1784 return c - '0';
1785 if (c >= 'a' && c <= 'f')
1786 return c - 'a' + 10;
1787 if (c >= 'A' && c <= 'F')
1788 return c - 'A' + 10;
1789 return -1;
1792 static int odigitval(int c)
1794 if (c >= '0' && c <= '7')
1795 return c - '0';
1796 return -1;
1799 /* Perform Tcl escape substitution of 's', storing the result
1800 * string into 'dest'. The escaped string is guaranteed to
1801 * be the same length or shorter than the source string.
1802 * slen is the length of the string at 's'.
1804 * The function returns the length of the resulting string. */
1805 static int JimEscape(char *dest, const char *s, int slen)
1807 char *p = dest;
1808 int i, len;
1810 for (i = 0; i < slen; i++) {
1811 switch (s[i]) {
1812 case '\\':
1813 switch (s[i + 1]) {
1814 case 'a':
1815 *p++ = 0x7;
1816 i++;
1817 break;
1818 case 'b':
1819 *p++ = 0x8;
1820 i++;
1821 break;
1822 case 'f':
1823 *p++ = 0xc;
1824 i++;
1825 break;
1826 case 'n':
1827 *p++ = 0xa;
1828 i++;
1829 break;
1830 case 'r':
1831 *p++ = 0xd;
1832 i++;
1833 break;
1834 case 't':
1835 *p++ = 0x9;
1836 i++;
1837 break;
1838 case 'u':
1839 case 'U':
1840 case 'x':
1841 /* A unicode or hex sequence.
1842 * \x Expect 1-2 hex chars and convert to hex.
1843 * \u Expect 1-4 hex chars and convert to utf-8.
1844 * \U Expect 1-8 hex chars and convert to utf-8.
1845 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1846 * An invalid sequence means simply the escaped char.
1849 unsigned val = 0;
1850 int k;
1851 int maxchars = 2;
1853 i++;
1855 if (s[i] == 'U') {
1856 maxchars = 8;
1858 else if (s[i] == 'u') {
1859 if (s[i + 1] == '{') {
1860 maxchars = 6;
1861 i++;
1863 else {
1864 maxchars = 4;
1868 for (k = 0; k < maxchars; k++) {
1869 int c = xdigitval(s[i + k + 1]);
1870 if (c == -1) {
1871 break;
1873 val = (val << 4) | c;
1875 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1876 if (s[i] == '{') {
1877 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1878 /* Back up */
1879 i--;
1880 k = 0;
1882 else {
1883 /* Skip the closing brace */
1884 k++;
1887 if (k) {
1888 /* Got a valid sequence, so convert */
1889 if (s[i] == 'x') {
1890 *p++ = val;
1892 else {
1893 p += utf8_fromunicode(p, val);
1895 i += k;
1896 break;
1898 /* Not a valid codepoint, just an escaped char */
1899 *p++ = s[i];
1901 break;
1902 case 'v':
1903 *p++ = 0xb;
1904 i++;
1905 break;
1906 case '\0':
1907 *p++ = '\\';
1908 i++;
1909 break;
1910 case '\n':
1911 /* Replace all spaces and tabs after backslash newline with a single space*/
1912 *p++ = ' ';
1913 do {
1914 i++;
1915 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1916 break;
1917 case '0':
1918 case '1':
1919 case '2':
1920 case '3':
1921 case '4':
1922 case '5':
1923 case '6':
1924 case '7':
1925 /* octal escape */
1927 int val = 0;
1928 int c = odigitval(s[i + 1]);
1930 val = c;
1931 c = odigitval(s[i + 2]);
1932 if (c == -1) {
1933 *p++ = val;
1934 i++;
1935 break;
1937 val = (val * 8) + c;
1938 c = odigitval(s[i + 3]);
1939 if (c == -1) {
1940 *p++ = val;
1941 i += 2;
1942 break;
1944 val = (val * 8) + c;
1945 *p++ = val;
1946 i += 3;
1948 break;
1949 default:
1950 *p++ = s[i + 1];
1951 i++;
1952 break;
1954 break;
1955 default:
1956 *p++ = s[i];
1957 break;
1960 len = p - dest;
1961 *p = '\0';
1962 return len;
1965 /* Returns a dynamically allocated copy of the current token in the
1966 * parser context. The function performs conversion of escapes if
1967 * the token is of type JIM_TT_ESC.
1969 * Note that after the conversion, tokens that are grouped with
1970 * braces in the source code, are always recognizable from the
1971 * identical string obtained in a different way from the type.
1973 * For example the string:
1975 * {*}$a
1977 * will return as first token "*", of type JIM_TT_STR
1979 * While the string:
1981 * *$a
1983 * will return as first token "*", of type JIM_TT_ESC
1985 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1987 const char *start, *end;
1988 char *token;
1989 int len;
1991 start = pc->tstart;
1992 end = pc->tend;
1993 len = (end - start) + 1;
1994 if (len < 0) {
1995 len = 0;
1997 token = Jim_Alloc(len + 1);
1998 if (pc->tt != JIM_TT_ESC) {
1999 /* No escape conversion needed? Just copy it. */
2000 memcpy(token, start, len);
2001 token[len] = '\0';
2003 else {
2004 /* Else convert the escape chars. */
2005 len = JimEscape(token, start, len);
2008 return Jim_NewStringObjNoAlloc(interp, token, len);
2011 /* -----------------------------------------------------------------------------
2012 * Tcl Lists parsing
2013 * ---------------------------------------------------------------------------*/
2014 static int JimParseListSep(struct JimParserCtx *pc);
2015 static int JimParseListStr(struct JimParserCtx *pc);
2016 static int JimParseListQuote(struct JimParserCtx *pc);
2018 static int JimParseList(struct JimParserCtx *pc)
2020 if (isspace(UCHAR(*pc->p))) {
2021 return JimParseListSep(pc);
2023 switch (*pc->p) {
2024 case '"':
2025 return JimParseListQuote(pc);
2027 case '{':
2028 return JimParseBrace(pc);
2030 default:
2031 if (pc->len) {
2032 return JimParseListStr(pc);
2034 break;
2037 pc->tstart = pc->tend = pc->p;
2038 pc->tline = pc->linenr;
2039 pc->tt = JIM_TT_EOL;
2040 pc->eof = 1;
2041 return JIM_OK;
2044 static int JimParseListSep(struct JimParserCtx *pc)
2046 pc->tstart = pc->p;
2047 pc->tline = pc->linenr;
2048 while (isspace(UCHAR(*pc->p))) {
2049 if (*pc->p == '\n') {
2050 pc->linenr++;
2052 pc->p++;
2053 pc->len--;
2055 pc->tend = pc->p - 1;
2056 pc->tt = JIM_TT_SEP;
2057 return JIM_OK;
2060 static int JimParseListQuote(struct JimParserCtx *pc)
2062 pc->p++;
2063 pc->len--;
2065 pc->tstart = pc->p;
2066 pc->tline = pc->linenr;
2067 pc->tt = JIM_TT_STR;
2069 while (pc->len) {
2070 switch (*pc->p) {
2071 case '\\':
2072 pc->tt = JIM_TT_ESC;
2073 if (--pc->len == 0) {
2074 /* Trailing backslash */
2075 pc->tend = pc->p;
2076 return JIM_OK;
2078 pc->p++;
2079 break;
2080 case '\n':
2081 pc->linenr++;
2082 break;
2083 case '"':
2084 pc->tend = pc->p - 1;
2085 pc->p++;
2086 pc->len--;
2087 return JIM_OK;
2089 pc->p++;
2090 pc->len--;
2093 pc->tend = pc->p - 1;
2094 return JIM_OK;
2097 static int JimParseListStr(struct JimParserCtx *pc)
2099 pc->tstart = pc->p;
2100 pc->tline = pc->linenr;
2101 pc->tt = JIM_TT_STR;
2103 while (pc->len) {
2104 if (isspace(UCHAR(*pc->p))) {
2105 pc->tend = pc->p - 1;
2106 return JIM_OK;
2108 if (*pc->p == '\\') {
2109 if (--pc->len == 0) {
2110 /* Trailing backslash */
2111 pc->tend = pc->p;
2112 return JIM_OK;
2114 pc->tt = JIM_TT_ESC;
2115 pc->p++;
2117 pc->p++;
2118 pc->len--;
2120 pc->tend = pc->p - 1;
2121 return JIM_OK;
2124 /* -----------------------------------------------------------------------------
2125 * Jim_Obj related functions
2126 * ---------------------------------------------------------------------------*/
2128 /* Return a new initialized object. */
2129 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2131 Jim_Obj *objPtr;
2133 /* -- Check if there are objects in the free list -- */
2134 if (interp->freeList != NULL) {
2135 /* -- Unlink the object from the free list -- */
2136 objPtr = interp->freeList;
2137 interp->freeList = objPtr->nextObjPtr;
2139 else {
2140 /* -- No ready to use objects: allocate a new one -- */
2141 objPtr = Jim_Alloc(sizeof(*objPtr));
2144 /* Object is returned with refCount of 0. Every
2145 * kind of GC implemented should take care to avoid
2146 * scanning objects with refCount == 0. */
2147 objPtr->refCount = 0;
2148 /* All the other fields are left uninitialized to save time.
2149 * The caller will probably want to set them to the right
2150 * value anyway. */
2152 /* -- Put the object into the live list -- */
2153 objPtr->prevObjPtr = NULL;
2154 objPtr->nextObjPtr = interp->liveList;
2155 if (interp->liveList)
2156 interp->liveList->prevObjPtr = objPtr;
2157 interp->liveList = objPtr;
2159 return objPtr;
2162 /* Free an object. Actually objects are never freed, but
2163 * just moved to the free objects list, where they will be
2164 * reused by Jim_NewObj(). */
2165 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2167 /* Check if the object was already freed, panic. */
2168 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2169 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2171 /* Free the internal representation */
2172 Jim_FreeIntRep(interp, objPtr);
2173 /* Free the string representation */
2174 if (objPtr->bytes != NULL) {
2175 if (objPtr->bytes != JimEmptyStringRep)
2176 Jim_Free(objPtr->bytes);
2178 /* Unlink the object from the live objects list */
2179 if (objPtr->prevObjPtr)
2180 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2181 if (objPtr->nextObjPtr)
2182 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2183 if (interp->liveList == objPtr)
2184 interp->liveList = objPtr->nextObjPtr;
2185 #ifdef JIM_DISABLE_OBJECT_POOL
2186 Jim_Free(objPtr);
2187 #else
2188 /* Link the object into the free objects list */
2189 objPtr->prevObjPtr = NULL;
2190 objPtr->nextObjPtr = interp->freeList;
2191 if (interp->freeList)
2192 interp->freeList->prevObjPtr = objPtr;
2193 interp->freeList = objPtr;
2194 objPtr->refCount = -1;
2195 #endif
2198 /* Invalidate the string representation of an object. */
2199 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2201 if (objPtr->bytes != NULL) {
2202 if (objPtr->bytes != JimEmptyStringRep)
2203 Jim_Free(objPtr->bytes);
2205 objPtr->bytes = NULL;
2208 /* Duplicate an object. The returned object has refcount = 0. */
2209 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2211 Jim_Obj *dupPtr;
2213 dupPtr = Jim_NewObj(interp);
2214 if (objPtr->bytes == NULL) {
2215 /* Object does not have a valid string representation. */
2216 dupPtr->bytes = NULL;
2218 else if (objPtr->length == 0) {
2219 /* Zero length, so don't even bother with the type-specific dup,
2220 * since all zero length objects look the same
2222 dupPtr->bytes = JimEmptyStringRep;
2223 dupPtr->length = 0;
2224 dupPtr->typePtr = NULL;
2225 return dupPtr;
2227 else {
2228 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2229 dupPtr->length = objPtr->length;
2230 /* Copy the null byte too */
2231 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2234 /* By default, the new object has the same type as the old object */
2235 dupPtr->typePtr = objPtr->typePtr;
2236 if (objPtr->typePtr != NULL) {
2237 if (objPtr->typePtr->dupIntRepProc == NULL) {
2238 dupPtr->internalRep = objPtr->internalRep;
2240 else {
2241 /* The dup proc may set a different type, e.g. NULL */
2242 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2245 return dupPtr;
2248 /* Return the string representation for objPtr. If the object's
2249 * string representation is invalid, calls the updateStringProc method to create
2250 * a new one from the internal representation of the object.
2252 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2254 if (objPtr->bytes == NULL) {
2255 /* Invalid string repr. Generate it. */
2256 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2257 objPtr->typePtr->updateStringProc(objPtr);
2259 if (lenPtr)
2260 *lenPtr = objPtr->length;
2261 return objPtr->bytes;
2264 /* Just returns the length (in bytes) of the object's string rep */
2265 int Jim_Length(Jim_Obj *objPtr)
2267 if (objPtr->bytes == NULL) {
2268 /* Invalid string repr. Generate it. */
2269 Jim_GetString(objPtr, NULL);
2271 return objPtr->length;
2274 /* Just returns object's string rep */
2275 const char *Jim_String(Jim_Obj *objPtr)
2277 if (objPtr->bytes == NULL) {
2278 /* Invalid string repr. Generate it. */
2279 Jim_GetString(objPtr, NULL);
2281 return objPtr->bytes;
2284 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2286 objPtr->bytes = Jim_StrDup(str);
2287 objPtr->length = strlen(str);
2290 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2291 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2293 static const Jim_ObjType dictSubstObjType = {
2294 "dict-substitution",
2295 FreeDictSubstInternalRep,
2296 DupDictSubstInternalRep,
2297 NULL,
2298 JIM_TYPE_NONE,
2301 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2302 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2304 static const Jim_ObjType interpolatedObjType = {
2305 "interpolated",
2306 FreeInterpolatedInternalRep,
2307 DupInterpolatedInternalRep,
2308 NULL,
2309 JIM_TYPE_NONE,
2312 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2314 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2317 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2319 /* Copy the interal rep */
2320 dupPtr->internalRep = srcPtr->internalRep;
2321 /* Need to increment the key ref count */
2322 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2325 /* -----------------------------------------------------------------------------
2326 * String Object
2327 * ---------------------------------------------------------------------------*/
2328 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2329 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2331 static const Jim_ObjType stringObjType = {
2332 "string",
2333 NULL,
2334 DupStringInternalRep,
2335 NULL,
2336 JIM_TYPE_REFERENCES,
2339 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2341 JIM_NOTUSED(interp);
2343 /* This is a bit subtle: the only caller of this function
2344 * should be Jim_DuplicateObj(), that will copy the
2345 * string representaion. After the copy, the duplicated
2346 * object will not have more room in the buffer than
2347 * srcPtr->length bytes. So we just set it to length. */
2348 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2349 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2352 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2354 if (objPtr->typePtr != &stringObjType) {
2355 /* Get a fresh string representation. */
2356 if (objPtr->bytes == NULL) {
2357 /* Invalid string repr. Generate it. */
2358 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2359 objPtr->typePtr->updateStringProc(objPtr);
2361 /* Free any other internal representation. */
2362 Jim_FreeIntRep(interp, objPtr);
2363 /* Set it as string, i.e. just set the maxLength field. */
2364 objPtr->typePtr = &stringObjType;
2365 objPtr->internalRep.strValue.maxLength = objPtr->length;
2366 /* Don't know the utf-8 length yet */
2367 objPtr->internalRep.strValue.charLength = -1;
2369 return JIM_OK;
2373 * Returns the length of the object string in chars, not bytes.
2375 * These may be different for a utf-8 string.
2377 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2379 #ifdef JIM_UTF8
2380 SetStringFromAny(interp, objPtr);
2382 if (objPtr->internalRep.strValue.charLength < 0) {
2383 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2385 return objPtr->internalRep.strValue.charLength;
2386 #else
2387 return Jim_Length(objPtr);
2388 #endif
2391 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2392 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2394 Jim_Obj *objPtr = Jim_NewObj(interp);
2396 /* Need to find out how many bytes the string requires */
2397 if (len == -1)
2398 len = strlen(s);
2399 /* Alloc/Set the string rep. */
2400 if (len == 0) {
2401 objPtr->bytes = JimEmptyStringRep;
2403 else {
2404 objPtr->bytes = Jim_StrDupLen(s, len);
2406 objPtr->length = len;
2408 /* No typePtr field for the vanilla string object. */
2409 objPtr->typePtr = NULL;
2410 return objPtr;
2413 /* charlen is in characters -- see also Jim_NewStringObj() */
2414 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2416 #ifdef JIM_UTF8
2417 /* Need to find out how many bytes the string requires */
2418 int bytelen = utf8_index(s, charlen);
2420 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2422 /* Remember the utf8 length, so set the type */
2423 objPtr->typePtr = &stringObjType;
2424 objPtr->internalRep.strValue.maxLength = bytelen;
2425 objPtr->internalRep.strValue.charLength = charlen;
2427 return objPtr;
2428 #else
2429 return Jim_NewStringObj(interp, s, charlen);
2430 #endif
2433 /* This version does not try to duplicate the 's' pointer, but
2434 * use it directly. */
2435 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2437 Jim_Obj *objPtr = Jim_NewObj(interp);
2439 objPtr->bytes = s;
2440 objPtr->length = (len == -1) ? strlen(s) : len;
2441 objPtr->typePtr = NULL;
2442 return objPtr;
2445 /* Low-level string append. Use it only against unshared objects
2446 * of type "string". */
2447 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2449 int needlen;
2451 if (len == -1)
2452 len = strlen(str);
2453 needlen = objPtr->length + len;
2454 if (objPtr->internalRep.strValue.maxLength < needlen ||
2455 objPtr->internalRep.strValue.maxLength == 0) {
2456 needlen *= 2;
2457 /* Inefficient to malloc() for less than 8 bytes */
2458 if (needlen < 7) {
2459 needlen = 7;
2461 if (objPtr->bytes == JimEmptyStringRep) {
2462 objPtr->bytes = Jim_Alloc(needlen + 1);
2464 else {
2465 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2467 objPtr->internalRep.strValue.maxLength = needlen;
2469 memcpy(objPtr->bytes + objPtr->length, str, len);
2470 objPtr->bytes[objPtr->length + len] = '\0';
2472 if (objPtr->internalRep.strValue.charLength >= 0) {
2473 /* Update the utf-8 char length */
2474 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2476 objPtr->length += len;
2479 /* Higher level API to append strings to objects.
2480 * Object must not be unshared for each of these.
2482 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2484 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2485 SetStringFromAny(interp, objPtr);
2486 StringAppendString(objPtr, str, len);
2489 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2491 int len;
2492 const char *str = Jim_GetString(appendObjPtr, &len);
2493 Jim_AppendString(interp, objPtr, str, len);
2496 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2498 va_list ap;
2500 SetStringFromAny(interp, objPtr);
2501 va_start(ap, objPtr);
2502 while (1) {
2503 const char *s = va_arg(ap, const char *);
2505 if (s == NULL)
2506 break;
2507 Jim_AppendString(interp, objPtr, s, -1);
2509 va_end(ap);
2512 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2514 if (aObjPtr == bObjPtr) {
2515 return 1;
2517 else {
2518 int Alen, Blen;
2519 const char *sA = Jim_GetString(aObjPtr, &Alen);
2520 const char *sB = Jim_GetString(bObjPtr, &Blen);
2522 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2527 * Note. Does not support embedded nulls in either the pattern or the object.
2529 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2531 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2534 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2536 const char *s1 = Jim_String(firstObjPtr);
2537 int l1 = Jim_Utf8Length(interp, firstObjPtr);
2538 const char *s2 = Jim_String(secondObjPtr);
2539 int l2 = Jim_Utf8Length(interp, secondObjPtr);
2540 return JimStringCompareUtf8(s1, l1, s2, l2, nocase);
2543 /* Convert a range, as returned by Jim_GetRange(), into
2544 * an absolute index into an object of the specified length.
2545 * This function may return negative values, or values
2546 * greater than or equal to the length of the list if the index
2547 * is out of range. */
2548 static int JimRelToAbsIndex(int len, int idx)
2550 if (idx < 0)
2551 return len + idx;
2552 return idx;
2555 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2556 * into a form suitable for implementation of commands like [string range] and [lrange].
2558 * The resulting range is guaranteed to address valid elements of
2559 * the structure.
2561 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2563 int rangeLen;
2565 if (*firstPtr > *lastPtr) {
2566 rangeLen = 0;
2568 else {
2569 rangeLen = *lastPtr - *firstPtr + 1;
2570 if (rangeLen) {
2571 if (*firstPtr < 0) {
2572 rangeLen += *firstPtr;
2573 *firstPtr = 0;
2575 if (*lastPtr >= len) {
2576 rangeLen -= (*lastPtr - (len - 1));
2577 *lastPtr = len - 1;
2581 if (rangeLen < 0)
2582 rangeLen = 0;
2584 *rangeLenPtr = rangeLen;
2587 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2588 int len, int *first, int *last, int *range)
2590 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2591 return JIM_ERR;
2593 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2594 return JIM_ERR;
2596 *first = JimRelToAbsIndex(len, *first);
2597 *last = JimRelToAbsIndex(len, *last);
2598 JimRelToAbsRange(len, first, last, range);
2599 return JIM_OK;
2602 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2603 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2605 int first, last;
2606 const char *str;
2607 int rangeLen;
2608 int bytelen;
2610 str = Jim_GetString(strObjPtr, &bytelen);
2612 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2613 return NULL;
2616 if (first == 0 && rangeLen == bytelen) {
2617 return strObjPtr;
2619 return Jim_NewStringObj(interp, str + first, rangeLen);
2622 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2623 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2625 #ifdef JIM_UTF8
2626 int first, last;
2627 const char *str;
2628 int len, rangeLen;
2629 int bytelen;
2631 str = Jim_GetString(strObjPtr, &bytelen);
2632 len = Jim_Utf8Length(interp, strObjPtr);
2634 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2635 return NULL;
2638 if (first == 0 && rangeLen == len) {
2639 return strObjPtr;
2641 if (len == bytelen) {
2642 /* ASCII optimisation */
2643 return Jim_NewStringObj(interp, str + first, rangeLen);
2645 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2646 #else
2647 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2648 #endif
2651 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2652 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2654 int first, last;
2655 const char *str;
2656 int len, rangeLen;
2657 Jim_Obj *objPtr;
2659 len = Jim_Utf8Length(interp, strObjPtr);
2661 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2662 return NULL;
2665 if (last < first) {
2666 return strObjPtr;
2669 str = Jim_String(strObjPtr);
2671 /* Before part */
2672 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2674 /* Replacement */
2675 if (newStrObj) {
2676 Jim_AppendObj(interp, objPtr, newStrObj);
2679 /* After part */
2680 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2682 return objPtr;
2686 * Note: does not support embedded nulls.
2688 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2690 while (*str) {
2691 int c;
2692 str += utf8_tounicode(str, &c);
2693 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2695 *dest = 0;
2699 * Note: does not support embedded nulls.
2701 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2703 char *buf;
2704 int len;
2705 const char *str;
2707 str = Jim_GetString(strObjPtr, &len);
2709 #ifdef JIM_UTF8
2710 /* Case mapping can change the utf-8 length of the string.
2711 * But at worst it will be by one extra byte per char
2713 len *= 2;
2714 #endif
2715 buf = Jim_Alloc(len + 1);
2716 JimStrCopyUpperLower(buf, str, 0);
2717 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2721 * Note: does not support embedded nulls.
2723 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2725 char *buf;
2726 const char *str;
2727 int len;
2729 str = Jim_GetString(strObjPtr, &len);
2731 #ifdef JIM_UTF8
2732 /* Case mapping can change the utf-8 length of the string.
2733 * But at worst it will be by one extra byte per char
2735 len *= 2;
2736 #endif
2737 buf = Jim_Alloc(len + 1);
2738 JimStrCopyUpperLower(buf, str, 1);
2739 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2743 * Note: does not support embedded nulls.
2745 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2747 char *buf, *p;
2748 int len;
2749 int c;
2750 const char *str;
2752 str = Jim_GetString(strObjPtr, &len);
2754 #ifdef JIM_UTF8
2755 /* Case mapping can change the utf-8 length of the string.
2756 * But at worst it will be by one extra byte per char
2758 len *= 2;
2759 #endif
2760 buf = p = Jim_Alloc(len + 1);
2762 str += utf8_tounicode(str, &c);
2763 p += utf8_getchars(p, utf8_title(c));
2765 JimStrCopyUpperLower(p, str, 0);
2767 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2770 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2771 * for unicode character 'c'.
2772 * Returns the position if found or NULL if not
2774 static const char *utf8_memchr(const char *str, int len, int c)
2776 #ifdef JIM_UTF8
2777 while (len) {
2778 int sc;
2779 int n = utf8_tounicode(str, &sc);
2780 if (sc == c) {
2781 return str;
2783 str += n;
2784 len -= n;
2786 return NULL;
2787 #else
2788 return memchr(str, c, len);
2789 #endif
2793 * Searches for the first non-trim char in string (str, len)
2795 * If none is found, returns just past the last char.
2797 * Lengths are in bytes.
2799 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2801 while (len) {
2802 int c;
2803 int n = utf8_tounicode(str, &c);
2805 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2806 /* Not a trim char, so stop */
2807 break;
2809 str += n;
2810 len -= n;
2812 return str;
2816 * Searches backwards for a non-trim char in string (str, len).
2818 * Returns a pointer to just after the non-trim char, or NULL if not found.
2820 * Lengths are in bytes.
2822 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2824 str += len;
2826 while (len) {
2827 int c;
2828 int n = utf8_prev_len(str, len);
2830 len -= n;
2831 str -= n;
2833 n = utf8_tounicode(str, &c);
2835 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2836 return str + n;
2840 return NULL;
2843 static const char default_trim_chars[] = " \t\n\r";
2844 /* sizeof() here includes the null byte */
2845 static int default_trim_chars_len = sizeof(default_trim_chars);
2847 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2849 int len;
2850 const char *str = Jim_GetString(strObjPtr, &len);
2851 const char *trimchars = default_trim_chars;
2852 int trimcharslen = default_trim_chars_len;
2853 const char *newstr;
2855 if (trimcharsObjPtr) {
2856 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2859 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2860 if (newstr == str) {
2861 return strObjPtr;
2864 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2867 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2869 int len;
2870 const char *trimchars = default_trim_chars;
2871 int trimcharslen = default_trim_chars_len;
2872 const char *nontrim;
2874 if (trimcharsObjPtr) {
2875 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2878 SetStringFromAny(interp, strObjPtr);
2880 len = Jim_Length(strObjPtr);
2881 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2883 if (nontrim == NULL) {
2884 /* All trim, so return a zero-length string */
2885 return Jim_NewEmptyStringObj(interp);
2887 if (nontrim == strObjPtr->bytes + len) {
2888 /* All non-trim, so return the original object */
2889 return strObjPtr;
2892 if (Jim_IsShared(strObjPtr)) {
2893 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2895 else {
2896 /* Can modify this string in place */
2897 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2898 strObjPtr->length = (nontrim - strObjPtr->bytes);
2901 return strObjPtr;
2904 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2906 /* First trim left. */
2907 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2909 /* Now trim right */
2910 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2912 /* Note: refCount check is needed since objPtr may be emptyObj */
2913 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2914 /* We don't want this object to be leaked */
2915 Jim_FreeNewObj(interp, objPtr);
2918 return strObjPtr;
2921 /* Some platforms don't have isascii - need a non-macro version */
2922 #ifdef HAVE_ISASCII
2923 #define jim_isascii isascii
2924 #else
2925 static int jim_isascii(int c)
2927 return !(c & ~0x7f);
2929 #endif
2931 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2933 static const char * const strclassnames[] = {
2934 "integer", "alpha", "alnum", "ascii", "digit",
2935 "double", "lower", "upper", "space", "xdigit",
2936 "control", "print", "graph", "punct", "boolean",
2937 NULL
2939 enum {
2940 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2941 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2942 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2944 int strclass;
2945 int len;
2946 int i;
2947 const char *str;
2948 int (*isclassfunc)(int c) = NULL;
2950 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2951 return JIM_ERR;
2954 str = Jim_GetString(strObjPtr, &len);
2955 if (len == 0) {
2956 Jim_SetResultBool(interp, !strict);
2957 return JIM_OK;
2960 switch (strclass) {
2961 case STR_IS_INTEGER:
2963 jim_wide w;
2964 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2965 return JIM_OK;
2968 case STR_IS_DOUBLE:
2970 double d;
2971 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
2972 return JIM_OK;
2975 case STR_IS_BOOLEAN:
2977 int b;
2978 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
2979 return JIM_OK;
2982 case STR_IS_ALPHA: isclassfunc = isalpha; break;
2983 case STR_IS_ALNUM: isclassfunc = isalnum; break;
2984 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
2985 case STR_IS_DIGIT: isclassfunc = isdigit; break;
2986 case STR_IS_LOWER: isclassfunc = islower; break;
2987 case STR_IS_UPPER: isclassfunc = isupper; break;
2988 case STR_IS_SPACE: isclassfunc = isspace; break;
2989 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
2990 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
2991 case STR_IS_PRINT: isclassfunc = isprint; break;
2992 case STR_IS_GRAPH: isclassfunc = isgraph; break;
2993 case STR_IS_PUNCT: isclassfunc = ispunct; break;
2994 default:
2995 return JIM_ERR;
2998 for (i = 0; i < len; i++) {
2999 if (!isclassfunc(UCHAR(str[i]))) {
3000 Jim_SetResultBool(interp, 0);
3001 return JIM_OK;
3004 Jim_SetResultBool(interp, 1);
3005 return JIM_OK;
3008 /* -----------------------------------------------------------------------------
3009 * Compared String Object
3010 * ---------------------------------------------------------------------------*/
3012 /* This is strange object that allows comparison of a C literal string
3013 * with a Jim object in a very short time if the same comparison is done
3014 * multiple times. For example every time the [if] command is executed,
3015 * Jim has to check if a given argument is "else".
3016 * If the code has no errors, this comparison is true most of the time,
3017 * so we can cache the pointer of the string of the last matching
3018 * comparison inside the object. Because most C compilers perform literal sharing,
3019 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3020 * this works pretty well even if comparisons are at different places
3021 * inside the C code. */
3023 static const Jim_ObjType comparedStringObjType = {
3024 "compared-string",
3025 NULL,
3026 NULL,
3027 NULL,
3028 JIM_TYPE_REFERENCES,
3031 /* The only way this object is exposed to the API is via the following
3032 * function. Returns true if the string and the object string repr.
3033 * are the same, otherwise zero is returned.
3035 * Note: this isn't binary safe, but it hardly needs to be.*/
3036 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3038 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3039 return 1;
3041 else {
3042 if (strcmp(str, Jim_String(objPtr)) != 0)
3043 return 0;
3045 if (objPtr->typePtr != &comparedStringObjType) {
3046 Jim_FreeIntRep(interp, objPtr);
3047 objPtr->typePtr = &comparedStringObjType;
3049 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3050 return 1;
3054 static int qsortCompareStringPointers(const void *a, const void *b)
3056 char *const *sa = (char *const *)a;
3057 char *const *sb = (char *const *)b;
3059 return strcmp(*sa, *sb);
3063 /* -----------------------------------------------------------------------------
3064 * Source Object
3066 * This object is just a string from the language point of view, but
3067 * the internal representation contains the filename and line number
3068 * where this token was read. This information is used by
3069 * Jim_EvalObj() if the object passed happens to be of type "source".
3071 * This allows propagation of the information about line numbers and file
3072 * names and gives error messages with absolute line numbers.
3074 * Note that this object uses the internal representation of the Jim_Object,
3075 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3077 * Also the object will be converted to something else if the given
3078 * token it represents in the source file is not something to be
3079 * evaluated (not a script), and will be specialized in some other way,
3080 * so the time overhead is also almost zero.
3081 * ---------------------------------------------------------------------------*/
3083 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3084 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3086 static const Jim_ObjType sourceObjType = {
3087 "source",
3088 FreeSourceInternalRep,
3089 DupSourceInternalRep,
3090 NULL,
3091 JIM_TYPE_REFERENCES,
3094 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3096 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3099 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3101 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3102 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3105 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3106 Jim_Obj *fileNameObj, int lineNumber)
3108 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3109 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3110 Jim_IncrRefCount(fileNameObj);
3111 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3112 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3113 objPtr->typePtr = &sourceObjType;
3116 /* -----------------------------------------------------------------------------
3117 * ScriptLine Object
3119 * This object is used only in the Script internal represenation.
3120 * For each line of the script, it holds the number of tokens on the line
3121 * and the source line number.
3123 static const Jim_ObjType scriptLineObjType = {
3124 "scriptline",
3125 NULL,
3126 NULL,
3127 NULL,
3128 JIM_NONE,
3131 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3133 Jim_Obj *objPtr;
3135 #ifdef DEBUG_SHOW_SCRIPT
3136 char buf[100];
3137 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3138 objPtr = Jim_NewStringObj(interp, buf, -1);
3139 #else
3140 objPtr = Jim_NewEmptyStringObj(interp);
3141 #endif
3142 objPtr->typePtr = &scriptLineObjType;
3143 objPtr->internalRep.scriptLineValue.argc = argc;
3144 objPtr->internalRep.scriptLineValue.line = line;
3146 return objPtr;
3149 /* -----------------------------------------------------------------------------
3150 * Script Object
3152 * This object holds the parsed internal representation of a script.
3153 * This representation is help within an allocated ScriptObj (see below)
3155 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3156 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3158 static const Jim_ObjType scriptObjType = {
3159 "script",
3160 FreeScriptInternalRep,
3161 DupScriptInternalRep,
3162 NULL,
3163 JIM_TYPE_REFERENCES,
3166 /* Each token of a script is represented by a ScriptToken.
3167 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3168 * can be specialized by commands operating on it.
3170 typedef struct ScriptToken
3172 Jim_Obj *objPtr;
3173 int type;
3174 } ScriptToken;
3176 /* This is the script object internal representation. An array of
3177 * ScriptToken structures, including a pre-computed representation of the
3178 * command length and arguments.
3180 * For example the script:
3182 * puts hello
3183 * set $i $x$y [foo]BAR
3185 * will produce a ScriptObj with the following ScriptToken's:
3187 * LIN 2
3188 * ESC puts
3189 * ESC hello
3190 * LIN 4
3191 * ESC set
3192 * VAR i
3193 * WRD 2
3194 * VAR x
3195 * VAR y
3196 * WRD 2
3197 * CMD foo
3198 * ESC BAR
3200 * "puts hello" has two args (LIN 2), composed of single tokens.
3201 * (Note that the WRD token is omitted for the common case of a single token.)
3203 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3204 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3206 * The precomputation of the command structure makes Jim_Eval() faster,
3207 * and simpler because there aren't dynamic lengths / allocations.
3209 * -- {expand}/{*} handling --
3211 * Expand is handled in a special way.
3213 * If a "word" begins with {*}, the word token count is -ve.
3215 * For example the command:
3217 * list {*}{a b}
3219 * Will produce the following cmdstruct array:
3221 * LIN 2
3222 * ESC list
3223 * WRD -1
3224 * STR a b
3226 * Note that the 'LIN' token also contains the source information for the
3227 * first word of the line for error reporting purposes
3229 * -- the substFlags field of the structure --
3231 * The scriptObj structure is used to represent both "script" objects
3232 * and "subst" objects. In the second case, there are no LIN and WRD
3233 * tokens. Instead SEP and EOL tokens are added as-is.
3234 * In addition, the field 'substFlags' is used to represent the flags used to turn
3235 * the string into the internal representation.
3236 * If these flags do not match what the application requires,
3237 * the scriptObj is created again. For example the script:
3239 * subst -nocommands $string
3240 * subst -novariables $string
3242 * Will (re)create the internal representation of the $string object
3243 * two times.
3245 typedef struct ScriptObj
3247 ScriptToken *token; /* Tokens array. */
3248 Jim_Obj *fileNameObj; /* Filename */
3249 int len; /* Length of token[] */
3250 int substFlags; /* flags used for the compilation of "subst" objects */
3251 int inUse; /* Used to share a ScriptObj. Currently
3252 only used by Jim_EvalObj() as protection against
3253 shimmering of the currently evaluated object. */
3254 int firstline; /* Line number of the first line */
3255 int linenr; /* Error line number, if any */
3256 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3257 } ScriptObj;
3259 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3260 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3261 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3263 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3265 int i;
3266 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3268 if (--script->inUse != 0)
3269 return;
3270 for (i = 0; i < script->len; i++) {
3271 Jim_DecrRefCount(interp, script->token[i].objPtr);
3273 Jim_Free(script->token);
3274 Jim_DecrRefCount(interp, script->fileNameObj);
3275 Jim_Free(script);
3278 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3280 JIM_NOTUSED(interp);
3281 JIM_NOTUSED(srcPtr);
3283 /* Just return a simple string. We don't try to preserve the source info
3284 * since in practice scripts are never duplicated
3286 dupPtr->typePtr = NULL;
3289 /* A simple parse token.
3290 * As the script is parsed, the created tokens point into the script string rep.
3292 typedef struct
3294 const char *token; /* Pointer to the start of the token */
3295 int len; /* Length of this token */
3296 int type; /* Token type */
3297 int line; /* Line number */
3298 } ParseToken;
3300 /* A list of parsed tokens representing a script.
3301 * Tokens are added to this list as the script is parsed.
3302 * It grows as needed.
3304 typedef struct
3306 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3307 ParseToken *list; /* Array of tokens */
3308 int size; /* Current size of the list */
3309 int count; /* Number of entries used */
3310 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3311 } ParseTokenList;
3313 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3315 tokenlist->list = tokenlist->static_list;
3316 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3317 tokenlist->count = 0;
3320 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3322 if (tokenlist->list != tokenlist->static_list) {
3323 Jim_Free(tokenlist->list);
3328 * Adds the new token to the tokenlist.
3329 * The token has the given length, type and line number.
3330 * The token list is resized as necessary.
3332 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3333 int line)
3335 ParseToken *t;
3337 if (tokenlist->count == tokenlist->size) {
3338 /* Resize the list */
3339 tokenlist->size *= 2;
3340 if (tokenlist->list != tokenlist->static_list) {
3341 tokenlist->list =
3342 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3344 else {
3345 /* The list needs to become allocated */
3346 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3347 memcpy(tokenlist->list, tokenlist->static_list,
3348 tokenlist->count * sizeof(*tokenlist->list));
3351 t = &tokenlist->list[tokenlist->count++];
3352 t->token = token;
3353 t->len = len;
3354 t->type = type;
3355 t->line = line;
3358 /* Counts the number of adjoining non-separator tokens.
3360 * Returns -ve if the first token is the expansion
3361 * operator (in which case the count doesn't include
3362 * that token).
3364 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3366 int expand = 1;
3367 int count = 0;
3369 /* Is the first word {*} or {expand}? */
3370 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3371 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3372 /* Create an expand token */
3373 expand = -1;
3374 t++;
3376 else {
3377 if (script->missing == ' ') {
3378 /* This is a "extra characters after close-brace" error. Report the first error */
3379 script->missing = '}';
3380 script->linenr = t[1].line;
3385 /* Now count non-separator words */
3386 while (!TOKEN_IS_SEP(t->type)) {
3387 t++;
3388 count++;
3391 return count * expand;
3395 * Create a script/subst object from the given token.
3397 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3399 Jim_Obj *objPtr;
3401 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3402 /* Convert backlash escapes. The result will never be longer than the original */
3403 int len = t->len;
3404 char *str = Jim_Alloc(len + 1);
3405 len = JimEscape(str, t->token, len);
3406 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3408 else {
3409 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3410 * with a single space.
3412 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3414 return objPtr;
3418 * Takes a tokenlist and creates the allocated list of script tokens
3419 * in script->token, of length script->len.
3421 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3422 * as required.
3424 * Also sets script->line to the line number of the first token
3426 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3427 ParseTokenList *tokenlist)
3429 int i;
3430 struct ScriptToken *token;
3431 /* Number of tokens so far for the current command */
3432 int lineargs = 0;
3433 /* This is the first token for the current command */
3434 ScriptToken *linefirst;
3435 int count;
3436 int linenr;
3438 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3439 printf("==== Tokens ====\n");
3440 for (i = 0; i < tokenlist->count; i++) {
3441 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3442 tokenlist->list[i].len, tokenlist->list[i].token);
3444 #endif
3446 /* May need up to one extra script token for each EOL in the worst case */
3447 count = tokenlist->count;
3448 for (i = 0; i < tokenlist->count; i++) {
3449 if (tokenlist->list[i].type == JIM_TT_EOL) {
3450 count++;
3453 linenr = script->firstline = tokenlist->list[0].line;
3455 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3457 /* This is the first token for the current command */
3458 linefirst = token++;
3460 for (i = 0; i < tokenlist->count; ) {
3461 /* Look ahead to find out how many tokens make up the next word */
3462 int wordtokens;
3464 /* Skip any leading separators */
3465 while (tokenlist->list[i].type == JIM_TT_SEP) {
3466 i++;
3469 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3471 if (wordtokens == 0) {
3472 /* None, so at end of line */
3473 if (lineargs) {
3474 linefirst->type = JIM_TT_LINE;
3475 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3476 Jim_IncrRefCount(linefirst->objPtr);
3478 /* Reset for new line */
3479 lineargs = 0;
3480 linefirst = token++;
3482 i++;
3483 continue;
3485 else if (wordtokens != 1) {
3486 /* More than 1, or {*}, so insert a WORD token */
3487 token->type = JIM_TT_WORD;
3488 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3489 Jim_IncrRefCount(token->objPtr);
3490 token++;
3491 if (wordtokens < 0) {
3492 /* Skip the expand token */
3493 i++;
3494 wordtokens = -wordtokens - 1;
3495 lineargs--;
3499 if (lineargs == 0) {
3500 /* First real token on the line, so record the line number */
3501 linenr = tokenlist->list[i].line;
3503 lineargs++;
3505 /* Add each non-separator word token to the line */
3506 while (wordtokens--) {
3507 const ParseToken *t = &tokenlist->list[i++];
3509 token->type = t->type;
3510 token->objPtr = JimMakeScriptObj(interp, t);
3511 Jim_IncrRefCount(token->objPtr);
3513 /* Every object is initially a string of type 'source', but the
3514 * internal type may be specialized during execution of the
3515 * script. */
3516 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3517 token++;
3521 if (lineargs == 0) {
3522 token--;
3525 script->len = token - script->token;
3527 JimPanic((script->len >= count, "allocated script array is too short"));
3529 #ifdef DEBUG_SHOW_SCRIPT
3530 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3531 for (i = 0; i < script->len; i++) {
3532 const ScriptToken *t = &script->token[i];
3533 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3535 #endif
3539 /* Parses the given string object to determine if it represents a complete script.
3541 * This is useful for interactive shells implementation, for [info complete].
3543 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3544 * '{' on scripts incomplete missing one or more '}' to be balanced.
3545 * '[' on scripts incomplete missing one or more ']' to be balanced.
3546 * '"' on scripts incomplete missing a '"' char.
3547 * '\\' on scripts with a trailing backslash.
3549 * If the script is complete, 1 is returned, otherwise 0.
3551 * If the script has extra characters after a close brace, this still returns 1,
3552 * but sets *stateCharPtr to '}'
3553 * Evaluating the script will give the error "extra characters after close-brace".
3555 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3557 ScriptObj *script = JimGetScript(interp, scriptObj);
3558 if (stateCharPtr) {
3559 *stateCharPtr = script->missing;
3561 return script->missing == ' ' || script->missing == '}';
3565 * Sets an appropriate error message for a missing script/expression terminator.
3567 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3569 * Note that a trailing backslash is not considered to be an error.
3571 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3573 const char *msg;
3575 switch (ch) {
3576 case '\\':
3577 case ' ':
3578 return JIM_OK;
3580 case '[':
3581 msg = "unmatched \"[\"";
3582 break;
3583 case '{':
3584 msg = "missing close-brace";
3585 break;
3586 case '}':
3587 msg = "extra characters after close-brace";
3588 break;
3589 case '"':
3590 default:
3591 msg = "missing quote";
3592 break;
3595 Jim_SetResultString(interp, msg, -1);
3596 return JIM_ERR;
3600 * Similar to ScriptObjAddTokens(), but for subst objects.
3602 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3603 ParseTokenList *tokenlist)
3605 int i;
3606 struct ScriptToken *token;
3608 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3610 for (i = 0; i < tokenlist->count; i++) {
3611 const ParseToken *t = &tokenlist->list[i];
3613 /* Create a token for 't' */
3614 token->type = t->type;
3615 token->objPtr = JimMakeScriptObj(interp, t);
3616 Jim_IncrRefCount(token->objPtr);
3617 token++;
3620 script->len = i;
3623 /* This method takes the string representation of an object
3624 * as a Tcl script, and generates the pre-parsed internal representation
3625 * of the script.
3627 * On parse error, sets an error message and returns JIM_ERR
3628 * (Note: the object is still converted to a script, even if an error occurs)
3630 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3632 int scriptTextLen;
3633 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3634 struct JimParserCtx parser;
3635 struct ScriptObj *script;
3636 ParseTokenList tokenlist;
3637 int line = 1;
3639 /* Try to get information about filename / line number */
3640 if (objPtr->typePtr == &sourceObjType) {
3641 line = objPtr->internalRep.sourceValue.lineNumber;
3644 /* Initially parse the script into tokens (in tokenlist) */
3645 ScriptTokenListInit(&tokenlist);
3647 JimParserInit(&parser, scriptText, scriptTextLen, line);
3648 while (!parser.eof) {
3649 JimParseScript(&parser);
3650 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3651 parser.tline);
3654 /* Add a final EOF token */
3655 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3657 /* Create the "real" script tokens from the parsed tokens */
3658 script = Jim_Alloc(sizeof(*script));
3659 memset(script, 0, sizeof(*script));
3660 script->inUse = 1;
3661 if (objPtr->typePtr == &sourceObjType) {
3662 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3664 else {
3665 script->fileNameObj = interp->emptyObj;
3667 Jim_IncrRefCount(script->fileNameObj);
3668 script->missing = parser.missing.ch;
3669 script->linenr = parser.missing.line;
3671 ScriptObjAddTokens(interp, script, &tokenlist);
3673 /* No longer need the token list */
3674 ScriptTokenListFree(&tokenlist);
3676 /* Free the old internal rep and set the new one. */
3677 Jim_FreeIntRep(interp, objPtr);
3678 Jim_SetIntRepPtr(objPtr, script);
3679 objPtr->typePtr = &scriptObjType;
3682 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3685 * Returns the parsed script.
3686 * Note that if there is any possibility that the script is not valid,
3687 * call JimScriptValid() to check
3689 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3691 if (objPtr == interp->emptyObj) {
3692 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3693 objPtr = interp->nullScriptObj;
3696 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3697 JimSetScriptFromAny(interp, objPtr);
3700 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3704 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3705 * and leaves an error message in the interp result.
3708 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3710 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3711 JimAddErrorToStack(interp, script);
3712 return 0;
3714 return 1;
3718 /* -----------------------------------------------------------------------------
3719 * Commands
3720 * ---------------------------------------------------------------------------*/
3721 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3723 cmdPtr->inUse++;
3726 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3728 if (--cmdPtr->inUse == 0) {
3729 if (cmdPtr->isproc) {
3730 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3731 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3732 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3733 if (cmdPtr->u.proc.staticVars) {
3734 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3735 Jim_Free(cmdPtr->u.proc.staticVars);
3738 else {
3739 /* native (C) */
3740 if (cmdPtr->u.native.delProc) {
3741 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3744 if (cmdPtr->prevCmd) {
3745 /* Delete any pushed command too */
3746 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3748 Jim_Free(cmdPtr);
3752 /* Variables HashTable Type.
3754 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3756 static void JimVariablesHTValDestructor(void *interp, void *val)
3758 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3759 Jim_Free(val);
3762 static const Jim_HashTableType JimVariablesHashTableType = {
3763 JimStringCopyHTHashFunction, /* hash function */
3764 JimStringCopyHTDup, /* key dup */
3765 NULL, /* val dup */
3766 JimStringCopyHTKeyCompare, /* key compare */
3767 JimStringCopyHTKeyDestructor, /* key destructor */
3768 JimVariablesHTValDestructor /* val destructor */
3771 /* Commands HashTable Type.
3773 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3775 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3777 JimDecrCmdRefCount(interp, val);
3780 static const Jim_HashTableType JimCommandsHashTableType = {
3781 JimStringCopyHTHashFunction, /* hash function */
3782 JimStringCopyHTDup, /* key dup */
3783 NULL, /* val dup */
3784 JimStringCopyHTKeyCompare, /* key compare */
3785 JimStringCopyHTKeyDestructor, /* key destructor */
3786 JimCommandsHT_ValDestructor /* val destructor */
3789 /* ------------------------- Commands related functions --------------------- */
3791 #ifdef jim_ext_namespace
3793 * If nameObjPtr starts with "::", returns it.
3794 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3795 * In this case, decrements the ref count of nameObjPtr.
3797 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3799 Jim_Obj *resultObj;
3801 const char *name = Jim_String(nameObjPtr);
3802 if (name[0] == ':' && name[1] == ':') {
3803 return nameObjPtr;
3805 Jim_IncrRefCount(nameObjPtr);
3806 resultObj = Jim_NewStringObj(interp, "::", -1);
3807 Jim_AppendObj(interp, resultObj, nameObjPtr);
3808 Jim_DecrRefCount(interp, nameObjPtr);
3810 return resultObj;
3814 * An efficient version of JimQualifyNameObj() where the name is
3815 * available (and needed) as a 'const char *'.
3816 * Avoids creating an object if not necessary.
3817 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3819 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3821 Jim_Obj *objPtr = interp->emptyObj;
3823 if (name[0] == ':' && name[1] == ':') {
3824 /* This command is being defined in the global namespace */
3825 while (*++name == ':') {
3828 else if (Jim_Length(interp->framePtr->nsObj)) {
3829 /* This command is being defined in a non-global namespace */
3830 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3831 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3832 name = Jim_String(objPtr);
3834 Jim_IncrRefCount(objPtr);
3835 *objPtrPtr = objPtr;
3836 return name;
3839 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3841 #else
3842 /* We can be more efficient in the no-namespace case */
3843 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3844 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3846 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3848 return nameObjPtr;
3850 #endif
3852 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3854 /* It may already exist, so we try to delete the old one.
3855 * Note that reference count means that it won't be deleted yet if
3856 * it exists in the call stack.
3858 * BUT, if 'local' is in force, instead of deleting the existing
3859 * proc, we stash a reference to the old proc here.
3861 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3862 if (he) {
3863 /* There was an old cmd with the same name,
3864 * so this requires a 'proc epoch' update. */
3866 /* If a procedure with the same name didn't exist there is no need
3867 * to increment the 'proc epoch' because creation of a new procedure
3868 * can never affect existing cached commands. We don't do
3869 * negative caching. */
3870 Jim_InterpIncrProcEpoch(interp);
3873 if (he && interp->local) {
3874 /* Push this command over the top of the previous one */
3875 cmd->prevCmd = Jim_GetHashEntryVal(he);
3876 Jim_SetHashVal(&interp->commands, he, cmd);
3878 else {
3879 if (he) {
3880 /* Replace the existing command */
3881 Jim_DeleteHashEntry(&interp->commands, name);
3884 Jim_AddHashEntry(&interp->commands, name, cmd);
3886 return JIM_OK;
3890 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3891 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3893 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3895 /* Store the new details for this command */
3896 memset(cmdPtr, 0, sizeof(*cmdPtr));
3897 cmdPtr->inUse = 1;
3898 cmdPtr->u.native.delProc = delProc;
3899 cmdPtr->u.native.cmdProc = cmdProc;
3900 cmdPtr->u.native.privData = privData;
3902 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3904 return JIM_OK;
3907 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3909 int len, i;
3911 len = Jim_ListLength(interp, staticsListObjPtr);
3912 if (len == 0) {
3913 return JIM_OK;
3916 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3917 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3918 for (i = 0; i < len; i++) {
3919 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3920 Jim_Var *varPtr;
3921 int subLen;
3923 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3924 /* Check if it's composed of two elements. */
3925 subLen = Jim_ListLength(interp, objPtr);
3926 if (subLen == 1 || subLen == 2) {
3927 /* Try to get the variable value from the current
3928 * environment. */
3929 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3930 if (subLen == 1) {
3931 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3932 if (initObjPtr == NULL) {
3933 Jim_SetResultFormatted(interp,
3934 "variable for initialization of static \"%#s\" not found in the local context",
3935 nameObjPtr);
3936 return JIM_ERR;
3939 else {
3940 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3942 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3943 return JIM_ERR;
3946 varPtr = Jim_Alloc(sizeof(*varPtr));
3947 varPtr->objPtr = initObjPtr;
3948 Jim_IncrRefCount(initObjPtr);
3949 varPtr->linkFramePtr = NULL;
3950 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3951 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3952 Jim_SetResultFormatted(interp,
3953 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3954 Jim_DecrRefCount(interp, initObjPtr);
3955 Jim_Free(varPtr);
3956 return JIM_ERR;
3959 else {
3960 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3961 objPtr);
3962 return JIM_ERR;
3965 return JIM_OK;
3969 * If the command is a proc, sets/updates the cached namespace (nsObj)
3970 * based on the command name.
3972 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3974 #ifdef jim_ext_namespace
3975 if (cmdPtr->isproc) {
3976 /* XXX: Really need JimNamespaceSplit() */
3977 const char *pt = strrchr(cmdname, ':');
3978 if (pt && pt != cmdname && pt[-1] == ':') {
3979 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3980 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3981 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3983 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3984 /* This command shadows a global command, so a proc epoch update is required */
3985 Jim_InterpIncrProcEpoch(interp);
3989 #endif
3992 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
3993 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
3995 Jim_Cmd *cmdPtr;
3996 int argListLen;
3997 int i;
3999 argListLen = Jim_ListLength(interp, argListObjPtr);
4001 /* Allocate space for both the command pointer and the arg list */
4002 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4003 memset(cmdPtr, 0, sizeof(*cmdPtr));
4004 cmdPtr->inUse = 1;
4005 cmdPtr->isproc = 1;
4006 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4007 cmdPtr->u.proc.argListLen = argListLen;
4008 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4009 cmdPtr->u.proc.argsPos = -1;
4010 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4011 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4012 Jim_IncrRefCount(argListObjPtr);
4013 Jim_IncrRefCount(bodyObjPtr);
4014 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4016 /* Create the statics hash table. */
4017 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4018 goto err;
4021 /* Parse the args out into arglist, validating as we go */
4022 /* Examine the argument list for default parameters and 'args' */
4023 for (i = 0; i < argListLen; i++) {
4024 Jim_Obj *argPtr;
4025 Jim_Obj *nameObjPtr;
4026 Jim_Obj *defaultObjPtr;
4027 int len;
4029 /* Examine a parameter */
4030 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4031 len = Jim_ListLength(interp, argPtr);
4032 if (len == 0) {
4033 Jim_SetResultString(interp, "argument with no name", -1);
4034 err:
4035 JimDecrCmdRefCount(interp, cmdPtr);
4036 return NULL;
4038 if (len > 2) {
4039 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4040 goto err;
4043 if (len == 2) {
4044 /* Optional parameter */
4045 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4046 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4048 else {
4049 /* Required parameter */
4050 nameObjPtr = argPtr;
4051 defaultObjPtr = NULL;
4055 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4056 if (cmdPtr->u.proc.argsPos >= 0) {
4057 Jim_SetResultString(interp, "'args' specified more than once", -1);
4058 goto err;
4060 cmdPtr->u.proc.argsPos = i;
4062 else {
4063 if (len == 2) {
4064 cmdPtr->u.proc.optArity++;
4066 else {
4067 cmdPtr->u.proc.reqArity++;
4071 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4072 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4075 return cmdPtr;
4078 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4080 int ret = JIM_OK;
4081 Jim_Obj *qualifiedNameObj;
4082 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4084 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4085 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4086 ret = JIM_ERR;
4088 else {
4089 Jim_InterpIncrProcEpoch(interp);
4092 JimFreeQualifiedName(interp, qualifiedNameObj);
4094 return ret;
4097 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4099 int ret = JIM_ERR;
4100 Jim_HashEntry *he;
4101 Jim_Cmd *cmdPtr;
4102 Jim_Obj *qualifiedOldNameObj;
4103 Jim_Obj *qualifiedNewNameObj;
4104 const char *fqold;
4105 const char *fqnew;
4107 if (newName[0] == 0) {
4108 return Jim_DeleteCommand(interp, oldName);
4111 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4112 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4114 /* Does it exist? */
4115 he = Jim_FindHashEntry(&interp->commands, fqold);
4116 if (he == NULL) {
4117 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4119 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4120 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4122 else {
4123 cmdPtr = Jim_GetHashEntryVal(he);
4124 if (cmdPtr->prevCmd) {
4125 /* If the command replaced another command with 'local', renaming it
4126 * would break the usage of upcall, so don't allow it.
4128 Jim_SetResultFormatted(interp, "can't rename local command \"%s\"", oldName);
4130 else {
4131 /* Add the new name first */
4132 JimIncrCmdRefCount(cmdPtr);
4133 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4134 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4136 /* Now remove the old name */
4137 Jim_DeleteHashEntry(&interp->commands, fqold);
4139 /* Increment the epoch */
4140 Jim_InterpIncrProcEpoch(interp);
4142 ret = JIM_OK;
4146 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4147 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4149 return ret;
4152 /* -----------------------------------------------------------------------------
4153 * Command object
4154 * ---------------------------------------------------------------------------*/
4156 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4158 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4161 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4163 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4164 dupPtr->typePtr = srcPtr->typePtr;
4165 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4168 static const Jim_ObjType commandObjType = {
4169 "command",
4170 FreeCommandInternalRep,
4171 DupCommandInternalRep,
4172 NULL,
4173 JIM_TYPE_REFERENCES,
4176 /* This function returns the command structure for the command name
4177 * stored in objPtr. It specializes the objPtr to contain
4178 * cached info instead of performing the lookup into the hash table
4179 * every time. The information cached may not be up-to-date, in this
4180 * case the lookup is performed and the cache updated.
4182 * Respects the 'upcall' setting.
4184 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4186 Jim_Cmd *cmd;
4188 /* In order to be valid, the proc epoch must match and
4189 * the lookup must have occurred in the same namespace
4191 if (objPtr->typePtr != &commandObjType ||
4192 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4193 #ifdef jim_ext_namespace
4194 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4195 #endif
4197 /* Not cached or out of date, so lookup */
4199 /* Do we need to try the local namespace? */
4200 const char *name = Jim_String(objPtr);
4201 Jim_HashEntry *he;
4203 if (name[0] == ':' && name[1] == ':') {
4204 while (*++name == ':') {
4207 #ifdef jim_ext_namespace
4208 else if (Jim_Length(interp->framePtr->nsObj)) {
4209 /* This command is being defined in a non-global namespace */
4210 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4211 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4212 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4213 Jim_FreeNewObj(interp, nameObj);
4214 if (he) {
4215 goto found;
4218 #endif
4220 /* Lookup in the global namespace */
4221 he = Jim_FindHashEntry(&interp->commands, name);
4222 if (he == NULL) {
4223 if (flags & JIM_ERRMSG) {
4224 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4226 return NULL;
4228 #ifdef jim_ext_namespace
4229 found:
4230 #endif
4231 cmd = Jim_GetHashEntryVal(he);
4233 /* Free the old internal rep and set the new one. */
4234 Jim_FreeIntRep(interp, objPtr);
4235 objPtr->typePtr = &commandObjType;
4236 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4237 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4238 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4239 Jim_IncrRefCount(interp->framePtr->nsObj);
4241 else {
4242 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4244 while (cmd->u.proc.upcall) {
4245 cmd = cmd->prevCmd;
4247 return cmd;
4250 /* -----------------------------------------------------------------------------
4251 * Variables
4252 * ---------------------------------------------------------------------------*/
4254 /* -----------------------------------------------------------------------------
4255 * Variable object
4256 * ---------------------------------------------------------------------------*/
4258 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4260 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4262 static const Jim_ObjType variableObjType = {
4263 "variable",
4264 NULL,
4265 NULL,
4266 NULL,
4267 JIM_TYPE_REFERENCES,
4271 * Check that the name does not contain embedded nulls.
4273 * Variable and procedure names are manipulated as null terminated strings, so
4274 * don't allow names with embedded nulls.
4276 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4278 /* Variable names and proc names can't contain embedded nulls */
4279 if (nameObjPtr->typePtr != &variableObjType) {
4280 int len;
4281 const char *str = Jim_GetString(nameObjPtr, &len);
4282 if (memchr(str, '\0', len)) {
4283 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4284 return JIM_ERR;
4287 return JIM_OK;
4290 /* This method should be called only by the variable API.
4291 * It returns JIM_OK on success (variable already exists),
4292 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4293 * a variable name, but syntax glue for [dict] i.e. the last
4294 * character is ')' */
4295 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4297 const char *varName;
4298 Jim_CallFrame *framePtr;
4299 Jim_HashEntry *he;
4300 int global;
4301 int len;
4303 /* Check if the object is already an uptodate variable */
4304 if (objPtr->typePtr == &variableObjType) {
4305 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4306 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4307 /* nothing to do */
4308 return JIM_OK;
4310 /* Need to re-resolve the variable in the updated callframe */
4312 else if (objPtr->typePtr == &dictSubstObjType) {
4313 return JIM_DICT_SUGAR;
4315 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4316 return JIM_ERR;
4320 varName = Jim_GetString(objPtr, &len);
4322 /* Make sure it's not syntax glue to get/set dict. */
4323 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4324 return JIM_DICT_SUGAR;
4327 if (varName[0] == ':' && varName[1] == ':') {
4328 while (*++varName == ':') {
4330 global = 1;
4331 framePtr = interp->topFramePtr;
4333 else {
4334 global = 0;
4335 framePtr = interp->framePtr;
4338 /* Resolve this name in the variables hash table */
4339 he = Jim_FindHashEntry(&framePtr->vars, varName);
4340 if (he == NULL) {
4341 if (!global && framePtr->staticVars) {
4342 /* Try with static vars. */
4343 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4345 if (he == NULL) {
4346 return JIM_ERR;
4350 /* Free the old internal repr and set the new one. */
4351 Jim_FreeIntRep(interp, objPtr);
4352 objPtr->typePtr = &variableObjType;
4353 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4354 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4355 objPtr->internalRep.varValue.global = global;
4356 return JIM_OK;
4359 /* -------------------- Variables related functions ------------------------- */
4360 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4361 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4363 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4365 const char *name;
4366 Jim_CallFrame *framePtr;
4367 int global;
4369 /* New variable to create */
4370 Jim_Var *var = Jim_Alloc(sizeof(*var));
4372 var->objPtr = valObjPtr;
4373 Jim_IncrRefCount(valObjPtr);
4374 var->linkFramePtr = NULL;
4376 name = Jim_String(nameObjPtr);
4377 if (name[0] == ':' && name[1] == ':') {
4378 while (*++name == ':') {
4380 framePtr = interp->topFramePtr;
4381 global = 1;
4383 else {
4384 framePtr = interp->framePtr;
4385 global = 0;
4388 /* Insert the new variable */
4389 Jim_AddHashEntry(&framePtr->vars, name, var);
4391 /* Make the object int rep a variable */
4392 Jim_FreeIntRep(interp, nameObjPtr);
4393 nameObjPtr->typePtr = &variableObjType;
4394 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4395 nameObjPtr->internalRep.varValue.varPtr = var;
4396 nameObjPtr->internalRep.varValue.global = global;
4398 return var;
4401 /* For now that's dummy. Variables lookup should be optimized
4402 * in many ways, with caching of lookups, and possibly with
4403 * a table of pre-allocated vars in every CallFrame for local vars.
4404 * All the caching should also have an 'epoch' mechanism similar
4405 * to the one used by Tcl for procedures lookup caching. */
4408 * Set the variable nameObjPtr to value valObjptr.
4410 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4412 int err;
4413 Jim_Var *var;
4415 switch (SetVariableFromAny(interp, nameObjPtr)) {
4416 case JIM_DICT_SUGAR:
4417 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4419 case JIM_ERR:
4420 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4421 return JIM_ERR;
4423 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4424 break;
4426 case JIM_OK:
4427 var = nameObjPtr->internalRep.varValue.varPtr;
4428 if (var->linkFramePtr == NULL) {
4429 Jim_IncrRefCount(valObjPtr);
4430 Jim_DecrRefCount(interp, var->objPtr);
4431 var->objPtr = valObjPtr;
4433 else { /* Else handle the link */
4434 Jim_CallFrame *savedCallFrame;
4436 savedCallFrame = interp->framePtr;
4437 interp->framePtr = var->linkFramePtr;
4438 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4439 interp->framePtr = savedCallFrame;
4440 if (err != JIM_OK)
4441 return err;
4444 return JIM_OK;
4447 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4449 Jim_Obj *nameObjPtr;
4450 int result;
4452 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4453 Jim_IncrRefCount(nameObjPtr);
4454 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4455 Jim_DecrRefCount(interp, nameObjPtr);
4456 return result;
4459 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4461 Jim_CallFrame *savedFramePtr;
4462 int result;
4464 savedFramePtr = interp->framePtr;
4465 interp->framePtr = interp->topFramePtr;
4466 result = Jim_SetVariableStr(interp, name, objPtr);
4467 interp->framePtr = savedFramePtr;
4468 return result;
4471 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4473 Jim_Obj *valObjPtr;
4474 int result;
4476 valObjPtr = Jim_NewStringObj(interp, val, -1);
4477 Jim_IncrRefCount(valObjPtr);
4478 result = Jim_SetVariableStr(interp, name, valObjPtr);
4479 Jim_DecrRefCount(interp, valObjPtr);
4480 return result;
4483 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4484 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4486 const char *varName;
4487 const char *targetName;
4488 Jim_CallFrame *framePtr;
4489 Jim_Var *varPtr;
4491 /* Check for an existing variable or link */
4492 switch (SetVariableFromAny(interp, nameObjPtr)) {
4493 case JIM_DICT_SUGAR:
4494 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4495 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4496 return JIM_ERR;
4498 case JIM_OK:
4499 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4501 if (varPtr->linkFramePtr == NULL) {
4502 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4503 return JIM_ERR;
4506 /* It exists, but is a link, so first delete the link */
4507 varPtr->linkFramePtr = NULL;
4508 break;
4511 /* Resolve the call frames for both variables */
4512 /* XXX: SetVariableFromAny() already did this! */
4513 varName = Jim_String(nameObjPtr);
4515 if (varName[0] == ':' && varName[1] == ':') {
4516 while (*++varName == ':') {
4518 /* Linking a global var does nothing */
4519 framePtr = interp->topFramePtr;
4521 else {
4522 framePtr = interp->framePtr;
4525 targetName = Jim_String(targetNameObjPtr);
4526 if (targetName[0] == ':' && targetName[1] == ':') {
4527 while (*++targetName == ':') {
4529 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4530 targetCallFrame = interp->topFramePtr;
4532 Jim_IncrRefCount(targetNameObjPtr);
4534 if (framePtr->level < targetCallFrame->level) {
4535 Jim_SetResultFormatted(interp,
4536 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4537 nameObjPtr);
4538 Jim_DecrRefCount(interp, targetNameObjPtr);
4539 return JIM_ERR;
4542 /* Check for cycles. */
4543 if (framePtr == targetCallFrame) {
4544 Jim_Obj *objPtr = targetNameObjPtr;
4546 /* Cycles are only possible with 'uplevel 0' */
4547 while (1) {
4548 if (strcmp(Jim_String(objPtr), varName) == 0) {
4549 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4550 Jim_DecrRefCount(interp, targetNameObjPtr);
4551 return JIM_ERR;
4553 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4554 break;
4555 varPtr = objPtr->internalRep.varValue.varPtr;
4556 if (varPtr->linkFramePtr != targetCallFrame)
4557 break;
4558 objPtr = varPtr->objPtr;
4562 /* Perform the binding */
4563 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4564 /* We are now sure 'nameObjPtr' type is variableObjType */
4565 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4566 Jim_DecrRefCount(interp, targetNameObjPtr);
4567 return JIM_OK;
4570 /* Return the Jim_Obj pointer associated with a variable name,
4571 * or NULL if the variable was not found in the current context.
4572 * The same optimization discussed in the comment to the
4573 * 'SetVariable' function should apply here.
4575 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4576 * in a dictionary which is shared, the array variable value is duplicated first.
4577 * This allows the array element to be updated (e.g. append, lappend) without
4578 * affecting other references to the dictionary.
4580 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4582 switch (SetVariableFromAny(interp, nameObjPtr)) {
4583 case JIM_OK:{
4584 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4586 if (varPtr->linkFramePtr == NULL) {
4587 return varPtr->objPtr;
4589 else {
4590 Jim_Obj *objPtr;
4592 /* The variable is a link? Resolve it. */
4593 Jim_CallFrame *savedCallFrame = interp->framePtr;
4595 interp->framePtr = varPtr->linkFramePtr;
4596 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4597 interp->framePtr = savedCallFrame;
4598 if (objPtr) {
4599 return objPtr;
4601 /* Error, so fall through to the error message */
4604 break;
4606 case JIM_DICT_SUGAR:
4607 /* [dict] syntax sugar. */
4608 return JimDictSugarGet(interp, nameObjPtr, flags);
4610 if (flags & JIM_ERRMSG) {
4611 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4613 return NULL;
4616 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4618 Jim_CallFrame *savedFramePtr;
4619 Jim_Obj *objPtr;
4621 savedFramePtr = interp->framePtr;
4622 interp->framePtr = interp->topFramePtr;
4623 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4624 interp->framePtr = savedFramePtr;
4626 return objPtr;
4629 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4631 Jim_Obj *nameObjPtr, *varObjPtr;
4633 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4634 Jim_IncrRefCount(nameObjPtr);
4635 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4636 Jim_DecrRefCount(interp, nameObjPtr);
4637 return varObjPtr;
4640 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4642 Jim_CallFrame *savedFramePtr;
4643 Jim_Obj *objPtr;
4645 savedFramePtr = interp->framePtr;
4646 interp->framePtr = interp->topFramePtr;
4647 objPtr = Jim_GetVariableStr(interp, name, flags);
4648 interp->framePtr = savedFramePtr;
4650 return objPtr;
4653 /* Unset a variable.
4654 * Note: On success unset invalidates all the (cached) variable objects
4655 * by incrementing callFrameEpoch
4657 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4659 Jim_Var *varPtr;
4660 int retval;
4661 Jim_CallFrame *framePtr;
4663 retval = SetVariableFromAny(interp, nameObjPtr);
4664 if (retval == JIM_DICT_SUGAR) {
4665 /* [dict] syntax sugar. */
4666 return JimDictSugarSet(interp, nameObjPtr, NULL);
4668 else if (retval == JIM_OK) {
4669 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4671 /* If it's a link call UnsetVariable recursively */
4672 if (varPtr->linkFramePtr) {
4673 framePtr = interp->framePtr;
4674 interp->framePtr = varPtr->linkFramePtr;
4675 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4676 interp->framePtr = framePtr;
4678 else {
4679 const char *name = Jim_String(nameObjPtr);
4680 if (nameObjPtr->internalRep.varValue.global) {
4681 name += 2;
4682 framePtr = interp->topFramePtr;
4684 else {
4685 framePtr = interp->framePtr;
4688 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4689 if (retval == JIM_OK) {
4690 /* Change the callframe id, invalidating var lookup caching */
4691 framePtr->id = interp->callFrameEpoch++;
4695 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4696 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4698 return retval;
4701 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4703 /* Given a variable name for [dict] operation syntax sugar,
4704 * this function returns two objects, the first with the name
4705 * of the variable to set, and the second with the respective key.
4706 * For example "foo(bar)" will return objects with string repr. of
4707 * "foo" and "bar".
4709 * The returned objects have refcount = 1. The function can't fail. */
4710 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4711 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4713 const char *str, *p;
4714 int len, keyLen;
4715 Jim_Obj *varObjPtr, *keyObjPtr;
4717 str = Jim_GetString(objPtr, &len);
4719 p = strchr(str, '(');
4720 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4722 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4724 p++;
4725 keyLen = (str + len) - p;
4726 if (str[len - 1] == ')') {
4727 keyLen--;
4730 /* Create the objects with the variable name and key. */
4731 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4733 Jim_IncrRefCount(varObjPtr);
4734 Jim_IncrRefCount(keyObjPtr);
4735 *varPtrPtr = varObjPtr;
4736 *keyPtrPtr = keyObjPtr;
4739 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4740 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4741 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4743 int err;
4745 SetDictSubstFromAny(interp, objPtr);
4747 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4748 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4750 if (err == JIM_OK) {
4751 /* Don't keep an extra ref to the result */
4752 Jim_SetEmptyResult(interp);
4754 else {
4755 if (!valObjPtr) {
4756 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4757 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4758 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4759 objPtr);
4760 return err;
4763 /* Make the error more informative and Tcl-compatible */
4764 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4765 (valObjPtr ? "set" : "unset"), objPtr);
4767 return err;
4771 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4773 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4774 * and stored back to the variable before expansion.
4776 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4777 Jim_Obj *keyObjPtr, int flags)
4779 Jim_Obj *dictObjPtr;
4780 Jim_Obj *resObjPtr = NULL;
4781 int ret;
4783 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4784 if (!dictObjPtr) {
4785 return NULL;
4788 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4789 if (ret != JIM_OK) {
4790 Jim_SetResultFormatted(interp,
4791 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4792 ret < 0 ? "variable isn't" : "no such element in");
4794 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4795 /* Update the variable to have an unshared copy */
4796 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4799 return resObjPtr;
4802 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4803 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4805 SetDictSubstFromAny(interp, objPtr);
4807 return JimDictExpandArrayVariable(interp,
4808 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4809 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4812 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4814 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4816 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4817 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4820 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4822 /* Copy the internal rep */
4823 dupPtr->internalRep = srcPtr->internalRep;
4824 /* Need to increment the ref counts */
4825 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4826 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4829 /* Note: The object *must* be in dict-sugar format */
4830 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4832 if (objPtr->typePtr != &dictSubstObjType) {
4833 Jim_Obj *varObjPtr, *keyObjPtr;
4835 if (objPtr->typePtr == &interpolatedObjType) {
4836 /* An interpolated object in dict-sugar form */
4838 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4839 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4841 Jim_IncrRefCount(varObjPtr);
4842 Jim_IncrRefCount(keyObjPtr);
4844 else {
4845 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4848 Jim_FreeIntRep(interp, objPtr);
4849 objPtr->typePtr = &dictSubstObjType;
4850 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4851 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4855 /* This function is used to expand [dict get] sugar in the form
4856 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4857 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4858 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4859 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4860 * the [dict]ionary contained in variable VARNAME. */
4861 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4863 Jim_Obj *resObjPtr = NULL;
4864 Jim_Obj *substKeyObjPtr = NULL;
4866 SetDictSubstFromAny(interp, objPtr);
4868 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4869 &substKeyObjPtr, JIM_NONE)
4870 != JIM_OK) {
4871 return NULL;
4873 Jim_IncrRefCount(substKeyObjPtr);
4874 resObjPtr =
4875 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4876 substKeyObjPtr, 0);
4877 Jim_DecrRefCount(interp, substKeyObjPtr);
4879 return resObjPtr;
4882 /* -----------------------------------------------------------------------------
4883 * CallFrame
4884 * ---------------------------------------------------------------------------*/
4886 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4888 Jim_CallFrame *cf;
4890 if (interp->freeFramesList) {
4891 cf = interp->freeFramesList;
4892 interp->freeFramesList = cf->next;
4894 cf->argv = NULL;
4895 cf->argc = 0;
4896 cf->procArgsObjPtr = NULL;
4897 cf->procBodyObjPtr = NULL;
4898 cf->next = NULL;
4899 cf->staticVars = NULL;
4900 cf->localCommands = NULL;
4901 cf->tailcallObj = NULL;
4902 cf->tailcallCmd = NULL;
4904 else {
4905 cf = Jim_Alloc(sizeof(*cf));
4906 memset(cf, 0, sizeof(*cf));
4908 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4911 cf->id = interp->callFrameEpoch++;
4912 cf->parent = parent;
4913 cf->level = parent ? parent->level + 1 : 0;
4914 cf->nsObj = nsObj;
4915 Jim_IncrRefCount(nsObj);
4917 return cf;
4920 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4922 /* Delete any local procs */
4923 if (localCommands) {
4924 Jim_Obj *cmdNameObj;
4926 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4927 Jim_HashEntry *he;
4928 Jim_Obj *fqObjName;
4929 Jim_HashTable *ht = &interp->commands;
4931 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4933 he = Jim_FindHashEntry(ht, fqname);
4935 if (he) {
4936 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4937 if (cmd->prevCmd) {
4938 Jim_Cmd *prevCmd = cmd->prevCmd;
4939 cmd->prevCmd = NULL;
4941 /* Delete the old command */
4942 JimDecrCmdRefCount(interp, cmd);
4944 /* And restore the original */
4945 Jim_SetHashVal(ht, he, prevCmd);
4947 else {
4948 Jim_DeleteHashEntry(ht, fqname);
4950 Jim_InterpIncrProcEpoch(interp);
4952 Jim_DecrRefCount(interp, cmdNameObj);
4953 JimFreeQualifiedName(interp, fqObjName);
4955 Jim_FreeStack(localCommands);
4956 Jim_Free(localCommands);
4958 return JIM_OK;
4962 * Run any $jim::defer scripts for the current call frame.
4964 * retcode is the return code from the current proc.
4966 * Returns the new return code.
4968 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
4970 Jim_Obj *objPtr;
4972 /* Fast check for the likely case that the variable doesn't exist */
4973 if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
4974 return retcode;
4977 objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
4979 if (objPtr) {
4980 int ret = JIM_OK;
4981 int i;
4982 int listLen = Jim_ListLength(interp, objPtr);
4983 Jim_Obj *resultObjPtr;
4985 Jim_IncrRefCount(objPtr);
4987 /* Need to save away the current interp result and
4988 * restore it if appropriate
4990 resultObjPtr = Jim_GetResult(interp);
4991 Jim_IncrRefCount(resultObjPtr);
4992 Jim_SetEmptyResult(interp);
4994 /* Invoke in reverse order */
4995 for (i = listLen; i > 0; i--) {
4996 /* If a defer script returns an error, don't evaluate remaining scripts */
4997 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
4998 ret = Jim_EvalObj(interp, scriptObjPtr);
4999 if (ret != JIM_OK) {
5000 break;
5004 if (ret == JIM_OK || retcode == JIM_ERR) {
5005 /* defer script had no error, or proc had an error so restore proc result */
5006 Jim_SetResult(interp, resultObjPtr);
5008 else {
5009 retcode = ret;
5012 Jim_DecrRefCount(interp, resultObjPtr);
5013 Jim_DecrRefCount(interp, objPtr);
5015 return retcode;
5018 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5019 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5020 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5022 JimDeleteLocalProcs(interp, cf->localCommands);
5024 if (cf->procArgsObjPtr)
5025 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5026 if (cf->procBodyObjPtr)
5027 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5028 Jim_DecrRefCount(interp, cf->nsObj);
5029 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5030 Jim_FreeHashTable(&cf->vars);
5031 else {
5032 int i;
5033 Jim_HashEntry **table = cf->vars.table, *he;
5035 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5036 he = table[i];
5037 while (he != NULL) {
5038 Jim_HashEntry *nextEntry = he->next;
5039 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5041 Jim_DecrRefCount(interp, varPtr->objPtr);
5042 Jim_Free(Jim_GetHashEntryKey(he));
5043 Jim_Free(varPtr);
5044 Jim_Free(he);
5045 table[i] = NULL;
5046 he = nextEntry;
5049 cf->vars.used = 0;
5051 cf->next = interp->freeFramesList;
5052 interp->freeFramesList = cf;
5056 /* -----------------------------------------------------------------------------
5057 * References
5058 * ---------------------------------------------------------------------------*/
5059 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5061 /* References HashTable Type.
5063 * Keys are unsigned long integers, dynamically allocated for now but in the
5064 * future it's worth to cache this 4 bytes objects. Values are pointers
5065 * to Jim_References. */
5066 static void JimReferencesHTValDestructor(void *interp, void *val)
5068 Jim_Reference *refPtr = (void *)val;
5070 Jim_DecrRefCount(interp, refPtr->objPtr);
5071 if (refPtr->finalizerCmdNamePtr != NULL) {
5072 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5074 Jim_Free(val);
5077 static unsigned int JimReferencesHTHashFunction(const void *key)
5079 /* Only the least significant bits are used. */
5080 const unsigned long *widePtr = key;
5081 unsigned int intValue = (unsigned int)*widePtr;
5083 return Jim_IntHashFunction(intValue);
5086 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5088 void *copy = Jim_Alloc(sizeof(unsigned long));
5090 JIM_NOTUSED(privdata);
5092 memcpy(copy, key, sizeof(unsigned long));
5093 return copy;
5096 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5098 JIM_NOTUSED(privdata);
5100 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5103 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5105 JIM_NOTUSED(privdata);
5107 Jim_Free(key);
5110 static const Jim_HashTableType JimReferencesHashTableType = {
5111 JimReferencesHTHashFunction, /* hash function */
5112 JimReferencesHTKeyDup, /* key dup */
5113 NULL, /* val dup */
5114 JimReferencesHTKeyCompare, /* key compare */
5115 JimReferencesHTKeyDestructor, /* key destructor */
5116 JimReferencesHTValDestructor /* val destructor */
5119 /* -----------------------------------------------------------------------------
5120 * Reference object type and References API
5121 * ---------------------------------------------------------------------------*/
5123 /* The string representation of references has two features in order
5124 * to make the GC faster. The first is that every reference starts
5125 * with a non common character '<', in order to make the string matching
5126 * faster. The second is that the reference string rep is 42 characters
5127 * in length, this means that it is not necessary to check any object with a string
5128 * repr < 42, and usually there aren't many of these objects. */
5130 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5132 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5134 const char *fmt = "<reference.<%s>.%020lu>";
5136 sprintf(buf, fmt, refPtr->tag, id);
5137 return JIM_REFERENCE_SPACE;
5140 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5142 static const Jim_ObjType referenceObjType = {
5143 "reference",
5144 NULL,
5145 NULL,
5146 UpdateStringOfReference,
5147 JIM_TYPE_REFERENCES,
5150 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5152 char buf[JIM_REFERENCE_SPACE + 1];
5154 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5155 JimSetStringBytes(objPtr, buf);
5158 /* returns true if 'c' is a valid reference tag character.
5159 * i.e. inside the range [_a-zA-Z0-9] */
5160 static int isrefchar(int c)
5162 return (c == '_' || isalnum(c));
5165 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5167 unsigned long value;
5168 int i, len;
5169 const char *str, *start, *end;
5170 char refId[21];
5171 Jim_Reference *refPtr;
5172 Jim_HashEntry *he;
5173 char *endptr;
5175 /* Get the string representation */
5176 str = Jim_GetString(objPtr, &len);
5177 /* Check if it looks like a reference */
5178 if (len < JIM_REFERENCE_SPACE)
5179 goto badformat;
5180 /* Trim spaces */
5181 start = str;
5182 end = str + len - 1;
5183 while (*start == ' ')
5184 start++;
5185 while (*end == ' ' && end > start)
5186 end--;
5187 if (end - start + 1 != JIM_REFERENCE_SPACE)
5188 goto badformat;
5189 /* <reference.<1234567>.%020> */
5190 if (memcmp(start, "<reference.<", 12) != 0)
5191 goto badformat;
5192 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5193 goto badformat;
5194 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5195 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5196 if (!isrefchar(start[12 + i]))
5197 goto badformat;
5199 /* Extract info from the reference. */
5200 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5201 refId[20] = '\0';
5202 /* Try to convert the ID into an unsigned long */
5203 value = strtoul(refId, &endptr, 10);
5204 if (JimCheckConversion(refId, endptr) != JIM_OK)
5205 goto badformat;
5206 /* Check if the reference really exists! */
5207 he = Jim_FindHashEntry(&interp->references, &value);
5208 if (he == NULL) {
5209 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5210 return JIM_ERR;
5212 refPtr = Jim_GetHashEntryVal(he);
5213 /* Free the old internal repr and set the new one. */
5214 Jim_FreeIntRep(interp, objPtr);
5215 objPtr->typePtr = &referenceObjType;
5216 objPtr->internalRep.refValue.id = value;
5217 objPtr->internalRep.refValue.refPtr = refPtr;
5218 return JIM_OK;
5220 badformat:
5221 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5222 return JIM_ERR;
5225 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5226 * as finalizer command (or NULL if there is no finalizer).
5227 * The returned reference object has refcount = 0. */
5228 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5230 struct Jim_Reference *refPtr;
5231 unsigned long id;
5232 Jim_Obj *refObjPtr;
5233 const char *tag;
5234 int tagLen, i;
5236 /* Perform the Garbage Collection if needed. */
5237 Jim_CollectIfNeeded(interp);
5239 refPtr = Jim_Alloc(sizeof(*refPtr));
5240 refPtr->objPtr = objPtr;
5241 Jim_IncrRefCount(objPtr);
5242 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5243 if (cmdNamePtr)
5244 Jim_IncrRefCount(cmdNamePtr);
5245 id = interp->referenceNextId++;
5246 Jim_AddHashEntry(&interp->references, &id, refPtr);
5247 refObjPtr = Jim_NewObj(interp);
5248 refObjPtr->typePtr = &referenceObjType;
5249 refObjPtr->bytes = NULL;
5250 refObjPtr->internalRep.refValue.id = id;
5251 refObjPtr->internalRep.refValue.refPtr = refPtr;
5252 interp->referenceNextId++;
5253 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5254 * that does not pass the 'isrefchar' test is replaced with '_' */
5255 tag = Jim_GetString(tagPtr, &tagLen);
5256 if (tagLen > JIM_REFERENCE_TAGLEN)
5257 tagLen = JIM_REFERENCE_TAGLEN;
5258 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5259 if (i < tagLen && isrefchar(tag[i]))
5260 refPtr->tag[i] = tag[i];
5261 else
5262 refPtr->tag[i] = '_';
5264 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5265 return refObjPtr;
5268 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5270 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5271 return NULL;
5272 return objPtr->internalRep.refValue.refPtr;
5275 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5277 Jim_Reference *refPtr;
5279 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5280 return JIM_ERR;
5281 Jim_IncrRefCount(cmdNamePtr);
5282 if (refPtr->finalizerCmdNamePtr)
5283 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5284 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5285 return JIM_OK;
5288 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5290 Jim_Reference *refPtr;
5292 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5293 return JIM_ERR;
5294 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5295 return JIM_OK;
5298 /* -----------------------------------------------------------------------------
5299 * References Garbage Collection
5300 * ---------------------------------------------------------------------------*/
5302 /* This the hash table type for the "MARK" phase of the GC */
5303 static const Jim_HashTableType JimRefMarkHashTableType = {
5304 JimReferencesHTHashFunction, /* hash function */
5305 JimReferencesHTKeyDup, /* key dup */
5306 NULL, /* val dup */
5307 JimReferencesHTKeyCompare, /* key compare */
5308 JimReferencesHTKeyDestructor, /* key destructor */
5309 NULL /* val destructor */
5312 /* Performs the garbage collection. */
5313 int Jim_Collect(Jim_Interp *interp)
5315 int collected = 0;
5316 Jim_HashTable marks;
5317 Jim_HashTableIterator htiter;
5318 Jim_HashEntry *he;
5319 Jim_Obj *objPtr;
5321 /* Avoid recursive calls */
5322 if (interp->lastCollectId == (unsigned long)~0) {
5323 /* Jim_Collect() already running. Return just now. */
5324 return 0;
5326 interp->lastCollectId = ~0;
5328 /* Mark all the references found into the 'mark' hash table.
5329 * The references are searched in every live object that
5330 * is of a type that can contain references. */
5331 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5332 objPtr = interp->liveList;
5333 while (objPtr) {
5334 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5335 const char *str, *p;
5336 int len;
5338 /* If the object is of type reference, to get the
5339 * Id is simple... */
5340 if (objPtr->typePtr == &referenceObjType) {
5341 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5342 #ifdef JIM_DEBUG_GC
5343 printf("MARK (reference): %d refcount: %d\n",
5344 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5345 #endif
5346 objPtr = objPtr->nextObjPtr;
5347 continue;
5349 /* Get the string repr of the object we want
5350 * to scan for references. */
5351 p = str = Jim_GetString(objPtr, &len);
5352 /* Skip objects too little to contain references. */
5353 if (len < JIM_REFERENCE_SPACE) {
5354 objPtr = objPtr->nextObjPtr;
5355 continue;
5357 /* Extract references from the object string repr. */
5358 while (1) {
5359 int i;
5360 unsigned long id;
5362 if ((p = strstr(p, "<reference.<")) == NULL)
5363 break;
5364 /* Check if it's a valid reference. */
5365 if (len - (p - str) < JIM_REFERENCE_SPACE)
5366 break;
5367 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5368 break;
5369 for (i = 21; i <= 40; i++)
5370 if (!isdigit(UCHAR(p[i])))
5371 break;
5372 /* Get the ID */
5373 id = strtoul(p + 21, NULL, 10);
5375 /* Ok, a reference for the given ID
5376 * was found. Mark it. */
5377 Jim_AddHashEntry(&marks, &id, NULL);
5378 #ifdef JIM_DEBUG_GC
5379 printf("MARK: %d\n", (int)id);
5380 #endif
5381 p += JIM_REFERENCE_SPACE;
5384 objPtr = objPtr->nextObjPtr;
5387 /* Run the references hash table to destroy every reference that
5388 * is not referenced outside (not present in the mark HT). */
5389 JimInitHashTableIterator(&interp->references, &htiter);
5390 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5391 const unsigned long *refId;
5392 Jim_Reference *refPtr;
5394 refId = he->key;
5395 /* Check if in the mark phase we encountered
5396 * this reference. */
5397 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5398 #ifdef JIM_DEBUG_GC
5399 printf("COLLECTING %d\n", (int)*refId);
5400 #endif
5401 collected++;
5402 /* Drop the reference, but call the
5403 * finalizer first if registered. */
5404 refPtr = Jim_GetHashEntryVal(he);
5405 if (refPtr->finalizerCmdNamePtr) {
5406 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5407 Jim_Obj *objv[3], *oldResult;
5409 JimFormatReference(refstr, refPtr, *refId);
5411 objv[0] = refPtr->finalizerCmdNamePtr;
5412 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5413 objv[2] = refPtr->objPtr;
5415 /* Drop the reference itself */
5416 /* Avoid the finaliser being freed here */
5417 Jim_IncrRefCount(objv[0]);
5418 /* Don't remove the reference from the hash table just yet
5419 * since that will free refPtr, and hence refPtr->objPtr
5422 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5423 oldResult = interp->result;
5424 Jim_IncrRefCount(oldResult);
5425 Jim_EvalObjVector(interp, 3, objv);
5426 Jim_SetResult(interp, oldResult);
5427 Jim_DecrRefCount(interp, oldResult);
5429 Jim_DecrRefCount(interp, objv[0]);
5431 Jim_DeleteHashEntry(&interp->references, refId);
5434 Jim_FreeHashTable(&marks);
5435 interp->lastCollectId = interp->referenceNextId;
5436 interp->lastCollectTime = JimClock();
5437 return collected;
5440 #define JIM_COLLECT_ID_PERIOD 5000000
5441 #define JIM_COLLECT_TIME_PERIOD 300000
5443 void Jim_CollectIfNeeded(Jim_Interp *interp)
5445 unsigned long elapsedId;
5446 jim_wide elapsedTime;
5448 elapsedId = interp->referenceNextId - interp->lastCollectId;
5449 elapsedTime = JimClock() - interp->lastCollectTime;
5452 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5453 Jim_Collect(interp);
5456 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5458 int Jim_IsBigEndian(void)
5460 union {
5461 unsigned short s;
5462 unsigned char c[2];
5463 } uval = {0x0102};
5465 return uval.c[0] == 1;
5468 /* -----------------------------------------------------------------------------
5469 * Interpreter related functions
5470 * ---------------------------------------------------------------------------*/
5472 Jim_Interp *Jim_CreateInterp(void)
5474 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5476 memset(i, 0, sizeof(*i));
5478 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5479 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5480 i->lastCollectTime = JimClock();
5482 /* Note that we can create objects only after the
5483 * interpreter liveList and freeList pointers are
5484 * initialized to NULL. */
5485 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5486 #ifdef JIM_REFERENCES
5487 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5488 #endif
5489 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5490 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5491 i->emptyObj = Jim_NewEmptyStringObj(i);
5492 i->trueObj = Jim_NewIntObj(i, 1);
5493 i->falseObj = Jim_NewIntObj(i, 0);
5494 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5495 i->errorFileNameObj = i->emptyObj;
5496 i->result = i->emptyObj;
5497 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5498 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5499 i->errorProc = i->emptyObj;
5500 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5501 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5502 Jim_IncrRefCount(i->emptyObj);
5503 Jim_IncrRefCount(i->errorFileNameObj);
5504 Jim_IncrRefCount(i->result);
5505 Jim_IncrRefCount(i->stackTrace);
5506 Jim_IncrRefCount(i->unknown);
5507 Jim_IncrRefCount(i->currentScriptObj);
5508 Jim_IncrRefCount(i->nullScriptObj);
5509 Jim_IncrRefCount(i->errorProc);
5510 Jim_IncrRefCount(i->trueObj);
5511 Jim_IncrRefCount(i->falseObj);
5513 /* Initialize key variables every interpreter should contain */
5514 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5515 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5517 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5518 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5519 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5520 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5521 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5522 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5523 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5524 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5526 return i;
5529 void Jim_FreeInterp(Jim_Interp *i)
5531 Jim_CallFrame *cf, *cfx;
5533 Jim_Obj *objPtr, *nextObjPtr;
5535 /* Free the active call frames list - must be done before i->commands is destroyed */
5536 for (cf = i->framePtr; cf; cf = cfx) {
5537 /* Note that we ignore any errors */
5538 JimInvokeDefer(i, JIM_OK);
5539 cfx = cf->parent;
5540 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5543 Jim_DecrRefCount(i, i->emptyObj);
5544 Jim_DecrRefCount(i, i->trueObj);
5545 Jim_DecrRefCount(i, i->falseObj);
5546 Jim_DecrRefCount(i, i->result);
5547 Jim_DecrRefCount(i, i->stackTrace);
5548 Jim_DecrRefCount(i, i->errorProc);
5549 Jim_DecrRefCount(i, i->unknown);
5550 Jim_DecrRefCount(i, i->errorFileNameObj);
5551 Jim_DecrRefCount(i, i->currentScriptObj);
5552 Jim_DecrRefCount(i, i->nullScriptObj);
5553 Jim_FreeHashTable(&i->commands);
5554 #ifdef JIM_REFERENCES
5555 Jim_FreeHashTable(&i->references);
5556 #endif
5557 Jim_FreeHashTable(&i->packages);
5558 Jim_Free(i->prngState);
5559 Jim_FreeHashTable(&i->assocData);
5561 /* Check that the live object list is empty, otherwise
5562 * there is a memory leak. */
5563 #ifdef JIM_MAINTAINER
5564 if (i->liveList != NULL) {
5565 objPtr = i->liveList;
5567 printf("\n-------------------------------------\n");
5568 printf("Objects still in the free list:\n");
5569 while (objPtr) {
5570 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5571 Jim_String(objPtr);
5573 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5574 printf("%p (%d) %-10s: '%.20s...'\n",
5575 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5577 else {
5578 printf("%p (%d) %-10s: '%s'\n",
5579 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5581 if (objPtr->typePtr == &sourceObjType) {
5582 printf("FILE %s LINE %d\n",
5583 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5584 objPtr->internalRep.sourceValue.lineNumber);
5586 objPtr = objPtr->nextObjPtr;
5588 printf("-------------------------------------\n\n");
5589 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5591 #endif
5593 /* Free all the freed objects. */
5594 objPtr = i->freeList;
5595 while (objPtr) {
5596 nextObjPtr = objPtr->nextObjPtr;
5597 Jim_Free(objPtr);
5598 objPtr = nextObjPtr;
5601 /* Free the free call frames list */
5602 for (cf = i->freeFramesList; cf; cf = cfx) {
5603 cfx = cf->next;
5604 if (cf->vars.table)
5605 Jim_FreeHashTable(&cf->vars);
5606 Jim_Free(cf);
5609 /* Free the interpreter structure. */
5610 Jim_Free(i);
5613 /* Returns the call frame relative to the level represented by
5614 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5616 * This function accepts the 'level' argument in the form
5617 * of the commands [uplevel] and [upvar].
5619 * Returns NULL on error.
5621 * Note: for a function accepting a relative integer as level suitable
5622 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5624 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5626 long level;
5627 const char *str;
5628 Jim_CallFrame *framePtr;
5630 if (levelObjPtr) {
5631 str = Jim_String(levelObjPtr);
5632 if (str[0] == '#') {
5633 char *endptr;
5635 level = jim_strtol(str + 1, &endptr);
5636 if (str[1] == '\0' || endptr[0] != '\0') {
5637 level = -1;
5640 else {
5641 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5642 level = -1;
5644 else {
5645 /* Convert from a relative to an absolute level */
5646 level = interp->framePtr->level - level;
5650 else {
5651 str = "1"; /* Needed to format the error message. */
5652 level = interp->framePtr->level - 1;
5655 if (level == 0) {
5656 return interp->topFramePtr;
5658 if (level > 0) {
5659 /* Lookup */
5660 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5661 if (framePtr->level == level) {
5662 return framePtr;
5667 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5668 return NULL;
5671 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5672 * as a relative integer like in the [info level ?level?] command.
5674 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5676 long level;
5677 Jim_CallFrame *framePtr;
5679 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5680 if (level <= 0) {
5681 /* Convert from a relative to an absolute level */
5682 level = interp->framePtr->level + level;
5685 if (level == 0) {
5686 return interp->topFramePtr;
5689 /* Lookup */
5690 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5691 if (framePtr->level == level) {
5692 return framePtr;
5697 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5698 return NULL;
5701 static void JimResetStackTrace(Jim_Interp *interp)
5703 Jim_DecrRefCount(interp, interp->stackTrace);
5704 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5705 Jim_IncrRefCount(interp->stackTrace);
5708 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5710 int len;
5712 /* Increment reference first in case these are the same object */
5713 Jim_IncrRefCount(stackTraceObj);
5714 Jim_DecrRefCount(interp, interp->stackTrace);
5715 interp->stackTrace = stackTraceObj;
5716 interp->errorFlag = 1;
5718 /* This is a bit ugly.
5719 * If the filename of the last entry of the stack trace is empty,
5720 * the next stack level should be added.
5722 len = Jim_ListLength(interp, interp->stackTrace);
5723 if (len >= 3) {
5724 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5725 interp->addStackTrace = 1;
5730 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5731 Jim_Obj *fileNameObj, int linenr)
5733 if (strcmp(procname, "unknown") == 0) {
5734 procname = "";
5736 if (!*procname && !Jim_Length(fileNameObj)) {
5737 /* No useful info here */
5738 return;
5741 if (Jim_IsShared(interp->stackTrace)) {
5742 Jim_DecrRefCount(interp, interp->stackTrace);
5743 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5744 Jim_IncrRefCount(interp->stackTrace);
5747 /* If we have no procname but the previous element did, merge with that frame */
5748 if (!*procname && Jim_Length(fileNameObj)) {
5749 /* Just a filename. Check the previous entry */
5750 int len = Jim_ListLength(interp, interp->stackTrace);
5752 if (len >= 3) {
5753 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5754 if (Jim_Length(objPtr)) {
5755 /* Yes, the previous level had procname */
5756 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5757 if (Jim_Length(objPtr) == 0) {
5758 /* But no filename, so merge the new info with that frame */
5759 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5760 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5761 return;
5767 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5768 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5769 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5772 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5773 void *data)
5775 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5777 assocEntryPtr->delProc = delProc;
5778 assocEntryPtr->data = data;
5779 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5782 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5784 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5786 if (entryPtr != NULL) {
5787 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5788 return assocEntryPtr->data;
5790 return NULL;
5793 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5795 return Jim_DeleteHashEntry(&interp->assocData, key);
5798 int Jim_GetExitCode(Jim_Interp *interp)
5800 return interp->exitCode;
5803 /* -----------------------------------------------------------------------------
5804 * Integer object
5805 * ---------------------------------------------------------------------------*/
5806 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5807 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5809 static const Jim_ObjType intObjType = {
5810 "int",
5811 NULL,
5812 NULL,
5813 UpdateStringOfInt,
5814 JIM_TYPE_NONE,
5817 /* A coerced double is closer to an int than a double.
5818 * It is an int value temporarily masquerading as a double value.
5819 * i.e. it has the same string value as an int and Jim_GetWide()
5820 * succeeds, but also Jim_GetDouble() returns the value directly.
5822 static const Jim_ObjType coercedDoubleObjType = {
5823 "coerced-double",
5824 NULL,
5825 NULL,
5826 UpdateStringOfInt,
5827 JIM_TYPE_NONE,
5831 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5833 char buf[JIM_INTEGER_SPACE + 1];
5834 jim_wide wideValue = JimWideValue(objPtr);
5835 int pos = 0;
5837 if (wideValue == 0) {
5838 buf[pos++] = '0';
5840 else {
5841 char tmp[JIM_INTEGER_SPACE];
5842 int num = 0;
5843 int i;
5845 if (wideValue < 0) {
5846 buf[pos++] = '-';
5847 i = wideValue % 10;
5848 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5849 * whereas C99 is always -6
5850 * coverity[dead_error_line]
5852 tmp[num++] = (i > 0) ? (10 - i) : -i;
5853 wideValue /= -10;
5856 while (wideValue) {
5857 tmp[num++] = wideValue % 10;
5858 wideValue /= 10;
5861 for (i = 0; i < num; i++) {
5862 buf[pos++] = '0' + tmp[num - i - 1];
5865 buf[pos] = 0;
5867 JimSetStringBytes(objPtr, buf);
5870 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5872 jim_wide wideValue;
5873 const char *str;
5875 if (objPtr->typePtr == &coercedDoubleObjType) {
5876 /* Simple switch */
5877 objPtr->typePtr = &intObjType;
5878 return JIM_OK;
5881 /* Get the string representation */
5882 str = Jim_String(objPtr);
5883 /* Try to convert into a jim_wide */
5884 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5885 if (flags & JIM_ERRMSG) {
5886 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5888 return JIM_ERR;
5890 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5891 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5892 return JIM_ERR;
5894 /* Free the old internal repr and set the new one. */
5895 Jim_FreeIntRep(interp, objPtr);
5896 objPtr->typePtr = &intObjType;
5897 objPtr->internalRep.wideValue = wideValue;
5898 return JIM_OK;
5901 #ifdef JIM_OPTIMIZATION
5902 static int JimIsWide(Jim_Obj *objPtr)
5904 return objPtr->typePtr == &intObjType;
5906 #endif
5908 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5910 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5911 return JIM_ERR;
5912 *widePtr = JimWideValue(objPtr);
5913 return JIM_OK;
5916 /* Get a wide but does not set an error if the format is bad. */
5917 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5919 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5920 return JIM_ERR;
5921 *widePtr = JimWideValue(objPtr);
5922 return JIM_OK;
5925 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5927 jim_wide wideValue;
5928 int retval;
5930 retval = Jim_GetWide(interp, objPtr, &wideValue);
5931 if (retval == JIM_OK) {
5932 *longPtr = (long)wideValue;
5933 return JIM_OK;
5935 return JIM_ERR;
5938 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5940 Jim_Obj *objPtr;
5942 objPtr = Jim_NewObj(interp);
5943 objPtr->typePtr = &intObjType;
5944 objPtr->bytes = NULL;
5945 objPtr->internalRep.wideValue = wideValue;
5946 return objPtr;
5949 /* -----------------------------------------------------------------------------
5950 * Double object
5951 * ---------------------------------------------------------------------------*/
5952 #define JIM_DOUBLE_SPACE 30
5954 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5955 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5957 static const Jim_ObjType doubleObjType = {
5958 "double",
5959 NULL,
5960 NULL,
5961 UpdateStringOfDouble,
5962 JIM_TYPE_NONE,
5965 #ifndef HAVE_ISNAN
5966 #undef isnan
5967 #define isnan(X) ((X) != (X))
5968 #endif
5969 #ifndef HAVE_ISINF
5970 #undef isinf
5971 #define isinf(X) (1.0 / (X) == 0.0)
5972 #endif
5974 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5976 double value = objPtr->internalRep.doubleValue;
5978 if (isnan(value)) {
5979 JimSetStringBytes(objPtr, "NaN");
5980 return;
5982 if (isinf(value)) {
5983 if (value < 0) {
5984 JimSetStringBytes(objPtr, "-Inf");
5986 else {
5987 JimSetStringBytes(objPtr, "Inf");
5989 return;
5992 char buf[JIM_DOUBLE_SPACE + 1];
5993 int i;
5994 int len = sprintf(buf, "%.12g", value);
5996 /* Add a final ".0" if necessary */
5997 for (i = 0; i < len; i++) {
5998 if (buf[i] == '.' || buf[i] == 'e') {
5999 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6000 /* If 'buf' ends in e-0nn or e+0nn, remove
6001 * the 0 after the + or - and reduce the length by 1
6003 char *e = strchr(buf, 'e');
6004 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6005 /* Move it up */
6006 e += 2;
6007 memmove(e, e + 1, len - (e - buf));
6009 #endif
6010 break;
6013 if (buf[i] == '\0') {
6014 buf[i++] = '.';
6015 buf[i++] = '0';
6016 buf[i] = '\0';
6018 JimSetStringBytes(objPtr, buf);
6022 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6024 double doubleValue;
6025 jim_wide wideValue;
6026 const char *str;
6028 #ifdef HAVE_LONG_LONG
6029 /* Assume a 53 bit mantissa */
6030 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6031 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6033 if (objPtr->typePtr == &intObjType
6034 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6035 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6037 /* Direct conversion to coerced double */
6038 objPtr->typePtr = &coercedDoubleObjType;
6039 return JIM_OK;
6041 #endif
6042 /* Preserve the string representation.
6043 * Needed so we can convert back to int without loss
6045 str = Jim_String(objPtr);
6047 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6048 /* Managed to convert to an int, so we can use this as a cooerced double */
6049 Jim_FreeIntRep(interp, objPtr);
6050 objPtr->typePtr = &coercedDoubleObjType;
6051 objPtr->internalRep.wideValue = wideValue;
6052 return JIM_OK;
6054 else {
6055 /* Try to convert into a double */
6056 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6057 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6058 return JIM_ERR;
6060 /* Free the old internal repr and set the new one. */
6061 Jim_FreeIntRep(interp, objPtr);
6063 objPtr->typePtr = &doubleObjType;
6064 objPtr->internalRep.doubleValue = doubleValue;
6065 return JIM_OK;
6068 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6070 if (objPtr->typePtr == &coercedDoubleObjType) {
6071 *doublePtr = JimWideValue(objPtr);
6072 return JIM_OK;
6074 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6075 return JIM_ERR;
6077 if (objPtr->typePtr == &coercedDoubleObjType) {
6078 *doublePtr = JimWideValue(objPtr);
6080 else {
6081 *doublePtr = objPtr->internalRep.doubleValue;
6083 return JIM_OK;
6086 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6088 Jim_Obj *objPtr;
6090 objPtr = Jim_NewObj(interp);
6091 objPtr->typePtr = &doubleObjType;
6092 objPtr->bytes = NULL;
6093 objPtr->internalRep.doubleValue = doubleValue;
6094 return objPtr;
6097 /* -----------------------------------------------------------------------------
6098 * Boolean conversion
6099 * ---------------------------------------------------------------------------*/
6100 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6102 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6104 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6105 return JIM_ERR;
6106 *booleanPtr = (int) JimWideValue(objPtr);
6107 return JIM_OK;
6110 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6112 static const char * const falses[] = {
6113 "0", "false", "no", "off", NULL
6115 static const char * const trues[] = {
6116 "1", "true", "yes", "on", NULL
6119 int boolean;
6121 int index;
6122 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6123 boolean = 0;
6124 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6125 boolean = 1;
6126 } else {
6127 if (flags & JIM_ERRMSG) {
6128 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6130 return JIM_ERR;
6133 /* Free the old internal repr and set the new one. */
6134 Jim_FreeIntRep(interp, objPtr);
6135 objPtr->typePtr = &intObjType;
6136 objPtr->internalRep.wideValue = boolean;
6137 return JIM_OK;
6140 /* -----------------------------------------------------------------------------
6141 * List object
6142 * ---------------------------------------------------------------------------*/
6143 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6144 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6145 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6146 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6147 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6148 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6150 /* Note that while the elements of the list may contain references,
6151 * the list object itself can't. This basically means that the
6152 * list object string representation as a whole can't contain references
6153 * that are not presents in the single elements. */
6154 static const Jim_ObjType listObjType = {
6155 "list",
6156 FreeListInternalRep,
6157 DupListInternalRep,
6158 UpdateStringOfList,
6159 JIM_TYPE_NONE,
6162 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6164 int i;
6166 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6167 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6169 Jim_Free(objPtr->internalRep.listValue.ele);
6172 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6174 int i;
6176 JIM_NOTUSED(interp);
6178 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6179 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6180 dupPtr->internalRep.listValue.ele =
6181 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6182 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6183 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6184 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6185 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6187 dupPtr->typePtr = &listObjType;
6190 /* The following function checks if a given string can be encoded
6191 * into a list element without any kind of quoting, surrounded by braces,
6192 * or using escapes to quote. */
6193 #define JIM_ELESTR_SIMPLE 0
6194 #define JIM_ELESTR_BRACE 1
6195 #define JIM_ELESTR_QUOTE 2
6196 static unsigned char ListElementQuotingType(const char *s, int len)
6198 int i, level, blevel, trySimple = 1;
6200 /* Try with the SIMPLE case */
6201 if (len == 0)
6202 return JIM_ELESTR_BRACE;
6203 if (s[0] == '"' || s[0] == '{') {
6204 trySimple = 0;
6205 goto testbrace;
6207 for (i = 0; i < len; i++) {
6208 switch (s[i]) {
6209 case ' ':
6210 case '$':
6211 case '"':
6212 case '[':
6213 case ']':
6214 case ';':
6215 case '\\':
6216 case '\r':
6217 case '\n':
6218 case '\t':
6219 case '\f':
6220 case '\v':
6221 trySimple = 0;
6222 /* fall through */
6223 case '{':
6224 case '}':
6225 goto testbrace;
6228 return JIM_ELESTR_SIMPLE;
6230 testbrace:
6231 /* Test if it's possible to do with braces */
6232 if (s[len - 1] == '\\')
6233 return JIM_ELESTR_QUOTE;
6234 level = 0;
6235 blevel = 0;
6236 for (i = 0; i < len; i++) {
6237 switch (s[i]) {
6238 case '{':
6239 level++;
6240 break;
6241 case '}':
6242 level--;
6243 if (level < 0)
6244 return JIM_ELESTR_QUOTE;
6245 break;
6246 case '[':
6247 blevel++;
6248 break;
6249 case ']':
6250 blevel--;
6251 break;
6252 case '\\':
6253 if (s[i + 1] == '\n')
6254 return JIM_ELESTR_QUOTE;
6255 else if (s[i + 1] != '\0')
6256 i++;
6257 break;
6260 if (blevel < 0) {
6261 return JIM_ELESTR_QUOTE;
6264 if (level == 0) {
6265 if (!trySimple)
6266 return JIM_ELESTR_BRACE;
6267 for (i = 0; i < len; i++) {
6268 switch (s[i]) {
6269 case ' ':
6270 case '$':
6271 case '"':
6272 case '[':
6273 case ']':
6274 case ';':
6275 case '\\':
6276 case '\r':
6277 case '\n':
6278 case '\t':
6279 case '\f':
6280 case '\v':
6281 return JIM_ELESTR_BRACE;
6282 break;
6285 return JIM_ELESTR_SIMPLE;
6287 return JIM_ELESTR_QUOTE;
6290 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6291 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6292 * scenario.
6293 * Returns the length of the result.
6295 static int BackslashQuoteString(const char *s, int len, char *q)
6297 char *p = q;
6299 while (len--) {
6300 switch (*s) {
6301 case ' ':
6302 case '$':
6303 case '"':
6304 case '[':
6305 case ']':
6306 case '{':
6307 case '}':
6308 case ';':
6309 case '\\':
6310 *p++ = '\\';
6311 *p++ = *s++;
6312 break;
6313 case '\n':
6314 *p++ = '\\';
6315 *p++ = 'n';
6316 s++;
6317 break;
6318 case '\r':
6319 *p++ = '\\';
6320 *p++ = 'r';
6321 s++;
6322 break;
6323 case '\t':
6324 *p++ = '\\';
6325 *p++ = 't';
6326 s++;
6327 break;
6328 case '\f':
6329 *p++ = '\\';
6330 *p++ = 'f';
6331 s++;
6332 break;
6333 case '\v':
6334 *p++ = '\\';
6335 *p++ = 'v';
6336 s++;
6337 break;
6338 default:
6339 *p++ = *s++;
6340 break;
6343 *p = '\0';
6345 return p - q;
6348 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6350 #define STATIC_QUOTING_LEN 32
6351 int i, bufLen, realLength;
6352 const char *strRep;
6353 char *p;
6354 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6356 /* Estimate the space needed. */
6357 if (objc > STATIC_QUOTING_LEN) {
6358 quotingType = Jim_Alloc(objc);
6360 else {
6361 quotingType = staticQuoting;
6363 bufLen = 0;
6364 for (i = 0; i < objc; i++) {
6365 int len;
6367 strRep = Jim_GetString(objv[i], &len);
6368 quotingType[i] = ListElementQuotingType(strRep, len);
6369 switch (quotingType[i]) {
6370 case JIM_ELESTR_SIMPLE:
6371 if (i != 0 || strRep[0] != '#') {
6372 bufLen += len;
6373 break;
6375 /* Special case '#' on first element needs braces */
6376 quotingType[i] = JIM_ELESTR_BRACE;
6377 /* fall through */
6378 case JIM_ELESTR_BRACE:
6379 bufLen += len + 2;
6380 break;
6381 case JIM_ELESTR_QUOTE:
6382 bufLen += len * 2;
6383 break;
6385 bufLen++; /* elements separator. */
6387 bufLen++;
6389 /* Generate the string rep. */
6390 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6391 realLength = 0;
6392 for (i = 0; i < objc; i++) {
6393 int len, qlen;
6395 strRep = Jim_GetString(objv[i], &len);
6397 switch (quotingType[i]) {
6398 case JIM_ELESTR_SIMPLE:
6399 memcpy(p, strRep, len);
6400 p += len;
6401 realLength += len;
6402 break;
6403 case JIM_ELESTR_BRACE:
6404 *p++ = '{';
6405 memcpy(p, strRep, len);
6406 p += len;
6407 *p++ = '}';
6408 realLength += len + 2;
6409 break;
6410 case JIM_ELESTR_QUOTE:
6411 if (i == 0 && strRep[0] == '#') {
6412 *p++ = '\\';
6413 realLength++;
6415 qlen = BackslashQuoteString(strRep, len, p);
6416 p += qlen;
6417 realLength += qlen;
6418 break;
6420 /* Add a separating space */
6421 if (i + 1 != objc) {
6422 *p++ = ' ';
6423 realLength++;
6426 *p = '\0'; /* nul term. */
6427 objPtr->length = realLength;
6429 if (quotingType != staticQuoting) {
6430 Jim_Free(quotingType);
6434 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6436 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6439 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6441 struct JimParserCtx parser;
6442 const char *str;
6443 int strLen;
6444 Jim_Obj *fileNameObj;
6445 int linenr;
6447 if (objPtr->typePtr == &listObjType) {
6448 return JIM_OK;
6451 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6452 * it also preserves any source location of the dict elements
6453 * which can be very useful
6455 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6456 Jim_Obj **listObjPtrPtr;
6457 int len;
6458 int i;
6460 listObjPtrPtr = JimDictPairs(objPtr, &len);
6461 for (i = 0; i < len; i++) {
6462 Jim_IncrRefCount(listObjPtrPtr[i]);
6465 /* Now just switch the internal rep */
6466 Jim_FreeIntRep(interp, objPtr);
6467 objPtr->typePtr = &listObjType;
6468 objPtr->internalRep.listValue.len = len;
6469 objPtr->internalRep.listValue.maxLen = len;
6470 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6472 return JIM_OK;
6475 /* Try to preserve information about filename / line number */
6476 if (objPtr->typePtr == &sourceObjType) {
6477 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6478 linenr = objPtr->internalRep.sourceValue.lineNumber;
6480 else {
6481 fileNameObj = interp->emptyObj;
6482 linenr = 1;
6484 Jim_IncrRefCount(fileNameObj);
6486 /* Get the string representation */
6487 str = Jim_GetString(objPtr, &strLen);
6489 /* Free the old internal repr just now and initialize the
6490 * new one just now. The string->list conversion can't fail. */
6491 Jim_FreeIntRep(interp, objPtr);
6492 objPtr->typePtr = &listObjType;
6493 objPtr->internalRep.listValue.len = 0;
6494 objPtr->internalRep.listValue.maxLen = 0;
6495 objPtr->internalRep.listValue.ele = NULL;
6497 /* Convert into a list */
6498 if (strLen) {
6499 JimParserInit(&parser, str, strLen, linenr);
6500 while (!parser.eof) {
6501 Jim_Obj *elementPtr;
6503 JimParseList(&parser);
6504 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6505 continue;
6506 elementPtr = JimParserGetTokenObj(interp, &parser);
6507 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6508 ListAppendElement(objPtr, elementPtr);
6511 Jim_DecrRefCount(interp, fileNameObj);
6512 return JIM_OK;
6515 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6517 Jim_Obj *objPtr;
6519 objPtr = Jim_NewObj(interp);
6520 objPtr->typePtr = &listObjType;
6521 objPtr->bytes = NULL;
6522 objPtr->internalRep.listValue.ele = NULL;
6523 objPtr->internalRep.listValue.len = 0;
6524 objPtr->internalRep.listValue.maxLen = 0;
6526 if (len) {
6527 ListInsertElements(objPtr, 0, len, elements);
6530 return objPtr;
6533 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6534 * length of the vector. Note that the user of this function should make
6535 * sure that the list object can't shimmer while the vector returned
6536 * is in use, this vector is the one stored inside the internal representation
6537 * of the list object. This function is not exported, extensions should
6538 * always access to the List object elements using Jim_ListIndex(). */
6539 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6540 Jim_Obj ***listVec)
6542 *listLen = Jim_ListLength(interp, listObj);
6543 *listVec = listObj->internalRep.listValue.ele;
6546 /* Sorting uses ints, but commands may return wide */
6547 static int JimSign(jim_wide w)
6549 if (w == 0) {
6550 return 0;
6552 else if (w < 0) {
6553 return -1;
6555 return 1;
6558 /* ListSortElements type values */
6559 struct lsort_info {
6560 jmp_buf jmpbuf;
6561 Jim_Obj *command;
6562 Jim_Interp *interp;
6563 enum {
6564 JIM_LSORT_ASCII,
6565 JIM_LSORT_NOCASE,
6566 JIM_LSORT_INTEGER,
6567 JIM_LSORT_REAL,
6568 JIM_LSORT_COMMAND
6569 } type;
6570 int order;
6571 int index;
6572 int indexed;
6573 int unique;
6574 int (*subfn)(Jim_Obj **, Jim_Obj **);
6577 static struct lsort_info *sort_info;
6579 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6581 Jim_Obj *lObj, *rObj;
6583 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6584 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6585 longjmp(sort_info->jmpbuf, JIM_ERR);
6587 return sort_info->subfn(&lObj, &rObj);
6590 /* Sort the internal rep of a list. */
6591 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6593 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6596 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6598 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6601 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6603 jim_wide lhs = 0, rhs = 0;
6605 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6606 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6607 longjmp(sort_info->jmpbuf, JIM_ERR);
6610 return JimSign(lhs - rhs) * sort_info->order;
6613 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6615 double lhs = 0, rhs = 0;
6617 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6618 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6619 longjmp(sort_info->jmpbuf, JIM_ERR);
6621 if (lhs == rhs) {
6622 return 0;
6624 if (lhs > rhs) {
6625 return sort_info->order;
6627 return -sort_info->order;
6630 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6632 Jim_Obj *compare_script;
6633 int rc;
6635 jim_wide ret = 0;
6637 /* This must be a valid list */
6638 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6639 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6640 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6642 rc = Jim_EvalObj(sort_info->interp, compare_script);
6644 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6645 longjmp(sort_info->jmpbuf, rc);
6648 return JimSign(ret) * sort_info->order;
6651 /* Remove duplicate elements from the (sorted) list in-place, according to the
6652 * comparison function, comp.
6654 * Note that the last unique value is kept, not the first
6656 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6658 int src;
6659 int dst = 0;
6660 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6662 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6663 if (comp(&ele[dst], &ele[src]) == 0) {
6664 /* Match, so replace the dest with the current source */
6665 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6667 else {
6668 /* No match, so keep the current source and move to the next destination */
6669 dst++;
6671 ele[dst] = ele[src];
6674 /* At end of list, keep the final element unless all elements were kept */
6675 dst++;
6676 if (dst < listObjPtr->internalRep.listValue.len) {
6677 ele[dst] = ele[src];
6680 /* Set the new length */
6681 listObjPtr->internalRep.listValue.len = dst;
6684 /* Sort a list *in place*. MUST be called with a non-shared list. */
6685 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6687 struct lsort_info *prev_info;
6689 typedef int (qsort_comparator) (const void *, const void *);
6690 int (*fn) (Jim_Obj **, Jim_Obj **);
6691 Jim_Obj **vector;
6692 int len;
6693 int rc;
6695 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6696 SetListFromAny(interp, listObjPtr);
6698 /* Allow lsort to be called reentrantly */
6699 prev_info = sort_info;
6700 sort_info = info;
6702 vector = listObjPtr->internalRep.listValue.ele;
6703 len = listObjPtr->internalRep.listValue.len;
6704 switch (info->type) {
6705 case JIM_LSORT_ASCII:
6706 fn = ListSortString;
6707 break;
6708 case JIM_LSORT_NOCASE:
6709 fn = ListSortStringNoCase;
6710 break;
6711 case JIM_LSORT_INTEGER:
6712 fn = ListSortInteger;
6713 break;
6714 case JIM_LSORT_REAL:
6715 fn = ListSortReal;
6716 break;
6717 case JIM_LSORT_COMMAND:
6718 fn = ListSortCommand;
6719 break;
6720 default:
6721 fn = NULL; /* avoid warning */
6722 JimPanic((1, "ListSort called with invalid sort type"));
6723 return -1; /* Should not be run but keeps static analysers happy */
6726 if (info->indexed) {
6727 /* Need to interpose a "list index" function */
6728 info->subfn = fn;
6729 fn = ListSortIndexHelper;
6732 if ((rc = setjmp(info->jmpbuf)) == 0) {
6733 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6735 if (info->unique && len > 1) {
6736 ListRemoveDuplicates(listObjPtr, fn);
6739 Jim_InvalidateStringRep(listObjPtr);
6741 sort_info = prev_info;
6743 return rc;
6746 /* This is the low-level function to insert elements into a list.
6747 * The higher-level Jim_ListInsertElements() performs shared object
6748 * check and invalidates the string repr. This version is used
6749 * in the internals of the List Object and is not exported.
6751 * NOTE: this function can be called only against objects
6752 * with internal type of List.
6754 * An insertion point (idx) of -1 means end-of-list.
6756 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6758 int currentLen = listPtr->internalRep.listValue.len;
6759 int requiredLen = currentLen + elemc;
6760 int i;
6761 Jim_Obj **point;
6763 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6764 if (requiredLen < 2) {
6765 /* Don't do allocations of under 4 pointers. */
6766 requiredLen = 4;
6768 else {
6769 requiredLen *= 2;
6772 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6773 sizeof(Jim_Obj *) * requiredLen);
6775 listPtr->internalRep.listValue.maxLen = requiredLen;
6777 if (idx < 0) {
6778 idx = currentLen;
6780 point = listPtr->internalRep.listValue.ele + idx;
6781 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6782 for (i = 0; i < elemc; ++i) {
6783 point[i] = elemVec[i];
6784 Jim_IncrRefCount(point[i]);
6786 listPtr->internalRep.listValue.len += elemc;
6789 /* Convenience call to ListInsertElements() to append a single element.
6791 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6793 ListInsertElements(listPtr, -1, 1, &objPtr);
6796 /* Appends every element of appendListPtr into listPtr.
6797 * Both have to be of the list type.
6798 * Convenience call to ListInsertElements()
6800 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6802 ListInsertElements(listPtr, -1,
6803 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6806 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6808 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6809 SetListFromAny(interp, listPtr);
6810 Jim_InvalidateStringRep(listPtr);
6811 ListAppendElement(listPtr, objPtr);
6814 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6816 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6817 SetListFromAny(interp, listPtr);
6818 SetListFromAny(interp, appendListPtr);
6819 Jim_InvalidateStringRep(listPtr);
6820 ListAppendList(listPtr, appendListPtr);
6823 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6825 SetListFromAny(interp, objPtr);
6826 return objPtr->internalRep.listValue.len;
6829 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6830 int objc, Jim_Obj *const *objVec)
6832 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6833 SetListFromAny(interp, listPtr);
6834 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6835 idx = listPtr->internalRep.listValue.len;
6836 else if (idx < 0)
6837 idx = 0;
6838 Jim_InvalidateStringRep(listPtr);
6839 ListInsertElements(listPtr, idx, objc, objVec);
6842 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6844 SetListFromAny(interp, listPtr);
6845 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6846 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6847 return NULL;
6849 if (idx < 0)
6850 idx = listPtr->internalRep.listValue.len + idx;
6851 return listPtr->internalRep.listValue.ele[idx];
6854 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6856 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6857 if (*objPtrPtr == NULL) {
6858 if (flags & JIM_ERRMSG) {
6859 Jim_SetResultString(interp, "list index out of range", -1);
6861 return JIM_ERR;
6863 return JIM_OK;
6866 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6867 Jim_Obj *newObjPtr, int flags)
6869 SetListFromAny(interp, listPtr);
6870 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6871 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6872 if (flags & JIM_ERRMSG) {
6873 Jim_SetResultString(interp, "list index out of range", -1);
6875 return JIM_ERR;
6877 if (idx < 0)
6878 idx = listPtr->internalRep.listValue.len + idx;
6879 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6880 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6881 Jim_IncrRefCount(newObjPtr);
6882 return JIM_OK;
6885 /* Modify the list stored in the variable named 'varNamePtr'
6886 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6887 * with the new element 'newObjptr'. (implements the [lset] command) */
6888 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6889 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6891 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6892 int shared, i, idx;
6894 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6895 if (objPtr == NULL)
6896 return JIM_ERR;
6897 if ((shared = Jim_IsShared(objPtr)))
6898 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6899 for (i = 0; i < indexc - 1; i++) {
6900 listObjPtr = objPtr;
6901 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6902 goto err;
6903 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6904 goto err;
6906 if (Jim_IsShared(objPtr)) {
6907 objPtr = Jim_DuplicateObj(interp, objPtr);
6908 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6910 Jim_InvalidateStringRep(listObjPtr);
6912 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6913 goto err;
6914 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6915 goto err;
6916 Jim_InvalidateStringRep(objPtr);
6917 Jim_InvalidateStringRep(varObjPtr);
6918 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6919 goto err;
6920 Jim_SetResult(interp, varObjPtr);
6921 return JIM_OK;
6922 err:
6923 if (shared) {
6924 Jim_FreeNewObj(interp, varObjPtr);
6926 return JIM_ERR;
6929 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6931 int i;
6932 int listLen = Jim_ListLength(interp, listObjPtr);
6933 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6935 for (i = 0; i < listLen; ) {
6936 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6937 if (++i != listLen) {
6938 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6941 return resObjPtr;
6944 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6946 int i;
6948 /* If all the objects in objv are lists,
6949 * it's possible to return a list as result, that's the
6950 * concatenation of all the lists. */
6951 for (i = 0; i < objc; i++) {
6952 if (!Jim_IsList(objv[i]))
6953 break;
6955 if (i == objc) {
6956 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6958 for (i = 0; i < objc; i++)
6959 ListAppendList(objPtr, objv[i]);
6960 return objPtr;
6962 else {
6963 /* Else... we have to glue strings together */
6964 int len = 0, objLen;
6965 char *bytes, *p;
6967 /* Compute the length */
6968 for (i = 0; i < objc; i++) {
6969 len += Jim_Length(objv[i]);
6971 if (objc)
6972 len += objc - 1;
6973 /* Create the string rep, and a string object holding it. */
6974 p = bytes = Jim_Alloc(len + 1);
6975 for (i = 0; i < objc; i++) {
6976 const char *s = Jim_GetString(objv[i], &objLen);
6978 /* Remove leading space */
6979 while (objLen && isspace(UCHAR(*s))) {
6980 s++;
6981 objLen--;
6982 len--;
6984 /* And trailing space */
6985 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6986 /* Handle trailing backslash-space case */
6987 if (objLen > 1 && s[objLen - 2] == '\\') {
6988 break;
6990 objLen--;
6991 len--;
6993 memcpy(p, s, objLen);
6994 p += objLen;
6995 if (i + 1 != objc) {
6996 if (objLen)
6997 *p++ = ' ';
6998 else {
6999 /* Drop the space calculated for this
7000 * element that is instead null. */
7001 len--;
7005 *p = '\0';
7006 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7010 /* Returns a list composed of the elements in the specified range.
7011 * first and start are directly accepted as Jim_Objects and
7012 * processed for the end?-index? case. */
7013 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7014 Jim_Obj *lastObjPtr)
7016 int first, last;
7017 int len, rangeLen;
7019 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7020 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7021 return NULL;
7022 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7023 first = JimRelToAbsIndex(len, first);
7024 last = JimRelToAbsIndex(len, last);
7025 JimRelToAbsRange(len, &first, &last, &rangeLen);
7026 if (first == 0 && last == len) {
7027 return listObjPtr;
7029 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7032 /* -----------------------------------------------------------------------------
7033 * Dict object
7034 * ---------------------------------------------------------------------------*/
7035 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7036 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7037 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7038 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7040 /* Dict HashTable Type.
7042 * Keys and Values are Jim objects. */
7044 static unsigned int JimObjectHTHashFunction(const void *key)
7046 int len;
7047 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7048 return Jim_GenHashFunction((const unsigned char *)str, len);
7051 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7053 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7056 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7058 Jim_IncrRefCount((Jim_Obj *)val);
7059 return (void *)val;
7062 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7064 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7067 static const Jim_HashTableType JimDictHashTableType = {
7068 JimObjectHTHashFunction, /* hash function */
7069 JimObjectHTKeyValDup, /* key dup */
7070 JimObjectHTKeyValDup, /* val dup */
7071 JimObjectHTKeyCompare, /* key compare */
7072 JimObjectHTKeyValDestructor, /* key destructor */
7073 JimObjectHTKeyValDestructor /* val destructor */
7076 /* Note that while the elements of the dict may contain references,
7077 * the list object itself can't. This basically means that the
7078 * dict object string representation as a whole can't contain references
7079 * that are not presents in the single elements. */
7080 static const Jim_ObjType dictObjType = {
7081 "dict",
7082 FreeDictInternalRep,
7083 DupDictInternalRep,
7084 UpdateStringOfDict,
7085 JIM_TYPE_NONE,
7088 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7090 JIM_NOTUSED(interp);
7092 Jim_FreeHashTable(objPtr->internalRep.ptr);
7093 Jim_Free(objPtr->internalRep.ptr);
7096 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7098 Jim_HashTable *ht, *dupHt;
7099 Jim_HashTableIterator htiter;
7100 Jim_HashEntry *he;
7102 /* Create a new hash table */
7103 ht = srcPtr->internalRep.ptr;
7104 dupHt = Jim_Alloc(sizeof(*dupHt));
7105 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7106 if (ht->size != 0)
7107 Jim_ExpandHashTable(dupHt, ht->size);
7108 /* Copy every element from the source to the dup hash table */
7109 JimInitHashTableIterator(ht, &htiter);
7110 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7111 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7114 dupPtr->internalRep.ptr = dupHt;
7115 dupPtr->typePtr = &dictObjType;
7118 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7120 Jim_HashTable *ht;
7121 Jim_HashTableIterator htiter;
7122 Jim_HashEntry *he;
7123 Jim_Obj **objv;
7124 int i;
7126 ht = dictPtr->internalRep.ptr;
7128 /* Turn the hash table into a flat vector of Jim_Objects. */
7129 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7130 JimInitHashTableIterator(ht, &htiter);
7131 i = 0;
7132 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7133 objv[i++] = Jim_GetHashEntryKey(he);
7134 objv[i++] = Jim_GetHashEntryVal(he);
7136 *len = i;
7137 return objv;
7140 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7142 /* Turn the hash table into a flat vector of Jim_Objects. */
7143 int len;
7144 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7146 /* And now generate the string rep as a list */
7147 JimMakeListStringRep(objPtr, objv, len);
7149 Jim_Free(objv);
7152 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7154 int listlen;
7156 if (objPtr->typePtr == &dictObjType) {
7157 return JIM_OK;
7160 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7161 /* A shared list, so get the string representation now to avoid
7162 * changing the order in case of fast conversion to dict.
7164 Jim_String(objPtr);
7167 /* For simplicity, convert a non-list object to a list and then to a dict */
7168 listlen = Jim_ListLength(interp, objPtr);
7169 if (listlen % 2) {
7170 Jim_SetResultString(interp, "missing value to go with key", -1);
7171 return JIM_ERR;
7173 else {
7174 /* Converting from a list to a dict can't fail */
7175 Jim_HashTable *ht;
7176 int i;
7178 ht = Jim_Alloc(sizeof(*ht));
7179 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7181 for (i = 0; i < listlen; i += 2) {
7182 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7183 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7185 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7188 Jim_FreeIntRep(interp, objPtr);
7189 objPtr->typePtr = &dictObjType;
7190 objPtr->internalRep.ptr = ht;
7192 return JIM_OK;
7196 /* Dict object API */
7198 /* Add an element to a dict. objPtr must be of the "dict" type.
7199 * The higher-level exported function is Jim_DictAddElement().
7200 * If an element with the specified key already exists, the value
7201 * associated is replaced with the new one.
7203 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7204 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7205 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7207 Jim_HashTable *ht = objPtr->internalRep.ptr;
7209 if (valueObjPtr == NULL) { /* unset */
7210 return Jim_DeleteHashEntry(ht, keyObjPtr);
7212 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7213 return JIM_OK;
7216 /* Add an element, higher-level interface for DictAddElement().
7217 * If valueObjPtr == NULL, the key is removed if it exists. */
7218 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7219 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7221 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7222 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7223 return JIM_ERR;
7225 Jim_InvalidateStringRep(objPtr);
7226 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7229 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7231 Jim_Obj *objPtr;
7232 int i;
7234 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7236 objPtr = Jim_NewObj(interp);
7237 objPtr->typePtr = &dictObjType;
7238 objPtr->bytes = NULL;
7239 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7240 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7241 for (i = 0; i < len; i += 2)
7242 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7243 return objPtr;
7246 /* Return the value associated to the specified dict key
7247 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7249 * Sets *objPtrPtr to non-NULL only upon success.
7251 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7252 Jim_Obj **objPtrPtr, int flags)
7254 Jim_HashEntry *he;
7255 Jim_HashTable *ht;
7257 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7258 return -1;
7260 ht = dictPtr->internalRep.ptr;
7261 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7262 if (flags & JIM_ERRMSG) {
7263 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7265 return JIM_ERR;
7267 else {
7268 *objPtrPtr = Jim_GetHashEntryVal(he);
7269 return JIM_OK;
7273 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7274 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7276 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7277 return JIM_ERR;
7279 *objPtrPtr = JimDictPairs(dictPtr, len);
7281 return JIM_OK;
7285 /* Return the value associated to the specified dict keys */
7286 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7287 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7289 int i;
7291 if (keyc == 0) {
7292 *objPtrPtr = dictPtr;
7293 return JIM_OK;
7296 for (i = 0; i < keyc; i++) {
7297 Jim_Obj *objPtr;
7299 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7300 if (rc != JIM_OK) {
7301 return rc;
7303 dictPtr = objPtr;
7305 *objPtrPtr = dictPtr;
7306 return JIM_OK;
7309 /* Modify the dict stored into the variable named 'varNamePtr'
7310 * setting the element specified by the 'keyc' keys objects in 'keyv',
7311 * with the new value of the element 'newObjPtr'.
7313 * If newObjPtr == NULL the operation is to remove the given key
7314 * from the dictionary.
7316 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7317 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7319 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7320 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7322 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7323 int shared, i;
7325 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7326 if (objPtr == NULL) {
7327 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7328 /* Cannot remove a key from non existing var */
7329 return JIM_ERR;
7331 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7332 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7333 Jim_FreeNewObj(interp, varObjPtr);
7334 return JIM_ERR;
7337 if ((shared = Jim_IsShared(objPtr)))
7338 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7339 for (i = 0; i < keyc; i++) {
7340 dictObjPtr = objPtr;
7342 /* Check if it's a valid dictionary */
7343 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7344 goto err;
7347 if (i == keyc - 1) {
7348 /* Last key: Note that error on unset with missing last key is OK */
7349 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7350 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7351 goto err;
7354 break;
7357 /* Check if the given key exists. */
7358 Jim_InvalidateStringRep(dictObjPtr);
7359 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7360 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7361 /* This key exists at the current level.
7362 * Make sure it's not shared!. */
7363 if (Jim_IsShared(objPtr)) {
7364 objPtr = Jim_DuplicateObj(interp, objPtr);
7365 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7368 else {
7369 /* Key not found. If it's an [unset] operation
7370 * this is an error. Only the last key may not
7371 * exist. */
7372 if (newObjPtr == NULL) {
7373 goto err;
7375 /* Otherwise set an empty dictionary
7376 * as key's value. */
7377 objPtr = Jim_NewDictObj(interp, NULL, 0);
7378 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7381 /* XXX: Is this necessary? */
7382 Jim_InvalidateStringRep(objPtr);
7383 Jim_InvalidateStringRep(varObjPtr);
7384 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7385 goto err;
7387 Jim_SetResult(interp, varObjPtr);
7388 return JIM_OK;
7389 err:
7390 if (shared) {
7391 Jim_FreeNewObj(interp, varObjPtr);
7393 return JIM_ERR;
7396 /* -----------------------------------------------------------------------------
7397 * Index object
7398 * ---------------------------------------------------------------------------*/
7399 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7400 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7402 static const Jim_ObjType indexObjType = {
7403 "index",
7404 NULL,
7405 NULL,
7406 UpdateStringOfIndex,
7407 JIM_TYPE_NONE,
7410 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7412 if (objPtr->internalRep.intValue == -1) {
7413 JimSetStringBytes(objPtr, "end");
7415 else {
7416 char buf[JIM_INTEGER_SPACE + 1];
7417 if (objPtr->internalRep.intValue >= 0 || objPtr->internalRep.intValue == -INT_MAX) {
7418 sprintf(buf, "%d", objPtr->internalRep.intValue);
7420 else {
7421 /* Must be <= -2 */
7422 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7424 JimSetStringBytes(objPtr, buf);
7428 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7430 int idx, end = 0;
7431 const char *str;
7432 char *endptr;
7434 /* Get the string representation */
7435 str = Jim_String(objPtr);
7437 /* Try to convert into an index */
7438 if (strncmp(str, "end", 3) == 0) {
7439 end = 1;
7440 str += 3;
7441 idx = 0;
7443 else {
7444 idx = jim_strtol(str, &endptr);
7446 if (endptr == str) {
7447 goto badindex;
7449 str = endptr;
7452 /* Now str may include or +<num> or -<num> */
7453 if (*str == '+' || *str == '-') {
7454 int sign = (*str == '+' ? 1 : -1);
7456 idx += sign * jim_strtol(++str, &endptr);
7457 if (str == endptr || *endptr) {
7458 goto badindex;
7460 str = endptr;
7462 /* The only thing left should be spaces */
7463 while (isspace(UCHAR(*str))) {
7464 str++;
7466 if (*str) {
7467 goto badindex;
7469 if (end) {
7470 if (idx > 0) {
7471 idx = INT_MAX;
7473 else {
7474 /* end-1 is repesented as -2 */
7475 idx--;
7478 else if (idx < 0) {
7479 idx = -INT_MAX;
7482 /* Free the old internal repr and set the new one. */
7483 Jim_FreeIntRep(interp, objPtr);
7484 objPtr->typePtr = &indexObjType;
7485 objPtr->internalRep.intValue = idx;
7486 return JIM_OK;
7488 badindex:
7489 Jim_SetResultFormatted(interp,
7490 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7491 return JIM_ERR;
7494 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7496 /* Avoid shimmering if the object is an integer. */
7497 if (objPtr->typePtr == &intObjType) {
7498 jim_wide val = JimWideValue(objPtr);
7500 if (val < 0)
7501 *indexPtr = -INT_MAX;
7502 else if (val > INT_MAX)
7503 *indexPtr = INT_MAX;
7504 else
7505 *indexPtr = (int)val;
7506 return JIM_OK;
7508 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7509 return JIM_ERR;
7510 *indexPtr = objPtr->internalRep.intValue;
7511 return JIM_OK;
7514 /* -----------------------------------------------------------------------------
7515 * Return Code Object.
7516 * ---------------------------------------------------------------------------*/
7518 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7519 static const char * const jimReturnCodes[] = {
7520 "ok",
7521 "error",
7522 "return",
7523 "break",
7524 "continue",
7525 "signal",
7526 "exit",
7527 "eval",
7528 NULL
7531 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7533 static const Jim_ObjType returnCodeObjType = {
7534 "return-code",
7535 NULL,
7536 NULL,
7537 NULL,
7538 JIM_TYPE_NONE,
7541 /* Converts a (standard) return code to a string. Returns "?" for
7542 * non-standard return codes.
7544 const char *Jim_ReturnCode(int code)
7546 if (code < 0 || code >= (int)jimReturnCodesSize) {
7547 return "?";
7549 else {
7550 return jimReturnCodes[code];
7554 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7556 int returnCode;
7557 jim_wide wideValue;
7559 /* Try to convert into an integer */
7560 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7561 returnCode = (int)wideValue;
7562 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7563 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7564 return JIM_ERR;
7566 /* Free the old internal repr and set the new one. */
7567 Jim_FreeIntRep(interp, objPtr);
7568 objPtr->typePtr = &returnCodeObjType;
7569 objPtr->internalRep.intValue = returnCode;
7570 return JIM_OK;
7573 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7575 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7576 return JIM_ERR;
7577 *intPtr = objPtr->internalRep.intValue;
7578 return JIM_OK;
7581 /* -----------------------------------------------------------------------------
7582 * Expression Parsing
7583 * ---------------------------------------------------------------------------*/
7584 static int JimParseExprOperator(struct JimParserCtx *pc);
7585 static int JimParseExprNumber(struct JimParserCtx *pc);
7586 static int JimParseExprIrrational(struct JimParserCtx *pc);
7587 static int JimParseExprBoolean(struct JimParserCtx *pc);
7589 /* expr operator opcodes. */
7590 enum
7592 /* Continues on from the JIM_TT_ space */
7594 /* Binary operators (numbers) */
7595 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7596 JIM_EXPROP_DIV,
7597 JIM_EXPROP_MOD,
7598 JIM_EXPROP_SUB,
7599 JIM_EXPROP_ADD,
7600 JIM_EXPROP_LSHIFT,
7601 JIM_EXPROP_RSHIFT,
7602 JIM_EXPROP_ROTL,
7603 JIM_EXPROP_ROTR,
7604 JIM_EXPROP_LT,
7605 JIM_EXPROP_GT,
7606 JIM_EXPROP_LTE,
7607 JIM_EXPROP_GTE,
7608 JIM_EXPROP_NUMEQ,
7609 JIM_EXPROP_NUMNE,
7610 JIM_EXPROP_BITAND, /* 35 */
7611 JIM_EXPROP_BITXOR,
7612 JIM_EXPROP_BITOR,
7613 JIM_EXPROP_LOGICAND, /* 38 */
7614 JIM_EXPROP_LOGICOR, /* 39 */
7615 JIM_EXPROP_TERNARY, /* 40 */
7616 JIM_EXPROP_COLON, /* 41 */
7617 JIM_EXPROP_POW, /* 42 */
7619 /* Binary operators (strings) */
7620 JIM_EXPROP_STREQ, /* 43 */
7621 JIM_EXPROP_STRNE,
7622 JIM_EXPROP_STRIN,
7623 JIM_EXPROP_STRNI,
7625 /* Unary operators (numbers) */
7626 JIM_EXPROP_NOT, /* 47 */
7627 JIM_EXPROP_BITNOT,
7628 JIM_EXPROP_UNARYMINUS,
7629 JIM_EXPROP_UNARYPLUS,
7631 /* Functions */
7632 JIM_EXPROP_FUNC_INT, /* 51 */
7633 JIM_EXPROP_FUNC_WIDE,
7634 JIM_EXPROP_FUNC_ABS,
7635 JIM_EXPROP_FUNC_DOUBLE,
7636 JIM_EXPROP_FUNC_ROUND,
7637 JIM_EXPROP_FUNC_RAND,
7638 JIM_EXPROP_FUNC_SRAND,
7640 /* math functions from libm */
7641 JIM_EXPROP_FUNC_SIN, /* 65 */
7642 JIM_EXPROP_FUNC_COS,
7643 JIM_EXPROP_FUNC_TAN,
7644 JIM_EXPROP_FUNC_ASIN,
7645 JIM_EXPROP_FUNC_ACOS,
7646 JIM_EXPROP_FUNC_ATAN,
7647 JIM_EXPROP_FUNC_ATAN2,
7648 JIM_EXPROP_FUNC_SINH,
7649 JIM_EXPROP_FUNC_COSH,
7650 JIM_EXPROP_FUNC_TANH,
7651 JIM_EXPROP_FUNC_CEIL,
7652 JIM_EXPROP_FUNC_FLOOR,
7653 JIM_EXPROP_FUNC_EXP,
7654 JIM_EXPROP_FUNC_LOG,
7655 JIM_EXPROP_FUNC_LOG10,
7656 JIM_EXPROP_FUNC_SQRT,
7657 JIM_EXPROP_FUNC_POW,
7658 JIM_EXPROP_FUNC_HYPOT,
7659 JIM_EXPROP_FUNC_FMOD,
7662 /* A expression node is either a term or an operator
7663 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7665 struct JimExprNode {
7666 int type; /* JIM_TT_xxx */
7667 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7669 struct JimExprNode *left; /* For all operators */
7670 struct JimExprNode *right; /* For binary operators */
7671 struct JimExprNode *ternary; /* For ternary operator only */
7674 /* Operators table */
7675 typedef struct Jim_ExprOperator
7677 const char *name;
7678 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7679 unsigned char precedence;
7680 unsigned char arity;
7681 unsigned char attr;
7682 unsigned char namelen;
7683 } Jim_ExprOperator;
7685 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7686 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7687 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7689 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7691 int intresult = 1;
7692 int rc;
7693 double dA, dC = 0;
7694 jim_wide wA, wC = 0;
7695 Jim_Obj *A;
7697 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7698 return rc;
7701 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7702 switch (node->type) {
7703 case JIM_EXPROP_FUNC_INT:
7704 case JIM_EXPROP_FUNC_WIDE:
7705 case JIM_EXPROP_FUNC_ROUND:
7706 case JIM_EXPROP_UNARYPLUS:
7707 wC = wA;
7708 break;
7709 case JIM_EXPROP_FUNC_DOUBLE:
7710 dC = wA;
7711 intresult = 0;
7712 break;
7713 case JIM_EXPROP_FUNC_ABS:
7714 wC = wA >= 0 ? wA : -wA;
7715 break;
7716 case JIM_EXPROP_UNARYMINUS:
7717 wC = -wA;
7718 break;
7719 case JIM_EXPROP_NOT:
7720 wC = !wA;
7721 break;
7722 default:
7723 abort();
7726 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7727 switch (node->type) {
7728 case JIM_EXPROP_FUNC_INT:
7729 case JIM_EXPROP_FUNC_WIDE:
7730 wC = dA;
7731 break;
7732 case JIM_EXPROP_FUNC_ROUND:
7733 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7734 break;
7735 case JIM_EXPROP_FUNC_DOUBLE:
7736 case JIM_EXPROP_UNARYPLUS:
7737 dC = dA;
7738 intresult = 0;
7739 break;
7740 case JIM_EXPROP_FUNC_ABS:
7741 #ifdef JIM_MATH_FUNCTIONS
7742 dC = fabs(dA);
7743 #else
7744 dC = dA >= 0 ? dA : -dA;
7745 #endif
7746 intresult = 0;
7747 break;
7748 case JIM_EXPROP_UNARYMINUS:
7749 dC = -dA;
7750 intresult = 0;
7751 break;
7752 case JIM_EXPROP_NOT:
7753 wC = !dA;
7754 break;
7755 default:
7756 abort();
7760 if (rc == JIM_OK) {
7761 if (intresult) {
7762 Jim_SetResultInt(interp, wC);
7764 else {
7765 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7769 Jim_DecrRefCount(interp, A);
7771 return rc;
7774 static double JimRandDouble(Jim_Interp *interp)
7776 unsigned long x;
7777 JimRandomBytes(interp, &x, sizeof(x));
7779 return (double)x / (unsigned long)~0;
7782 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7784 jim_wide wA;
7785 Jim_Obj *A;
7786 int rc;
7788 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7789 return rc;
7792 rc = Jim_GetWide(interp, A, &wA);
7793 if (rc == JIM_OK) {
7794 switch (node->type) {
7795 case JIM_EXPROP_BITNOT:
7796 Jim_SetResultInt(interp, ~wA);
7797 break;
7798 case JIM_EXPROP_FUNC_SRAND:
7799 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7800 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7801 break;
7802 default:
7803 abort();
7807 Jim_DecrRefCount(interp, A);
7809 return rc;
7812 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7814 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7816 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7818 return JIM_OK;
7821 #ifdef JIM_MATH_FUNCTIONS
7822 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7824 int rc;
7825 double dA, dC;
7826 Jim_Obj *A;
7828 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7829 return rc;
7832 rc = Jim_GetDouble(interp, A, &dA);
7833 if (rc == JIM_OK) {
7834 switch (node->type) {
7835 case JIM_EXPROP_FUNC_SIN:
7836 dC = sin(dA);
7837 break;
7838 case JIM_EXPROP_FUNC_COS:
7839 dC = cos(dA);
7840 break;
7841 case JIM_EXPROP_FUNC_TAN:
7842 dC = tan(dA);
7843 break;
7844 case JIM_EXPROP_FUNC_ASIN:
7845 dC = asin(dA);
7846 break;
7847 case JIM_EXPROP_FUNC_ACOS:
7848 dC = acos(dA);
7849 break;
7850 case JIM_EXPROP_FUNC_ATAN:
7851 dC = atan(dA);
7852 break;
7853 case JIM_EXPROP_FUNC_SINH:
7854 dC = sinh(dA);
7855 break;
7856 case JIM_EXPROP_FUNC_COSH:
7857 dC = cosh(dA);
7858 break;
7859 case JIM_EXPROP_FUNC_TANH:
7860 dC = tanh(dA);
7861 break;
7862 case JIM_EXPROP_FUNC_CEIL:
7863 dC = ceil(dA);
7864 break;
7865 case JIM_EXPROP_FUNC_FLOOR:
7866 dC = floor(dA);
7867 break;
7868 case JIM_EXPROP_FUNC_EXP:
7869 dC = exp(dA);
7870 break;
7871 case JIM_EXPROP_FUNC_LOG:
7872 dC = log(dA);
7873 break;
7874 case JIM_EXPROP_FUNC_LOG10:
7875 dC = log10(dA);
7876 break;
7877 case JIM_EXPROP_FUNC_SQRT:
7878 dC = sqrt(dA);
7879 break;
7880 default:
7881 abort();
7883 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7886 Jim_DecrRefCount(interp, A);
7888 return rc;
7890 #endif
7892 /* A binary operation on two ints */
7893 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7895 jim_wide wA, wB;
7896 int rc;
7897 Jim_Obj *A, *B;
7899 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7900 return rc;
7902 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7903 Jim_DecrRefCount(interp, A);
7904 return rc;
7907 rc = JIM_ERR;
7909 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7910 jim_wide wC;
7912 rc = JIM_OK;
7914 switch (node->type) {
7915 case JIM_EXPROP_LSHIFT:
7916 wC = wA << wB;
7917 break;
7918 case JIM_EXPROP_RSHIFT:
7919 wC = wA >> wB;
7920 break;
7921 case JIM_EXPROP_BITAND:
7922 wC = wA & wB;
7923 break;
7924 case JIM_EXPROP_BITXOR:
7925 wC = wA ^ wB;
7926 break;
7927 case JIM_EXPROP_BITOR:
7928 wC = wA | wB;
7929 break;
7930 case JIM_EXPROP_MOD:
7931 if (wB == 0) {
7932 wC = 0;
7933 Jim_SetResultString(interp, "Division by zero", -1);
7934 rc = JIM_ERR;
7936 else {
7938 * From Tcl 8.x
7940 * This code is tricky: C doesn't guarantee much
7941 * about the quotient or remainder, but Tcl does.
7942 * The remainder always has the same sign as the
7943 * divisor and a smaller absolute value.
7945 int negative = 0;
7947 if (wB < 0) {
7948 wB = -wB;
7949 wA = -wA;
7950 negative = 1;
7952 wC = wA % wB;
7953 if (wC < 0) {
7954 wC += wB;
7956 if (negative) {
7957 wC = -wC;
7960 break;
7961 case JIM_EXPROP_ROTL:
7962 case JIM_EXPROP_ROTR:{
7963 /* uint32_t would be better. But not everyone has inttypes.h? */
7964 unsigned long uA = (unsigned long)wA;
7965 unsigned long uB = (unsigned long)wB;
7966 const unsigned int S = sizeof(unsigned long) * 8;
7968 /* Shift left by the word size or more is undefined. */
7969 uB %= S;
7971 if (node->type == JIM_EXPROP_ROTR) {
7972 uB = S - uB;
7974 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7975 break;
7977 default:
7978 abort();
7980 Jim_SetResultInt(interp, wC);
7983 Jim_DecrRefCount(interp, A);
7984 Jim_DecrRefCount(interp, B);
7986 return rc;
7990 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7991 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
7993 int rc = JIM_OK;
7994 double dA, dB, dC = 0;
7995 jim_wide wA, wB, wC = 0;
7996 Jim_Obj *A, *B;
7998 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7999 return rc;
8001 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8002 Jim_DecrRefCount(interp, A);
8003 return rc;
8006 if ((A->typePtr != &doubleObjType || A->bytes) &&
8007 (B->typePtr != &doubleObjType || B->bytes) &&
8008 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8010 /* Both are ints */
8012 switch (node->type) {
8013 case JIM_EXPROP_POW:
8014 case JIM_EXPROP_FUNC_POW:
8015 if (wA == 0 && wB < 0) {
8016 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8017 rc = JIM_ERR;
8018 goto done;
8020 wC = JimPowWide(wA, wB);
8021 goto intresult;
8022 case JIM_EXPROP_ADD:
8023 wC = wA + wB;
8024 goto intresult;
8025 case JIM_EXPROP_SUB:
8026 wC = wA - wB;
8027 goto intresult;
8028 case JIM_EXPROP_MUL:
8029 wC = wA * wB;
8030 goto intresult;
8031 case JIM_EXPROP_DIV:
8032 if (wB == 0) {
8033 Jim_SetResultString(interp, "Division by zero", -1);
8034 rc = JIM_ERR;
8035 goto done;
8037 else {
8039 * From Tcl 8.x
8041 * This code is tricky: C doesn't guarantee much
8042 * about the quotient or remainder, but Tcl does.
8043 * The remainder always has the same sign as the
8044 * divisor and a smaller absolute value.
8046 if (wB < 0) {
8047 wB = -wB;
8048 wA = -wA;
8050 wC = wA / wB;
8051 if (wA % wB < 0) {
8052 wC--;
8054 goto intresult;
8056 case JIM_EXPROP_LT:
8057 wC = wA < wB;
8058 goto intresult;
8059 case JIM_EXPROP_GT:
8060 wC = wA > wB;
8061 goto intresult;
8062 case JIM_EXPROP_LTE:
8063 wC = wA <= wB;
8064 goto intresult;
8065 case JIM_EXPROP_GTE:
8066 wC = wA >= wB;
8067 goto intresult;
8068 case JIM_EXPROP_NUMEQ:
8069 wC = wA == wB;
8070 goto intresult;
8071 case JIM_EXPROP_NUMNE:
8072 wC = wA != wB;
8073 goto intresult;
8076 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8077 switch (node->type) {
8078 #ifndef JIM_MATH_FUNCTIONS
8079 case JIM_EXPROP_POW:
8080 case JIM_EXPROP_FUNC_POW:
8081 case JIM_EXPROP_FUNC_ATAN2:
8082 case JIM_EXPROP_FUNC_HYPOT:
8083 case JIM_EXPROP_FUNC_FMOD:
8084 Jim_SetResultString(interp, "unsupported", -1);
8085 rc = JIM_ERR;
8086 goto done;
8087 #else
8088 case JIM_EXPROP_POW:
8089 case JIM_EXPROP_FUNC_POW:
8090 dC = pow(dA, dB);
8091 goto doubleresult;
8092 case JIM_EXPROP_FUNC_ATAN2:
8093 dC = atan2(dA, dB);
8094 goto doubleresult;
8095 case JIM_EXPROP_FUNC_HYPOT:
8096 dC = hypot(dA, dB);
8097 goto doubleresult;
8098 case JIM_EXPROP_FUNC_FMOD:
8099 dC = fmod(dA, dB);
8100 goto doubleresult;
8101 #endif
8102 case JIM_EXPROP_ADD:
8103 dC = dA + dB;
8104 goto doubleresult;
8105 case JIM_EXPROP_SUB:
8106 dC = dA - dB;
8107 goto doubleresult;
8108 case JIM_EXPROP_MUL:
8109 dC = dA * dB;
8110 goto doubleresult;
8111 case JIM_EXPROP_DIV:
8112 if (dB == 0) {
8113 #ifdef INFINITY
8114 dC = dA < 0 ? -INFINITY : INFINITY;
8115 #else
8116 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8117 #endif
8119 else {
8120 dC = dA / dB;
8122 goto doubleresult;
8123 case JIM_EXPROP_LT:
8124 wC = dA < dB;
8125 goto intresult;
8126 case JIM_EXPROP_GT:
8127 wC = dA > dB;
8128 goto intresult;
8129 case JIM_EXPROP_LTE:
8130 wC = dA <= dB;
8131 goto intresult;
8132 case JIM_EXPROP_GTE:
8133 wC = dA >= dB;
8134 goto intresult;
8135 case JIM_EXPROP_NUMEQ:
8136 wC = dA == dB;
8137 goto intresult;
8138 case JIM_EXPROP_NUMNE:
8139 wC = dA != dB;
8140 goto intresult;
8143 else {
8144 /* Handle the string case */
8146 /* XXX: Could optimise the eq/ne case by checking lengths */
8147 int i = Jim_StringCompareObj(interp, A, B, 0);
8149 switch (node->type) {
8150 case JIM_EXPROP_LT:
8151 wC = i < 0;
8152 goto intresult;
8153 case JIM_EXPROP_GT:
8154 wC = i > 0;
8155 goto intresult;
8156 case JIM_EXPROP_LTE:
8157 wC = i <= 0;
8158 goto intresult;
8159 case JIM_EXPROP_GTE:
8160 wC = i >= 0;
8161 goto intresult;
8162 case JIM_EXPROP_NUMEQ:
8163 wC = i == 0;
8164 goto intresult;
8165 case JIM_EXPROP_NUMNE:
8166 wC = i != 0;
8167 goto intresult;
8170 /* If we get here, it is an error */
8171 rc = JIM_ERR;
8172 done:
8173 Jim_DecrRefCount(interp, A);
8174 Jim_DecrRefCount(interp, B);
8175 return rc;
8176 intresult:
8177 Jim_SetResultInt(interp, wC);
8178 goto done;
8179 doubleresult:
8180 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8181 goto done;
8184 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8186 int listlen;
8187 int i;
8189 listlen = Jim_ListLength(interp, listObjPtr);
8190 for (i = 0; i < listlen; i++) {
8191 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8192 return 1;
8195 return 0;
8200 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8202 Jim_Obj *A, *B;
8203 jim_wide wC;
8204 int rc;
8206 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8207 return rc;
8209 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8210 Jim_DecrRefCount(interp, A);
8211 return rc;
8214 switch (node->type) {
8215 case JIM_EXPROP_STREQ:
8216 case JIM_EXPROP_STRNE:
8217 wC = Jim_StringEqObj(A, B);
8218 if (node->type == JIM_EXPROP_STRNE) {
8219 wC = !wC;
8221 break;
8222 case JIM_EXPROP_STRIN:
8223 wC = JimSearchList(interp, B, A);
8224 break;
8225 case JIM_EXPROP_STRNI:
8226 wC = !JimSearchList(interp, B, A);
8227 break;
8228 default:
8229 abort();
8231 Jim_SetResultInt(interp, wC);
8233 Jim_DecrRefCount(interp, A);
8234 Jim_DecrRefCount(interp, B);
8236 return rc;
8239 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8241 long l;
8242 double d;
8243 int b;
8244 int ret = -1;
8246 /* In case the object is interp->result with refcount 1*/
8247 Jim_IncrRefCount(obj);
8249 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8250 ret = (l != 0);
8252 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8253 ret = (d != 0);
8255 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8256 ret = (b != 0);
8259 Jim_DecrRefCount(interp, obj);
8260 return ret;
8263 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8265 /* evaluate left */
8266 int result = JimExprGetTermBoolean(interp, node->left);
8268 if (result == 1) {
8269 /* true so evaluate right */
8270 result = JimExprGetTermBoolean(interp, node->right);
8272 if (result == -1) {
8273 return JIM_ERR;
8275 Jim_SetResultInt(interp, result);
8276 return JIM_OK;
8279 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8281 /* evaluate left */
8282 int result = JimExprGetTermBoolean(interp, node->left);
8284 if (result == 0) {
8285 /* false so evaluate right */
8286 result = JimExprGetTermBoolean(interp, node->right);
8288 if (result == -1) {
8289 return JIM_ERR;
8291 Jim_SetResultInt(interp, result);
8292 return JIM_OK;
8295 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8297 /* evaluate left */
8298 int result = JimExprGetTermBoolean(interp, node->left);
8300 if (result == 1) {
8301 /* true so select right */
8302 return JimExprEvalTermNode(interp, node->right);
8304 else if (result == 0) {
8305 /* false so select ternary */
8306 return JimExprEvalTermNode(interp, node->ternary);
8308 /* error */
8309 return JIM_ERR;
8312 enum
8314 OP_FUNC = 0x0001, /* function syntax */
8315 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8318 /* name - precedence - arity - opcode
8320 * This array *must* be kept in sync with the JIM_EXPROP enum.
8322 * The following macros pre-compute the string length at compile time.
8324 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8325 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8327 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8328 OPRINIT("*", 110, 2, JimExprOpBin),
8329 OPRINIT("/", 110, 2, JimExprOpBin),
8330 OPRINIT("%", 110, 2, JimExprOpIntBin),
8332 OPRINIT("-", 100, 2, JimExprOpBin),
8333 OPRINIT("+", 100, 2, JimExprOpBin),
8335 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8336 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8338 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8339 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8341 OPRINIT("<", 80, 2, JimExprOpBin),
8342 OPRINIT(">", 80, 2, JimExprOpBin),
8343 OPRINIT("<=", 80, 2, JimExprOpBin),
8344 OPRINIT(">=", 80, 2, JimExprOpBin),
8346 OPRINIT("==", 70, 2, JimExprOpBin),
8347 OPRINIT("!=", 70, 2, JimExprOpBin),
8349 OPRINIT("&", 50, 2, JimExprOpIntBin),
8350 OPRINIT("^", 49, 2, JimExprOpIntBin),
8351 OPRINIT("|", 48, 2, JimExprOpIntBin),
8353 OPRINIT("&&", 10, 2, JimExprOpAnd),
8354 OPRINIT("||", 9, 2, JimExprOpOr),
8355 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8356 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8358 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8359 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8361 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8362 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8364 OPRINIT("in", 55, 2, JimExprOpStrBin),
8365 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8367 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8368 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8369 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8370 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8374 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8375 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8376 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8377 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8378 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8379 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8380 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8382 #ifdef JIM_MATH_FUNCTIONS
8383 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8384 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8385 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8386 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8387 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8388 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8389 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8390 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8391 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8392 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8393 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8394 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8395 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8396 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8397 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8398 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8399 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8400 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8401 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8402 #endif
8404 #undef OPRINIT
8405 #undef OPRINIT_ATTR
8407 #define JIM_EXPR_OPERATORS_NUM \
8408 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8410 static int JimParseExpression(struct JimParserCtx *pc)
8412 /* Discard spaces and quoted newline */
8413 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8414 if (*pc->p == '\n') {
8415 pc->linenr++;
8417 pc->p++;
8418 pc->len--;
8421 /* Common case */
8422 pc->tline = pc->linenr;
8423 pc->tstart = pc->p;
8425 if (pc->len == 0) {
8426 pc->tend = pc->p;
8427 pc->tt = JIM_TT_EOL;
8428 pc->eof = 1;
8429 return JIM_OK;
8431 switch (*(pc->p)) {
8432 case '(':
8433 pc->tt = JIM_TT_SUBEXPR_START;
8434 goto singlechar;
8435 case ')':
8436 pc->tt = JIM_TT_SUBEXPR_END;
8437 goto singlechar;
8438 case ',':
8439 pc->tt = JIM_TT_SUBEXPR_COMMA;
8440 singlechar:
8441 pc->tend = pc->p;
8442 pc->p++;
8443 pc->len--;
8444 break;
8445 case '[':
8446 return JimParseCmd(pc);
8447 case '$':
8448 if (JimParseVar(pc) == JIM_ERR)
8449 return JimParseExprOperator(pc);
8450 else {
8451 /* Don't allow expr sugar in expressions */
8452 if (pc->tt == JIM_TT_EXPRSUGAR) {
8453 return JIM_ERR;
8455 return JIM_OK;
8457 break;
8458 case '0':
8459 case '1':
8460 case '2':
8461 case '3':
8462 case '4':
8463 case '5':
8464 case '6':
8465 case '7':
8466 case '8':
8467 case '9':
8468 case '.':
8469 return JimParseExprNumber(pc);
8470 case '"':
8471 return JimParseQuote(pc);
8472 case '{':
8473 return JimParseBrace(pc);
8475 case 'N':
8476 case 'I':
8477 case 'n':
8478 case 'i':
8479 if (JimParseExprIrrational(pc) == JIM_ERR)
8480 if (JimParseExprBoolean(pc) == JIM_ERR)
8481 return JimParseExprOperator(pc);
8482 break;
8483 case 't':
8484 case 'f':
8485 case 'o':
8486 case 'y':
8487 if (JimParseExprBoolean(pc) == JIM_ERR)
8488 return JimParseExprOperator(pc);
8489 break;
8490 default:
8491 return JimParseExprOperator(pc);
8492 break;
8494 return JIM_OK;
8497 static int JimParseExprNumber(struct JimParserCtx *pc)
8499 char *end;
8501 /* Assume an integer for now */
8502 pc->tt = JIM_TT_EXPR_INT;
8504 jim_strtoull(pc->p, (char **)&pc->p);
8505 /* Tried as an integer, but perhaps it parses as a double */
8506 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8507 /* Some stupid compilers insist they are cleverer that
8508 * we are. Even a (void) cast doesn't prevent this warning!
8510 if (strtod(pc->tstart, &end)) { /* nothing */ }
8511 if (end == pc->tstart)
8512 return JIM_ERR;
8513 if (end > pc->p) {
8514 /* Yes, double captured more chars */
8515 pc->tt = JIM_TT_EXPR_DOUBLE;
8516 pc->p = end;
8519 pc->tend = pc->p - 1;
8520 pc->len -= (pc->p - pc->tstart);
8521 return JIM_OK;
8524 static int JimParseExprIrrational(struct JimParserCtx *pc)
8526 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8527 int i;
8529 for (i = 0; irrationals[i]; i++) {
8530 const char *irr = irrationals[i];
8532 if (strncmp(irr, pc->p, 3) == 0) {
8533 pc->p += 3;
8534 pc->len -= 3;
8535 pc->tend = pc->p - 1;
8536 pc->tt = JIM_TT_EXPR_DOUBLE;
8537 return JIM_OK;
8540 return JIM_ERR;
8543 static int JimParseExprBoolean(struct JimParserCtx *pc)
8545 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8546 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8547 int i;
8549 for (i = 0; booleans[i]; i++) {
8550 const char *boolean = booleans[i];
8551 int length = lengths[i];
8553 if (strncmp(boolean, pc->p, length) == 0) {
8554 pc->p += length;
8555 pc->len -= length;
8556 pc->tend = pc->p - 1;
8557 pc->tt = JIM_TT_EXPR_BOOLEAN;
8558 return JIM_OK;
8561 return JIM_ERR;
8564 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8566 static Jim_ExprOperator dummy_op;
8567 if (opcode < JIM_TT_EXPR_OP) {
8568 return &dummy_op;
8570 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8573 static int JimParseExprOperator(struct JimParserCtx *pc)
8575 int i;
8576 const struct Jim_ExprOperator *bestOp = NULL;
8577 int bestLen = 0;
8579 /* Try to get the longest match. */
8580 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8581 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8583 if (op->name[0] != pc->p[0]) {
8584 continue;
8587 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8588 bestOp = op;
8589 bestLen = op->namelen;
8592 if (bestOp == NULL) {
8593 return JIM_ERR;
8596 /* Validate paretheses around function arguments */
8597 if (bestOp->attr & OP_FUNC) {
8598 const char *p = pc->p + bestLen;
8599 int len = pc->len - bestLen;
8601 while (len && isspace(UCHAR(*p))) {
8602 len--;
8603 p++;
8605 if (*p != '(') {
8606 return JIM_ERR;
8609 pc->tend = pc->p + bestLen - 1;
8610 pc->p += bestLen;
8611 pc->len -= bestLen;
8613 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8614 return JIM_OK;
8617 const char *jim_tt_name(int type)
8619 static const char * const tt_names[JIM_TT_EXPR_OP] =
8620 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8621 "DBL", "BOO", "$()" };
8622 if (type < JIM_TT_EXPR_OP) {
8623 return tt_names[type];
8625 else if (type == JIM_EXPROP_UNARYMINUS) {
8626 return "-VE";
8628 else if (type == JIM_EXPROP_UNARYPLUS) {
8629 return "+VE";
8631 else {
8632 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8633 static char buf[20];
8635 if (op->name) {
8636 return op->name;
8638 sprintf(buf, "(%d)", type);
8639 return buf;
8643 /* -----------------------------------------------------------------------------
8644 * Expression Object
8645 * ---------------------------------------------------------------------------*/
8646 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8647 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8648 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8650 static const Jim_ObjType exprObjType = {
8651 "expression",
8652 FreeExprInternalRep,
8653 DupExprInternalRep,
8654 NULL,
8655 JIM_TYPE_REFERENCES,
8658 /* expr tree structure */
8659 struct ExprTree
8661 struct JimExprNode *expr; /* The first operator or term */
8662 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8663 int len; /* Number of nodes in use */
8664 int inUse; /* Used for sharing. */
8667 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8669 int i;
8670 for (i = 0; i < num; i++) {
8671 if (nodes[i].objPtr) {
8672 Jim_DecrRefCount(interp, nodes[i].objPtr);
8675 Jim_Free(nodes);
8678 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8680 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8681 Jim_Free(expr);
8684 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8686 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8688 if (expr) {
8689 if (--expr->inUse != 0) {
8690 return;
8693 ExprTreeFree(interp, expr);
8697 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8699 JIM_NOTUSED(interp);
8700 JIM_NOTUSED(srcPtr);
8702 /* Just returns an simple string. */
8703 dupPtr->typePtr = NULL;
8706 struct ExprBuilder {
8707 int parencount; /* count of outstanding parentheses */
8708 int level; /* recursion depth */
8709 ParseToken *token; /* The current token */
8710 ParseToken *first_token; /* The first token */
8711 Jim_Stack stack; /* stack of pending terms */
8712 Jim_Obj *exprObjPtr; /* the original expression */
8713 Jim_Obj *fileNameObj; /* filename of the original expression */
8714 struct JimExprNode *nodes; /* storage for all nodes */
8715 struct JimExprNode *next; /* storage for the next node */
8718 #ifdef DEBUG_SHOW_EXPR
8719 static void JimShowExprNode(struct JimExprNode *node, int level)
8721 int i;
8722 for (i = 0; i < level; i++) {
8723 printf(" ");
8725 if (TOKEN_IS_EXPR_OP(node->type)) {
8726 printf("%s\n", jim_tt_name(node->type));
8727 if (node->left) {
8728 JimShowExprNode(node->left, level + 1);
8730 if (node->right) {
8731 JimShowExprNode(node->right, level + 1);
8733 if (node->ternary) {
8734 JimShowExprNode(node->ternary, level + 1);
8737 else {
8738 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8741 #endif
8743 #define EXPR_UNTIL_CLOSE 0x0001
8744 #define EXPR_FUNC_ARGS 0x0002
8745 #define EXPR_TERNARY 0x0004
8748 * Parse the subexpression at builder->token and return with the node on the stack.
8749 * builder->token is advanced to the next unconsumed token.
8750 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8752 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8753 * with an equal or lower precedence is reached (or strictly lower if right associative).
8755 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8756 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8757 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8759 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8761 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8763 int rc;
8764 struct JimExprNode *node;
8765 /* Calculate the stack length expected after pushing the number of expected terms */
8766 int exp_stacklen = builder->stack.len + exp_numterms;
8768 if (builder->level++ > 200) {
8769 Jim_SetResultString(interp, "Expression too complex", -1);
8770 return JIM_ERR;
8773 while (builder->token->type != JIM_TT_EOL) {
8774 ParseToken *t = builder->token++;
8775 int prevtt;
8777 if (t == builder->first_token) {
8778 prevtt = JIM_TT_NONE;
8780 else {
8781 prevtt = t[-1].type;
8784 if (t->type == JIM_TT_SUBEXPR_START) {
8785 if (builder->stack.len == exp_stacklen) {
8786 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8787 return JIM_ERR;
8789 builder->parencount++;
8790 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8791 if (rc != JIM_OK) {
8792 return rc;
8794 /* A complete subexpression is on the stack */
8796 else if (t->type == JIM_TT_SUBEXPR_END) {
8797 if (!(flags & EXPR_UNTIL_CLOSE)) {
8798 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8799 builder->token--;
8800 builder->level--;
8801 return JIM_OK;
8803 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8804 return JIM_ERR;
8806 builder->parencount--;
8807 if (builder->stack.len == exp_stacklen) {
8808 /* Return with the expected number of subexpressions on the stack */
8809 break;
8812 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8813 if (!(flags & EXPR_FUNC_ARGS)) {
8814 if (builder->stack.len == exp_stacklen) {
8815 /* handle the comma back at the parent level */
8816 builder->token--;
8817 builder->level--;
8818 return JIM_OK;
8820 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8821 return JIM_ERR;
8823 else {
8824 /* If we see more terms than expected, it is an error */
8825 if (builder->stack.len > exp_stacklen) {
8826 Jim_SetResultFormatted(interp, "too many arguments to math function");
8827 return JIM_ERR;
8830 /* just go onto the next arg */
8832 else if (t->type == JIM_EXPROP_COLON) {
8833 if (!(flags & EXPR_TERNARY)) {
8834 if (builder->level != 1) {
8835 /* handle the comma back at the parent level */
8836 builder->token--;
8837 builder->level--;
8838 return JIM_OK;
8840 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8841 return JIM_ERR;
8843 if (builder->stack.len == exp_stacklen) {
8844 /* handle the comma back at the parent level */
8845 builder->token--;
8846 builder->level--;
8847 return JIM_OK;
8849 /* just go onto the next term */
8851 else if (TOKEN_IS_EXPR_OP(t->type)) {
8852 const struct Jim_ExprOperator *op;
8854 /* Convert -/+ to unary minus or unary plus if necessary */
8855 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8856 if (t->type == JIM_EXPROP_SUB) {
8857 t->type = JIM_EXPROP_UNARYMINUS;
8859 else if (t->type == JIM_EXPROP_ADD) {
8860 t->type = JIM_EXPROP_UNARYPLUS;
8864 op = JimExprOperatorInfoByOpcode(t->type);
8866 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8867 /* next op is lower precedence, or equal and left associative, so done here */
8868 builder->token--;
8869 break;
8872 if (op->attr & OP_FUNC) {
8873 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8874 Jim_SetResultString(interp, "missing arguments for math function", -1);
8875 return JIM_ERR;
8877 builder->token++;
8878 if (op->arity == 0) {
8879 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8880 Jim_SetResultString(interp, "too many arguments for math function", -1);
8881 return JIM_ERR;
8883 builder->token++;
8884 goto noargs;
8886 builder->parencount++;
8888 /* This will push left and return right */
8889 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8891 else if (t->type == JIM_EXPROP_TERNARY) {
8892 /* Collect the two arguments to the ternary operator */
8893 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8895 else {
8896 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8897 * and push that on the term stack
8899 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8902 if (rc != JIM_OK) {
8903 return rc;
8906 noargs:
8907 node = builder->next++;
8908 node->type = t->type;
8910 if (op->arity >= 3) {
8911 node->ternary = Jim_StackPop(&builder->stack);
8912 if (node->ternary == NULL) {
8913 goto missingoperand;
8916 if (op->arity >= 2) {
8917 node->right = Jim_StackPop(&builder->stack);
8918 if (node->right == NULL) {
8919 goto missingoperand;
8922 if (op->arity >= 1) {
8923 node->left = Jim_StackPop(&builder->stack);
8924 if (node->left == NULL) {
8925 missingoperand:
8926 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8927 builder->next--;
8928 return JIM_ERR;
8933 /* Now push the node */
8934 Jim_StackPush(&builder->stack, node);
8936 else {
8937 Jim_Obj *objPtr = NULL;
8939 /* This is a simple non-operator term, so create and push the appropriate object */
8941 /* Two consecutive terms without an operator is invalid */
8942 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
8943 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
8944 return JIM_ERR;
8947 /* Immediately create a double or int object? */
8948 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
8949 char *endptr;
8950 if (t->type == JIM_TT_EXPR_INT) {
8951 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8953 else {
8954 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8956 if (endptr != t->token + t->len) {
8957 /* Conversion failed, so just store it as a string */
8958 Jim_FreeNewObj(interp, objPtr);
8959 objPtr = NULL;
8963 if (!objPtr) {
8964 /* Everything else is stored a simple string term */
8965 objPtr = Jim_NewStringObj(interp, t->token, t->len);
8966 if (t->type == JIM_TT_CMD) {
8967 /* Only commands need source info */
8968 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
8972 /* Now push a term node */
8973 node = builder->next++;
8974 node->objPtr = objPtr;
8975 Jim_IncrRefCount(node->objPtr);
8976 node->type = t->type;
8977 Jim_StackPush(&builder->stack, node);
8981 if (builder->stack.len == exp_stacklen) {
8982 builder->level--;
8983 return JIM_OK;
8986 if ((flags & EXPR_FUNC_ARGS)) {
8987 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
8989 else {
8990 if (builder->stack.len < exp_stacklen) {
8991 if (builder->level == 0) {
8992 Jim_SetResultFormatted(interp, "empty expression");
8994 else {
8995 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
8998 else {
8999 Jim_SetResultFormatted(interp, "extra terms after expression");
9003 return JIM_ERR;
9006 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9008 struct ExprTree *expr;
9009 struct ExprBuilder builder;
9010 int rc;
9011 struct JimExprNode *top = NULL;
9013 builder.parencount = 0;
9014 builder.level = 0;
9015 builder.token = builder.first_token = tokenlist->list;
9016 builder.exprObjPtr = exprObjPtr;
9017 builder.fileNameObj = fileNameObj;
9018 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9019 builder.nodes = Jim_Alloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9020 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9021 builder.next = builder.nodes;
9022 Jim_InitStack(&builder.stack);
9024 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9026 if (rc == JIM_OK) {
9027 top = Jim_StackPop(&builder.stack);
9029 if (builder.parencount) {
9030 Jim_SetResultString(interp, "missing close parenthesis", -1);
9031 rc = JIM_ERR;
9035 /* Free the stack used for the compilation. */
9036 Jim_FreeStack(&builder.stack);
9038 if (rc != JIM_OK) {
9039 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9040 return NULL;
9043 expr = Jim_Alloc(sizeof(*expr));
9044 expr->inUse = 1;
9045 expr->expr = top;
9046 expr->nodes = builder.nodes;
9047 expr->len = builder.next - builder.nodes;
9049 assert(expr->len <= tokenlist->count - 1);
9051 return expr;
9054 /* This method takes the string representation of an expression
9055 * and generates a program for the expr engine */
9056 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9058 int exprTextLen;
9059 const char *exprText;
9060 struct JimParserCtx parser;
9061 struct ExprTree *expr;
9062 ParseTokenList tokenlist;
9063 int line;
9064 Jim_Obj *fileNameObj;
9065 int rc = JIM_ERR;
9067 /* Try to get information about filename / line number */
9068 if (objPtr->typePtr == &sourceObjType) {
9069 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9070 line = objPtr->internalRep.sourceValue.lineNumber;
9072 else {
9073 fileNameObj = interp->emptyObj;
9074 line = 1;
9076 Jim_IncrRefCount(fileNameObj);
9078 exprText = Jim_GetString(objPtr, &exprTextLen);
9080 /* Initially tokenise the expression into tokenlist */
9081 ScriptTokenListInit(&tokenlist);
9083 JimParserInit(&parser, exprText, exprTextLen, line);
9084 while (!parser.eof) {
9085 if (JimParseExpression(&parser) != JIM_OK) {
9086 ScriptTokenListFree(&tokenlist);
9087 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9088 expr = NULL;
9089 goto err;
9092 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9093 parser.tline);
9096 #ifdef DEBUG_SHOW_EXPR_TOKENS
9098 int i;
9099 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9100 for (i = 0; i < tokenlist.count; i++) {
9101 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9102 tokenlist.list[i].len, tokenlist.list[i].token);
9105 #endif
9107 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9108 ScriptTokenListFree(&tokenlist);
9109 Jim_DecrRefCount(interp, fileNameObj);
9110 return JIM_ERR;
9113 /* Now create the expression bytecode from the tokenlist */
9114 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9116 /* No longer need the token list */
9117 ScriptTokenListFree(&tokenlist);
9119 if (!expr) {
9120 goto err;
9123 #ifdef DEBUG_SHOW_EXPR
9124 printf("==== Expr ====\n");
9125 JimShowExprNode(expr->expr, 0);
9126 #endif
9128 rc = JIM_OK;
9130 err:
9131 /* Free the old internal rep and set the new one. */
9132 Jim_DecrRefCount(interp, fileNameObj);
9133 Jim_FreeIntRep(interp, objPtr);
9134 Jim_SetIntRepPtr(objPtr, expr);
9135 objPtr->typePtr = &exprObjType;
9136 return rc;
9139 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9141 if (objPtr->typePtr != &exprObjType) {
9142 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9143 return NULL;
9146 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9149 #ifdef JIM_OPTIMIZATION
9150 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9152 if (node->type == JIM_TT_EXPR_INT)
9153 return node->objPtr;
9154 else if (node->type == JIM_TT_VAR)
9155 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9156 else if (node->type == JIM_TT_DICTSUGAR)
9157 return JimExpandDictSugar(interp, node->objPtr);
9158 else
9159 return NULL;
9161 #endif
9163 /* -----------------------------------------------------------------------------
9164 * Expressions evaluation.
9165 * Jim uses a recursive evaluation engine for expressions,
9166 * that takes advantage of the fact that expr's operators
9167 * can't be redefined.
9169 * Jim_EvalExpression() uses the expression tree compiled by
9170 * SetExprFromAny() method of the "expression" object.
9172 * On success a Tcl Object containing the result of the evaluation
9173 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9174 * returned.
9175 * On error the function returns a retcode != to JIM_OK and set a suitable
9176 * error on the interp.
9177 * ---------------------------------------------------------------------------*/
9179 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9181 if (TOKEN_IS_EXPR_OP(node->type)) {
9182 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9183 return op->funcop(interp, node);
9185 else {
9186 Jim_Obj *objPtr;
9188 /* A term */
9189 switch (node->type) {
9190 case JIM_TT_EXPR_INT:
9191 case JIM_TT_EXPR_DOUBLE:
9192 case JIM_TT_EXPR_BOOLEAN:
9193 case JIM_TT_STR:
9194 Jim_SetResult(interp, node->objPtr);
9195 return JIM_OK;
9197 case JIM_TT_VAR:
9198 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9199 if (objPtr) {
9200 Jim_SetResult(interp, objPtr);
9201 return JIM_OK;
9203 return JIM_ERR;
9205 case JIM_TT_DICTSUGAR:
9206 objPtr = JimExpandDictSugar(interp, node->objPtr);
9207 if (objPtr) {
9208 Jim_SetResult(interp, objPtr);
9209 return JIM_OK;
9211 return JIM_ERR;
9213 case JIM_TT_ESC:
9214 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9215 Jim_SetResult(interp, objPtr);
9216 return JIM_OK;
9218 return JIM_ERR;
9220 case JIM_TT_CMD:
9221 return Jim_EvalObj(interp, node->objPtr);
9223 default:
9224 /* Should never get here */
9225 return JIM_ERR;
9230 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9232 int rc = JimExprEvalTermNode(interp, node);
9233 if (rc == JIM_OK) {
9234 *objPtrPtr = Jim_GetResult(interp);
9235 Jim_IncrRefCount(*objPtrPtr);
9237 return rc;
9240 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9242 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9243 return ExprBool(interp, Jim_GetResult(interp));
9245 return -1;
9248 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9250 struct ExprTree *expr;
9251 int retcode = JIM_OK;
9253 Jim_IncrRefCount(exprObjPtr); /* Make sure it's shared. */
9254 expr = JimGetExpression(interp, exprObjPtr);
9255 if (!expr) {
9256 retcode = JIM_ERR;
9257 goto done;
9260 #ifdef JIM_OPTIMIZATION
9261 /* Check for one of the following common expressions used by while/for
9263 * CONST
9264 * $a
9265 * !$a
9266 * $a < CONST, $a < $b
9267 * $a <= CONST, $a <= $b
9268 * $a > CONST, $a > $b
9269 * $a >= CONST, $a >= $b
9270 * $a != CONST, $a != $b
9271 * $a == CONST, $a == $b
9274 Jim_Obj *objPtr;
9276 /* STEP 1 -- Check if there are the conditions to run the specialized
9277 * version of while */
9279 switch (expr->len) {
9280 case 1:
9281 objPtr = JimExprIntValOrVar(interp, expr->expr);
9282 if (objPtr) {
9283 Jim_SetResult(interp, objPtr);
9284 goto done;
9286 break;
9288 case 2:
9289 if (expr->expr->type == JIM_EXPROP_NOT) {
9290 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9292 if (objPtr && JimIsWide(objPtr)) {
9293 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9294 goto done;
9297 break;
9299 case 3:
9300 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9301 if (objPtr && JimIsWide(objPtr)) {
9302 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9303 if (objPtr2 && JimIsWide(objPtr2)) {
9304 jim_wide wideValueA = JimWideValue(objPtr);
9305 jim_wide wideValueB = JimWideValue(objPtr2);
9306 int cmpRes;
9307 switch (expr->expr->type) {
9308 case JIM_EXPROP_LT:
9309 cmpRes = wideValueA < wideValueB;
9310 break;
9311 case JIM_EXPROP_LTE:
9312 cmpRes = wideValueA <= wideValueB;
9313 break;
9314 case JIM_EXPROP_GT:
9315 cmpRes = wideValueA > wideValueB;
9316 break;
9317 case JIM_EXPROP_GTE:
9318 cmpRes = wideValueA >= wideValueB;
9319 break;
9320 case JIM_EXPROP_NUMEQ:
9321 cmpRes = wideValueA == wideValueB;
9322 break;
9323 case JIM_EXPROP_NUMNE:
9324 cmpRes = wideValueA != wideValueB;
9325 break;
9326 default:
9327 goto noopt;
9329 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9330 goto done;
9333 break;
9336 noopt:
9337 #endif
9339 /* In order to avoid the internal repr being freed due to
9340 * shimmering of the exprObjPtr's object, we increment the use count
9341 * and keep our own pointer outside the object.
9343 expr->inUse++;
9345 /* Evaluate with the recursive expr engine */
9346 retcode = JimExprEvalTermNode(interp, expr->expr);
9348 /* Now transfer ownership of expr back into the object in case it shimmered away */
9349 Jim_FreeIntRep(interp, exprObjPtr);
9350 exprObjPtr->typePtr = &exprObjType;
9351 Jim_SetIntRepPtr(exprObjPtr, expr);
9353 done:
9354 Jim_DecrRefCount(interp, exprObjPtr);
9356 return retcode;
9359 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9361 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9363 if (retcode == JIM_OK) {
9364 switch (ExprBool(interp, Jim_GetResult(interp))) {
9365 case 0:
9366 *boolPtr = 0;
9367 break;
9369 case 1:
9370 *boolPtr = 1;
9371 break;
9373 case -1:
9374 retcode = JIM_ERR;
9375 break;
9378 return retcode;
9381 /* -----------------------------------------------------------------------------
9382 * ScanFormat String Object
9383 * ---------------------------------------------------------------------------*/
9385 /* This Jim_Obj will held a parsed representation of a format string passed to
9386 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9387 * to be parsed in its entirely first and then, if correct, can be used for
9388 * scanning. To avoid endless re-parsing, the parsed representation will be
9389 * stored in an internal representation and re-used for performance reason. */
9391 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9392 * scanformat string. This part will later be used to extract information
9393 * out from the string to be parsed by Jim_ScanString */
9395 typedef struct ScanFmtPartDescr
9397 const char *arg; /* Specification of a CHARSET conversion */
9398 const char *prefix; /* Prefix to be scanned literally before conversion */
9399 size_t width; /* Maximal width of input to be converted */
9400 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9401 char type; /* Type of conversion (e.g. c, d, f) */
9402 char modifier; /* Modify type (e.g. l - long, h - short */
9403 } ScanFmtPartDescr;
9405 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9406 * string parsed and separated in part descriptions. Furthermore it contains
9407 * the original string representation of the scanformat string to allow for
9408 * fast update of the Jim_Obj's string representation part.
9410 * As an add-on the internal object representation adds some scratch pad area
9411 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9412 * memory for purpose of string scanning.
9414 * The error member points to a static allocated string in case of a mal-
9415 * formed scanformat string or it contains '0' (NULL) in case of a valid
9416 * parse representation.
9418 * The whole memory of the internal representation is allocated as a single
9419 * area of memory that will be internally separated. So freeing and duplicating
9420 * of such an object is cheap */
9422 typedef struct ScanFmtStringObj
9424 jim_wide size; /* Size of internal repr in bytes */
9425 char *stringRep; /* Original string representation */
9426 size_t count; /* Number of ScanFmtPartDescr contained */
9427 size_t convCount; /* Number of conversions that will assign */
9428 size_t maxPos; /* Max position index if XPG3 is used */
9429 const char *error; /* Ptr to error text (NULL if no error */
9430 char *scratch; /* Some scratch pad used by Jim_ScanString */
9431 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9432 } ScanFmtStringObj;
9435 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9436 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9437 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9439 static const Jim_ObjType scanFmtStringObjType = {
9440 "scanformatstring",
9441 FreeScanFmtInternalRep,
9442 DupScanFmtInternalRep,
9443 UpdateStringOfScanFmt,
9444 JIM_TYPE_NONE,
9447 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9449 JIM_NOTUSED(interp);
9450 Jim_Free((char *)objPtr->internalRep.ptr);
9451 objPtr->internalRep.ptr = 0;
9454 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9456 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9457 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9459 JIM_NOTUSED(interp);
9460 memcpy(newVec, srcPtr->internalRep.ptr, size);
9461 dupPtr->internalRep.ptr = newVec;
9462 dupPtr->typePtr = &scanFmtStringObjType;
9465 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9467 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9470 /* SetScanFmtFromAny will parse a given string and create the internal
9471 * representation of the format specification. In case of an error
9472 * the error data member of the internal representation will be set
9473 * to an descriptive error text and the function will be left with
9474 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9475 * specification */
9477 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9479 ScanFmtStringObj *fmtObj;
9480 char *buffer;
9481 int maxCount, i, approxSize, lastPos = -1;
9482 const char *fmt = Jim_String(objPtr);
9483 int maxFmtLen = Jim_Length(objPtr);
9484 const char *fmtEnd = fmt + maxFmtLen;
9485 int curr;
9487 Jim_FreeIntRep(interp, objPtr);
9488 /* Count how many conversions could take place maximally */
9489 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9490 if (fmt[i] == '%')
9491 ++maxCount;
9492 /* Calculate an approximation of the memory necessary */
9493 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9494 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9495 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9496 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9497 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9498 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9499 +1; /* safety byte */
9500 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9501 memset(fmtObj, 0, approxSize);
9502 fmtObj->size = approxSize;
9503 fmtObj->maxPos = 0;
9504 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9505 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9506 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9507 buffer = fmtObj->stringRep + maxFmtLen + 1;
9508 objPtr->internalRep.ptr = fmtObj;
9509 objPtr->typePtr = &scanFmtStringObjType;
9510 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9511 int width = 0, skip;
9512 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9514 fmtObj->count++;
9515 descr->width = 0; /* Assume width unspecified */
9516 /* Overread and store any "literal" prefix */
9517 if (*fmt != '%' || fmt[1] == '%') {
9518 descr->type = 0;
9519 descr->prefix = &buffer[i];
9520 for (; fmt < fmtEnd; ++fmt) {
9521 if (*fmt == '%') {
9522 if (fmt[1] != '%')
9523 break;
9524 ++fmt;
9526 buffer[i++] = *fmt;
9528 buffer[i++] = 0;
9530 /* Skip the conversion introducing '%' sign */
9531 ++fmt;
9532 /* End reached due to non-conversion literal only? */
9533 if (fmt >= fmtEnd)
9534 goto done;
9535 descr->pos = 0; /* Assume "natural" positioning */
9536 if (*fmt == '*') {
9537 descr->pos = -1; /* Okay, conversion will not be assigned */
9538 ++fmt;
9540 else
9541 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9542 /* Check if next token is a number (could be width or pos */
9543 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9544 fmt += skip;
9545 /* Was the number a XPG3 position specifier? */
9546 if (descr->pos != -1 && *fmt == '$') {
9547 int prev;
9549 ++fmt;
9550 descr->pos = width;
9551 width = 0;
9552 /* Look if "natural" postioning and XPG3 one was mixed */
9553 if ((lastPos == 0 && descr->pos > 0)
9554 || (lastPos > 0 && descr->pos == 0)) {
9555 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9556 return JIM_ERR;
9558 /* Look if this position was already used */
9559 for (prev = 0; prev < curr; ++prev) {
9560 if (fmtObj->descr[prev].pos == -1)
9561 continue;
9562 if (fmtObj->descr[prev].pos == descr->pos) {
9563 fmtObj->error =
9564 "variable is assigned by multiple \"%n$\" conversion specifiers";
9565 return JIM_ERR;
9568 if (descr->pos < 0) {
9569 fmtObj->error =
9570 "\"%n$\" conversion specifier is negative";
9571 return JIM_ERR;
9573 /* Try to find a width after the XPG3 specifier */
9574 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9575 descr->width = width;
9576 fmt += skip;
9578 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9579 fmtObj->maxPos = descr->pos;
9581 else {
9582 /* Number was not a XPG3, so it has to be a width */
9583 descr->width = width;
9586 /* If positioning mode was undetermined yet, fix this */
9587 if (lastPos == -1)
9588 lastPos = descr->pos;
9589 /* Handle CHARSET conversion type ... */
9590 if (*fmt == '[') {
9591 int swapped = 1, beg = i, end, j;
9593 descr->type = '[';
9594 descr->arg = &buffer[i];
9595 ++fmt;
9596 if (*fmt == '^')
9597 buffer[i++] = *fmt++;
9598 if (*fmt == ']')
9599 buffer[i++] = *fmt++;
9600 while (*fmt && *fmt != ']')
9601 buffer[i++] = *fmt++;
9602 if (*fmt != ']') {
9603 fmtObj->error = "unmatched [ in format string";
9604 return JIM_ERR;
9606 end = i;
9607 buffer[i++] = 0;
9608 /* In case a range fence was given "backwards", swap it */
9609 while (swapped) {
9610 swapped = 0;
9611 for (j = beg + 1; j < end - 1; ++j) {
9612 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9613 char tmp = buffer[j - 1];
9615 buffer[j - 1] = buffer[j + 1];
9616 buffer[j + 1] = tmp;
9617 swapped = 1;
9622 else {
9623 /* Remember any valid modifier if given */
9624 if (fmt < fmtEnd && strchr("hlL", *fmt))
9625 descr->modifier = tolower((int)*fmt++);
9627 if (fmt >= fmtEnd) {
9628 fmtObj->error = "missing scan conversion character";
9629 return JIM_ERR;
9632 descr->type = *fmt;
9633 if (strchr("efgcsndoxui", *fmt) == 0) {
9634 fmtObj->error = "bad scan conversion character";
9635 return JIM_ERR;
9637 else if (*fmt == 'c' && descr->width != 0) {
9638 fmtObj->error = "field width may not be specified in %c " "conversion";
9639 return JIM_ERR;
9641 else if (*fmt == 'u' && descr->modifier == 'l') {
9642 fmtObj->error = "unsigned wide not supported";
9643 return JIM_ERR;
9646 curr++;
9648 done:
9649 return JIM_OK;
9652 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9654 #define FormatGetCnvCount(_fo_) \
9655 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9656 #define FormatGetMaxPos(_fo_) \
9657 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9658 #define FormatGetError(_fo_) \
9659 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9661 /* JimScanAString is used to scan an unspecified string that ends with
9662 * next WS, or a string that is specified via a charset.
9665 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9667 char *buffer = Jim_StrDup(str);
9668 char *p = buffer;
9670 while (*str) {
9671 int c;
9672 int n;
9674 if (!sdescr && isspace(UCHAR(*str)))
9675 break; /* EOS via WS if unspecified */
9677 n = utf8_tounicode(str, &c);
9678 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9679 break;
9680 while (n--)
9681 *p++ = *str++;
9683 *p = 0;
9684 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9687 /* ScanOneEntry will scan one entry out of the string passed as argument.
9688 * It use the sscanf() function for this task. After extracting and
9689 * converting of the value, the count of scanned characters will be
9690 * returned of -1 in case of no conversion tool place and string was
9691 * already scanned thru */
9693 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int str_bytelen,
9694 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9696 const char *tok;
9697 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9698 size_t scanned = 0;
9699 size_t anchor = pos;
9700 int i;
9701 Jim_Obj *tmpObj = NULL;
9703 /* First pessimistically assume, we will not scan anything :-) */
9704 *valObjPtr = 0;
9705 if (descr->prefix) {
9706 /* There was a prefix given before the conversion, skip it and adjust
9707 * the string-to-be-parsed accordingly */
9708 for (i = 0; pos < str_bytelen && descr->prefix[i]; ++i) {
9709 /* If prefix require, skip WS */
9710 if (isspace(UCHAR(descr->prefix[i])))
9711 while (pos < str_bytelen && isspace(UCHAR(str[pos])))
9712 ++pos;
9713 else if (descr->prefix[i] != str[pos])
9714 break; /* Prefix do not match here, leave the loop */
9715 else
9716 ++pos; /* Prefix matched so far, next round */
9718 if (pos >= str_bytelen) {
9719 return -1; /* All of str consumed: EOF condition */
9721 else if (descr->prefix[i] != 0)
9722 return 0; /* Not whole prefix consumed, no conversion possible */
9724 /* For all but following conversion, skip leading WS */
9725 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9726 while (isspace(UCHAR(str[pos])))
9727 ++pos;
9729 /* Determine how much skipped/scanned so far */
9730 scanned = pos - anchor;
9732 /* %c is a special, simple case. no width */
9733 if (descr->type == 'n') {
9734 /* Return pseudo conversion means: how much scanned so far? */
9735 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9737 else if (pos >= str_bytelen) {
9738 /* Cannot scan anything, as str is totally consumed */
9739 return -1;
9741 else if (descr->type == 'c') {
9742 int c;
9743 scanned += utf8_tounicode(&str[pos], &c);
9744 *valObjPtr = Jim_NewIntObj(interp, c);
9745 return scanned;
9747 else {
9748 /* Processing of conversions follows ... */
9749 if (descr->width > 0) {
9750 /* Do not try to scan as fas as possible but only the given width.
9751 * To ensure this, we copy the part that should be scanned. */
9752 size_t sLen = utf8_strlen(&str[pos], str_bytelen - pos);
9753 size_t tLen = descr->width > sLen ? sLen : descr->width;
9755 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9756 tok = tmpObj->bytes;
9758 else {
9759 /* As no width was given, simply refer to the original string */
9760 tok = &str[pos];
9762 switch (descr->type) {
9763 case 'd':
9764 case 'o':
9765 case 'x':
9766 case 'u':
9767 case 'i':{
9768 char *endp; /* Position where the number finished */
9769 jim_wide w;
9771 int base = descr->type == 'o' ? 8
9772 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9774 /* Try to scan a number with the given base */
9775 if (base == 0) {
9776 w = jim_strtoull(tok, &endp);
9778 else {
9779 w = strtoull(tok, &endp, base);
9782 if (endp != tok) {
9783 /* There was some number sucessfully scanned! */
9784 *valObjPtr = Jim_NewIntObj(interp, w);
9786 /* Adjust the number-of-chars scanned so far */
9787 scanned += endp - tok;
9789 else {
9790 /* Nothing was scanned. We have to determine if this
9791 * happened due to e.g. prefix mismatch or input str
9792 * exhausted */
9793 scanned = *tok ? 0 : -1;
9795 break;
9797 case 's':
9798 case '[':{
9799 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9800 scanned += Jim_Length(*valObjPtr);
9801 break;
9803 case 'e':
9804 case 'f':
9805 case 'g':{
9806 char *endp;
9807 double value = strtod(tok, &endp);
9809 if (endp != tok) {
9810 /* There was some number sucessfully scanned! */
9811 *valObjPtr = Jim_NewDoubleObj(interp, value);
9812 /* Adjust the number-of-chars scanned so far */
9813 scanned += endp - tok;
9815 else {
9816 /* Nothing was scanned. We have to determine if this
9817 * happened due to e.g. prefix mismatch or input str
9818 * exhausted */
9819 scanned = *tok ? 0 : -1;
9821 break;
9824 /* If a substring was allocated (due to pre-defined width) do not
9825 * forget to free it */
9826 if (tmpObj) {
9827 Jim_FreeNewObj(interp, tmpObj);
9830 return scanned;
9833 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9834 * string and returns all converted (and not ignored) values in a list back
9835 * to the caller. If an error occured, a NULL pointer will be returned */
9837 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9839 size_t i, pos;
9840 int scanned = 1;
9841 const char *str = Jim_String(strObjPtr);
9842 int str_bytelen = Jim_Length(strObjPtr);
9843 Jim_Obj *resultList = 0;
9844 Jim_Obj **resultVec = 0;
9845 int resultc;
9846 Jim_Obj *emptyStr = 0;
9847 ScanFmtStringObj *fmtObj;
9849 /* This should never happen. The format object should already be of the correct type */
9850 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9852 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9853 /* Check if format specification was valid */
9854 if (fmtObj->error != 0) {
9855 if (flags & JIM_ERRMSG)
9856 Jim_SetResultString(interp, fmtObj->error, -1);
9857 return 0;
9859 /* Allocate a new "shared" empty string for all unassigned conversions */
9860 emptyStr = Jim_NewEmptyStringObj(interp);
9861 Jim_IncrRefCount(emptyStr);
9862 /* Create a list and fill it with empty strings up to max specified XPG3 */
9863 resultList = Jim_NewListObj(interp, NULL, 0);
9864 if (fmtObj->maxPos > 0) {
9865 for (i = 0; i < fmtObj->maxPos; ++i)
9866 Jim_ListAppendElement(interp, resultList, emptyStr);
9867 JimListGetElements(interp, resultList, &resultc, &resultVec);
9869 /* Now handle every partial format description */
9870 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9871 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9872 Jim_Obj *value = 0;
9874 /* Only last type may be "literal" w/o conversion - skip it! */
9875 if (descr->type == 0)
9876 continue;
9877 /* As long as any conversion could be done, we will proceed */
9878 if (scanned > 0)
9879 scanned = ScanOneEntry(interp, str, pos, str_bytelen, fmtObj, i, &value);
9880 /* In case our first try results in EOF, we will leave */
9881 if (scanned == -1 && i == 0)
9882 goto eof;
9883 /* Advance next pos-to-be-scanned for the amount scanned already */
9884 pos += scanned;
9886 /* value == 0 means no conversion took place so take empty string */
9887 if (value == 0)
9888 value = Jim_NewEmptyStringObj(interp);
9889 /* If value is a non-assignable one, skip it */
9890 if (descr->pos == -1) {
9891 Jim_FreeNewObj(interp, value);
9893 else if (descr->pos == 0)
9894 /* Otherwise append it to the result list if no XPG3 was given */
9895 Jim_ListAppendElement(interp, resultList, value);
9896 else if (resultVec[descr->pos - 1] == emptyStr) {
9897 /* But due to given XPG3, put the value into the corr. slot */
9898 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9899 Jim_IncrRefCount(value);
9900 resultVec[descr->pos - 1] = value;
9902 else {
9903 /* Otherwise, the slot was already used - free obj and ERROR */
9904 Jim_FreeNewObj(interp, value);
9905 goto err;
9908 Jim_DecrRefCount(interp, emptyStr);
9909 return resultList;
9910 eof:
9911 Jim_DecrRefCount(interp, emptyStr);
9912 Jim_FreeNewObj(interp, resultList);
9913 return (Jim_Obj *)EOF;
9914 err:
9915 Jim_DecrRefCount(interp, emptyStr);
9916 Jim_FreeNewObj(interp, resultList);
9917 return 0;
9920 /* -----------------------------------------------------------------------------
9921 * Pseudo Random Number Generation
9922 * ---------------------------------------------------------------------------*/
9923 /* Initialize the sbox with the numbers from 0 to 255 */
9924 static void JimPrngInit(Jim_Interp *interp)
9926 #define PRNG_SEED_SIZE 256
9927 int i;
9928 unsigned int *seed;
9929 time_t t = time(NULL);
9931 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9933 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9934 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9935 seed[i] = (rand() ^ t ^ clock());
9937 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9938 Jim_Free(seed);
9941 /* Generates N bytes of random data */
9942 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9944 Jim_PrngState *prng;
9945 unsigned char *destByte = (unsigned char *)dest;
9946 unsigned int si, sj, x;
9948 /* initialization, only needed the first time */
9949 if (interp->prngState == NULL)
9950 JimPrngInit(interp);
9951 prng = interp->prngState;
9952 /* generates 'len' bytes of pseudo-random numbers */
9953 for (x = 0; x < len; x++) {
9954 prng->i = (prng->i + 1) & 0xff;
9955 si = prng->sbox[prng->i];
9956 prng->j = (prng->j + si) & 0xff;
9957 sj = prng->sbox[prng->j];
9958 prng->sbox[prng->i] = sj;
9959 prng->sbox[prng->j] = si;
9960 *destByte++ = prng->sbox[(si + sj) & 0xff];
9964 /* Re-seed the generator with user-provided bytes */
9965 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
9967 int i;
9968 Jim_PrngState *prng;
9970 /* initialization, only needed the first time */
9971 if (interp->prngState == NULL)
9972 JimPrngInit(interp);
9973 prng = interp->prngState;
9975 /* Set the sbox[i] with i */
9976 for (i = 0; i < 256; i++)
9977 prng->sbox[i] = i;
9978 /* Now use the seed to perform a random permutation of the sbox */
9979 for (i = 0; i < seedLen; i++) {
9980 unsigned char t;
9982 t = prng->sbox[i & 0xFF];
9983 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
9984 prng->sbox[seed[i]] = t;
9986 prng->i = prng->j = 0;
9988 /* discard at least the first 256 bytes of stream.
9989 * borrow the seed buffer for this
9991 for (i = 0; i < 256; i += seedLen) {
9992 JimRandomBytes(interp, seed, seedLen);
9996 /* [incr] */
9997 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
9999 jim_wide wideValue, increment = 1;
10000 Jim_Obj *intObjPtr;
10002 if (argc != 2 && argc != 3) {
10003 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10004 return JIM_ERR;
10006 if (argc == 3) {
10007 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10008 return JIM_ERR;
10010 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10011 if (!intObjPtr) {
10012 /* Set missing variable to 0 */
10013 wideValue = 0;
10015 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10016 return JIM_ERR;
10018 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10019 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10020 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10021 Jim_FreeNewObj(interp, intObjPtr);
10022 return JIM_ERR;
10025 else {
10026 /* Can do it the quick way */
10027 Jim_InvalidateStringRep(intObjPtr);
10028 JimWideValue(intObjPtr) = wideValue + increment;
10030 /* The following step is required in order to invalidate the
10031 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10032 if (argv[1]->typePtr != &variableObjType) {
10033 /* Note that this can't fail since GetVariable already succeeded */
10034 Jim_SetVariable(interp, argv[1], intObjPtr);
10037 Jim_SetResult(interp, intObjPtr);
10038 return JIM_OK;
10042 /* -----------------------------------------------------------------------------
10043 * Eval
10044 * ---------------------------------------------------------------------------*/
10045 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10046 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10048 /* Handle calls to the [unknown] command */
10049 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10051 int retcode;
10053 /* If JimUnknown() is recursively called too many times...
10054 * done here
10056 if (interp->unknown_called > 50) {
10057 return JIM_ERR;
10060 /* The object interp->unknown just contains
10061 * the "unknown" string, it is used in order to
10062 * avoid to lookup the unknown command every time
10063 * but instead to cache the result. */
10065 /* If the [unknown] command does not exist ... */
10066 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10067 return JIM_ERR;
10069 interp->unknown_called++;
10070 /* XXX: Are we losing fileNameObj and linenr? */
10071 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10072 interp->unknown_called--;
10074 return retcode;
10077 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10079 int retcode;
10080 Jim_Cmd *cmdPtr;
10081 void *prevPrivData;
10082 Jim_Obj *tailcallObj = NULL;
10084 #if 0
10085 printf("invoke");
10086 int j;
10087 for (j = 0; j < objc; j++) {
10088 printf(" '%s'", Jim_String(objv[j]));
10090 printf("\n");
10091 #endif
10093 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10094 if (cmdPtr == NULL) {
10095 return JimUnknown(interp, objc, objv);
10097 JimIncrCmdRefCount(cmdPtr);
10099 if (interp->evalDepth == interp->maxEvalDepth) {
10100 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10101 retcode = JIM_ERR;
10102 goto out;
10104 interp->evalDepth++;
10105 prevPrivData = interp->cmdPrivData;
10107 tailcall:
10109 /* Call it -- Make sure result is an empty object. */
10110 Jim_SetEmptyResult(interp);
10111 if (cmdPtr->isproc) {
10112 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10114 /* Handle the JIM_RETURN return code */
10115 if (retcode == JIM_RETURN) {
10116 if (--interp->returnLevel <= 0) {
10117 retcode = interp->returnCode;
10118 interp->returnCode = JIM_OK;
10119 interp->returnLevel = 0;
10122 else if (retcode == JIM_ERR) {
10123 interp->addStackTrace++;
10124 Jim_DecrRefCount(interp, interp->errorProc);
10125 interp->errorProc = objv[0];
10126 Jim_IncrRefCount(interp->errorProc);
10129 else {
10130 interp->cmdPrivData = cmdPtr->u.native.privData;
10131 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10134 if (tailcallObj) {
10135 /* clean up previous tailcall if we were invoking one */
10136 Jim_DecrRefCount(interp, tailcallObj);
10137 tailcallObj = NULL;
10140 /* If a tailcall is returned for this frame, loop to invoke the new command */
10141 if (retcode == JIM_EVAL && interp->framePtr->tailcallObj) {
10142 JimDecrCmdRefCount(interp, cmdPtr);
10144 /* Replace the current command with the new tailcall command */
10145 cmdPtr = interp->framePtr->tailcallCmd;
10146 interp->framePtr->tailcallCmd = NULL;
10147 tailcallObj = interp->framePtr->tailcallObj;
10148 interp->framePtr->tailcallObj = NULL;
10149 /* We can access the internal rep here because the object can only
10150 * be constructed by the tailcall command
10152 objc = tailcallObj->internalRep.listValue.len;
10153 objv = tailcallObj->internalRep.listValue.ele;
10154 goto tailcall;
10157 interp->cmdPrivData = prevPrivData;
10158 interp->evalDepth--;
10160 out:
10161 JimDecrCmdRefCount(interp, cmdPtr);
10163 if (interp->framePtr->tailcallObj) {
10164 /* We might have skipped invoking a tailcall, perhaps because of an error
10165 * in defer handling so cleanup now
10167 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10168 Jim_DecrRefCount(interp, interp->framePtr->tailcallObj);
10169 interp->framePtr->tailcallCmd = NULL;
10170 interp->framePtr->tailcallObj = NULL;
10173 return retcode;
10176 /* Eval the object vector 'objv' composed of 'objc' elements.
10177 * Every element is used as single argument.
10178 * Jim_EvalObj() will call this function every time its object
10179 * argument is of "list" type, with no string representation.
10181 * This is possible because the string representation of a
10182 * list object generated by the UpdateStringOfList is made
10183 * in a way that ensures that every list element is a different
10184 * command argument. */
10185 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10187 int i, retcode;
10189 /* Incr refcount of arguments. */
10190 for (i = 0; i < objc; i++)
10191 Jim_IncrRefCount(objv[i]);
10193 retcode = JimInvokeCommand(interp, objc, objv);
10195 /* Decr refcount of arguments and return the retcode */
10196 for (i = 0; i < objc; i++)
10197 Jim_DecrRefCount(interp, objv[i]);
10199 return retcode;
10203 * Invokes 'prefix' as a command with the objv array as arguments.
10205 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10207 int ret;
10208 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10210 nargv[0] = prefix;
10211 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10212 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10213 Jim_Free(nargv);
10214 return ret;
10217 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10219 if (!interp->errorFlag) {
10220 /* This is the first error, so save the file/line information and reset the stack */
10221 interp->errorFlag = 1;
10222 Jim_IncrRefCount(script->fileNameObj);
10223 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10224 interp->errorFileNameObj = script->fileNameObj;
10225 interp->errorLine = script->linenr;
10227 JimResetStackTrace(interp);
10228 /* Always add a level where the error first occurs */
10229 interp->addStackTrace++;
10232 /* Now if this is an "interesting" level, add it to the stack trace */
10233 if (interp->addStackTrace > 0) {
10234 /* Add the stack info for the current level */
10236 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10238 /* Note: if we didn't have a filename for this level,
10239 * don't clear the addStackTrace flag
10240 * so we can pick it up at the next level
10242 if (Jim_Length(script->fileNameObj)) {
10243 interp->addStackTrace = 0;
10246 Jim_DecrRefCount(interp, interp->errorProc);
10247 interp->errorProc = interp->emptyObj;
10248 Jim_IncrRefCount(interp->errorProc);
10252 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10254 Jim_Obj *objPtr;
10255 int ret = JIM_ERR;
10257 switch (token->type) {
10258 case JIM_TT_STR:
10259 case JIM_TT_ESC:
10260 objPtr = token->objPtr;
10261 break;
10262 case JIM_TT_VAR:
10263 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10264 break;
10265 case JIM_TT_DICTSUGAR:
10266 objPtr = JimExpandDictSugar(interp, token->objPtr);
10267 break;
10268 case JIM_TT_EXPRSUGAR:
10269 ret = Jim_EvalExpression(interp, token->objPtr);
10270 if (ret == JIM_OK) {
10271 objPtr = Jim_GetResult(interp);
10273 else {
10274 objPtr = NULL;
10276 break;
10277 case JIM_TT_CMD:
10278 ret = Jim_EvalObj(interp, token->objPtr);
10279 if (ret == JIM_OK || ret == JIM_RETURN) {
10280 objPtr = interp->result;
10281 } else {
10282 /* includes JIM_BREAK, JIM_CONTINUE */
10283 objPtr = NULL;
10285 break;
10286 default:
10287 JimPanic((1,
10288 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10289 objPtr = NULL;
10290 break;
10292 if (objPtr) {
10293 *objPtrPtr = objPtr;
10294 return JIM_OK;
10296 return ret;
10299 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10300 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10301 * The returned object has refcount = 0.
10303 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10305 int totlen = 0, i;
10306 Jim_Obj **intv;
10307 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10308 Jim_Obj *objPtr;
10309 char *s;
10311 if (tokens <= JIM_EVAL_SINTV_LEN)
10312 intv = sintv;
10313 else
10314 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10316 /* Compute every token forming the argument
10317 * in the intv objects vector. */
10318 for (i = 0; i < tokens; i++) {
10319 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10320 case JIM_OK:
10321 case JIM_RETURN:
10322 break;
10323 case JIM_BREAK:
10324 if (flags & JIM_SUBST_FLAG) {
10325 /* Stop here */
10326 tokens = i;
10327 continue;
10329 /* XXX: Should probably set an error about break outside loop */
10330 /* fall through to error */
10331 case JIM_CONTINUE:
10332 if (flags & JIM_SUBST_FLAG) {
10333 intv[i] = NULL;
10334 continue;
10336 /* XXX: Ditto continue outside loop */
10337 /* fall through to error */
10338 default:
10339 while (i--) {
10340 Jim_DecrRefCount(interp, intv[i]);
10342 if (intv != sintv) {
10343 Jim_Free(intv);
10345 return NULL;
10347 Jim_IncrRefCount(intv[i]);
10348 Jim_String(intv[i]);
10349 totlen += intv[i]->length;
10352 /* Fast path return for a single token */
10353 if (tokens == 1 && intv[0] && intv == sintv) {
10354 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10355 intv[0]->refCount--;
10356 return intv[0];
10359 /* Concatenate every token in an unique
10360 * object. */
10361 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10363 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10364 && token[2].type == JIM_TT_VAR) {
10365 /* May be able to do fast interpolated object -> dictSubst */
10366 objPtr->typePtr = &interpolatedObjType;
10367 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10368 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10369 Jim_IncrRefCount(intv[2]);
10371 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10372 /* The first interpolated token is source, so preserve the source info */
10373 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10377 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10378 objPtr->length = totlen;
10379 for (i = 0; i < tokens; i++) {
10380 if (intv[i]) {
10381 memcpy(s, intv[i]->bytes, intv[i]->length);
10382 s += intv[i]->length;
10383 Jim_DecrRefCount(interp, intv[i]);
10386 objPtr->bytes[totlen] = '\0';
10387 /* Free the intv vector if not static. */
10388 if (intv != sintv) {
10389 Jim_Free(intv);
10392 return objPtr;
10396 /* listPtr *must* be a list.
10397 * The contents of the list is evaluated with the first element as the command and
10398 * the remaining elements as the arguments.
10400 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10402 int retcode = JIM_OK;
10404 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10406 if (listPtr->internalRep.listValue.len) {
10407 Jim_IncrRefCount(listPtr);
10408 retcode = JimInvokeCommand(interp,
10409 listPtr->internalRep.listValue.len,
10410 listPtr->internalRep.listValue.ele);
10411 Jim_DecrRefCount(interp, listPtr);
10413 return retcode;
10416 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10418 SetListFromAny(interp, listPtr);
10419 return JimEvalObjList(interp, listPtr);
10422 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10424 int i;
10425 ScriptObj *script;
10426 ScriptToken *token;
10427 int retcode = JIM_OK;
10428 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10429 Jim_Obj *prevScriptObj;
10431 /* If the object is of type "list", with no string rep we can call
10432 * a specialized version of Jim_EvalObj() */
10433 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10434 return JimEvalObjList(interp, scriptObjPtr);
10437 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10438 script = JimGetScript(interp, scriptObjPtr);
10439 if (!JimScriptValid(interp, script)) {
10440 Jim_DecrRefCount(interp, scriptObjPtr);
10441 return JIM_ERR;
10444 /* Reset the interpreter result. This is useful to
10445 * return the empty result in the case of empty program. */
10446 Jim_SetEmptyResult(interp);
10448 token = script->token;
10450 #ifdef JIM_OPTIMIZATION
10451 /* Check for one of the following common scripts used by for, while
10453 * {}
10454 * incr a
10456 if (script->len == 0) {
10457 Jim_DecrRefCount(interp, scriptObjPtr);
10458 return JIM_OK;
10460 if (script->len == 3
10461 && token[1].objPtr->typePtr == &commandObjType
10462 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10463 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10464 && token[2].objPtr->typePtr == &variableObjType) {
10466 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10468 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10469 JimWideValue(objPtr)++;
10470 Jim_InvalidateStringRep(objPtr);
10471 Jim_DecrRefCount(interp, scriptObjPtr);
10472 Jim_SetResult(interp, objPtr);
10473 return JIM_OK;
10476 #endif
10478 /* Now we have to make sure the internal repr will not be
10479 * freed on shimmering.
10481 * Think for example to this:
10483 * set x {llength $x; ... some more code ...}; eval $x
10485 * In order to preserve the internal rep, we increment the
10486 * inUse field of the script internal rep structure. */
10487 script->inUse++;
10489 /* Stash the current script */
10490 prevScriptObj = interp->currentScriptObj;
10491 interp->currentScriptObj = scriptObjPtr;
10493 interp->errorFlag = 0;
10494 argv = sargv;
10496 /* Execute every command sequentially until the end of the script
10497 * or an error occurs.
10499 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10500 int argc;
10501 int j;
10503 /* First token of the line is always JIM_TT_LINE */
10504 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10505 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10507 /* Allocate the arguments vector if required */
10508 if (argc > JIM_EVAL_SARGV_LEN)
10509 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10511 /* Skip the JIM_TT_LINE token */
10512 i++;
10514 /* Populate the arguments objects.
10515 * If an error occurs, retcode will be set and
10516 * 'j' will be set to the number of args expanded
10518 for (j = 0; j < argc; j++) {
10519 long wordtokens = 1;
10520 int expand = 0;
10521 Jim_Obj *wordObjPtr = NULL;
10523 if (token[i].type == JIM_TT_WORD) {
10524 wordtokens = JimWideValue(token[i++].objPtr);
10525 if (wordtokens < 0) {
10526 expand = 1;
10527 wordtokens = -wordtokens;
10531 if (wordtokens == 1) {
10532 /* Fast path if the token does not
10533 * need interpolation */
10535 switch (token[i].type) {
10536 case JIM_TT_ESC:
10537 case JIM_TT_STR:
10538 wordObjPtr = token[i].objPtr;
10539 break;
10540 case JIM_TT_VAR:
10541 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10542 break;
10543 case JIM_TT_EXPRSUGAR:
10544 retcode = Jim_EvalExpression(interp, token[i].objPtr);
10545 if (retcode == JIM_OK) {
10546 wordObjPtr = Jim_GetResult(interp);
10548 else {
10549 wordObjPtr = NULL;
10551 break;
10552 case JIM_TT_DICTSUGAR:
10553 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10554 break;
10555 case JIM_TT_CMD:
10556 retcode = Jim_EvalObj(interp, token[i].objPtr);
10557 if (retcode == JIM_OK) {
10558 wordObjPtr = Jim_GetResult(interp);
10560 break;
10561 default:
10562 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10565 else {
10566 /* For interpolation we call a helper
10567 * function to do the work for us. */
10568 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10571 if (!wordObjPtr) {
10572 if (retcode == JIM_OK) {
10573 retcode = JIM_ERR;
10575 break;
10578 Jim_IncrRefCount(wordObjPtr);
10579 i += wordtokens;
10581 if (!expand) {
10582 argv[j] = wordObjPtr;
10584 else {
10585 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10586 int len = Jim_ListLength(interp, wordObjPtr);
10587 int newargc = argc + len - 1;
10588 int k;
10590 if (len > 1) {
10591 if (argv == sargv) {
10592 if (newargc > JIM_EVAL_SARGV_LEN) {
10593 argv = Jim_Alloc(sizeof(*argv) * newargc);
10594 memcpy(argv, sargv, sizeof(*argv) * j);
10597 else {
10598 /* Need to realloc to make room for (len - 1) more entries */
10599 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10603 /* Now copy in the expanded version */
10604 for (k = 0; k < len; k++) {
10605 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10606 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10609 /* The original object reference is no longer needed,
10610 * after the expansion it is no longer present on
10611 * the argument vector, but the single elements are
10612 * in its place. */
10613 Jim_DecrRefCount(interp, wordObjPtr);
10615 /* And update the indexes */
10616 j--;
10617 argc += len - 1;
10621 if (retcode == JIM_OK && argc) {
10622 /* Invoke the command */
10623 retcode = JimInvokeCommand(interp, argc, argv);
10624 /* Check for a signal after each command */
10625 if (Jim_CheckSignal(interp)) {
10626 retcode = JIM_SIGNAL;
10630 /* Finished with the command, so decrement ref counts of each argument */
10631 while (j-- > 0) {
10632 Jim_DecrRefCount(interp, argv[j]);
10635 if (argv != sargv) {
10636 Jim_Free(argv);
10637 argv = sargv;
10641 /* Possibly add to the error stack trace */
10642 if (retcode == JIM_ERR) {
10643 JimAddErrorToStack(interp, script);
10645 /* Propagate the addStackTrace value through 'return -code error' */
10646 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10647 /* No need to add stack trace */
10648 interp->addStackTrace = 0;
10651 /* Restore the current script */
10652 interp->currentScriptObj = prevScriptObj;
10654 /* Note that we don't have to decrement inUse, because the
10655 * following code transfers our use of the reference again to
10656 * the script object. */
10657 Jim_FreeIntRep(interp, scriptObjPtr);
10658 scriptObjPtr->typePtr = &scriptObjType;
10659 Jim_SetIntRepPtr(scriptObjPtr, script);
10660 Jim_DecrRefCount(interp, scriptObjPtr);
10662 return retcode;
10665 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10667 int retcode;
10668 /* If argObjPtr begins with '&', do an automatic upvar */
10669 const char *varname = Jim_String(argNameObj);
10670 if (*varname == '&') {
10671 /* First check that the target variable exists */
10672 Jim_Obj *objPtr;
10673 Jim_CallFrame *savedCallFrame = interp->framePtr;
10675 interp->framePtr = interp->framePtr->parent;
10676 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10677 interp->framePtr = savedCallFrame;
10678 if (!objPtr) {
10679 return JIM_ERR;
10682 /* It exists, so perform the binding. */
10683 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10684 Jim_IncrRefCount(objPtr);
10685 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10686 Jim_DecrRefCount(interp, objPtr);
10688 else {
10689 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10691 return retcode;
10695 * Sets the interp result to be an error message indicating the required proc args.
10697 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10699 /* Create a nice error message, consistent with Tcl 8.5 */
10700 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10701 int i;
10703 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10704 Jim_AppendString(interp, argmsg, " ", 1);
10706 if (i == cmd->u.proc.argsPos) {
10707 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10708 /* Renamed args */
10709 Jim_AppendString(interp, argmsg, "?", 1);
10710 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10711 Jim_AppendString(interp, argmsg, " ...?", -1);
10713 else {
10714 /* We have plain args */
10715 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10718 else {
10719 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10720 Jim_AppendString(interp, argmsg, "?", 1);
10721 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10722 Jim_AppendString(interp, argmsg, "?", 1);
10724 else {
10725 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10726 if (*arg == '&') {
10727 arg++;
10729 Jim_AppendString(interp, argmsg, arg, -1);
10733 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10736 #ifdef jim_ext_namespace
10738 * [namespace eval]
10740 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10742 Jim_CallFrame *callFramePtr;
10743 int retcode;
10745 /* Create a new callframe */
10746 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10747 callFramePtr->argv = &interp->emptyObj;
10748 callFramePtr->argc = 0;
10749 callFramePtr->procArgsObjPtr = NULL;
10750 callFramePtr->procBodyObjPtr = scriptObj;
10751 callFramePtr->staticVars = NULL;
10752 callFramePtr->fileNameObj = interp->emptyObj;
10753 callFramePtr->line = 0;
10754 Jim_IncrRefCount(scriptObj);
10755 interp->framePtr = callFramePtr;
10757 /* Check if there are too nested calls */
10758 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10759 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10760 retcode = JIM_ERR;
10762 else {
10763 /* Eval the body */
10764 retcode = Jim_EvalObj(interp, scriptObj);
10767 /* Destroy the callframe */
10768 interp->framePtr = interp->framePtr->parent;
10769 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10771 return retcode;
10773 #endif
10775 /* Call a procedure implemented in Tcl.
10776 * It's possible to speed-up a lot this function, currently
10777 * the callframes are not cached, but allocated and
10778 * destroied every time. What is expecially costly is
10779 * to create/destroy the local vars hash table every time.
10781 * This can be fixed just implementing callframes caching
10782 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10783 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10785 Jim_CallFrame *callFramePtr;
10786 int i, d, retcode, optargs;
10787 ScriptObj *script;
10789 /* Check arity */
10790 if (argc - 1 < cmd->u.proc.reqArity ||
10791 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10792 JimSetProcWrongArgs(interp, argv[0], cmd);
10793 return JIM_ERR;
10796 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10797 /* Optimise for procedure with no body - useful for optional debugging */
10798 return JIM_OK;
10801 /* Check if there are too nested calls */
10802 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10803 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10804 return JIM_ERR;
10807 /* Create a new callframe */
10808 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10809 callFramePtr->argv = argv;
10810 callFramePtr->argc = argc;
10811 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10812 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10813 callFramePtr->staticVars = cmd->u.proc.staticVars;
10815 /* Remember where we were called from. */
10816 script = JimGetScript(interp, interp->currentScriptObj);
10817 callFramePtr->fileNameObj = script->fileNameObj;
10818 callFramePtr->line = script->linenr;
10820 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10821 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10822 interp->framePtr = callFramePtr;
10824 /* How many optional args are available */
10825 optargs = (argc - 1 - cmd->u.proc.reqArity);
10827 /* Step 'i' along the actual args, and step 'd' along the formal args */
10828 i = 1;
10829 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10830 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10831 if (d == cmd->u.proc.argsPos) {
10832 /* assign $args */
10833 Jim_Obj *listObjPtr;
10834 int argsLen = 0;
10835 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10836 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10838 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10840 /* It is possible to rename args. */
10841 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10842 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10844 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10845 if (retcode != JIM_OK) {
10846 goto badargset;
10849 i += argsLen;
10850 continue;
10853 /* Optional or required? */
10854 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10855 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10857 else {
10858 /* Ran out, so use the default */
10859 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10861 if (retcode != JIM_OK) {
10862 goto badargset;
10866 /* Eval the body */
10867 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10869 badargset:
10871 /* Invoke $jim::defer then destroy the callframe */
10872 retcode = JimInvokeDefer(interp, retcode);
10873 interp->framePtr = interp->framePtr->parent;
10874 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10876 return retcode;
10879 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10881 int retval;
10882 Jim_Obj *scriptObjPtr;
10884 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10885 Jim_IncrRefCount(scriptObjPtr);
10887 if (filename) {
10888 Jim_Obj *prevScriptObj;
10890 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10892 prevScriptObj = interp->currentScriptObj;
10893 interp->currentScriptObj = scriptObjPtr;
10895 retval = Jim_EvalObj(interp, scriptObjPtr);
10897 interp->currentScriptObj = prevScriptObj;
10899 else {
10900 retval = Jim_EvalObj(interp, scriptObjPtr);
10902 Jim_DecrRefCount(interp, scriptObjPtr);
10903 return retval;
10906 int Jim_Eval(Jim_Interp *interp, const char *script)
10908 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10911 /* Execute script in the scope of the global level */
10912 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10914 int retval;
10915 Jim_CallFrame *savedFramePtr = interp->framePtr;
10917 interp->framePtr = interp->topFramePtr;
10918 retval = Jim_Eval(interp, script);
10919 interp->framePtr = savedFramePtr;
10921 return retval;
10924 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10926 int retval;
10927 Jim_CallFrame *savedFramePtr = interp->framePtr;
10929 interp->framePtr = interp->topFramePtr;
10930 retval = Jim_EvalFile(interp, filename);
10931 interp->framePtr = savedFramePtr;
10933 return retval;
10936 #include <sys/stat.h>
10938 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10940 FILE *fp;
10941 char *buf;
10942 Jim_Obj *scriptObjPtr;
10943 Jim_Obj *prevScriptObj;
10944 struct stat sb;
10945 int retcode;
10946 int readlen;
10948 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10949 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10950 return JIM_ERR;
10952 if (sb.st_size == 0) {
10953 fclose(fp);
10954 return JIM_OK;
10957 buf = Jim_Alloc(sb.st_size + 1);
10958 readlen = fread(buf, 1, sb.st_size, fp);
10959 if (ferror(fp)) {
10960 fclose(fp);
10961 Jim_Free(buf);
10962 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10963 return JIM_ERR;
10965 fclose(fp);
10966 buf[readlen] = 0;
10968 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10969 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
10970 Jim_IncrRefCount(scriptObjPtr);
10972 prevScriptObj = interp->currentScriptObj;
10973 interp->currentScriptObj = scriptObjPtr;
10975 retcode = Jim_EvalObj(interp, scriptObjPtr);
10977 /* Handle the JIM_RETURN return code */
10978 if (retcode == JIM_RETURN) {
10979 if (--interp->returnLevel <= 0) {
10980 retcode = interp->returnCode;
10981 interp->returnCode = JIM_OK;
10982 interp->returnLevel = 0;
10985 if (retcode == JIM_ERR) {
10986 /* EvalFile changes context, so add a stack frame here */
10987 interp->addStackTrace++;
10990 interp->currentScriptObj = prevScriptObj;
10992 Jim_DecrRefCount(interp, scriptObjPtr);
10994 return retcode;
10997 /* -----------------------------------------------------------------------------
10998 * Subst
10999 * ---------------------------------------------------------------------------*/
11000 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11002 pc->tstart = pc->p;
11003 pc->tline = pc->linenr;
11005 if (pc->len == 0) {
11006 pc->tend = pc->p;
11007 pc->tt = JIM_TT_EOL;
11008 pc->eof = 1;
11009 return;
11011 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11012 JimParseCmd(pc);
11013 return;
11015 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11016 if (JimParseVar(pc) == JIM_OK) {
11017 return;
11019 /* Not a var, so treat as a string */
11020 pc->tstart = pc->p;
11021 flags |= JIM_SUBST_NOVAR;
11023 while (pc->len) {
11024 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11025 break;
11027 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11028 break;
11030 if (*pc->p == '\\' && pc->len > 1) {
11031 pc->p++;
11032 pc->len--;
11034 pc->p++;
11035 pc->len--;
11037 pc->tend = pc->p - 1;
11038 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11041 /* The subst object type reuses most of the data structures and functions
11042 * of the script object. Script's data structures are a bit more complex
11043 * for what is needed for [subst]itution tasks, but the reuse helps to
11044 * deal with a single data structure at the cost of some more memory
11045 * usage for substitutions. */
11047 /* This method takes the string representation of an object
11048 * as a Tcl string where to perform [subst]itution, and generates
11049 * the pre-parsed internal representation. */
11050 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11052 int scriptTextLen;
11053 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11054 struct JimParserCtx parser;
11055 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11056 ParseTokenList tokenlist;
11058 /* Initially parse the subst into tokens (in tokenlist) */
11059 ScriptTokenListInit(&tokenlist);
11061 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11062 while (1) {
11063 JimParseSubst(&parser, flags);
11064 if (parser.eof) {
11065 /* Note that subst doesn't need the EOL token */
11066 break;
11068 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11069 parser.tline);
11072 /* Create the "real" subst/script tokens from the initial token list */
11073 script->inUse = 1;
11074 script->substFlags = flags;
11075 script->fileNameObj = interp->emptyObj;
11076 Jim_IncrRefCount(script->fileNameObj);
11077 SubstObjAddTokens(interp, script, &tokenlist);
11079 /* No longer need the token list */
11080 ScriptTokenListFree(&tokenlist);
11082 #ifdef DEBUG_SHOW_SUBST
11084 int i;
11086 printf("==== Subst ====\n");
11087 for (i = 0; i < script->len; i++) {
11088 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11089 Jim_String(script->token[i].objPtr));
11092 #endif
11094 /* Free the old internal rep and set the new one. */
11095 Jim_FreeIntRep(interp, objPtr);
11096 Jim_SetIntRepPtr(objPtr, script);
11097 objPtr->typePtr = &scriptObjType;
11098 return JIM_OK;
11101 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11103 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11104 SetSubstFromAny(interp, objPtr, flags);
11105 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11108 /* Performs commands,variables,blackslashes substitution,
11109 * storing the result object (with refcount 0) into
11110 * resObjPtrPtr. */
11111 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11113 ScriptObj *script;
11115 JimPanic((substObjPtr->refCount == 0, "Jim_SubstObj() called with zero refcount object"));
11117 script = Jim_GetSubst(interp, substObjPtr, flags);
11119 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11120 /* In order to preserve the internal rep, we increment the
11121 * inUse field of the script internal rep structure. */
11122 script->inUse++;
11124 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11126 script->inUse--;
11127 Jim_DecrRefCount(interp, substObjPtr);
11128 if (*resObjPtrPtr == NULL) {
11129 return JIM_ERR;
11131 return JIM_OK;
11134 /* -----------------------------------------------------------------------------
11135 * Core commands utility functions
11136 * ---------------------------------------------------------------------------*/
11137 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11139 Jim_Obj *objPtr;
11140 Jim_Obj *listObjPtr;
11142 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11144 listObjPtr = Jim_NewListObj(interp, argv, argc);
11146 if (msg && *msg) {
11147 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11149 Jim_IncrRefCount(listObjPtr);
11150 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11151 Jim_DecrRefCount(interp, listObjPtr);
11153 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11157 * May add the key and/or value to the list.
11159 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11160 Jim_HashEntry *he, int type);
11162 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11165 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11166 * invoke the callback to add entries to a list.
11167 * Returns the list.
11169 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11170 JimHashtableIteratorCallbackType *callback, int type)
11172 Jim_HashEntry *he;
11173 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11175 /* Check for the non-pattern case. We can do this much more efficiently. */
11176 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11177 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11178 if (he) {
11179 callback(interp, listObjPtr, he, type);
11182 else {
11183 Jim_HashTableIterator htiter;
11184 JimInitHashTableIterator(ht, &htiter);
11185 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11186 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11187 callback(interp, listObjPtr, he, type);
11191 return listObjPtr;
11194 /* Keep these in order */
11195 #define JIM_CMDLIST_COMMANDS 0
11196 #define JIM_CMDLIST_PROCS 1
11197 #define JIM_CMDLIST_CHANNELS 2
11200 * Adds matching command names (procs, channels) to the list.
11202 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11203 Jim_HashEntry *he, int type)
11205 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11206 Jim_Obj *objPtr;
11208 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11209 /* not a proc */
11210 return;
11213 objPtr = Jim_NewStringObj(interp, he->key, -1);
11214 Jim_IncrRefCount(objPtr);
11216 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11217 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11219 Jim_DecrRefCount(interp, objPtr);
11222 /* type is JIM_CMDLIST_xxx */
11223 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11225 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11228 /* Keep these in order */
11229 #define JIM_VARLIST_GLOBALS 0
11230 #define JIM_VARLIST_LOCALS 1
11231 #define JIM_VARLIST_VARS 2
11233 #define JIM_VARLIST_VALUES 0x1000
11236 * Adds matching variable names to the list.
11238 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11239 Jim_HashEntry *he, int type)
11241 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11243 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11244 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11245 if (type & JIM_VARLIST_VALUES) {
11246 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11251 /* mode is JIM_VARLIST_xxx */
11252 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11254 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11255 /* For [info locals], if we are at top level an emtpy list
11256 * is returned. I don't agree, but we aim at compatibility (SS) */
11257 return interp->emptyObj;
11259 else {
11260 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11261 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11265 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11266 Jim_Obj **objPtrPtr, int info_level_cmd)
11268 Jim_CallFrame *targetCallFrame;
11270 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11271 if (targetCallFrame == NULL) {
11272 return JIM_ERR;
11274 /* No proc call at toplevel callframe */
11275 if (targetCallFrame == interp->topFramePtr) {
11276 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11277 return JIM_ERR;
11279 if (info_level_cmd) {
11280 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11282 else {
11283 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11285 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11286 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11287 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11288 *objPtrPtr = listObj;
11290 return JIM_OK;
11293 /* -----------------------------------------------------------------------------
11294 * Core commands
11295 * ---------------------------------------------------------------------------*/
11297 /* fake [puts] -- not the real puts, just for debugging. */
11298 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11300 if (argc != 2 && argc != 3) {
11301 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11302 return JIM_ERR;
11304 if (argc == 3) {
11305 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11306 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11307 return JIM_ERR;
11309 else {
11310 fputs(Jim_String(argv[2]), stdout);
11313 else {
11314 puts(Jim_String(argv[1]));
11316 return JIM_OK;
11319 /* Helper for [+] and [*] */
11320 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11322 jim_wide wideValue, res;
11323 double doubleValue, doubleRes;
11324 int i;
11326 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11328 for (i = 1; i < argc; i++) {
11329 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11330 goto trydouble;
11331 if (op == JIM_EXPROP_ADD)
11332 res += wideValue;
11333 else
11334 res *= wideValue;
11336 Jim_SetResultInt(interp, res);
11337 return JIM_OK;
11338 trydouble:
11339 doubleRes = (double)res;
11340 for (; i < argc; i++) {
11341 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11342 return JIM_ERR;
11343 if (op == JIM_EXPROP_ADD)
11344 doubleRes += doubleValue;
11345 else
11346 doubleRes *= doubleValue;
11348 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11349 return JIM_OK;
11352 /* Helper for [-] and [/] */
11353 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11355 jim_wide wideValue, res = 0;
11356 double doubleValue, doubleRes = 0;
11357 int i = 2;
11359 if (argc < 2) {
11360 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11361 return JIM_ERR;
11363 else if (argc == 2) {
11364 /* The arity = 2 case is different. For [- x] returns -x,
11365 * while [/ x] returns 1/x. */
11366 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11367 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11368 return JIM_ERR;
11370 else {
11371 if (op == JIM_EXPROP_SUB)
11372 doubleRes = -doubleValue;
11373 else
11374 doubleRes = 1.0 / doubleValue;
11375 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11376 return JIM_OK;
11379 if (op == JIM_EXPROP_SUB) {
11380 res = -wideValue;
11381 Jim_SetResultInt(interp, res);
11383 else {
11384 doubleRes = 1.0 / wideValue;
11385 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11387 return JIM_OK;
11389 else {
11390 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11391 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11392 != JIM_OK) {
11393 return JIM_ERR;
11395 else {
11396 goto trydouble;
11400 for (i = 2; i < argc; i++) {
11401 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11402 doubleRes = (double)res;
11403 goto trydouble;
11405 if (op == JIM_EXPROP_SUB)
11406 res -= wideValue;
11407 else {
11408 if (wideValue == 0) {
11409 Jim_SetResultString(interp, "Division by zero", -1);
11410 return JIM_ERR;
11412 res /= wideValue;
11415 Jim_SetResultInt(interp, res);
11416 return JIM_OK;
11417 trydouble:
11418 for (; i < argc; i++) {
11419 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11420 return JIM_ERR;
11421 if (op == JIM_EXPROP_SUB)
11422 doubleRes -= doubleValue;
11423 else
11424 doubleRes /= doubleValue;
11426 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11427 return JIM_OK;
11431 /* [+] */
11432 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11434 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11437 /* [*] */
11438 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11440 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11443 /* [-] */
11444 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11446 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11449 /* [/] */
11450 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11452 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11455 /* [set] */
11456 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11458 if (argc != 2 && argc != 3) {
11459 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11460 return JIM_ERR;
11462 if (argc == 2) {
11463 Jim_Obj *objPtr;
11465 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11466 if (!objPtr)
11467 return JIM_ERR;
11468 Jim_SetResult(interp, objPtr);
11469 return JIM_OK;
11471 /* argc == 3 case. */
11472 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11473 return JIM_ERR;
11474 Jim_SetResult(interp, argv[2]);
11475 return JIM_OK;
11478 /* [unset]
11480 * unset ?-nocomplain? ?--? ?varName ...?
11482 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11484 int i = 1;
11485 int complain = 1;
11487 while (i < argc) {
11488 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11489 i++;
11490 break;
11492 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11493 complain = 0;
11494 i++;
11495 continue;
11497 break;
11500 while (i < argc) {
11501 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11502 && complain) {
11503 return JIM_ERR;
11505 i++;
11507 return JIM_OK;
11510 /* [while] */
11511 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11513 if (argc != 3) {
11514 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11515 return JIM_ERR;
11518 /* The general purpose implementation of while starts here */
11519 while (1) {
11520 int boolean, retval;
11522 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11523 return retval;
11524 if (!boolean)
11525 break;
11527 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11528 switch (retval) {
11529 case JIM_BREAK:
11530 goto out;
11531 break;
11532 case JIM_CONTINUE:
11533 continue;
11534 break;
11535 default:
11536 return retval;
11540 out:
11541 Jim_SetEmptyResult(interp);
11542 return JIM_OK;
11545 /* [for] */
11546 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11548 int retval;
11549 int boolean = 1;
11550 Jim_Obj *varNamePtr = NULL;
11551 Jim_Obj *stopVarNamePtr = NULL;
11553 if (argc != 5) {
11554 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11555 return JIM_ERR;
11558 /* Do the initialisation */
11559 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11560 return retval;
11563 /* And do the first test now. Better for optimisation
11564 * if we can do next/test at the bottom of the loop
11566 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11568 /* Ready to do the body as follows:
11569 * while (1) {
11570 * body // check retcode
11571 * next // check retcode
11572 * test // check retcode/test bool
11576 #ifdef JIM_OPTIMIZATION
11577 /* Check if the for is on the form:
11578 * for ... {$i < CONST} {incr i}
11579 * for ... {$i < $j} {incr i}
11581 if (retval == JIM_OK && boolean) {
11582 ScriptObj *incrScript;
11583 struct ExprTree *expr;
11584 jim_wide stop, currentVal;
11585 Jim_Obj *objPtr;
11586 int cmpOffset;
11588 /* Do it only if there aren't shared arguments */
11589 expr = JimGetExpression(interp, argv[2]);
11590 incrScript = JimGetScript(interp, argv[3]);
11592 /* Ensure proper lengths to start */
11593 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11594 goto evalstart;
11596 /* Ensure proper token types. */
11597 if (incrScript->token[1].type != JIM_TT_ESC) {
11598 goto evalstart;
11601 if (expr->expr->type == JIM_EXPROP_LT) {
11602 cmpOffset = 0;
11604 else if (expr->expr->type == JIM_EXPROP_LTE) {
11605 cmpOffset = 1;
11607 else {
11608 goto evalstart;
11611 if (expr->expr->left->type != JIM_TT_VAR) {
11612 goto evalstart;
11615 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11616 goto evalstart;
11619 /* Update command must be incr */
11620 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11621 goto evalstart;
11624 /* incr, expression must be about the same variable */
11625 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11626 goto evalstart;
11629 /* Get the stop condition (must be a variable or integer) */
11630 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11631 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11632 goto evalstart;
11635 else {
11636 stopVarNamePtr = expr->expr->right->objPtr;
11637 Jim_IncrRefCount(stopVarNamePtr);
11638 /* Keep the compiler happy */
11639 stop = 0;
11642 /* Initialization */
11643 varNamePtr = expr->expr->left->objPtr;
11644 Jim_IncrRefCount(varNamePtr);
11646 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11647 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11648 goto testcond;
11651 /* --- OPTIMIZED FOR --- */
11652 while (retval == JIM_OK) {
11653 /* === Check condition === */
11654 /* Note that currentVal is already set here */
11656 /* Immediate or Variable? get the 'stop' value if the latter. */
11657 if (stopVarNamePtr) {
11658 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11659 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11660 goto testcond;
11664 if (currentVal >= stop + cmpOffset) {
11665 break;
11668 /* Eval body */
11669 retval = Jim_EvalObj(interp, argv[4]);
11670 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11671 retval = JIM_OK;
11673 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11675 /* Increment */
11676 if (objPtr == NULL) {
11677 retval = JIM_ERR;
11678 goto out;
11680 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11681 currentVal = ++JimWideValue(objPtr);
11682 Jim_InvalidateStringRep(objPtr);
11684 else {
11685 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11686 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11687 ++currentVal)) != JIM_OK) {
11688 goto evalnext;
11693 goto out;
11695 evalstart:
11696 #endif
11698 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11699 /* Body */
11700 retval = Jim_EvalObj(interp, argv[4]);
11702 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11703 /* increment */
11704 JIM_IF_OPTIM(evalnext:)
11705 retval = Jim_EvalObj(interp, argv[3]);
11706 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11707 /* test */
11708 JIM_IF_OPTIM(testcond:)
11709 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11713 JIM_IF_OPTIM(out:)
11714 if (stopVarNamePtr) {
11715 Jim_DecrRefCount(interp, stopVarNamePtr);
11717 if (varNamePtr) {
11718 Jim_DecrRefCount(interp, varNamePtr);
11721 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11722 Jim_SetEmptyResult(interp);
11723 return JIM_OK;
11726 return retval;
11729 /* [loop] */
11730 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11732 int retval;
11733 jim_wide i;
11734 jim_wide limit;
11735 jim_wide incr = 1;
11736 Jim_Obj *bodyObjPtr;
11738 if (argc != 5 && argc != 6) {
11739 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11740 return JIM_ERR;
11743 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11744 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11745 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11746 return JIM_ERR;
11748 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11750 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11752 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11753 retval = Jim_EvalObj(interp, bodyObjPtr);
11754 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11755 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11757 retval = JIM_OK;
11759 /* Increment */
11760 i += incr;
11762 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11763 if (argv[1]->typePtr != &variableObjType) {
11764 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11765 return JIM_ERR;
11768 JimWideValue(objPtr) = i;
11769 Jim_InvalidateStringRep(objPtr);
11771 /* The following step is required in order to invalidate the
11772 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11773 if (argv[1]->typePtr != &variableObjType) {
11774 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11775 retval = JIM_ERR;
11776 break;
11780 else {
11781 objPtr = Jim_NewIntObj(interp, i);
11782 retval = Jim_SetVariable(interp, argv[1], objPtr);
11783 if (retval != JIM_OK) {
11784 Jim_FreeNewObj(interp, objPtr);
11790 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11791 Jim_SetEmptyResult(interp);
11792 return JIM_OK;
11794 return retval;
11797 /* List iterators make it easy to iterate over a list.
11798 * At some point iterators will be expanded to support generators.
11800 typedef struct {
11801 Jim_Obj *objPtr;
11802 int idx;
11803 } Jim_ListIter;
11806 * Initialise the iterator at the start of the list.
11808 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11810 iter->objPtr = objPtr;
11811 iter->idx = 0;
11815 * Returns the next object from the list, or NULL on end-of-list.
11817 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11819 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11820 return NULL;
11822 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11826 * Returns 1 if end-of-list has been reached.
11828 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11830 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11833 /* foreach + lmap implementation. */
11834 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11836 int result = JIM_OK;
11837 int i, numargs;
11838 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11839 Jim_ListIter *iters;
11840 Jim_Obj *script;
11841 Jim_Obj *resultObj;
11843 if (argc < 4 || argc % 2 != 0) {
11844 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11845 return JIM_ERR;
11847 script = argv[argc - 1]; /* Last argument is a script */
11848 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11850 if (numargs == 2) {
11851 iters = twoiters;
11853 else {
11854 iters = Jim_Alloc(numargs * sizeof(*iters));
11856 for (i = 0; i < numargs; i++) {
11857 JimListIterInit(&iters[i], argv[i + 1]);
11858 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11859 result = JIM_ERR;
11862 if (result != JIM_OK) {
11863 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11864 goto empty_varlist;
11867 if (doMap) {
11868 resultObj = Jim_NewListObj(interp, NULL, 0);
11870 else {
11871 resultObj = interp->emptyObj;
11873 Jim_IncrRefCount(resultObj);
11875 while (1) {
11876 /* Have we expired all lists? */
11877 for (i = 0; i < numargs; i += 2) {
11878 if (!JimListIterDone(interp, &iters[i + 1])) {
11879 break;
11882 if (i == numargs) {
11883 /* All done */
11884 break;
11887 /* For each list */
11888 for (i = 0; i < numargs; i += 2) {
11889 Jim_Obj *varName;
11891 /* foreach var */
11892 JimListIterInit(&iters[i], argv[i + 1]);
11893 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11894 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11895 if (!valObj) {
11896 /* Ran out, so store the empty string */
11897 valObj = interp->emptyObj;
11899 /* Avoid shimmering */
11900 Jim_IncrRefCount(valObj);
11901 result = Jim_SetVariable(interp, varName, valObj);
11902 Jim_DecrRefCount(interp, valObj);
11903 if (result != JIM_OK) {
11904 goto err;
11908 switch (result = Jim_EvalObj(interp, script)) {
11909 case JIM_OK:
11910 if (doMap) {
11911 Jim_ListAppendElement(interp, resultObj, interp->result);
11913 break;
11914 case JIM_CONTINUE:
11915 break;
11916 case JIM_BREAK:
11917 goto out;
11918 default:
11919 goto err;
11922 out:
11923 result = JIM_OK;
11924 Jim_SetResult(interp, resultObj);
11925 err:
11926 Jim_DecrRefCount(interp, resultObj);
11927 empty_varlist:
11928 if (numargs > 2) {
11929 Jim_Free(iters);
11931 return result;
11934 /* [foreach] */
11935 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11937 return JimForeachMapHelper(interp, argc, argv, 0);
11940 /* [lmap] */
11941 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11943 return JimForeachMapHelper(interp, argc, argv, 1);
11946 /* [lassign] */
11947 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11949 int result = JIM_ERR;
11950 int i;
11951 Jim_ListIter iter;
11952 Jim_Obj *resultObj;
11954 if (argc < 2) {
11955 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11956 return JIM_ERR;
11959 JimListIterInit(&iter, argv[1]);
11961 for (i = 2; i < argc; i++) {
11962 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11963 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11964 if (result != JIM_OK) {
11965 return result;
11969 resultObj = Jim_NewListObj(interp, NULL, 0);
11970 while (!JimListIterDone(interp, &iter)) {
11971 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
11974 Jim_SetResult(interp, resultObj);
11976 return JIM_OK;
11979 /* [if] */
11980 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11982 int boolean, retval, current = 1, falsebody = 0;
11984 if (argc >= 3) {
11985 while (1) {
11986 /* Far not enough arguments given! */
11987 if (current >= argc)
11988 goto err;
11989 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
11990 != JIM_OK)
11991 return retval;
11992 /* There lacks something, isn't it? */
11993 if (current >= argc)
11994 goto err;
11995 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
11996 current++;
11997 /* Tsk tsk, no then-clause? */
11998 if (current >= argc)
11999 goto err;
12000 if (boolean)
12001 return Jim_EvalObj(interp, argv[current]);
12002 /* Ok: no else-clause follows */
12003 if (++current >= argc) {
12004 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12005 return JIM_OK;
12007 falsebody = current++;
12008 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12009 /* IIICKS - else-clause isn't last cmd? */
12010 if (current != argc - 1)
12011 goto err;
12012 return Jim_EvalObj(interp, argv[current]);
12014 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12015 /* Ok: elseif follows meaning all the stuff
12016 * again (how boring...) */
12017 continue;
12018 /* OOPS - else-clause is not last cmd? */
12019 else if (falsebody != argc - 1)
12020 goto err;
12021 return Jim_EvalObj(interp, argv[falsebody]);
12023 return JIM_OK;
12025 err:
12026 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12027 return JIM_ERR;
12031 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12032 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12033 Jim_Obj *stringObj, int nocase)
12035 Jim_Obj *parms[4];
12036 int argc = 0;
12037 long eq;
12038 int rc;
12040 parms[argc++] = commandObj;
12041 if (nocase) {
12042 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12044 parms[argc++] = patternObj;
12045 parms[argc++] = stringObj;
12047 rc = Jim_EvalObjVector(interp, argc, parms);
12049 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12050 eq = -rc;
12053 return eq;
12056 /* [switch] */
12057 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12059 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12060 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12061 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12062 Jim_Obj **caseList;
12064 if (argc < 3) {
12065 wrongnumargs:
12066 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12067 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12068 return JIM_ERR;
12070 for (opt = 1; opt < argc; ++opt) {
12071 const char *option = Jim_String(argv[opt]);
12073 if (*option != '-')
12074 break;
12075 else if (strncmp(option, "--", 2) == 0) {
12076 ++opt;
12077 break;
12079 else if (strncmp(option, "-exact", 2) == 0)
12080 matchOpt = SWITCH_EXACT;
12081 else if (strncmp(option, "-glob", 2) == 0)
12082 matchOpt = SWITCH_GLOB;
12083 else if (strncmp(option, "-regexp", 2) == 0)
12084 matchOpt = SWITCH_RE;
12085 else if (strncmp(option, "-command", 2) == 0) {
12086 matchOpt = SWITCH_CMD;
12087 if ((argc - opt) < 2)
12088 goto wrongnumargs;
12089 command = argv[++opt];
12091 else {
12092 Jim_SetResultFormatted(interp,
12093 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12094 argv[opt]);
12095 return JIM_ERR;
12097 if ((argc - opt) < 2)
12098 goto wrongnumargs;
12100 strObj = argv[opt++];
12101 patCount = argc - opt;
12102 if (patCount == 1) {
12103 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12105 else
12106 caseList = (Jim_Obj **)&argv[opt];
12107 if (patCount == 0 || patCount % 2 != 0)
12108 goto wrongnumargs;
12109 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12110 Jim_Obj *patObj = caseList[i];
12112 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12113 || i < (patCount - 2)) {
12114 switch (matchOpt) {
12115 case SWITCH_EXACT:
12116 if (Jim_StringEqObj(strObj, patObj))
12117 scriptObj = caseList[i + 1];
12118 break;
12119 case SWITCH_GLOB:
12120 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12121 scriptObj = caseList[i + 1];
12122 break;
12123 case SWITCH_RE:
12124 command = Jim_NewStringObj(interp, "regexp", -1);
12125 /* Fall thru intentionally */
12126 case SWITCH_CMD:{
12127 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12129 /* After the execution of a command we need to
12130 * make sure to reconvert the object into a list
12131 * again. Only for the single-list style [switch]. */
12132 if (argc - opt == 1) {
12133 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12135 /* command is here already decref'd */
12136 if (rc < 0) {
12137 return -rc;
12139 if (rc)
12140 scriptObj = caseList[i + 1];
12141 break;
12145 else {
12146 scriptObj = caseList[i + 1];
12149 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12150 scriptObj = caseList[i + 1];
12151 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12152 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12153 return JIM_ERR;
12155 Jim_SetEmptyResult(interp);
12156 if (scriptObj) {
12157 return Jim_EvalObj(interp, scriptObj);
12159 return JIM_OK;
12162 /* [list] */
12163 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12165 Jim_Obj *listObjPtr;
12167 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12168 Jim_SetResult(interp, listObjPtr);
12169 return JIM_OK;
12172 /* [lindex] */
12173 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12175 Jim_Obj *objPtr, *listObjPtr;
12176 int i;
12177 int idx;
12179 if (argc < 2) {
12180 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12181 return JIM_ERR;
12183 objPtr = argv[1];
12184 Jim_IncrRefCount(objPtr);
12185 for (i = 2; i < argc; i++) {
12186 listObjPtr = objPtr;
12187 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12188 Jim_DecrRefCount(interp, listObjPtr);
12189 return JIM_ERR;
12191 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12192 /* Returns an empty object if the index
12193 * is out of range. */
12194 Jim_DecrRefCount(interp, listObjPtr);
12195 Jim_SetEmptyResult(interp);
12196 return JIM_OK;
12198 Jim_IncrRefCount(objPtr);
12199 Jim_DecrRefCount(interp, listObjPtr);
12201 Jim_SetResult(interp, objPtr);
12202 Jim_DecrRefCount(interp, objPtr);
12203 return JIM_OK;
12206 /* [llength] */
12207 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12209 if (argc != 2) {
12210 Jim_WrongNumArgs(interp, 1, argv, "list");
12211 return JIM_ERR;
12213 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12214 return JIM_OK;
12217 /* [lsearch] */
12218 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12220 static const char * const options[] = {
12221 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12222 NULL
12224 enum
12225 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12226 OPT_COMMAND };
12227 int i;
12228 int opt_bool = 0;
12229 int opt_not = 0;
12230 int opt_nocase = 0;
12231 int opt_all = 0;
12232 int opt_inline = 0;
12233 int opt_match = OPT_EXACT;
12234 int listlen;
12235 int rc = JIM_OK;
12236 Jim_Obj *listObjPtr = NULL;
12237 Jim_Obj *commandObj = NULL;
12239 if (argc < 3) {
12240 wrongargs:
12241 Jim_WrongNumArgs(interp, 1, argv,
12242 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12243 return JIM_ERR;
12246 for (i = 1; i < argc - 2; i++) {
12247 int option;
12249 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12250 return JIM_ERR;
12252 switch (option) {
12253 case OPT_BOOL:
12254 opt_bool = 1;
12255 opt_inline = 0;
12256 break;
12257 case OPT_NOT:
12258 opt_not = 1;
12259 break;
12260 case OPT_NOCASE:
12261 opt_nocase = 1;
12262 break;
12263 case OPT_INLINE:
12264 opt_inline = 1;
12265 opt_bool = 0;
12266 break;
12267 case OPT_ALL:
12268 opt_all = 1;
12269 break;
12270 case OPT_COMMAND:
12271 if (i >= argc - 2) {
12272 goto wrongargs;
12274 commandObj = argv[++i];
12275 /* fallthru */
12276 case OPT_EXACT:
12277 case OPT_GLOB:
12278 case OPT_REGEXP:
12279 opt_match = option;
12280 break;
12284 argv += i;
12286 if (opt_all) {
12287 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12289 if (opt_match == OPT_REGEXP) {
12290 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12292 if (commandObj) {
12293 Jim_IncrRefCount(commandObj);
12296 listlen = Jim_ListLength(interp, argv[0]);
12297 for (i = 0; i < listlen; i++) {
12298 int eq = 0;
12299 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12301 switch (opt_match) {
12302 case OPT_EXACT:
12303 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12304 break;
12306 case OPT_GLOB:
12307 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12308 break;
12310 case OPT_REGEXP:
12311 case OPT_COMMAND:
12312 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12313 if (eq < 0) {
12314 if (listObjPtr) {
12315 Jim_FreeNewObj(interp, listObjPtr);
12317 rc = JIM_ERR;
12318 goto done;
12320 break;
12323 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12324 if (!eq && opt_bool && opt_not && !opt_all) {
12325 continue;
12328 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12329 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12330 Jim_Obj *resultObj;
12332 if (opt_bool) {
12333 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12335 else if (!opt_inline) {
12336 resultObj = Jim_NewIntObj(interp, i);
12338 else {
12339 resultObj = objPtr;
12342 if (opt_all) {
12343 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12345 else {
12346 Jim_SetResult(interp, resultObj);
12347 goto done;
12352 if (opt_all) {
12353 Jim_SetResult(interp, listObjPtr);
12355 else {
12356 /* No match */
12357 if (opt_bool) {
12358 Jim_SetResultBool(interp, opt_not);
12360 else if (!opt_inline) {
12361 Jim_SetResultInt(interp, -1);
12365 done:
12366 if (commandObj) {
12367 Jim_DecrRefCount(interp, commandObj);
12369 return rc;
12372 /* [lappend] */
12373 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12375 Jim_Obj *listObjPtr;
12376 int new_obj = 0;
12377 int i;
12379 if (argc < 2) {
12380 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12381 return JIM_ERR;
12383 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12384 if (!listObjPtr) {
12385 /* Create the list if it does not exist */
12386 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12387 new_obj = 1;
12389 else if (Jim_IsShared(listObjPtr)) {
12390 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12391 new_obj = 1;
12393 for (i = 2; i < argc; i++)
12394 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12395 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12396 if (new_obj)
12397 Jim_FreeNewObj(interp, listObjPtr);
12398 return JIM_ERR;
12400 Jim_SetResult(interp, listObjPtr);
12401 return JIM_OK;
12404 /* [linsert] */
12405 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12407 int idx, len;
12408 Jim_Obj *listPtr;
12410 if (argc < 3) {
12411 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12412 return JIM_ERR;
12414 listPtr = argv[1];
12415 if (Jim_IsShared(listPtr))
12416 listPtr = Jim_DuplicateObj(interp, listPtr);
12417 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12418 goto err;
12419 len = Jim_ListLength(interp, listPtr);
12420 if (idx >= len)
12421 idx = len;
12422 else if (idx < 0)
12423 idx = len + idx + 1;
12424 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12425 Jim_SetResult(interp, listPtr);
12426 return JIM_OK;
12427 err:
12428 if (listPtr != argv[1]) {
12429 Jim_FreeNewObj(interp, listPtr);
12431 return JIM_ERR;
12434 /* [lreplace] */
12435 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12437 int first, last, len, rangeLen;
12438 Jim_Obj *listObj;
12439 Jim_Obj *newListObj;
12441 if (argc < 4) {
12442 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12443 return JIM_ERR;
12445 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12446 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12447 return JIM_ERR;
12450 listObj = argv[1];
12451 len = Jim_ListLength(interp, listObj);
12453 first = JimRelToAbsIndex(len, first);
12454 last = JimRelToAbsIndex(len, last);
12455 JimRelToAbsRange(len, &first, &last, &rangeLen);
12457 /* Now construct a new list which consists of:
12458 * <elements before first> <supplied elements> <elements after last>
12461 /* Trying to replace past the end of the list means end of list
12462 * See TIP #505
12464 if (first > len) {
12465 first = len;
12468 /* Add the first set of elements */
12469 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12471 /* Add supplied elements */
12472 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12474 /* Add the remaining elements */
12475 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12477 Jim_SetResult(interp, newListObj);
12478 return JIM_OK;
12481 /* [lset] */
12482 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12484 if (argc < 3) {
12485 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12486 return JIM_ERR;
12488 else if (argc == 3) {
12489 /* With no indexes, simply implements [set] */
12490 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12491 return JIM_ERR;
12492 Jim_SetResult(interp, argv[2]);
12493 return JIM_OK;
12495 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12498 /* [lsort] */
12499 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12501 static const char * const options[] = {
12502 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12504 enum
12505 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12506 Jim_Obj *resObj;
12507 int i;
12508 int retCode;
12509 int shared;
12511 struct lsort_info info;
12513 if (argc < 2) {
12514 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12515 return JIM_ERR;
12518 info.type = JIM_LSORT_ASCII;
12519 info.order = 1;
12520 info.indexed = 0;
12521 info.unique = 0;
12522 info.command = NULL;
12523 info.interp = interp;
12525 for (i = 1; i < (argc - 1); i++) {
12526 int option;
12528 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12529 != JIM_OK)
12530 return JIM_ERR;
12531 switch (option) {
12532 case OPT_ASCII:
12533 info.type = JIM_LSORT_ASCII;
12534 break;
12535 case OPT_NOCASE:
12536 info.type = JIM_LSORT_NOCASE;
12537 break;
12538 case OPT_INTEGER:
12539 info.type = JIM_LSORT_INTEGER;
12540 break;
12541 case OPT_REAL:
12542 info.type = JIM_LSORT_REAL;
12543 break;
12544 case OPT_INCREASING:
12545 info.order = 1;
12546 break;
12547 case OPT_DECREASING:
12548 info.order = -1;
12549 break;
12550 case OPT_UNIQUE:
12551 info.unique = 1;
12552 break;
12553 case OPT_COMMAND:
12554 if (i >= (argc - 2)) {
12555 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12556 return JIM_ERR;
12558 info.type = JIM_LSORT_COMMAND;
12559 info.command = argv[i + 1];
12560 i++;
12561 break;
12562 case OPT_INDEX:
12563 if (i >= (argc - 2)) {
12564 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12565 return JIM_ERR;
12567 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12568 return JIM_ERR;
12570 info.indexed = 1;
12571 i++;
12572 break;
12575 resObj = argv[argc - 1];
12576 if ((shared = Jim_IsShared(resObj)))
12577 resObj = Jim_DuplicateObj(interp, resObj);
12578 retCode = ListSortElements(interp, resObj, &info);
12579 if (retCode == JIM_OK) {
12580 Jim_SetResult(interp, resObj);
12582 else if (shared) {
12583 Jim_FreeNewObj(interp, resObj);
12585 return retCode;
12588 /* [append] */
12589 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12591 Jim_Obj *stringObjPtr;
12592 int i;
12594 if (argc < 2) {
12595 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12596 return JIM_ERR;
12598 if (argc == 2) {
12599 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12600 if (!stringObjPtr)
12601 return JIM_ERR;
12603 else {
12604 int new_obj = 0;
12605 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12606 if (!stringObjPtr) {
12607 /* Create the string if it doesn't exist */
12608 stringObjPtr = Jim_NewEmptyStringObj(interp);
12609 new_obj = 1;
12611 else if (Jim_IsShared(stringObjPtr)) {
12612 new_obj = 1;
12613 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12615 for (i = 2; i < argc; i++) {
12616 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12618 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12619 if (new_obj) {
12620 Jim_FreeNewObj(interp, stringObjPtr);
12622 return JIM_ERR;
12625 Jim_SetResult(interp, stringObjPtr);
12626 return JIM_OK;
12629 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12631 * Returns a zero-refcount list describing the expression at 'node'
12633 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12635 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12637 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12638 if (TOKEN_IS_EXPR_OP(node->type)) {
12639 if (node->left) {
12640 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12642 if (node->right) {
12643 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12645 if (node->ternary) {
12646 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12649 else {
12650 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12652 return listObjPtr;
12654 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12656 /* [debug] */
12657 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12658 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12660 static const char * const options[] = {
12661 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12662 "exprbc", "show",
12663 NULL
12665 enum
12667 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12668 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12670 int option;
12672 if (argc < 2) {
12673 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12674 return JIM_ERR;
12676 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12677 return Jim_CheckShowCommands(interp, argv[1], options);
12678 if (option == OPT_REFCOUNT) {
12679 if (argc != 3) {
12680 Jim_WrongNumArgs(interp, 2, argv, "object");
12681 return JIM_ERR;
12683 Jim_SetResultInt(interp, argv[2]->refCount);
12684 return JIM_OK;
12686 else if (option == OPT_OBJCOUNT) {
12687 int freeobj = 0, liveobj = 0;
12688 char buf[256];
12689 Jim_Obj *objPtr;
12691 if (argc != 2) {
12692 Jim_WrongNumArgs(interp, 2, argv, "");
12693 return JIM_ERR;
12695 /* Count the number of free objects. */
12696 objPtr = interp->freeList;
12697 while (objPtr) {
12698 freeobj++;
12699 objPtr = objPtr->nextObjPtr;
12701 /* Count the number of live objects. */
12702 objPtr = interp->liveList;
12703 while (objPtr) {
12704 liveobj++;
12705 objPtr = objPtr->nextObjPtr;
12707 /* Set the result string and return. */
12708 sprintf(buf, "free %d used %d", freeobj, liveobj);
12709 Jim_SetResultString(interp, buf, -1);
12710 return JIM_OK;
12712 else if (option == OPT_OBJECTS) {
12713 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12715 if (argc != 2) {
12716 Jim_WrongNumArgs(interp, 2, argv, "");
12717 return JIM_ERR;
12720 /* Count the number of live objects. */
12721 objPtr = interp->liveList;
12722 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12723 while (objPtr) {
12724 char buf[128];
12725 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12727 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12728 sprintf(buf, "%p", objPtr);
12729 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12730 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12731 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12732 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12733 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12734 objPtr = objPtr->nextObjPtr;
12736 Jim_SetResult(interp, listObjPtr);
12737 return JIM_OK;
12739 else if (option == OPT_INVSTR) {
12740 Jim_Obj *objPtr;
12742 if (argc != 3) {
12743 Jim_WrongNumArgs(interp, 2, argv, "object");
12744 return JIM_ERR;
12746 objPtr = argv[2];
12747 if (objPtr->typePtr != NULL)
12748 Jim_InvalidateStringRep(objPtr);
12749 Jim_SetEmptyResult(interp);
12750 return JIM_OK;
12752 else if (option == OPT_SHOW) {
12753 const char *s;
12754 int len, charlen;
12756 if (argc != 3) {
12757 Jim_WrongNumArgs(interp, 2, argv, "object");
12758 return JIM_ERR;
12760 s = Jim_GetString(argv[2], &len);
12761 #ifdef JIM_UTF8
12762 charlen = utf8_strlen(s, len);
12763 #else
12764 charlen = len;
12765 #endif
12766 char buf[256];
12767 snprintf(buf, sizeof(buf), "refcount: %d, type: %s\n"
12768 "chars (%d):",
12769 argv[2]->refCount, JimObjTypeName(argv[2]), charlen);
12770 Jim_SetResultFormatted(interp, "%s <<%s>>\n", buf, s);
12771 snprintf(buf, sizeof(buf), "bytes (%d):", len);
12772 Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
12773 while (len--) {
12774 snprintf(buf, sizeof(buf), " %02x", (unsigned char)*s++);
12775 Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
12777 return JIM_OK;
12779 else if (option == OPT_SCRIPTLEN) {
12780 ScriptObj *script;
12782 if (argc != 3) {
12783 Jim_WrongNumArgs(interp, 2, argv, "script");
12784 return JIM_ERR;
12786 script = JimGetScript(interp, argv[2]);
12787 if (script == NULL)
12788 return JIM_ERR;
12789 Jim_SetResultInt(interp, script->len);
12790 return JIM_OK;
12792 else if (option == OPT_EXPRLEN) {
12793 struct ExprTree *expr;
12795 if (argc != 3) {
12796 Jim_WrongNumArgs(interp, 2, argv, "expression");
12797 return JIM_ERR;
12799 expr = JimGetExpression(interp, argv[2]);
12800 if (expr == NULL)
12801 return JIM_ERR;
12802 Jim_SetResultInt(interp, expr->len);
12803 return JIM_OK;
12805 else if (option == OPT_EXPRBC) {
12806 struct ExprTree *expr;
12808 if (argc != 3) {
12809 Jim_WrongNumArgs(interp, 2, argv, "expression");
12810 return JIM_ERR;
12812 expr = JimGetExpression(interp, argv[2]);
12813 if (expr == NULL)
12814 return JIM_ERR;
12815 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12816 return JIM_OK;
12818 else {
12819 Jim_SetResultString(interp,
12820 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12821 return JIM_ERR;
12823 /* unreached */
12825 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12827 /* [eval] */
12828 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12830 int rc;
12832 if (argc < 2) {
12833 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12834 return JIM_ERR;
12837 if (argc == 2) {
12838 rc = Jim_EvalObj(interp, argv[1]);
12840 else {
12841 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12844 if (rc == JIM_ERR) {
12845 /* eval is "interesting", so add a stack frame here */
12846 interp->addStackTrace++;
12848 return rc;
12851 /* [uplevel] */
12852 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12854 if (argc >= 2) {
12855 int retcode;
12856 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12857 const char *str;
12859 /* Save the old callframe pointer */
12860 savedCallFrame = interp->framePtr;
12862 /* Lookup the target frame pointer */
12863 str = Jim_String(argv[1]);
12864 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12865 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12866 argc--;
12867 argv++;
12869 else {
12870 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12872 if (targetCallFrame == NULL) {
12873 return JIM_ERR;
12875 if (argc < 2) {
12876 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12877 return JIM_ERR;
12879 /* Eval the code in the target callframe. */
12880 interp->framePtr = targetCallFrame;
12881 if (argc == 2) {
12882 retcode = Jim_EvalObj(interp, argv[1]);
12884 else {
12885 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12887 interp->framePtr = savedCallFrame;
12888 return retcode;
12890 else {
12891 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12892 return JIM_ERR;
12896 /* [expr] */
12897 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12899 int retcode;
12901 if (argc == 2) {
12902 retcode = Jim_EvalExpression(interp, argv[1]);
12904 else if (argc > 2) {
12905 Jim_Obj *objPtr;
12907 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12908 Jim_IncrRefCount(objPtr);
12909 retcode = Jim_EvalExpression(interp, objPtr);
12910 Jim_DecrRefCount(interp, objPtr);
12912 else {
12913 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12914 return JIM_ERR;
12916 if (retcode != JIM_OK)
12917 return retcode;
12918 return JIM_OK;
12921 /* [break] */
12922 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12924 if (argc != 1) {
12925 Jim_WrongNumArgs(interp, 1, argv, "");
12926 return JIM_ERR;
12928 return JIM_BREAK;
12931 /* [continue] */
12932 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12934 if (argc != 1) {
12935 Jim_WrongNumArgs(interp, 1, argv, "");
12936 return JIM_ERR;
12938 return JIM_CONTINUE;
12941 /* [return] */
12942 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12944 int i;
12945 Jim_Obj *stackTraceObj = NULL;
12946 Jim_Obj *errorCodeObj = NULL;
12947 int returnCode = JIM_OK;
12948 long level = 1;
12950 for (i = 1; i < argc - 1; i += 2) {
12951 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12952 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12953 return JIM_ERR;
12956 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12957 stackTraceObj = argv[i + 1];
12959 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12960 errorCodeObj = argv[i + 1];
12962 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12963 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12964 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12965 return JIM_ERR;
12968 else {
12969 break;
12973 if (i != argc - 1 && i != argc) {
12974 Jim_WrongNumArgs(interp, 1, argv,
12975 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
12978 /* If a stack trace is supplied and code is error, set the stack trace */
12979 if (stackTraceObj && returnCode == JIM_ERR) {
12980 JimSetStackTrace(interp, stackTraceObj);
12982 /* If an error code list is supplied, set the global $errorCode */
12983 if (errorCodeObj && returnCode == JIM_ERR) {
12984 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
12986 interp->returnCode = returnCode;
12987 interp->returnLevel = level;
12989 if (i == argc - 1) {
12990 Jim_SetResult(interp, argv[i]);
12992 return level == 0 ? returnCode : JIM_RETURN;
12995 /* [tailcall] */
12996 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12998 if (interp->framePtr->level == 0) {
12999 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13000 return JIM_ERR;
13002 else if (argc >= 2) {
13003 /* Need to resolve the tailcall command in the current context */
13004 Jim_CallFrame *cf = interp->framePtr->parent;
13006 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13007 if (cmdPtr == NULL) {
13008 return JIM_ERR;
13011 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13013 /* And stash this pre-resolved command */
13014 JimIncrCmdRefCount(cmdPtr);
13015 cf->tailcallCmd = cmdPtr;
13017 /* And stash the command list */
13018 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13020 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13021 Jim_IncrRefCount(cf->tailcallObj);
13023 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13024 return JIM_EVAL;
13026 return JIM_OK;
13029 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13031 Jim_Obj *cmdList;
13032 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13034 /* prefixListObj is a list to which the args need to be appended */
13035 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13036 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13038 return JimEvalObjList(interp, cmdList);
13041 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13043 Jim_Obj *prefixListObj = privData;
13044 Jim_DecrRefCount(interp, prefixListObj);
13047 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13049 Jim_Obj *prefixListObj;
13050 const char *newname;
13052 if (argc < 3) {
13053 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13054 return JIM_ERR;
13057 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13058 Jim_IncrRefCount(prefixListObj);
13059 newname = Jim_String(argv[1]);
13060 if (newname[0] == ':' && newname[1] == ':') {
13061 while (*++newname == ':') {
13065 Jim_SetResult(interp, argv[1]);
13067 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13070 /* [proc] */
13071 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13073 Jim_Cmd *cmd;
13075 if (argc != 4 && argc != 5) {
13076 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13077 return JIM_ERR;
13080 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13081 return JIM_ERR;
13084 if (argc == 4) {
13085 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13087 else {
13088 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13091 if (cmd) {
13092 /* Add the new command */
13093 Jim_Obj *qualifiedCmdNameObj;
13094 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13096 JimCreateCommand(interp, cmdname, cmd);
13098 /* Calculate and set the namespace for this proc */
13099 JimUpdateProcNamespace(interp, cmd, cmdname);
13101 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13103 /* Unlike Tcl, set the name of the proc as the result */
13104 Jim_SetResult(interp, argv[1]);
13105 return JIM_OK;
13107 return JIM_ERR;
13110 /* [local] */
13111 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13113 int retcode;
13115 if (argc < 2) {
13116 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13117 return JIM_ERR;
13120 /* Evaluate the arguments with 'local' in force */
13121 interp->local++;
13122 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13123 interp->local--;
13126 /* If OK, and the result is a proc, add it to the list of local procs */
13127 if (retcode == 0) {
13128 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13130 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13131 return JIM_ERR;
13133 if (interp->framePtr->localCommands == NULL) {
13134 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13135 Jim_InitStack(interp->framePtr->localCommands);
13137 Jim_IncrRefCount(cmdNameObj);
13138 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13141 return retcode;
13144 /* [upcall] */
13145 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13147 if (argc < 2) {
13148 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13149 return JIM_ERR;
13151 else {
13152 int retcode;
13154 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13155 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13156 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13157 return JIM_ERR;
13159 /* OK. Mark this command as being in an upcall */
13160 cmdPtr->u.proc.upcall++;
13161 JimIncrCmdRefCount(cmdPtr);
13163 /* Invoke the command as normal */
13164 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13166 /* No longer in an upcall */
13167 cmdPtr->u.proc.upcall--;
13168 JimDecrCmdRefCount(interp, cmdPtr);
13170 return retcode;
13174 /* [apply] */
13175 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13177 if (argc < 2) {
13178 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13179 return JIM_ERR;
13181 else {
13182 int ret;
13183 Jim_Cmd *cmd;
13184 Jim_Obj *argListObjPtr;
13185 Jim_Obj *bodyObjPtr;
13186 Jim_Obj *nsObj = NULL;
13187 Jim_Obj **nargv;
13189 int len = Jim_ListLength(interp, argv[1]);
13190 if (len != 2 && len != 3) {
13191 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13192 return JIM_ERR;
13195 if (len == 3) {
13196 #ifdef jim_ext_namespace
13197 /* Need to canonicalise the given namespaces, but it is always treated as global */
13198 const char *name;
13199 nsObj = Jim_ListGetIndex(interp, argv[1], 2);
13200 name = Jim_String(nsObj);
13201 if (name[0] == ':' && name[1] == ':') {
13202 while (*++name == ':') {
13204 nsObj = Jim_NewStringObj(interp, name, -1);
13206 #else
13207 Jim_SetResultString(interp, "namespaces not enabled", -1);
13208 return JIM_ERR;
13209 #endif
13211 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13212 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13214 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13216 if (cmd) {
13217 /* Create a new argv array with a dummy argv[0], for error messages */
13218 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13219 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13220 Jim_IncrRefCount(nargv[0]);
13221 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13222 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13223 Jim_DecrRefCount(interp, nargv[0]);
13224 Jim_Free(nargv);
13226 JimDecrCmdRefCount(interp, cmd);
13227 return ret;
13229 return JIM_ERR;
13234 /* [concat] */
13235 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13237 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13238 return JIM_OK;
13241 /* [upvar] */
13242 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13244 int i;
13245 Jim_CallFrame *targetCallFrame;
13247 /* Lookup the target frame pointer */
13248 if (argc > 3 && (argc % 2 == 0)) {
13249 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13250 argc--;
13251 argv++;
13253 else {
13254 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13256 if (targetCallFrame == NULL) {
13257 return JIM_ERR;
13260 /* Check for arity */
13261 if (argc < 3) {
13262 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13263 return JIM_ERR;
13266 /* Now... for every other/local couple: */
13267 for (i = 1; i < argc; i += 2) {
13268 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13269 return JIM_ERR;
13271 return JIM_OK;
13274 /* [global] */
13275 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13277 int i;
13279 if (argc < 2) {
13280 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13281 return JIM_ERR;
13283 /* Link every var to the toplevel having the same name */
13284 if (interp->framePtr->level == 0)
13285 return JIM_OK; /* global at toplevel... */
13286 for (i = 1; i < argc; i++) {
13287 /* global ::blah does nothing */
13288 const char *name = Jim_String(argv[i]);
13289 if (name[0] != ':' || name[1] != ':') {
13290 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13291 return JIM_ERR;
13294 return JIM_OK;
13297 /* does the [string map] operation. On error NULL is returned,
13298 * otherwise a new string object with the result, having refcount = 0,
13299 * is returned. */
13300 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13301 Jim_Obj *objPtr, int nocase)
13303 int numMaps;
13304 const char *str, *noMatchStart = NULL;
13305 int strLen, i;
13306 Jim_Obj *resultObjPtr;
13308 numMaps = Jim_ListLength(interp, mapListObjPtr);
13309 if (numMaps % 2) {
13310 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13311 return NULL;
13314 str = Jim_String(objPtr);
13315 strLen = Jim_Utf8Length(interp, objPtr);
13317 /* Map it */
13318 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13319 while (strLen) {
13320 for (i = 0; i < numMaps; i += 2) {
13321 Jim_Obj *eachObjPtr;
13322 const char *k;
13323 int kl;
13325 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13326 k = Jim_String(eachObjPtr);
13327 kl = Jim_Utf8Length(interp, eachObjPtr);
13329 if (strLen >= kl && kl) {
13330 int rc;
13331 rc = JimStringCompareUtf8(str, kl, k, kl, nocase);
13332 if (rc == 0) {
13333 if (noMatchStart) {
13334 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13335 noMatchStart = NULL;
13337 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13338 str += utf8_index(str, kl);
13339 strLen -= kl;
13340 break;
13344 if (i == numMaps) { /* no match */
13345 int c;
13346 if (noMatchStart == NULL)
13347 noMatchStart = str;
13348 str += utf8_tounicode(str, &c);
13349 strLen--;
13352 if (noMatchStart) {
13353 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13355 return resultObjPtr;
13358 /* [string] */
13359 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13361 int len;
13362 int opt_case = 1;
13363 int option;
13364 static const char * const options[] = {
13365 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13366 "map", "repeat", "reverse", "index", "first", "last", "cat",
13367 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13369 enum
13371 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13372 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13373 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13375 static const char * const nocase_options[] = {
13376 "-nocase", NULL
13378 static const char * const nocase_length_options[] = {
13379 "-nocase", "-length", NULL
13382 if (argc < 2) {
13383 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13384 return JIM_ERR;
13386 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13387 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13388 return Jim_CheckShowCommands(interp, argv[1], options);
13390 switch (option) {
13391 case OPT_LENGTH:
13392 case OPT_BYTELENGTH:
13393 if (argc != 3) {
13394 Jim_WrongNumArgs(interp, 2, argv, "string");
13395 return JIM_ERR;
13397 if (option == OPT_LENGTH) {
13398 len = Jim_Utf8Length(interp, argv[2]);
13400 else {
13401 len = Jim_Length(argv[2]);
13403 Jim_SetResultInt(interp, len);
13404 return JIM_OK;
13406 case OPT_CAT:{
13407 Jim_Obj *objPtr;
13408 if (argc == 3) {
13409 /* optimise the one-arg case */
13410 objPtr = argv[2];
13412 else {
13413 int i;
13415 objPtr = Jim_NewStringObj(interp, "", 0);
13417 for (i = 2; i < argc; i++) {
13418 Jim_AppendObj(interp, objPtr, argv[i]);
13421 Jim_SetResult(interp, objPtr);
13422 return JIM_OK;
13425 case OPT_COMPARE:
13426 case OPT_EQUAL:
13428 /* n is the number of remaining option args */
13429 long opt_length = -1;
13430 int n = argc - 4;
13431 int i = 2;
13432 while (n > 0) {
13433 int subopt;
13434 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13435 JIM_ENUM_ABBREV) != JIM_OK) {
13436 badcompareargs:
13437 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13438 return JIM_ERR;
13440 if (subopt == 0) {
13441 /* -nocase */
13442 opt_case = 0;
13443 n--;
13445 else {
13446 /* -length */
13447 if (n < 2) {
13448 goto badcompareargs;
13450 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13451 return JIM_ERR;
13453 n -= 2;
13456 if (n) {
13457 goto badcompareargs;
13459 argv += argc - 2;
13460 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13461 /* Fast version - [string equal], case sensitive, no length */
13462 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13464 else {
13465 const char *s1 = Jim_String(argv[0]);
13466 int l1 = Jim_Utf8Length(interp, argv[0]);
13467 const char *s2 = Jim_String(argv[1]);
13468 int l2 = Jim_Utf8Length(interp, argv[1]);
13469 if (opt_length >= 0) {
13470 if (l1 > opt_length) {
13471 l1 = opt_length;
13473 if (l2 > opt_length) {
13474 l2 = opt_length;
13477 n = JimStringCompareUtf8(s1, l1, s2, l2, !opt_case);
13478 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13480 return JIM_OK;
13483 case OPT_MATCH:
13484 if (argc != 4 &&
13485 (argc != 5 ||
13486 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13487 JIM_ENUM_ABBREV) != JIM_OK)) {
13488 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13489 return JIM_ERR;
13491 if (opt_case == 0) {
13492 argv++;
13494 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13495 return JIM_OK;
13497 case OPT_MAP:{
13498 Jim_Obj *objPtr;
13500 if (argc != 4 &&
13501 (argc != 5 ||
13502 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13503 JIM_ENUM_ABBREV) != JIM_OK)) {
13504 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13505 return JIM_ERR;
13508 if (opt_case == 0) {
13509 argv++;
13511 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13512 if (objPtr == NULL) {
13513 return JIM_ERR;
13515 Jim_SetResult(interp, objPtr);
13516 return JIM_OK;
13519 case OPT_RANGE:
13520 case OPT_BYTERANGE:{
13521 Jim_Obj *objPtr;
13523 if (argc != 5) {
13524 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13525 return JIM_ERR;
13527 if (option == OPT_RANGE) {
13528 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13530 else
13532 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13535 if (objPtr == NULL) {
13536 return JIM_ERR;
13538 Jim_SetResult(interp, objPtr);
13539 return JIM_OK;
13542 case OPT_REPLACE:{
13543 Jim_Obj *objPtr;
13545 if (argc != 5 && argc != 6) {
13546 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13547 return JIM_ERR;
13549 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13550 if (objPtr == NULL) {
13551 return JIM_ERR;
13553 Jim_SetResult(interp, objPtr);
13554 return JIM_OK;
13558 case OPT_REPEAT:{
13559 Jim_Obj *objPtr;
13560 jim_wide count;
13562 if (argc != 4) {
13563 Jim_WrongNumArgs(interp, 2, argv, "string count");
13564 return JIM_ERR;
13566 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13567 return JIM_ERR;
13569 objPtr = Jim_NewStringObj(interp, "", 0);
13570 if (count > 0) {
13571 while (count--) {
13572 Jim_AppendObj(interp, objPtr, argv[2]);
13575 Jim_SetResult(interp, objPtr);
13576 return JIM_OK;
13579 case OPT_REVERSE:{
13580 char *buf, *p;
13581 const char *str;
13582 int i;
13584 if (argc != 3) {
13585 Jim_WrongNumArgs(interp, 2, argv, "string");
13586 return JIM_ERR;
13589 str = Jim_GetString(argv[2], &len);
13590 buf = Jim_Alloc(len + 1);
13591 p = buf + len;
13592 *p = 0;
13593 for (i = 0; i < len; ) {
13594 int c;
13595 int l = utf8_tounicode(str, &c);
13596 memcpy(p - l, str, l);
13597 p -= l;
13598 i += l;
13599 str += l;
13601 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13602 return JIM_OK;
13605 case OPT_INDEX:{
13606 int idx;
13607 const char *str;
13609 if (argc != 4) {
13610 Jim_WrongNumArgs(interp, 2, argv, "string index");
13611 return JIM_ERR;
13613 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13614 return JIM_ERR;
13616 str = Jim_String(argv[2]);
13617 len = Jim_Utf8Length(interp, argv[2]);
13618 if (idx != INT_MIN && idx != INT_MAX) {
13619 idx = JimRelToAbsIndex(len, idx);
13621 if (idx < 0 || idx >= len || str == NULL) {
13622 Jim_SetResultString(interp, "", 0);
13624 else if (len == Jim_Length(argv[2])) {
13625 /* ASCII optimisation */
13626 Jim_SetResultString(interp, str + idx, 1);
13628 else {
13629 int c;
13630 int i = utf8_index(str, idx);
13631 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13633 return JIM_OK;
13636 case OPT_FIRST:
13637 case OPT_LAST:{
13638 int idx = 0, l1, l2;
13639 const char *s1, *s2;
13641 if (argc != 4 && argc != 5) {
13642 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13643 return JIM_ERR;
13645 s1 = Jim_String(argv[2]);
13646 s2 = Jim_String(argv[3]);
13647 l1 = Jim_Utf8Length(interp, argv[2]);
13648 l2 = Jim_Utf8Length(interp, argv[3]);
13649 if (argc == 5) {
13650 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13651 return JIM_ERR;
13653 idx = JimRelToAbsIndex(l2, idx);
13655 else if (option == OPT_LAST) {
13656 idx = l2;
13658 if (option == OPT_FIRST) {
13659 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13661 else {
13662 #ifdef JIM_UTF8
13663 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13664 #else
13665 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13666 #endif
13668 return JIM_OK;
13671 case OPT_TRIM:
13672 case OPT_TRIMLEFT:
13673 case OPT_TRIMRIGHT:{
13674 Jim_Obj *trimchars;
13676 if (argc != 3 && argc != 4) {
13677 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13678 return JIM_ERR;
13680 trimchars = (argc == 4 ? argv[3] : NULL);
13681 if (option == OPT_TRIM) {
13682 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13684 else if (option == OPT_TRIMLEFT) {
13685 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13687 else if (option == OPT_TRIMRIGHT) {
13688 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13690 return JIM_OK;
13693 case OPT_TOLOWER:
13694 case OPT_TOUPPER:
13695 case OPT_TOTITLE:
13696 if (argc != 3) {
13697 Jim_WrongNumArgs(interp, 2, argv, "string");
13698 return JIM_ERR;
13700 if (option == OPT_TOLOWER) {
13701 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13703 else if (option == OPT_TOUPPER) {
13704 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13706 else {
13707 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13709 return JIM_OK;
13711 case OPT_IS:
13712 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13713 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13715 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13716 return JIM_ERR;
13718 return JIM_OK;
13721 /* [time] */
13722 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13724 long i, count = 1;
13725 jim_wide start, elapsed;
13726 char buf[60];
13727 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13729 if (argc < 2) {
13730 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13731 return JIM_ERR;
13733 if (argc == 3) {
13734 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13735 return JIM_ERR;
13737 if (count < 0)
13738 return JIM_OK;
13739 i = count;
13740 start = JimClock();
13741 while (i-- > 0) {
13742 int retval;
13744 retval = Jim_EvalObj(interp, argv[1]);
13745 if (retval != JIM_OK) {
13746 return retval;
13749 elapsed = JimClock() - start;
13750 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13751 Jim_SetResultString(interp, buf, -1);
13752 return JIM_OK;
13755 /* [exit] */
13756 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13758 long exitCode = 0;
13760 if (argc > 2) {
13761 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13762 return JIM_ERR;
13764 if (argc == 2) {
13765 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13766 return JIM_ERR;
13767 Jim_SetResult(interp, argv[1]);
13769 interp->exitCode = exitCode;
13770 return JIM_EXIT;
13773 /* [catch] */
13774 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13776 int exitCode = 0;
13777 int i;
13778 int sig = 0;
13780 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13781 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13782 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13784 /* Reset the error code before catch.
13785 * Note that this is not strictly correct.
13787 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13789 for (i = 1; i < argc - 1; i++) {
13790 const char *arg = Jim_String(argv[i]);
13791 jim_wide option;
13792 int ignore;
13794 /* It's a pity we can't use Jim_GetEnum here :-( */
13795 if (strcmp(arg, "--") == 0) {
13796 i++;
13797 break;
13799 if (*arg != '-') {
13800 break;
13803 if (strncmp(arg, "-no", 3) == 0) {
13804 arg += 3;
13805 ignore = 1;
13807 else {
13808 arg++;
13809 ignore = 0;
13812 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13813 option = -1;
13815 if (option < 0) {
13816 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13818 if (option < 0) {
13819 goto wrongargs;
13822 if (ignore) {
13823 ignore_mask |= ((jim_wide)1 << option);
13825 else {
13826 ignore_mask &= (~((jim_wide)1 << option));
13830 argc -= i;
13831 if (argc < 1 || argc > 3) {
13832 wrongargs:
13833 Jim_WrongNumArgs(interp, 1, argv,
13834 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13835 return JIM_ERR;
13837 argv += i;
13839 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13840 sig++;
13843 interp->signal_level += sig;
13844 if (Jim_CheckSignal(interp)) {
13845 /* If a signal is set, don't even try to execute the body */
13846 exitCode = JIM_SIGNAL;
13848 else {
13849 exitCode = Jim_EvalObj(interp, argv[0]);
13850 /* Don't want any caught error included in a later stack trace */
13851 interp->errorFlag = 0;
13853 interp->signal_level -= sig;
13855 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13856 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13857 /* Not caught, pass it up */
13858 return exitCode;
13861 if (sig && exitCode == JIM_SIGNAL) {
13862 /* Catch the signal at this level */
13863 if (interp->signal_set_result) {
13864 interp->signal_set_result(interp, interp->sigmask);
13866 else {
13867 Jim_SetResultInt(interp, interp->sigmask);
13869 interp->sigmask = 0;
13872 if (argc >= 2) {
13873 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13874 return JIM_ERR;
13876 if (argc == 3) {
13877 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13879 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13880 Jim_ListAppendElement(interp, optListObj,
13881 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13882 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13883 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13884 if (exitCode == JIM_ERR) {
13885 Jim_Obj *errorCode;
13886 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13887 -1));
13888 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13890 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13891 if (errorCode) {
13892 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13893 Jim_ListAppendElement(interp, optListObj, errorCode);
13896 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13897 return JIM_ERR;
13901 Jim_SetResultInt(interp, exitCode);
13902 return JIM_OK;
13905 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13907 /* [ref] */
13908 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13910 if (argc != 3 && argc != 4) {
13911 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13912 return JIM_ERR;
13914 if (argc == 3) {
13915 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13917 else {
13918 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13920 return JIM_OK;
13923 /* [getref] */
13924 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13926 Jim_Reference *refPtr;
13928 if (argc != 2) {
13929 Jim_WrongNumArgs(interp, 1, argv, "reference");
13930 return JIM_ERR;
13932 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13933 return JIM_ERR;
13934 Jim_SetResult(interp, refPtr->objPtr);
13935 return JIM_OK;
13938 /* [setref] */
13939 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13941 Jim_Reference *refPtr;
13943 if (argc != 3) {
13944 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13945 return JIM_ERR;
13947 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13948 return JIM_ERR;
13949 Jim_IncrRefCount(argv[2]);
13950 Jim_DecrRefCount(interp, refPtr->objPtr);
13951 refPtr->objPtr = argv[2];
13952 Jim_SetResult(interp, argv[2]);
13953 return JIM_OK;
13956 /* [collect] */
13957 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13959 if (argc != 1) {
13960 Jim_WrongNumArgs(interp, 1, argv, "");
13961 return JIM_ERR;
13963 Jim_SetResultInt(interp, Jim_Collect(interp));
13965 /* Free all the freed objects. */
13966 while (interp->freeList) {
13967 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13968 Jim_Free(interp->freeList);
13969 interp->freeList = nextObjPtr;
13972 return JIM_OK;
13975 /* [finalize] reference ?newValue? */
13976 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13978 if (argc != 2 && argc != 3) {
13979 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13980 return JIM_ERR;
13982 if (argc == 2) {
13983 Jim_Obj *cmdNamePtr;
13985 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13986 return JIM_ERR;
13987 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13988 Jim_SetResult(interp, cmdNamePtr);
13990 else {
13991 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
13992 return JIM_ERR;
13993 Jim_SetResult(interp, argv[2]);
13995 return JIM_OK;
13998 /* [info references] */
13999 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14001 Jim_Obj *listObjPtr;
14002 Jim_HashTableIterator htiter;
14003 Jim_HashEntry *he;
14005 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14007 JimInitHashTableIterator(&interp->references, &htiter);
14008 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14009 char buf[JIM_REFERENCE_SPACE + 1];
14010 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14011 const unsigned long *refId = he->key;
14013 JimFormatReference(buf, refPtr, *refId);
14014 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14016 Jim_SetResult(interp, listObjPtr);
14017 return JIM_OK;
14019 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14021 /* [rename] */
14022 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14024 if (argc != 3) {
14025 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14026 return JIM_ERR;
14029 if (JimValidName(interp, "new procedure", argv[2])) {
14030 return JIM_ERR;
14033 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14036 #define JIM_DICTMATCH_KEYS 0x0001
14037 #define JIM_DICTMATCH_VALUES 0x002
14040 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14041 * return_types should be either or both
14043 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14045 Jim_HashEntry *he;
14046 Jim_Obj *listObjPtr;
14047 Jim_HashTableIterator htiter;
14049 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14050 return JIM_ERR;
14053 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14055 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14056 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14057 if (patternObj) {
14058 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14059 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14060 /* no match */
14061 continue;
14064 if (return_types & JIM_DICTMATCH_KEYS) {
14065 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14067 if (return_types & JIM_DICTMATCH_VALUES) {
14068 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14072 Jim_SetResult(interp, listObjPtr);
14073 return JIM_OK;
14076 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14078 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14079 return -1;
14081 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14085 * Must be called with at least one object.
14086 * Returns the new dictionary, or NULL on error.
14088 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14090 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14091 int i;
14093 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14095 /* Note that we don't optimise the trivial case of a single argument */
14097 for (i = 0; i < objc; i++) {
14098 Jim_HashTable *ht;
14099 Jim_HashTableIterator htiter;
14100 Jim_HashEntry *he;
14102 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14103 Jim_FreeNewObj(interp, objPtr);
14104 return NULL;
14106 ht = objv[i]->internalRep.ptr;
14107 JimInitHashTableIterator(ht, &htiter);
14108 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14109 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14112 return objPtr;
14115 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14117 Jim_HashTable *ht;
14118 unsigned int i;
14119 char buffer[100];
14120 int sum = 0;
14121 int nonzero_count = 0;
14122 Jim_Obj *output;
14123 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14125 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14126 return JIM_ERR;
14129 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14131 /* Note that this uses internal knowledge of the hash table */
14132 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14133 output = Jim_NewStringObj(interp, buffer, -1);
14135 for (i = 0; i < ht->size; i++) {
14136 Jim_HashEntry *he = ht->table[i];
14137 int entries = 0;
14138 while (he) {
14139 entries++;
14140 he = he->next;
14142 if (entries > 9) {
14143 bucket_counts[10]++;
14145 else {
14146 bucket_counts[entries]++;
14148 if (entries) {
14149 sum += entries;
14150 nonzero_count++;
14153 for (i = 0; i < 10; i++) {
14154 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14155 Jim_AppendString(interp, output, buffer, -1);
14157 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14158 Jim_AppendString(interp, output, buffer, -1);
14159 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14160 Jim_AppendString(interp, output, buffer, -1);
14161 Jim_SetResult(interp, output);
14162 return JIM_OK;
14165 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14167 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14169 Jim_AppendString(interp, prefixObj, " ", 1);
14170 Jim_AppendString(interp, prefixObj, subcmd, -1);
14172 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14176 * Implements the [dict with] command
14178 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14180 int i;
14181 Jim_Obj *objPtr;
14182 Jim_Obj *dictObj;
14183 Jim_Obj **dictValues;
14184 int len;
14185 int ret = JIM_OK;
14187 /* Open up the appropriate level of the dictionary */
14188 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14189 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14190 return JIM_ERR;
14192 /* Set the local variables */
14193 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14194 return JIM_ERR;
14196 for (i = 0; i < len; i += 2) {
14197 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14198 Jim_Free(dictValues);
14199 return JIM_ERR;
14203 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14204 if (Jim_Length(scriptObj)) {
14205 ret = Jim_EvalObj(interp, scriptObj);
14207 /* Now if the dictionary still exists, update it based on the local variables */
14208 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14209 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14210 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14211 for (i = 0; i < keyc; i++) {
14212 newkeyv[i] = keyv[i];
14215 for (i = 0; i < len; i += 2) {
14216 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14217 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14218 newkeyv[keyc] = dictValues[i];
14219 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14221 Jim_Free(newkeyv);
14225 Jim_Free(dictValues);
14227 return ret;
14230 /* [dict] */
14231 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14233 Jim_Obj *objPtr;
14234 int types = JIM_DICTMATCH_KEYS;
14235 int option;
14236 static const char * const options[] = {
14237 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14238 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14239 "replace", "update", NULL
14241 enum
14243 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14244 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14245 OPT_REPLACE, OPT_UPDATE,
14248 if (argc < 2) {
14249 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14250 return JIM_ERR;
14253 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14254 return Jim_CheckShowCommands(interp, argv[1], options);
14257 switch (option) {
14258 case OPT_GET:
14259 if (argc < 3) {
14260 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14261 return JIM_ERR;
14263 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14264 JIM_ERRMSG) != JIM_OK) {
14265 return JIM_ERR;
14267 Jim_SetResult(interp, objPtr);
14268 return JIM_OK;
14270 case OPT_SET:
14271 if (argc < 5) {
14272 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14273 return JIM_ERR;
14275 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14277 case OPT_EXISTS:
14278 if (argc < 4) {
14279 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14280 return JIM_ERR;
14282 else {
14283 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14284 if (rc < 0) {
14285 return JIM_ERR;
14287 Jim_SetResultBool(interp, rc == JIM_OK);
14288 return JIM_OK;
14291 case OPT_UNSET:
14292 if (argc < 4) {
14293 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14294 return JIM_ERR;
14296 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14297 return JIM_ERR;
14299 return JIM_OK;
14301 case OPT_VALUES:
14302 types = JIM_DICTMATCH_VALUES;
14303 /* fallthru */
14304 case OPT_KEYS:
14305 if (argc != 3 && argc != 4) {
14306 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14307 return JIM_ERR;
14309 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14311 case OPT_SIZE:
14312 if (argc != 3) {
14313 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14314 return JIM_ERR;
14316 else if (Jim_DictSize(interp, argv[2]) < 0) {
14317 return JIM_ERR;
14319 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14320 return JIM_OK;
14322 case OPT_MERGE:
14323 if (argc == 2) {
14324 return JIM_OK;
14326 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14327 if (objPtr == NULL) {
14328 return JIM_ERR;
14330 Jim_SetResult(interp, objPtr);
14331 return JIM_OK;
14333 case OPT_UPDATE:
14334 if (argc < 6 || argc % 2) {
14335 /* Better error message */
14336 argc = 2;
14338 break;
14340 case OPT_CREATE:
14341 if (argc % 2) {
14342 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14343 return JIM_ERR;
14345 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14346 Jim_SetResult(interp, objPtr);
14347 return JIM_OK;
14349 case OPT_INFO:
14350 if (argc != 3) {
14351 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14352 return JIM_ERR;
14354 return Jim_DictInfo(interp, argv[2]);
14356 case OPT_WITH:
14357 if (argc < 4) {
14358 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14359 return JIM_ERR;
14361 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14363 /* Handle command as an ensemble */
14364 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14367 /* [subst] */
14368 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14370 static const char * const options[] = {
14371 "-nobackslashes", "-nocommands", "-novariables", NULL
14373 enum
14374 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14375 int i;
14376 int flags = JIM_SUBST_FLAG;
14377 Jim_Obj *objPtr;
14379 if (argc < 2) {
14380 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14381 return JIM_ERR;
14383 for (i = 1; i < (argc - 1); i++) {
14384 int option;
14386 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14387 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14388 return JIM_ERR;
14390 switch (option) {
14391 case OPT_NOBACKSLASHES:
14392 flags |= JIM_SUBST_NOESC;
14393 break;
14394 case OPT_NOCOMMANDS:
14395 flags |= JIM_SUBST_NOCMD;
14396 break;
14397 case OPT_NOVARIABLES:
14398 flags |= JIM_SUBST_NOVAR;
14399 break;
14402 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14403 return JIM_ERR;
14405 Jim_SetResult(interp, objPtr);
14406 return JIM_OK;
14409 /* [info] */
14410 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14412 int cmd;
14413 Jim_Obj *objPtr;
14414 int mode = 0;
14416 static const char * const commands[] = {
14417 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14418 "vars", "version", "patchlevel", "complete", "args", "hostname",
14419 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14420 "references", "alias", NULL
14422 enum
14423 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14424 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14425 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14426 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14429 #ifdef jim_ext_namespace
14430 int nons = 0;
14432 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14433 /* This is for internal use only */
14434 argc--;
14435 argv++;
14436 nons = 1;
14438 #endif
14440 if (argc < 2) {
14441 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14442 return JIM_ERR;
14444 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14445 return Jim_CheckShowCommands(interp, argv[1], commands);
14448 /* Test for the most common commands first, just in case it makes a difference */
14449 switch (cmd) {
14450 case INFO_EXISTS:
14451 if (argc != 3) {
14452 Jim_WrongNumArgs(interp, 2, argv, "varName");
14453 return JIM_ERR;
14455 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14456 break;
14458 case INFO_ALIAS:{
14459 Jim_Cmd *cmdPtr;
14461 if (argc != 3) {
14462 Jim_WrongNumArgs(interp, 2, argv, "command");
14463 return JIM_ERR;
14465 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14466 return JIM_ERR;
14468 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14469 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14470 return JIM_ERR;
14472 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14473 return JIM_OK;
14476 case INFO_CHANNELS:
14477 mode++; /* JIM_CMDLIST_CHANNELS */
14478 #ifndef jim_ext_aio
14479 Jim_SetResultString(interp, "aio not enabled", -1);
14480 return JIM_ERR;
14481 #endif
14482 /* fall through */
14483 case INFO_PROCS:
14484 mode++; /* JIM_CMDLIST_PROCS */
14485 /* fall through */
14486 case INFO_COMMANDS:
14487 /* mode 0 => JIM_CMDLIST_COMMANDS */
14488 if (argc != 2 && argc != 3) {
14489 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14490 return JIM_ERR;
14492 #ifdef jim_ext_namespace
14493 if (!nons) {
14494 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14495 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14498 #endif
14499 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14500 break;
14502 case INFO_VARS:
14503 mode++; /* JIM_VARLIST_VARS */
14504 /* fall through */
14505 case INFO_LOCALS:
14506 mode++; /* JIM_VARLIST_LOCALS */
14507 /* fall through */
14508 case INFO_GLOBALS:
14509 /* mode 0 => JIM_VARLIST_GLOBALS */
14510 if (argc != 2 && argc != 3) {
14511 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14512 return JIM_ERR;
14514 #ifdef jim_ext_namespace
14515 if (!nons) {
14516 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14517 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14520 #endif
14521 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14522 break;
14524 case INFO_SCRIPT:
14525 if (argc != 2) {
14526 Jim_WrongNumArgs(interp, 2, argv, "");
14527 return JIM_ERR;
14529 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14530 break;
14532 case INFO_SOURCE:{
14533 jim_wide line;
14534 Jim_Obj *resObjPtr;
14535 Jim_Obj *fileNameObj;
14537 if (argc != 3 && argc != 5) {
14538 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14539 return JIM_ERR;
14541 if (argc == 5) {
14542 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14543 return JIM_ERR;
14545 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14546 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14548 else {
14549 if (argv[2]->typePtr == &sourceObjType) {
14550 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14551 line = argv[2]->internalRep.sourceValue.lineNumber;
14553 else if (argv[2]->typePtr == &scriptObjType) {
14554 ScriptObj *script = JimGetScript(interp, argv[2]);
14555 fileNameObj = script->fileNameObj;
14556 line = script->firstline;
14558 else {
14559 fileNameObj = interp->emptyObj;
14560 line = 1;
14562 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14563 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14564 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14566 Jim_SetResult(interp, resObjPtr);
14567 break;
14570 case INFO_STACKTRACE:
14571 Jim_SetResult(interp, interp->stackTrace);
14572 break;
14574 case INFO_LEVEL:
14575 case INFO_FRAME:
14576 switch (argc) {
14577 case 2:
14578 Jim_SetResultInt(interp, interp->framePtr->level);
14579 break;
14581 case 3:
14582 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14583 return JIM_ERR;
14585 Jim_SetResult(interp, objPtr);
14586 break;
14588 default:
14589 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14590 return JIM_ERR;
14592 break;
14594 case INFO_BODY:
14595 case INFO_STATICS:
14596 case INFO_ARGS:{
14597 Jim_Cmd *cmdPtr;
14599 if (argc != 3) {
14600 Jim_WrongNumArgs(interp, 2, argv, "procname");
14601 return JIM_ERR;
14603 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14604 return JIM_ERR;
14606 if (!cmdPtr->isproc) {
14607 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14608 return JIM_ERR;
14610 switch (cmd) {
14611 case INFO_BODY:
14612 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14613 break;
14614 case INFO_ARGS:
14615 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14616 break;
14617 case INFO_STATICS:
14618 if (cmdPtr->u.proc.staticVars) {
14619 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14620 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14622 break;
14624 break;
14627 case INFO_VERSION:
14628 case INFO_PATCHLEVEL:{
14629 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14631 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14632 Jim_SetResultString(interp, buf, -1);
14633 break;
14636 case INFO_COMPLETE:
14637 if (argc != 3 && argc != 4) {
14638 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14639 return JIM_ERR;
14641 else {
14642 char missing;
14644 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14645 if (missing != ' ' && argc == 4) {
14646 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14649 break;
14651 case INFO_HOSTNAME:
14652 /* Redirect to os.gethostname if it exists */
14653 return Jim_Eval(interp, "os.gethostname");
14655 case INFO_NAMEOFEXECUTABLE:
14656 /* Redirect to Tcl proc */
14657 return Jim_Eval(interp, "{info nameofexecutable}");
14659 case INFO_RETURNCODES:
14660 if (argc == 2) {
14661 int i;
14662 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14664 for (i = 0; jimReturnCodes[i]; i++) {
14665 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14666 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14667 jimReturnCodes[i], -1));
14670 Jim_SetResult(interp, listObjPtr);
14672 else if (argc == 3) {
14673 long code;
14674 const char *name;
14676 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14677 return JIM_ERR;
14679 name = Jim_ReturnCode(code);
14680 if (*name == '?') {
14681 Jim_SetResultInt(interp, code);
14683 else {
14684 Jim_SetResultString(interp, name, -1);
14687 else {
14688 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14689 return JIM_ERR;
14691 break;
14692 case INFO_REFERENCES:
14693 #ifdef JIM_REFERENCES
14694 return JimInfoReferences(interp, argc, argv);
14695 #else
14696 Jim_SetResultString(interp, "not supported", -1);
14697 return JIM_ERR;
14698 #endif
14700 return JIM_OK;
14703 /* [exists] */
14704 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14706 Jim_Obj *objPtr;
14707 int result = 0;
14709 static const char * const options[] = {
14710 "-command", "-proc", "-alias", "-var", NULL
14712 enum
14714 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14716 int option;
14718 if (argc == 2) {
14719 option = OPT_VAR;
14720 objPtr = argv[1];
14722 else if (argc == 3) {
14723 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14724 return JIM_ERR;
14726 objPtr = argv[2];
14728 else {
14729 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14730 return JIM_ERR;
14733 if (option == OPT_VAR) {
14734 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14736 else {
14737 /* Now different kinds of commands */
14738 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14740 if (cmd) {
14741 switch (option) {
14742 case OPT_COMMAND:
14743 result = 1;
14744 break;
14746 case OPT_ALIAS:
14747 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14748 break;
14750 case OPT_PROC:
14751 result = cmd->isproc;
14752 break;
14756 Jim_SetResultBool(interp, result);
14757 return JIM_OK;
14760 /* [split] */
14761 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14763 const char *str, *splitChars, *noMatchStart;
14764 int splitLen, strLen;
14765 Jim_Obj *resObjPtr;
14766 int c;
14767 int len;
14769 if (argc != 2 && argc != 3) {
14770 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14771 return JIM_ERR;
14774 str = Jim_GetString(argv[1], &len);
14775 if (len == 0) {
14776 return JIM_OK;
14778 strLen = Jim_Utf8Length(interp, argv[1]);
14780 /* Init */
14781 if (argc == 2) {
14782 splitChars = " \n\t\r";
14783 splitLen = 4;
14785 else {
14786 splitChars = Jim_String(argv[2]);
14787 splitLen = Jim_Utf8Length(interp, argv[2]);
14790 noMatchStart = str;
14791 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14793 /* Split */
14794 if (splitLen) {
14795 Jim_Obj *objPtr;
14796 while (strLen--) {
14797 const char *sc = splitChars;
14798 int scLen = splitLen;
14799 int sl = utf8_tounicode(str, &c);
14800 while (scLen--) {
14801 int pc;
14802 sc += utf8_tounicode(sc, &pc);
14803 if (c == pc) {
14804 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14805 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14806 noMatchStart = str + sl;
14807 break;
14810 str += sl;
14812 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14813 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14815 else {
14816 /* This handles the special case of splitchars eq {}
14817 * Optimise by sharing common (ASCII) characters
14819 Jim_Obj **commonObj = NULL;
14820 #define NUM_COMMON (128 - 9)
14821 while (strLen--) {
14822 int n = utf8_tounicode(str, &c);
14823 #ifdef JIM_OPTIMIZATION
14824 if (c >= 9 && c < 128) {
14825 /* Common ASCII char. Note that 9 is the tab character */
14826 c -= 9;
14827 if (!commonObj) {
14828 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14829 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14831 if (!commonObj[c]) {
14832 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14834 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14835 str++;
14836 continue;
14838 #endif
14839 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14840 str += n;
14842 Jim_Free(commonObj);
14845 Jim_SetResult(interp, resObjPtr);
14846 return JIM_OK;
14849 /* [join] */
14850 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14852 const char *joinStr;
14853 int joinStrLen;
14855 if (argc != 2 && argc != 3) {
14856 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14857 return JIM_ERR;
14859 /* Init */
14860 if (argc == 2) {
14861 joinStr = " ";
14862 joinStrLen = 1;
14864 else {
14865 joinStr = Jim_GetString(argv[2], &joinStrLen);
14867 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14868 return JIM_OK;
14871 /* [format] */
14872 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14874 Jim_Obj *objPtr;
14876 if (argc < 2) {
14877 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14878 return JIM_ERR;
14880 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14881 if (objPtr == NULL)
14882 return JIM_ERR;
14883 Jim_SetResult(interp, objPtr);
14884 return JIM_OK;
14887 /* [scan] */
14888 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14890 Jim_Obj *listPtr, **outVec;
14891 int outc, i;
14893 if (argc < 3) {
14894 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14895 return JIM_ERR;
14897 if (argv[2]->typePtr != &scanFmtStringObjType)
14898 SetScanFmtFromAny(interp, argv[2]);
14899 if (FormatGetError(argv[2]) != 0) {
14900 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14901 return JIM_ERR;
14903 if (argc > 3) {
14904 int maxPos = FormatGetMaxPos(argv[2]);
14905 int count = FormatGetCnvCount(argv[2]);
14907 if (maxPos > argc - 3) {
14908 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14909 return JIM_ERR;
14911 else if (count > argc - 3) {
14912 Jim_SetResultString(interp, "different numbers of variable names and "
14913 "field specifiers", -1);
14914 return JIM_ERR;
14916 else if (count < argc - 3) {
14917 Jim_SetResultString(interp, "variable is not assigned by any "
14918 "conversion specifiers", -1);
14919 return JIM_ERR;
14922 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14923 if (listPtr == 0)
14924 return JIM_ERR;
14925 if (argc > 3) {
14926 int rc = JIM_OK;
14927 int count = 0;
14929 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14930 int len = Jim_ListLength(interp, listPtr);
14932 if (len != 0) {
14933 JimListGetElements(interp, listPtr, &outc, &outVec);
14934 for (i = 0; i < outc; ++i) {
14935 if (Jim_Length(outVec[i]) > 0) {
14936 ++count;
14937 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14938 rc = JIM_ERR;
14943 Jim_FreeNewObj(interp, listPtr);
14945 else {
14946 count = -1;
14948 if (rc == JIM_OK) {
14949 Jim_SetResultInt(interp, count);
14951 return rc;
14953 else {
14954 if (listPtr == (Jim_Obj *)EOF) {
14955 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14956 return JIM_OK;
14958 Jim_SetResult(interp, listPtr);
14960 return JIM_OK;
14963 /* [error] */
14964 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14966 if (argc != 2 && argc != 3) {
14967 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14968 return JIM_ERR;
14970 Jim_SetResult(interp, argv[1]);
14971 if (argc == 3) {
14972 JimSetStackTrace(interp, argv[2]);
14973 return JIM_ERR;
14975 interp->addStackTrace++;
14976 return JIM_ERR;
14979 /* [lrange] */
14980 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14982 Jim_Obj *objPtr;
14984 if (argc != 4) {
14985 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14986 return JIM_ERR;
14988 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14989 return JIM_ERR;
14990 Jim_SetResult(interp, objPtr);
14991 return JIM_OK;
14994 /* [lrepeat] */
14995 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14997 Jim_Obj *objPtr;
14998 long count;
15000 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15001 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15002 return JIM_ERR;
15005 if (count == 0 || argc == 2) {
15006 return JIM_OK;
15009 argc -= 2;
15010 argv += 2;
15012 objPtr = Jim_NewListObj(interp, argv, argc);
15013 while (--count) {
15014 ListInsertElements(objPtr, -1, argc, argv);
15017 Jim_SetResult(interp, objPtr);
15018 return JIM_OK;
15021 char **Jim_GetEnviron(void)
15023 #if defined(HAVE__NSGETENVIRON)
15024 return *_NSGetEnviron();
15025 #else
15026 #if !defined(NO_ENVIRON_EXTERN)
15027 extern char **environ;
15028 #endif
15030 return environ;
15031 #endif
15034 void Jim_SetEnviron(char **env)
15036 #if defined(HAVE__NSGETENVIRON)
15037 *_NSGetEnviron() = env;
15038 #else
15039 #if !defined(NO_ENVIRON_EXTERN)
15040 extern char **environ;
15041 #endif
15043 environ = env;
15044 #endif
15047 /* [env] */
15048 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15050 const char *key;
15051 const char *val;
15053 if (argc == 1) {
15054 char **e = Jim_GetEnviron();
15056 int i;
15057 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15059 for (i = 0; e[i]; i++) {
15060 const char *equals = strchr(e[i], '=');
15062 if (equals) {
15063 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15064 equals - e[i]));
15065 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15069 Jim_SetResult(interp, listObjPtr);
15070 return JIM_OK;
15073 if (argc > 3) {
15074 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15075 return JIM_ERR;
15077 key = Jim_String(argv[1]);
15078 val = getenv(key);
15079 if (val == NULL) {
15080 if (argc < 3) {
15081 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15082 return JIM_ERR;
15084 val = Jim_String(argv[2]);
15086 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15087 return JIM_OK;
15090 /* [source] */
15091 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15093 int retval;
15095 if (argc != 2) {
15096 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15097 return JIM_ERR;
15099 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15100 if (retval == JIM_RETURN)
15101 return JIM_OK;
15102 return retval;
15105 /* [lreverse] */
15106 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15108 Jim_Obj *revObjPtr, **ele;
15109 int len;
15111 if (argc != 2) {
15112 Jim_WrongNumArgs(interp, 1, argv, "list");
15113 return JIM_ERR;
15115 JimListGetElements(interp, argv[1], &len, &ele);
15116 len--;
15117 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15118 while (len >= 0)
15119 ListAppendElement(revObjPtr, ele[len--]);
15120 Jim_SetResult(interp, revObjPtr);
15121 return JIM_OK;
15124 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15126 jim_wide len;
15128 if (step == 0)
15129 return -1;
15130 if (start == end)
15131 return 0;
15132 else if (step > 0 && start > end)
15133 return -1;
15134 else if (step < 0 && end > start)
15135 return -1;
15136 len = end - start;
15137 if (len < 0)
15138 len = -len; /* abs(len) */
15139 if (step < 0)
15140 step = -step; /* abs(step) */
15141 len = 1 + ((len - 1) / step);
15142 /* We can truncate safely to INT_MAX, the range command
15143 * will always return an error for a such long range
15144 * because Tcl lists can't be so long. */
15145 if (len > INT_MAX)
15146 len = INT_MAX;
15147 return (int)((len < 0) ? -1 : len);
15150 /* [range] */
15151 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15153 jim_wide start = 0, end, step = 1;
15154 int len, i;
15155 Jim_Obj *objPtr;
15157 if (argc < 2 || argc > 4) {
15158 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15159 return JIM_ERR;
15161 if (argc == 2) {
15162 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15163 return JIM_ERR;
15165 else {
15166 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15167 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15168 return JIM_ERR;
15169 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15170 return JIM_ERR;
15172 if ((len = JimRangeLen(start, end, step)) == -1) {
15173 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15174 return JIM_ERR;
15176 objPtr = Jim_NewListObj(interp, NULL, 0);
15177 for (i = 0; i < len; i++)
15178 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15179 Jim_SetResult(interp, objPtr);
15180 return JIM_OK;
15183 /* [rand] */
15184 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15186 jim_wide min = 0, max = 0, len, maxMul;
15188 if (argc < 1 || argc > 3) {
15189 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15190 return JIM_ERR;
15192 if (argc == 1) {
15193 max = JIM_WIDE_MAX;
15194 } else if (argc == 2) {
15195 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15196 return JIM_ERR;
15197 } else if (argc == 3) {
15198 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15199 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15200 return JIM_ERR;
15202 len = max-min;
15203 if (len < 0) {
15204 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15205 return JIM_ERR;
15207 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15208 while (1) {
15209 jim_wide r;
15211 JimRandomBytes(interp, &r, sizeof(jim_wide));
15212 if (r < 0 || r >= maxMul) continue;
15213 r = (len == 0) ? 0 : r%len;
15214 Jim_SetResultInt(interp, min+r);
15215 return JIM_OK;
15219 static const struct {
15220 const char *name;
15221 Jim_CmdProc *cmdProc;
15222 } Jim_CoreCommandsTable[] = {
15223 {"alias", Jim_AliasCoreCommand},
15224 {"set", Jim_SetCoreCommand},
15225 {"unset", Jim_UnsetCoreCommand},
15226 {"puts", Jim_PutsCoreCommand},
15227 {"+", Jim_AddCoreCommand},
15228 {"*", Jim_MulCoreCommand},
15229 {"-", Jim_SubCoreCommand},
15230 {"/", Jim_DivCoreCommand},
15231 {"incr", Jim_IncrCoreCommand},
15232 {"while", Jim_WhileCoreCommand},
15233 {"loop", Jim_LoopCoreCommand},
15234 {"for", Jim_ForCoreCommand},
15235 {"foreach", Jim_ForeachCoreCommand},
15236 {"lmap", Jim_LmapCoreCommand},
15237 {"lassign", Jim_LassignCoreCommand},
15238 {"if", Jim_IfCoreCommand},
15239 {"switch", Jim_SwitchCoreCommand},
15240 {"list", Jim_ListCoreCommand},
15241 {"lindex", Jim_LindexCoreCommand},
15242 {"lset", Jim_LsetCoreCommand},
15243 {"lsearch", Jim_LsearchCoreCommand},
15244 {"llength", Jim_LlengthCoreCommand},
15245 {"lappend", Jim_LappendCoreCommand},
15246 {"linsert", Jim_LinsertCoreCommand},
15247 {"lreplace", Jim_LreplaceCoreCommand},
15248 {"lsort", Jim_LsortCoreCommand},
15249 {"append", Jim_AppendCoreCommand},
15250 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
15251 {"debug", Jim_DebugCoreCommand},
15252 #endif
15253 {"eval", Jim_EvalCoreCommand},
15254 {"uplevel", Jim_UplevelCoreCommand},
15255 {"expr", Jim_ExprCoreCommand},
15256 {"break", Jim_BreakCoreCommand},
15257 {"continue", Jim_ContinueCoreCommand},
15258 {"proc", Jim_ProcCoreCommand},
15259 {"concat", Jim_ConcatCoreCommand},
15260 {"return", Jim_ReturnCoreCommand},
15261 {"upvar", Jim_UpvarCoreCommand},
15262 {"global", Jim_GlobalCoreCommand},
15263 {"string", Jim_StringCoreCommand},
15264 {"time", Jim_TimeCoreCommand},
15265 {"exit", Jim_ExitCoreCommand},
15266 {"catch", Jim_CatchCoreCommand},
15267 #ifdef JIM_REFERENCES
15268 {"ref", Jim_RefCoreCommand},
15269 {"getref", Jim_GetrefCoreCommand},
15270 {"setref", Jim_SetrefCoreCommand},
15271 {"finalize", Jim_FinalizeCoreCommand},
15272 {"collect", Jim_CollectCoreCommand},
15273 #endif
15274 {"rename", Jim_RenameCoreCommand},
15275 {"dict", Jim_DictCoreCommand},
15276 {"subst", Jim_SubstCoreCommand},
15277 {"info", Jim_InfoCoreCommand},
15278 {"exists", Jim_ExistsCoreCommand},
15279 {"split", Jim_SplitCoreCommand},
15280 {"join", Jim_JoinCoreCommand},
15281 {"format", Jim_FormatCoreCommand},
15282 {"scan", Jim_ScanCoreCommand},
15283 {"error", Jim_ErrorCoreCommand},
15284 {"lrange", Jim_LrangeCoreCommand},
15285 {"lrepeat", Jim_LrepeatCoreCommand},
15286 {"env", Jim_EnvCoreCommand},
15287 {"source", Jim_SourceCoreCommand},
15288 {"lreverse", Jim_LreverseCoreCommand},
15289 {"range", Jim_RangeCoreCommand},
15290 {"rand", Jim_RandCoreCommand},
15291 {"tailcall", Jim_TailcallCoreCommand},
15292 {"local", Jim_LocalCoreCommand},
15293 {"upcall", Jim_UpcallCoreCommand},
15294 {"apply", Jim_ApplyCoreCommand},
15295 {NULL, NULL},
15298 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15300 int i = 0;
15302 while (Jim_CoreCommandsTable[i].name != NULL) {
15303 Jim_CreateCommand(interp,
15304 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15305 i++;
15309 /* -----------------------------------------------------------------------------
15310 * Interactive prompt
15311 * ---------------------------------------------------------------------------*/
15312 void Jim_MakeErrorMessage(Jim_Interp *interp)
15314 Jim_Obj *argv[2];
15316 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15317 argv[1] = interp->result;
15319 Jim_EvalObjVector(interp, 2, argv);
15323 * Given a null terminated array of strings, returns an allocated, sorted
15324 * copy of the array.
15326 static char **JimSortStringTable(const char *const *tablePtr)
15328 int count;
15329 char **tablePtrSorted;
15331 /* Find the size of the table */
15332 for (count = 0; tablePtr[count]; count++) {
15335 /* Allocate one extra for the terminating NULL pointer */
15336 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15337 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15338 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15339 tablePtrSorted[count] = NULL;
15341 return tablePtrSorted;
15344 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15345 const char *prefix, const char *const *tablePtr, const char *name)
15347 char **tablePtrSorted;
15348 int i;
15350 if (name == NULL) {
15351 name = "option";
15354 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15355 tablePtrSorted = JimSortStringTable(tablePtr);
15356 for (i = 0; tablePtrSorted[i]; i++) {
15357 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15358 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15360 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15361 if (tablePtrSorted[i + 1]) {
15362 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15365 Jim_Free(tablePtrSorted);
15370 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15371 * and returns JIM_OK.
15373 * Otherwise returns JIM_ERR.
15375 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15377 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15378 int i;
15379 char **tablePtrSorted = JimSortStringTable(tablePtr);
15380 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15381 for (i = 0; tablePtrSorted[i]; i++) {
15382 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15384 Jim_Free(tablePtrSorted);
15385 return JIM_OK;
15387 return JIM_ERR;
15390 /* internal rep is stored in ptrIntvalue
15391 * ptr = tablePtr
15392 * int1 = flags
15393 * int2 = index
15395 static const Jim_ObjType getEnumObjType = {
15396 "get-enum",
15397 NULL,
15398 NULL,
15399 NULL,
15400 JIM_TYPE_REFERENCES
15403 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15404 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15406 const char *bad = "bad ";
15407 const char *const *entryPtr = NULL;
15408 int i;
15409 int match = -1;
15410 int arglen;
15411 const char *arg;
15413 if (objPtr->typePtr == &getEnumObjType) {
15414 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15415 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15416 return JIM_OK;
15420 arg = Jim_GetString(objPtr, &arglen);
15422 *indexPtr = -1;
15424 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15425 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15426 /* Found an exact match */
15427 match = i;
15428 goto found;
15430 if (flags & JIM_ENUM_ABBREV) {
15431 /* Accept an unambiguous abbreviation.
15432 * Note that '-' doesnt' consitute a valid abbreviation
15434 if (strncmp(arg, *entryPtr, arglen) == 0) {
15435 if (*arg == '-' && arglen == 1) {
15436 break;
15438 if (match >= 0) {
15439 bad = "ambiguous ";
15440 goto ambiguous;
15442 match = i;
15447 /* If we had an unambiguous partial match */
15448 if (match >= 0) {
15449 found:
15450 /* Record the match in the object */
15451 Jim_FreeIntRep(interp, objPtr);
15452 objPtr->typePtr = &getEnumObjType;
15453 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15454 objPtr->internalRep.ptrIntValue.int1 = flags;
15455 objPtr->internalRep.ptrIntValue.int2 = match;
15456 /* Return the result */
15457 *indexPtr = match;
15458 return JIM_OK;
15461 ambiguous:
15462 if (flags & JIM_ERRMSG) {
15463 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15465 return JIM_ERR;
15468 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15470 int i;
15472 for (i = 0; i < (int)len; i++) {
15473 if (array[i] && strcmp(array[i], name) == 0) {
15474 return i;
15477 return -1;
15480 int Jim_IsDict(Jim_Obj *objPtr)
15482 return objPtr->typePtr == &dictObjType;
15485 int Jim_IsList(Jim_Obj *objPtr)
15487 return objPtr->typePtr == &listObjType;
15491 * Very simple printf-like formatting, designed for error messages.
15493 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15494 * The resulting string is created and set as the result.
15496 * Each '%s' should correspond to a regular string parameter.
15497 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15498 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15500 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15502 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15504 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15506 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15508 /* Initial space needed */
15509 int len = strlen(format);
15510 int extra = 0;
15511 int n = 0;
15512 const char *params[5];
15513 int nobjparam = 0;
15514 Jim_Obj *objparam[5];
15515 char *buf;
15516 va_list args;
15517 int i;
15519 va_start(args, format);
15521 for (i = 0; i < len && n < 5; i++) {
15522 int l;
15524 if (strncmp(format + i, "%s", 2) == 0) {
15525 params[n] = va_arg(args, char *);
15527 l = strlen(params[n]);
15529 else if (strncmp(format + i, "%#s", 3) == 0) {
15530 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15532 params[n] = Jim_GetString(objPtr, &l);
15533 objparam[nobjparam++] = objPtr;
15534 Jim_IncrRefCount(objPtr);
15536 else {
15537 if (format[i] == '%') {
15538 i++;
15540 continue;
15542 n++;
15543 extra += l;
15546 len += extra;
15547 buf = Jim_Alloc(len + 1);
15548 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15550 va_end(args);
15552 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15554 for (i = 0; i < nobjparam; i++) {
15555 Jim_DecrRefCount(interp, objparam[i]);
15559 /* stubs */
15560 #ifndef jim_ext_package
15561 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15563 return JIM_OK;
15565 #endif
15566 #ifndef jim_ext_aio
15567 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15569 Jim_SetResultString(interp, "aio not enabled", -1);
15570 return NULL;
15572 #endif
15576 * Local Variables: ***
15577 * c-basic-offset: 4 ***
15578 * tab-width: 4 ***
15579 * End: ***