package: add package names as an alias for package list
[jimtcl.git] / jim.c
blob668f43cf23fa2cabdec2f6aa9e5d197f8867a13c
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44 #ifndef _GNU_SOURCE
45 #define _GNU_SOURCE /* Mostly just for environ */
46 #endif
48 #include <stdio.h>
49 #include <stdlib.h>
51 #include <string.h>
52 #include <stdarg.h>
53 #include <ctype.h>
54 #include <limits.h>
55 #include <assert.h>
56 #include <errno.h>
57 #include <time.h>
58 #include <setjmp.h>
60 #include "jim.h"
61 #include "jimautoconf.h"
62 #include "utf8.h"
64 #ifdef HAVE_SYS_TIME_H
65 #include <sys/time.h>
66 #endif
67 #ifdef HAVE_BACKTRACE
68 #include <execinfo.h>
69 #endif
70 #ifdef HAVE_CRT_EXTERNS_H
71 #include <crt_externs.h>
72 #endif
74 /* For INFINITY, even if math functions are not enabled */
75 #include <math.h>
77 /* We may decide to switch to using $[...] after all, so leave it as an option */
78 /*#define EXPRSUGAR_BRACKET*/
80 /* For the no-autoconf case */
81 #ifndef TCL_LIBRARY
82 #define TCL_LIBRARY "."
83 #endif
84 #ifndef TCL_PLATFORM_OS
85 #define TCL_PLATFORM_OS "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PLATFORM
88 #define TCL_PLATFORM_PLATFORM "unknown"
89 #endif
90 #ifndef TCL_PLATFORM_PATH_SEPARATOR
91 #define TCL_PLATFORM_PATH_SEPARATOR ":"
92 #endif
94 /*#define DEBUG_SHOW_SCRIPT*/
95 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
96 /*#define DEBUG_SHOW_SUBST*/
97 /*#define DEBUG_SHOW_EXPR*/
98 /*#define DEBUG_SHOW_EXPR_TOKENS*/
99 /*#define JIM_DEBUG_GC*/
100 #ifdef JIM_MAINTAINER
101 #define JIM_DEBUG_COMMAND
102 #define JIM_DEBUG_PANIC
103 #endif
104 /* Enable this (in conjunction with valgrind) to help debug
105 * reference counting issues
107 /*#define JIM_DISABLE_OBJECT_POOL*/
109 /* Maximum size of an integer */
110 #define JIM_INTEGER_SPACE 24
112 const char *jim_tt_name(int type);
114 #ifdef JIM_DEBUG_PANIC
115 static void JimPanicDump(int fail_condition, const char *fmt, ...);
116 #define JimPanic(X) JimPanicDump X
117 #else
118 #define JimPanic(X)
119 #endif
121 #ifdef JIM_OPTIMIZATION
122 #define JIM_IF_OPTIM(X) X
123 #else
124 #define JIM_IF_OPTIM(X)
125 #endif
127 /* -----------------------------------------------------------------------------
128 * Global variables
129 * ---------------------------------------------------------------------------*/
131 /* A shared empty string for the objects string representation.
132 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
133 static char JimEmptyStringRep[] = "";
135 /* -----------------------------------------------------------------------------
136 * Required prototypes of not exported functions
137 * ---------------------------------------------------------------------------*/
138 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
139 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
140 int flags);
141 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
142 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
143 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
144 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
145 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
146 const char *prefix, const char *const *tablePtr, const char *name);
147 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
148 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
149 static int JimSign(jim_wide w);
150 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
151 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
152 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
155 /* Fast access to the int (wide) value of an object which is known to be of int type */
156 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
158 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
160 static int utf8_tounicode_case(const char *s, int *uc, int upper)
162 int l = utf8_tounicode(s, uc);
163 if (upper) {
164 *uc = utf8_upper(*uc);
166 return l;
169 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
170 #define JIM_CHARSET_SCAN 2
171 #define JIM_CHARSET_GLOB 0
174 * pattern points to a string like "[^a-z\ub5]"
176 * The pattern may contain trailing chars, which are ignored.
178 * The pattern is matched against unicode char 'c'.
180 * If (flags & JIM_NOCASE), case is ignored when matching.
181 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
182 * of the charset, per scan, rather than glob/string match.
184 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
185 * or the null character if the ']' is missing.
187 * Returns NULL on no match.
189 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
191 int not = 0;
192 int pchar;
193 int match = 0;
194 int nocase = 0;
196 if (flags & JIM_NOCASE) {
197 nocase++;
198 c = utf8_upper(c);
201 if (flags & JIM_CHARSET_SCAN) {
202 if (*pattern == '^') {
203 not++;
204 pattern++;
207 /* Special case. If the first char is ']', it is part of the set */
208 if (*pattern == ']') {
209 goto first;
213 while (*pattern && *pattern != ']') {
214 /* Exact match */
215 if (pattern[0] == '\\') {
216 first:
217 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
219 else {
220 /* Is this a range? a-z */
221 int start;
222 int end;
224 pattern += utf8_tounicode_case(pattern, &start, nocase);
225 if (pattern[0] == '-' && pattern[1]) {
226 /* skip '-' */
227 pattern++;
228 pattern += utf8_tounicode_case(pattern, &end, nocase);
230 /* Handle reversed range too */
231 if ((c >= start && c <= end) || (c >= end && c <= start)) {
232 match = 1;
234 continue;
236 pchar = start;
239 if (pchar == c) {
240 match = 1;
243 if (not) {
244 match = !match;
247 return match ? pattern : NULL;
250 /* Glob-style pattern matching. */
252 /* Note: string *must* be valid UTF-8 sequences
254 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
256 int c;
257 int pchar;
258 while (*pattern) {
259 switch (pattern[0]) {
260 case '*':
261 while (pattern[1] == '*') {
262 pattern++;
264 pattern++;
265 if (!pattern[0]) {
266 return 1; /* match */
268 while (*string) {
269 /* Recursive call - Does the remaining pattern match anywhere? */
270 if (JimGlobMatch(pattern, string, nocase))
271 return 1; /* match */
272 string += utf8_tounicode(string, &c);
274 return 0; /* no match */
276 case '?':
277 string += utf8_tounicode(string, &c);
278 break;
280 case '[': {
281 string += utf8_tounicode(string, &c);
282 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
283 if (!pattern) {
284 return 0;
286 if (!*pattern) {
287 /* Ran out of pattern (no ']') */
288 continue;
290 break;
292 case '\\':
293 if (pattern[1]) {
294 pattern++;
296 /* fall through */
297 default:
298 string += utf8_tounicode_case(string, &c, nocase);
299 utf8_tounicode_case(pattern, &pchar, nocase);
300 if (pchar != c) {
301 return 0;
303 break;
305 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
306 if (!*string) {
307 while (*pattern == '*') {
308 pattern++;
310 break;
313 if (!*pattern && !*string) {
314 return 1;
316 return 0;
320 * utf-8 string comparison. case-insensitive if nocase is set.
322 * Returns -1, 0 or 1
324 * Note that the lengths are character lengths, not byte lengths.
326 static int JimStringCompareUtf8(const char *s1, int l1, const char *s2, int l2, int nocase)
328 int minlen = l1;
329 if (l2 < l1) {
330 minlen = l2;
332 while (minlen) {
333 int c1, c2;
334 s1 += utf8_tounicode_case(s1, &c1, nocase);
335 s2 += utf8_tounicode_case(s2, &c2, nocase);
336 if (c1 != c2) {
337 return JimSign(c1 - c2);
339 minlen--;
341 /* Equal to this point, so the shorter string is less */
342 if (l1 < l2) {
343 return -1;
345 if (l1 > l2) {
346 return 1;
348 return 0;
351 /* Search for 's1' inside 's2', starting to search from char 'index' of 's2'.
352 * The index of the first occurrence of s1 in s2 is returned.
353 * If s1 is not found inside s2, -1 is returned.
355 * Note: Lengths and return value are in bytes, not chars.
357 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
359 int i;
360 int l1bytelen;
362 if (!l1 || !l2 || l1 > l2) {
363 return -1;
365 if (idx < 0)
366 idx = 0;
367 s2 += utf8_index(s2, idx);
369 l1bytelen = utf8_index(s1, l1);
371 for (i = idx; i <= l2 - l1; i++) {
372 int c;
373 if (memcmp(s2, s1, l1bytelen) == 0) {
374 return i;
376 s2 += utf8_tounicode(s2, &c);
378 return -1;
381 /* Search for the last occurrence 's1' inside 's2', starting to search from char 'index' of 's2'.
382 * The index of the last occurrence of s1 in s2 is returned.
383 * If s1 is not found inside s2, -1 is returned.
385 * Note: Lengths and return value are in bytes, not chars.
387 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
389 const char *p;
391 if (!l1 || !l2 || l1 > l2)
392 return -1;
394 /* Now search for the needle */
395 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
396 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
397 return p - s2;
400 return -1;
403 #ifdef JIM_UTF8
405 * Per JimStringLast but lengths and return value are in chars, not bytes.
407 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
409 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
410 if (n > 0) {
411 n = utf8_strlen(s2, n);
413 return n;
415 #endif
418 * After an strtol()/strtod()-like conversion,
419 * check whether something was converted and that
420 * the only thing left is white space.
422 * Returns JIM_OK or JIM_ERR.
424 static int JimCheckConversion(const char *str, const char *endptr)
426 if (str[0] == '\0' || str == endptr) {
427 return JIM_ERR;
430 if (endptr[0] != '\0') {
431 while (*endptr) {
432 if (!isspace(UCHAR(*endptr))) {
433 return JIM_ERR;
435 endptr++;
438 return JIM_OK;
441 /* Parses the front of a number to determine its sign and base.
442 * Returns the index to start parsing according to the given base
444 static int JimNumberBase(const char *str, int *base, int *sign)
446 int i = 0;
448 *base = 10;
450 while (isspace(UCHAR(str[i]))) {
451 i++;
454 if (str[i] == '-') {
455 *sign = -1;
456 i++;
458 else {
459 if (str[i] == '+') {
460 i++;
462 *sign = 1;
465 if (str[i] != '0') {
466 /* base 10 */
467 return 0;
470 /* We have 0<x>, so see if we can convert it */
471 switch (str[i + 1]) {
472 case 'x': case 'X': *base = 16; break;
473 case 'o': case 'O': *base = 8; break;
474 case 'b': case 'B': *base = 2; break;
475 default: return 0;
477 i += 2;
478 /* Ensure that (e.g.) 0x-5 fails to parse */
479 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
480 /* Parse according to this base */
481 return i;
483 /* Parse as base 10 */
484 *base = 10;
485 return 0;
488 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
489 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
491 static long jim_strtol(const char *str, char **endptr)
493 int sign;
494 int base;
495 int i = JimNumberBase(str, &base, &sign);
497 if (base != 10) {
498 long value = strtol(str + i, endptr, base);
499 if (endptr == NULL || *endptr != str + i) {
500 return value * sign;
504 /* Can just do a regular base-10 conversion */
505 return strtol(str, endptr, 10);
509 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
510 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
512 static jim_wide jim_strtoull(const char *str, char **endptr)
514 #ifdef HAVE_LONG_LONG
515 int sign;
516 int base;
517 int i = JimNumberBase(str, &base, &sign);
519 if (base != 10) {
520 jim_wide value = strtoull(str + i, endptr, base);
521 if (endptr == NULL || *endptr != str + i) {
522 return value * sign;
526 /* Can just do a regular base-10 conversion */
527 return strtoull(str, endptr, 10);
528 #else
529 return (unsigned long)jim_strtol(str, endptr);
530 #endif
533 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
535 char *endptr;
537 if (base) {
538 *widePtr = strtoull(str, &endptr, base);
540 else {
541 *widePtr = jim_strtoull(str, &endptr);
544 return JimCheckConversion(str, endptr);
547 int Jim_StringToDouble(const char *str, double *doublePtr)
549 char *endptr;
551 /* Callers can check for underflow via ERANGE */
552 errno = 0;
554 *doublePtr = strtod(str, &endptr);
556 return JimCheckConversion(str, endptr);
559 static jim_wide JimPowWide(jim_wide b, jim_wide e)
561 jim_wide res = 1;
563 /* Special cases */
564 if (b == 1) {
565 /* 1 ^ any = 1 */
566 return 1;
568 if (e < 0) {
569 if (b != -1) {
570 return 0;
572 /* Only special case is -1 ^ -n
573 * -1^-1 = -1
574 * -1^-2 = 1
575 * i.e. same as +ve n
577 e = -e;
579 while (e)
581 if (e & 1) {
582 res *= b;
584 e >>= 1;
585 b *= b;
587 return res;
590 /* -----------------------------------------------------------------------------
591 * Special functions
592 * ---------------------------------------------------------------------------*/
593 #ifdef JIM_DEBUG_PANIC
594 static void JimPanicDump(int condition, const char *fmt, ...)
596 va_list ap;
598 if (!condition) {
599 return;
602 va_start(ap, fmt);
604 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
605 vfprintf(stderr, fmt, ap);
606 fprintf(stderr, "\n\n");
607 va_end(ap);
609 #ifdef HAVE_BACKTRACE
611 void *array[40];
612 int size, i;
613 char **strings;
615 size = backtrace(array, 40);
616 strings = backtrace_symbols(array, size);
617 for (i = 0; i < size; i++)
618 fprintf(stderr, "[backtrace] %s\n", strings[i]);
619 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
620 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
622 #endif
624 exit(1);
626 #endif
628 /* -----------------------------------------------------------------------------
629 * Memory allocation
630 * ---------------------------------------------------------------------------*/
632 void *Jim_Alloc(int size)
634 return size ? malloc(size) : NULL;
637 void Jim_Free(void *ptr)
639 free(ptr);
642 void *Jim_Realloc(void *ptr, int size)
644 return realloc(ptr, size);
647 char *Jim_StrDup(const char *s)
649 return strdup(s);
652 char *Jim_StrDupLen(const char *s, int l)
654 char *copy = Jim_Alloc(l + 1);
656 memcpy(copy, s, l + 1);
657 copy[l] = 0; /* Just to be sure, original could be substring */
658 return copy;
661 /* -----------------------------------------------------------------------------
662 * Time related functions
663 * ---------------------------------------------------------------------------*/
665 /* Returns current time in microseconds */
666 static jim_wide JimClock(void)
668 struct timeval tv;
670 gettimeofday(&tv, NULL);
671 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
674 /* -----------------------------------------------------------------------------
675 * Hash Tables
676 * ---------------------------------------------------------------------------*/
678 /* -------------------------- private prototypes ---------------------------- */
679 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
680 static unsigned int JimHashTableNextPower(unsigned int size);
681 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
683 /* -------------------------- hash functions -------------------------------- */
685 /* Thomas Wang's 32 bit Mix Function */
686 unsigned int Jim_IntHashFunction(unsigned int key)
688 key += ~(key << 15);
689 key ^= (key >> 10);
690 key += (key << 3);
691 key ^= (key >> 6);
692 key += ~(key << 11);
693 key ^= (key >> 16);
694 return key;
697 /* Generic hash function (we are using to multiply by 9 and add the byte
698 * as Tcl) */
699 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
701 unsigned int h = 0;
703 while (len--)
704 h += (h << 3) + *buf++;
705 return h;
708 /* ----------------------------- API implementation ------------------------- */
711 * Reset a hashtable already initialized.
712 * The table data should already have been freed.
714 * Note that type and privdata are not initialised
715 * to allow the now-empty hashtable to be reused
717 static void JimResetHashTable(Jim_HashTable *ht)
719 ht->table = NULL;
720 ht->size = 0;
721 ht->sizemask = 0;
722 ht->used = 0;
723 ht->collisions = 0;
724 #ifdef JIM_RANDOMISE_HASH
725 /* This is initialised to a random value to avoid a hash collision attack.
726 * See: n.runs-SA-2011.004
728 ht->uniq = (rand() ^ time(NULL) ^ clock());
729 #else
730 ht->uniq = 0;
731 #endif
734 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
736 iter->ht = ht;
737 iter->index = -1;
738 iter->entry = NULL;
739 iter->nextEntry = NULL;
742 /* Initialize the hash table */
743 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
745 JimResetHashTable(ht);
746 ht->type = type;
747 ht->privdata = privDataPtr;
748 return JIM_OK;
751 /* Expand or create the hashtable */
752 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
754 Jim_HashTable n; /* the new hashtable */
755 unsigned int realsize = JimHashTableNextPower(size), i;
757 /* the size is invalid if it is smaller than the number of
758 * elements already inside the hashtable */
759 if (size <= ht->used)
760 return;
762 Jim_InitHashTable(&n, ht->type, ht->privdata);
763 n.size = realsize;
764 n.sizemask = realsize - 1;
765 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
766 /* Keep the same 'uniq' as the original */
767 n.uniq = ht->uniq;
769 /* Initialize all the pointers to NULL */
770 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
772 /* Copy all the elements from the old to the new table:
773 * note that if the old hash table is empty ht->used is zero,
774 * so Jim_ExpandHashTable just creates an empty hash table. */
775 n.used = ht->used;
776 for (i = 0; ht->used > 0; i++) {
777 Jim_HashEntry *he, *nextHe;
779 if (ht->table[i] == NULL)
780 continue;
782 /* For each hash entry on this slot... */
783 he = ht->table[i];
784 while (he) {
785 unsigned int h;
787 nextHe = he->next;
788 /* Get the new element index */
789 h = Jim_HashKey(ht, he->key) & n.sizemask;
790 he->next = n.table[h];
791 n.table[h] = he;
792 ht->used--;
793 /* Pass to the next element */
794 he = nextHe;
797 assert(ht->used == 0);
798 Jim_Free(ht->table);
800 /* Remap the new hashtable in the old */
801 *ht = n;
804 /* Add an element to the target hash table */
805 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
807 Jim_HashEntry *entry;
809 /* Get the index of the new element, or -1 if
810 * the element already exists. */
811 entry = JimInsertHashEntry(ht, key, 0);
812 if (entry == NULL)
813 return JIM_ERR;
815 /* Set the hash entry fields. */
816 Jim_SetHashKey(ht, entry, key);
817 Jim_SetHashVal(ht, entry, val);
818 return JIM_OK;
821 /* Add an element, discarding the old if the key already exists */
822 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
824 int existed;
825 Jim_HashEntry *entry;
827 /* Get the index of the new element, or -1 if
828 * the element already exists. */
829 entry = JimInsertHashEntry(ht, key, 1);
830 if (entry->key) {
831 /* It already exists, so only replace the value.
832 * Note if both a destructor and a duplicate function exist,
833 * need to dup before destroy. perhaps they are the same
834 * reference counted object
836 if (ht->type->valDestructor && ht->type->valDup) {
837 void *newval = ht->type->valDup(ht->privdata, val);
838 ht->type->valDestructor(ht->privdata, entry->u.val);
839 entry->u.val = newval;
841 else {
842 Jim_FreeEntryVal(ht, entry);
843 Jim_SetHashVal(ht, entry, val);
845 existed = 1;
847 else {
848 /* Doesn't exist, so set the key */
849 Jim_SetHashKey(ht, entry, key);
850 Jim_SetHashVal(ht, entry, val);
851 existed = 0;
854 return existed;
857 /* Search and remove an element */
858 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
860 unsigned int h;
861 Jim_HashEntry *he, *prevHe;
863 if (ht->used == 0)
864 return JIM_ERR;
865 h = Jim_HashKey(ht, key) & ht->sizemask;
866 he = ht->table[h];
868 prevHe = NULL;
869 while (he) {
870 if (Jim_CompareHashKeys(ht, key, he->key)) {
871 /* Unlink the element from the list */
872 if (prevHe)
873 prevHe->next = he->next;
874 else
875 ht->table[h] = he->next;
876 Jim_FreeEntryKey(ht, he);
877 Jim_FreeEntryVal(ht, he);
878 Jim_Free(he);
879 ht->used--;
880 return JIM_OK;
882 prevHe = he;
883 he = he->next;
885 return JIM_ERR; /* not found */
888 /* Remove all entries from the hash table
889 * and leave it empty for reuse
891 int Jim_FreeHashTable(Jim_HashTable *ht)
893 unsigned int i;
895 /* Free all the elements */
896 for (i = 0; ht->used > 0; i++) {
897 Jim_HashEntry *he, *nextHe;
899 if ((he = ht->table[i]) == NULL)
900 continue;
901 while (he) {
902 nextHe = he->next;
903 Jim_FreeEntryKey(ht, he);
904 Jim_FreeEntryVal(ht, he);
905 Jim_Free(he);
906 ht->used--;
907 he = nextHe;
910 /* Free the table and the allocated cache structure */
911 Jim_Free(ht->table);
912 /* Re-initialize the table */
913 JimResetHashTable(ht);
914 return JIM_OK; /* never fails */
917 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
919 Jim_HashEntry *he;
920 unsigned int h;
922 if (ht->used == 0)
923 return NULL;
924 h = Jim_HashKey(ht, key) & ht->sizemask;
925 he = ht->table[h];
926 while (he) {
927 if (Jim_CompareHashKeys(ht, key, he->key))
928 return he;
929 he = he->next;
931 return NULL;
934 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
936 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
937 JimInitHashTableIterator(ht, iter);
938 return iter;
941 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
943 while (1) {
944 if (iter->entry == NULL) {
945 iter->index++;
946 if (iter->index >= (signed)iter->ht->size)
947 break;
948 iter->entry = iter->ht->table[iter->index];
950 else {
951 iter->entry = iter->nextEntry;
953 if (iter->entry) {
954 /* We need to save the 'next' here, the iterator user
955 * may delete the entry we are returning. */
956 iter->nextEntry = iter->entry->next;
957 return iter->entry;
960 return NULL;
963 /* ------------------------- private functions ------------------------------ */
965 /* Expand the hash table if needed */
966 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
968 /* If the hash table is empty expand it to the intial size,
969 * if the table is "full" double its size. */
970 if (ht->size == 0)
971 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
972 if (ht->size == ht->used)
973 Jim_ExpandHashTable(ht, ht->size * 2);
976 /* Our hash table capability is a power of two */
977 static unsigned int JimHashTableNextPower(unsigned int size)
979 unsigned int i = JIM_HT_INITIAL_SIZE;
981 if (size >= 2147483648U)
982 return 2147483648U;
983 while (1) {
984 if (i >= size)
985 return i;
986 i *= 2;
990 /* Returns the index of a free slot that can be populated with
991 * a hash entry for the given 'key'.
992 * If the key already exists, -1 is returned. */
993 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
995 unsigned int h;
996 Jim_HashEntry *he;
998 /* Expand the hashtable if needed */
999 JimExpandHashTableIfNeeded(ht);
1001 /* Compute the key hash value */
1002 h = Jim_HashKey(ht, key) & ht->sizemask;
1003 /* Search if this slot does not already contain the given key */
1004 he = ht->table[h];
1005 while (he) {
1006 if (Jim_CompareHashKeys(ht, key, he->key))
1007 return replace ? he : NULL;
1008 he = he->next;
1011 /* Allocates the memory and stores key */
1012 he = Jim_Alloc(sizeof(*he));
1013 he->next = ht->table[h];
1014 ht->table[h] = he;
1015 ht->used++;
1016 he->key = NULL;
1018 return he;
1021 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1023 static unsigned int JimStringCopyHTHashFunction(const void *key)
1025 return Jim_GenHashFunction(key, strlen(key));
1028 static void *JimStringCopyHTDup(void *privdata, const void *key)
1030 return Jim_StrDup(key);
1033 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1035 return strcmp(key1, key2) == 0;
1038 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1040 Jim_Free(key);
1043 static const Jim_HashTableType JimPackageHashTableType = {
1044 JimStringCopyHTHashFunction, /* hash function */
1045 JimStringCopyHTDup, /* key dup */
1046 NULL, /* val dup */
1047 JimStringCopyHTKeyCompare, /* key compare */
1048 JimStringCopyHTKeyDestructor, /* key destructor */
1049 NULL /* val destructor */
1052 typedef struct AssocDataValue
1054 Jim_InterpDeleteProc *delProc;
1055 void *data;
1056 } AssocDataValue;
1058 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1060 AssocDataValue *assocPtr = (AssocDataValue *) data;
1062 if (assocPtr->delProc != NULL)
1063 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1064 Jim_Free(data);
1067 static const Jim_HashTableType JimAssocDataHashTableType = {
1068 JimStringCopyHTHashFunction, /* hash function */
1069 JimStringCopyHTDup, /* key dup */
1070 NULL, /* val dup */
1071 JimStringCopyHTKeyCompare, /* key compare */
1072 JimStringCopyHTKeyDestructor, /* key destructor */
1073 JimAssocDataHashTableValueDestructor /* val destructor */
1076 /* -----------------------------------------------------------------------------
1077 * Stack - This is a simple generic stack implementation. It is used for
1078 * example in the 'expr' expression compiler.
1079 * ---------------------------------------------------------------------------*/
1080 void Jim_InitStack(Jim_Stack *stack)
1082 stack->len = 0;
1083 stack->maxlen = 0;
1084 stack->vector = NULL;
1087 void Jim_FreeStack(Jim_Stack *stack)
1089 Jim_Free(stack->vector);
1092 int Jim_StackLen(Jim_Stack *stack)
1094 return stack->len;
1097 void Jim_StackPush(Jim_Stack *stack, void *element)
1099 int neededLen = stack->len + 1;
1101 if (neededLen > stack->maxlen) {
1102 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1103 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1105 stack->vector[stack->len] = element;
1106 stack->len++;
1109 void *Jim_StackPop(Jim_Stack *stack)
1111 if (stack->len == 0)
1112 return NULL;
1113 stack->len--;
1114 return stack->vector[stack->len];
1117 void *Jim_StackPeek(Jim_Stack *stack)
1119 if (stack->len == 0)
1120 return NULL;
1121 return stack->vector[stack->len - 1];
1124 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1126 int i;
1128 for (i = 0; i < stack->len; i++)
1129 freeFunc(stack->vector[i]);
1132 /* -----------------------------------------------------------------------------
1133 * Tcl Parser
1134 * ---------------------------------------------------------------------------*/
1136 /* Token types */
1137 #define JIM_TT_NONE 0 /* No token returned */
1138 #define JIM_TT_STR 1 /* simple string */
1139 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1140 #define JIM_TT_VAR 3 /* var substitution */
1141 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1142 #define JIM_TT_CMD 5 /* command substitution */
1143 /* Note: Keep these three together for TOKEN_IS_SEP() */
1144 #define JIM_TT_SEP 6 /* word separator (white space) */
1145 #define JIM_TT_EOL 7 /* line separator */
1146 #define JIM_TT_EOF 8 /* end of script */
1148 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1149 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1151 /* Additional token types needed for expressions */
1152 #define JIM_TT_SUBEXPR_START 11
1153 #define JIM_TT_SUBEXPR_END 12
1154 #define JIM_TT_SUBEXPR_COMMA 13
1155 #define JIM_TT_EXPR_INT 14
1156 #define JIM_TT_EXPR_DOUBLE 15
1157 #define JIM_TT_EXPR_BOOLEAN 16
1159 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1161 /* Operator token types start here */
1162 #define JIM_TT_EXPR_OP 20
1164 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1165 /* Can this token start an expression? */
1166 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1167 /* Is this token an expression operator? */
1168 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1171 * Results of missing quotes, braces, etc. from parsing.
1173 struct JimParseMissing {
1174 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\', '}' if incomplete */
1175 int line; /* Line number starting the missing token */
1178 /* Parser context structure. The same context is used to parse
1179 * Tcl scripts, expressions and lists. */
1180 struct JimParserCtx
1182 const char *p; /* Pointer to the point of the program we are parsing */
1183 int len; /* Remaining length */
1184 int linenr; /* Current line number */
1185 const char *tstart;
1186 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1187 int tline; /* Line number of the returned token */
1188 int tt; /* Token type */
1189 int eof; /* Non zero if EOF condition is true. */
1190 int inquote; /* Parsing a quoted string */
1191 int comment; /* Non zero if the next chars may be a comment. */
1192 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1195 static int JimParseScript(struct JimParserCtx *pc);
1196 static int JimParseSep(struct JimParserCtx *pc);
1197 static int JimParseEol(struct JimParserCtx *pc);
1198 static int JimParseCmd(struct JimParserCtx *pc);
1199 static int JimParseQuote(struct JimParserCtx *pc);
1200 static int JimParseVar(struct JimParserCtx *pc);
1201 static int JimParseBrace(struct JimParserCtx *pc);
1202 static int JimParseStr(struct JimParserCtx *pc);
1203 static int JimParseComment(struct JimParserCtx *pc);
1204 static void JimParseSubCmd(struct JimParserCtx *pc);
1205 static int JimParseSubQuote(struct JimParserCtx *pc);
1206 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1208 /* Initialize a parser context.
1209 * 'prg' is a pointer to the program text, linenr is the line
1210 * number of the first line contained in the program. */
1211 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1213 pc->p = prg;
1214 pc->len = len;
1215 pc->tstart = NULL;
1216 pc->tend = NULL;
1217 pc->tline = 0;
1218 pc->tt = JIM_TT_NONE;
1219 pc->eof = 0;
1220 pc->inquote = 0;
1221 pc->linenr = linenr;
1222 pc->comment = 1;
1223 pc->missing.ch = ' ';
1224 pc->missing.line = linenr;
1227 static int JimParseScript(struct JimParserCtx *pc)
1229 while (1) { /* the while is used to reiterate with continue if needed */
1230 if (!pc->len) {
1231 pc->tstart = pc->p;
1232 pc->tend = pc->p - 1;
1233 pc->tline = pc->linenr;
1234 pc->tt = JIM_TT_EOL;
1235 pc->eof = 1;
1236 return JIM_OK;
1238 switch (*(pc->p)) {
1239 case '\\':
1240 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1241 return JimParseSep(pc);
1243 pc->comment = 0;
1244 return JimParseStr(pc);
1245 case ' ':
1246 case '\t':
1247 case '\r':
1248 case '\f':
1249 if (!pc->inquote)
1250 return JimParseSep(pc);
1251 pc->comment = 0;
1252 return JimParseStr(pc);
1253 case '\n':
1254 case ';':
1255 pc->comment = 1;
1256 if (!pc->inquote)
1257 return JimParseEol(pc);
1258 return JimParseStr(pc);
1259 case '[':
1260 pc->comment = 0;
1261 return JimParseCmd(pc);
1262 case '$':
1263 pc->comment = 0;
1264 if (JimParseVar(pc) == JIM_ERR) {
1265 /* An orphan $. Create as a separate token */
1266 pc->tstart = pc->tend = pc->p++;
1267 pc->len--;
1268 pc->tt = JIM_TT_ESC;
1270 return JIM_OK;
1271 case '#':
1272 if (pc->comment) {
1273 JimParseComment(pc);
1274 continue;
1276 return JimParseStr(pc);
1277 default:
1278 pc->comment = 0;
1279 return JimParseStr(pc);
1281 return JIM_OK;
1285 static int JimParseSep(struct JimParserCtx *pc)
1287 pc->tstart = pc->p;
1288 pc->tline = pc->linenr;
1289 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1290 if (*pc->p == '\n') {
1291 break;
1293 if (*pc->p == '\\') {
1294 pc->p++;
1295 pc->len--;
1296 pc->linenr++;
1298 pc->p++;
1299 pc->len--;
1301 pc->tend = pc->p - 1;
1302 pc->tt = JIM_TT_SEP;
1303 return JIM_OK;
1306 static int JimParseEol(struct JimParserCtx *pc)
1308 pc->tstart = pc->p;
1309 pc->tline = pc->linenr;
1310 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1311 if (*pc->p == '\n')
1312 pc->linenr++;
1313 pc->p++;
1314 pc->len--;
1316 pc->tend = pc->p - 1;
1317 pc->tt = JIM_TT_EOL;
1318 return JIM_OK;
1322 ** Here are the rules for parsing:
1323 ** {braced expression}
1324 ** - Count open and closing braces
1325 ** - Backslash escapes meaning of braces but doesn't remove the backslash
1327 ** "quoted expression"
1328 ** - Unescaped double quote terminates the expression
1329 ** - Backslash escapes next char
1330 ** - [commands brackets] are counted/nested
1331 ** - command rules apply within [brackets], not quoting rules (i.e. brackets have their own rules)
1333 ** [command expression]
1334 ** - Count open and closing brackets
1335 ** - Backslash escapes next char
1336 ** - [commands brackets] are counted/nested
1337 ** - "quoted expressions" are parsed according to quoting rules
1338 ** - {braced expressions} are parsed according to brace rules
1340 ** For everything, backslash escapes the next char, newline increments current line
1344 * Parses a braced expression starting at pc->p.
1346 * Positions the parser at the end of the braced expression,
1347 * sets pc->tend and possibly pc->missing.
1349 static void JimParseSubBrace(struct JimParserCtx *pc)
1351 int level = 1;
1353 /* Skip the brace */
1354 pc->p++;
1355 pc->len--;
1356 while (pc->len) {
1357 switch (*pc->p) {
1358 case '\\':
1359 if (pc->len > 1) {
1360 if (*++pc->p == '\n') {
1361 pc->linenr++;
1363 pc->len--;
1365 break;
1367 case '{':
1368 level++;
1369 break;
1371 case '}':
1372 if (--level == 0) {
1373 pc->tend = pc->p - 1;
1374 pc->p++;
1375 pc->len--;
1376 return;
1378 break;
1380 case '\n':
1381 pc->linenr++;
1382 break;
1384 pc->p++;
1385 pc->len--;
1387 pc->missing.ch = '{';
1388 pc->missing.line = pc->tline;
1389 pc->tend = pc->p - 1;
1393 * Parses a quoted expression starting at pc->p.
1395 * Positions the parser at the end of the quoted expression,
1396 * sets pc->tend and possibly pc->missing.
1398 * Returns the type of the token of the string,
1399 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1400 * or JIM_TT_STR.
1402 static int JimParseSubQuote(struct JimParserCtx *pc)
1404 int tt = JIM_TT_STR;
1405 int line = pc->tline;
1407 /* Skip the quote */
1408 pc->p++;
1409 pc->len--;
1410 while (pc->len) {
1411 switch (*pc->p) {
1412 case '\\':
1413 if (pc->len > 1) {
1414 if (*++pc->p == '\n') {
1415 pc->linenr++;
1417 pc->len--;
1418 tt = JIM_TT_ESC;
1420 break;
1422 case '"':
1423 pc->tend = pc->p - 1;
1424 pc->p++;
1425 pc->len--;
1426 return tt;
1428 case '[':
1429 JimParseSubCmd(pc);
1430 tt = JIM_TT_ESC;
1431 continue;
1433 case '\n':
1434 pc->linenr++;
1435 break;
1437 case '$':
1438 tt = JIM_TT_ESC;
1439 break;
1441 pc->p++;
1442 pc->len--;
1444 pc->missing.ch = '"';
1445 pc->missing.line = line;
1446 pc->tend = pc->p - 1;
1447 return tt;
1451 * Parses a [command] expression starting at pc->p.
1453 * Positions the parser at the end of the command expression,
1454 * sets pc->tend and possibly pc->missing.
1456 static void JimParseSubCmd(struct JimParserCtx *pc)
1458 int level = 1;
1459 int startofword = 1;
1460 int line = pc->tline;
1462 /* Skip the bracket */
1463 pc->p++;
1464 pc->len--;
1465 while (pc->len) {
1466 switch (*pc->p) {
1467 case '\\':
1468 if (pc->len > 1) {
1469 if (*++pc->p == '\n') {
1470 pc->linenr++;
1472 pc->len--;
1474 break;
1476 case '[':
1477 level++;
1478 break;
1480 case ']':
1481 if (--level == 0) {
1482 pc->tend = pc->p - 1;
1483 pc->p++;
1484 pc->len--;
1485 return;
1487 break;
1489 case '"':
1490 if (startofword) {
1491 JimParseSubQuote(pc);
1492 continue;
1494 break;
1496 case '{':
1497 JimParseSubBrace(pc);
1498 startofword = 0;
1499 continue;
1501 case '\n':
1502 pc->linenr++;
1503 break;
1505 startofword = isspace(UCHAR(*pc->p));
1506 pc->p++;
1507 pc->len--;
1509 pc->missing.ch = '[';
1510 pc->missing.line = line;
1511 pc->tend = pc->p - 1;
1514 static int JimParseBrace(struct JimParserCtx *pc)
1516 pc->tstart = pc->p + 1;
1517 pc->tline = pc->linenr;
1518 pc->tt = JIM_TT_STR;
1519 JimParseSubBrace(pc);
1520 return JIM_OK;
1523 static int JimParseCmd(struct JimParserCtx *pc)
1525 pc->tstart = pc->p + 1;
1526 pc->tline = pc->linenr;
1527 pc->tt = JIM_TT_CMD;
1528 JimParseSubCmd(pc);
1529 return JIM_OK;
1532 static int JimParseQuote(struct JimParserCtx *pc)
1534 pc->tstart = pc->p + 1;
1535 pc->tline = pc->linenr;
1536 pc->tt = JimParseSubQuote(pc);
1537 return JIM_OK;
1540 static int JimParseVar(struct JimParserCtx *pc)
1542 /* skip the $ */
1543 pc->p++;
1544 pc->len--;
1546 #ifdef EXPRSUGAR_BRACKET
1547 if (*pc->p == '[') {
1548 /* Parse $[...] expr shorthand syntax */
1549 JimParseCmd(pc);
1550 pc->tt = JIM_TT_EXPRSUGAR;
1551 return JIM_OK;
1553 #endif
1555 pc->tstart = pc->p;
1556 pc->tt = JIM_TT_VAR;
1557 pc->tline = pc->linenr;
1559 if (*pc->p == '{') {
1560 pc->tstart = ++pc->p;
1561 pc->len--;
1563 while (pc->len && *pc->p != '}') {
1564 if (*pc->p == '\n') {
1565 pc->linenr++;
1567 pc->p++;
1568 pc->len--;
1570 pc->tend = pc->p - 1;
1571 if (pc->len) {
1572 pc->p++;
1573 pc->len--;
1576 else {
1577 while (1) {
1578 /* Skip double colon, but not single colon! */
1579 if (pc->p[0] == ':' && pc->p[1] == ':') {
1580 while (*pc->p == ':') {
1581 pc->p++;
1582 pc->len--;
1584 continue;
1586 /* Note that any char >= 0x80 must be part of a utf-8 char.
1587 * We consider all unicode points outside of ASCII as letters
1589 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1590 pc->p++;
1591 pc->len--;
1592 continue;
1594 break;
1596 /* Parse [dict get] syntax sugar. */
1597 if (*pc->p == '(') {
1598 int count = 1;
1599 const char *paren = NULL;
1601 pc->tt = JIM_TT_DICTSUGAR;
1603 while (count && pc->len) {
1604 pc->p++;
1605 pc->len--;
1606 if (*pc->p == '\\' && pc->len >= 1) {
1607 pc->p++;
1608 pc->len--;
1610 else if (*pc->p == '(') {
1611 count++;
1613 else if (*pc->p == ')') {
1614 paren = pc->p;
1615 count--;
1618 if (count == 0) {
1619 pc->p++;
1620 pc->len--;
1622 else if (paren) {
1623 /* Did not find a matching paren. Back up */
1624 paren++;
1625 pc->len += (pc->p - paren);
1626 pc->p = paren;
1628 #ifndef EXPRSUGAR_BRACKET
1629 if (*pc->tstart == '(') {
1630 pc->tt = JIM_TT_EXPRSUGAR;
1632 #endif
1634 pc->tend = pc->p - 1;
1636 /* Check if we parsed just the '$' character.
1637 * That's not a variable so an error is returned
1638 * to tell the state machine to consider this '$' just
1639 * a string. */
1640 if (pc->tstart == pc->p) {
1641 pc->p--;
1642 pc->len++;
1643 return JIM_ERR;
1645 return JIM_OK;
1648 static int JimParseStr(struct JimParserCtx *pc)
1650 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1651 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1652 /* Starting a new word */
1653 if (*pc->p == '{') {
1654 return JimParseBrace(pc);
1656 if (*pc->p == '"') {
1657 pc->inquote = 1;
1658 pc->p++;
1659 pc->len--;
1660 /* In case the end quote is missing */
1661 pc->missing.line = pc->tline;
1664 pc->tstart = pc->p;
1665 pc->tline = pc->linenr;
1666 while (1) {
1667 if (pc->len == 0) {
1668 if (pc->inquote) {
1669 pc->missing.ch = '"';
1671 pc->tend = pc->p - 1;
1672 pc->tt = JIM_TT_ESC;
1673 return JIM_OK;
1675 switch (*pc->p) {
1676 case '\\':
1677 if (!pc->inquote && *(pc->p + 1) == '\n') {
1678 pc->tend = pc->p - 1;
1679 pc->tt = JIM_TT_ESC;
1680 return JIM_OK;
1682 if (pc->len >= 2) {
1683 if (*(pc->p + 1) == '\n') {
1684 pc->linenr++;
1686 pc->p++;
1687 pc->len--;
1689 else if (pc->len == 1) {
1690 /* End of script with trailing backslash */
1691 pc->missing.ch = '\\';
1693 break;
1694 case '(':
1695 /* If the following token is not '$' just keep going */
1696 if (pc->len > 1 && pc->p[1] != '$') {
1697 break;
1699 /* fall through */
1700 case ')':
1701 /* Only need a separate ')' token if the previous was a var */
1702 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1703 if (pc->p == pc->tstart) {
1704 /* At the start of the token, so just return this char */
1705 pc->p++;
1706 pc->len--;
1708 pc->tend = pc->p - 1;
1709 pc->tt = JIM_TT_ESC;
1710 return JIM_OK;
1712 break;
1714 case '$':
1715 case '[':
1716 pc->tend = pc->p - 1;
1717 pc->tt = JIM_TT_ESC;
1718 return JIM_OK;
1719 case ' ':
1720 case '\t':
1721 case '\n':
1722 case '\r':
1723 case '\f':
1724 case ';':
1725 if (!pc->inquote) {
1726 pc->tend = pc->p - 1;
1727 pc->tt = JIM_TT_ESC;
1728 return JIM_OK;
1730 else if (*pc->p == '\n') {
1731 pc->linenr++;
1733 break;
1734 case '"':
1735 if (pc->inquote) {
1736 pc->tend = pc->p - 1;
1737 pc->tt = JIM_TT_ESC;
1738 pc->p++;
1739 pc->len--;
1740 pc->inquote = 0;
1741 return JIM_OK;
1743 break;
1745 pc->p++;
1746 pc->len--;
1748 return JIM_OK; /* unreached */
1751 static int JimParseComment(struct JimParserCtx *pc)
1753 while (*pc->p) {
1754 if (*pc->p == '\\') {
1755 pc->p++;
1756 pc->len--;
1757 if (pc->len == 0) {
1758 pc->missing.ch = '\\';
1759 return JIM_OK;
1761 if (*pc->p == '\n') {
1762 pc->linenr++;
1765 else if (*pc->p == '\n') {
1766 pc->p++;
1767 pc->len--;
1768 pc->linenr++;
1769 break;
1771 pc->p++;
1772 pc->len--;
1774 return JIM_OK;
1777 /* xdigitval and odigitval are helper functions for JimEscape() */
1778 static int xdigitval(int c)
1780 if (c >= '0' && c <= '9')
1781 return c - '0';
1782 if (c >= 'a' && c <= 'f')
1783 return c - 'a' + 10;
1784 if (c >= 'A' && c <= 'F')
1785 return c - 'A' + 10;
1786 return -1;
1789 static int odigitval(int c)
1791 if (c >= '0' && c <= '7')
1792 return c - '0';
1793 return -1;
1796 /* Perform Tcl escape substitution of 's', storing the result
1797 * string into 'dest'. The escaped string is guaranteed to
1798 * be the same length or shorter than the source string.
1799 * slen is the length of the string at 's'.
1801 * The function returns the length of the resulting string. */
1802 static int JimEscape(char *dest, const char *s, int slen)
1804 char *p = dest;
1805 int i, len;
1807 for (i = 0; i < slen; i++) {
1808 switch (s[i]) {
1809 case '\\':
1810 switch (s[i + 1]) {
1811 case 'a':
1812 *p++ = 0x7;
1813 i++;
1814 break;
1815 case 'b':
1816 *p++ = 0x8;
1817 i++;
1818 break;
1819 case 'f':
1820 *p++ = 0xc;
1821 i++;
1822 break;
1823 case 'n':
1824 *p++ = 0xa;
1825 i++;
1826 break;
1827 case 'r':
1828 *p++ = 0xd;
1829 i++;
1830 break;
1831 case 't':
1832 *p++ = 0x9;
1833 i++;
1834 break;
1835 case 'u':
1836 case 'U':
1837 case 'x':
1838 /* A unicode or hex sequence.
1839 * \x Expect 1-2 hex chars and convert to hex.
1840 * \u Expect 1-4 hex chars and convert to utf-8.
1841 * \U Expect 1-8 hex chars and convert to utf-8.
1842 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1843 * An invalid sequence means simply the escaped char.
1846 unsigned val = 0;
1847 int k;
1848 int maxchars = 2;
1850 i++;
1852 if (s[i] == 'U') {
1853 maxchars = 8;
1855 else if (s[i] == 'u') {
1856 if (s[i + 1] == '{') {
1857 maxchars = 6;
1858 i++;
1860 else {
1861 maxchars = 4;
1865 for (k = 0; k < maxchars; k++) {
1866 int c = xdigitval(s[i + k + 1]);
1867 if (c == -1) {
1868 break;
1870 val = (val << 4) | c;
1872 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1873 if (s[i] == '{') {
1874 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1875 /* Back up */
1876 i--;
1877 k = 0;
1879 else {
1880 /* Skip the closing brace */
1881 k++;
1884 if (k) {
1885 /* Got a valid sequence, so convert */
1886 if (s[i] == 'x') {
1887 *p++ = val;
1889 else {
1890 p += utf8_fromunicode(p, val);
1892 i += k;
1893 break;
1895 /* Not a valid codepoint, just an escaped char */
1896 *p++ = s[i];
1898 break;
1899 case 'v':
1900 *p++ = 0xb;
1901 i++;
1902 break;
1903 case '\0':
1904 *p++ = '\\';
1905 i++;
1906 break;
1907 case '\n':
1908 /* Replace all spaces and tabs after backslash newline with a single space*/
1909 *p++ = ' ';
1910 do {
1911 i++;
1912 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1913 break;
1914 case '0':
1915 case '1':
1916 case '2':
1917 case '3':
1918 case '4':
1919 case '5':
1920 case '6':
1921 case '7':
1922 /* octal escape */
1924 int val = 0;
1925 int c = odigitval(s[i + 1]);
1927 val = c;
1928 c = odigitval(s[i + 2]);
1929 if (c == -1) {
1930 *p++ = val;
1931 i++;
1932 break;
1934 val = (val * 8) + c;
1935 c = odigitval(s[i + 3]);
1936 if (c == -1) {
1937 *p++ = val;
1938 i += 2;
1939 break;
1941 val = (val * 8) + c;
1942 *p++ = val;
1943 i += 3;
1945 break;
1946 default:
1947 *p++ = s[i + 1];
1948 i++;
1949 break;
1951 break;
1952 default:
1953 *p++ = s[i];
1954 break;
1957 len = p - dest;
1958 *p = '\0';
1959 return len;
1962 /* Returns a dynamically allocated copy of the current token in the
1963 * parser context. The function performs conversion of escapes if
1964 * the token is of type JIM_TT_ESC.
1966 * Note that after the conversion, tokens that are grouped with
1967 * braces in the source code, are always recognizable from the
1968 * identical string obtained in a different way from the type.
1970 * For example the string:
1972 * {*}$a
1974 * will return as first token "*", of type JIM_TT_STR
1976 * While the string:
1978 * *$a
1980 * will return as first token "*", of type JIM_TT_ESC
1982 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1984 const char *start, *end;
1985 char *token;
1986 int len;
1988 start = pc->tstart;
1989 end = pc->tend;
1990 len = (end - start) + 1;
1991 if (len < 0) {
1992 len = 0;
1994 token = Jim_Alloc(len + 1);
1995 if (pc->tt != JIM_TT_ESC) {
1996 /* No escape conversion needed? Just copy it. */
1997 memcpy(token, start, len);
1998 token[len] = '\0';
2000 else {
2001 /* Else convert the escape chars. */
2002 len = JimEscape(token, start, len);
2005 return Jim_NewStringObjNoAlloc(interp, token, len);
2008 /* -----------------------------------------------------------------------------
2009 * Tcl Lists parsing
2010 * ---------------------------------------------------------------------------*/
2011 static int JimParseListSep(struct JimParserCtx *pc);
2012 static int JimParseListStr(struct JimParserCtx *pc);
2013 static int JimParseListQuote(struct JimParserCtx *pc);
2015 static int JimParseList(struct JimParserCtx *pc)
2017 if (isspace(UCHAR(*pc->p))) {
2018 return JimParseListSep(pc);
2020 switch (*pc->p) {
2021 case '"':
2022 return JimParseListQuote(pc);
2024 case '{':
2025 return JimParseBrace(pc);
2027 default:
2028 if (pc->len) {
2029 return JimParseListStr(pc);
2031 break;
2034 pc->tstart = pc->tend = pc->p;
2035 pc->tline = pc->linenr;
2036 pc->tt = JIM_TT_EOL;
2037 pc->eof = 1;
2038 return JIM_OK;
2041 static int JimParseListSep(struct JimParserCtx *pc)
2043 pc->tstart = pc->p;
2044 pc->tline = pc->linenr;
2045 while (isspace(UCHAR(*pc->p))) {
2046 if (*pc->p == '\n') {
2047 pc->linenr++;
2049 pc->p++;
2050 pc->len--;
2052 pc->tend = pc->p - 1;
2053 pc->tt = JIM_TT_SEP;
2054 return JIM_OK;
2057 static int JimParseListQuote(struct JimParserCtx *pc)
2059 pc->p++;
2060 pc->len--;
2062 pc->tstart = pc->p;
2063 pc->tline = pc->linenr;
2064 pc->tt = JIM_TT_STR;
2066 while (pc->len) {
2067 switch (*pc->p) {
2068 case '\\':
2069 pc->tt = JIM_TT_ESC;
2070 if (--pc->len == 0) {
2071 /* Trailing backslash */
2072 pc->tend = pc->p;
2073 return JIM_OK;
2075 pc->p++;
2076 break;
2077 case '\n':
2078 pc->linenr++;
2079 break;
2080 case '"':
2081 pc->tend = pc->p - 1;
2082 pc->p++;
2083 pc->len--;
2084 return JIM_OK;
2086 pc->p++;
2087 pc->len--;
2090 pc->tend = pc->p - 1;
2091 return JIM_OK;
2094 static int JimParseListStr(struct JimParserCtx *pc)
2096 pc->tstart = pc->p;
2097 pc->tline = pc->linenr;
2098 pc->tt = JIM_TT_STR;
2100 while (pc->len) {
2101 if (isspace(UCHAR(*pc->p))) {
2102 pc->tend = pc->p - 1;
2103 return JIM_OK;
2105 if (*pc->p == '\\') {
2106 if (--pc->len == 0) {
2107 /* Trailing backslash */
2108 pc->tend = pc->p;
2109 return JIM_OK;
2111 pc->tt = JIM_TT_ESC;
2112 pc->p++;
2114 pc->p++;
2115 pc->len--;
2117 pc->tend = pc->p - 1;
2118 return JIM_OK;
2121 /* -----------------------------------------------------------------------------
2122 * Jim_Obj related functions
2123 * ---------------------------------------------------------------------------*/
2125 /* Return a new initialized object. */
2126 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2128 Jim_Obj *objPtr;
2130 /* -- Check if there are objects in the free list -- */
2131 if (interp->freeList != NULL) {
2132 /* -- Unlink the object from the free list -- */
2133 objPtr = interp->freeList;
2134 interp->freeList = objPtr->nextObjPtr;
2136 else {
2137 /* -- No ready to use objects: allocate a new one -- */
2138 objPtr = Jim_Alloc(sizeof(*objPtr));
2141 /* Object is returned with refCount of 0. Every
2142 * kind of GC implemented should take care to avoid
2143 * scanning objects with refCount == 0. */
2144 objPtr->refCount = 0;
2145 /* All the other fields are left uninitialized to save time.
2146 * The caller will probably want to set them to the right
2147 * value anyway. */
2149 /* -- Put the object into the live list -- */
2150 objPtr->prevObjPtr = NULL;
2151 objPtr->nextObjPtr = interp->liveList;
2152 if (interp->liveList)
2153 interp->liveList->prevObjPtr = objPtr;
2154 interp->liveList = objPtr;
2156 return objPtr;
2159 /* Free an object. Actually objects are never freed, but
2160 * just moved to the free objects list, where they will be
2161 * reused by Jim_NewObj(). */
2162 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2164 /* Check if the object was already freed, panic. */
2165 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2166 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2168 /* Free the internal representation */
2169 Jim_FreeIntRep(interp, objPtr);
2170 /* Free the string representation */
2171 if (objPtr->bytes != NULL) {
2172 if (objPtr->bytes != JimEmptyStringRep)
2173 Jim_Free(objPtr->bytes);
2175 /* Unlink the object from the live objects list */
2176 if (objPtr->prevObjPtr)
2177 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2178 if (objPtr->nextObjPtr)
2179 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2180 if (interp->liveList == objPtr)
2181 interp->liveList = objPtr->nextObjPtr;
2182 #ifdef JIM_DISABLE_OBJECT_POOL
2183 Jim_Free(objPtr);
2184 #else
2185 /* Link the object into the free objects list */
2186 objPtr->prevObjPtr = NULL;
2187 objPtr->nextObjPtr = interp->freeList;
2188 if (interp->freeList)
2189 interp->freeList->prevObjPtr = objPtr;
2190 interp->freeList = objPtr;
2191 objPtr->refCount = -1;
2192 #endif
2195 /* Invalidate the string representation of an object. */
2196 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2198 if (objPtr->bytes != NULL) {
2199 if (objPtr->bytes != JimEmptyStringRep)
2200 Jim_Free(objPtr->bytes);
2202 objPtr->bytes = NULL;
2205 /* Duplicate an object. The returned object has refcount = 0. */
2206 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2208 Jim_Obj *dupPtr;
2210 dupPtr = Jim_NewObj(interp);
2211 if (objPtr->bytes == NULL) {
2212 /* Object does not have a valid string representation. */
2213 dupPtr->bytes = NULL;
2215 else if (objPtr->length == 0) {
2216 /* Zero length, so don't even bother with the type-specific dup,
2217 * since all zero length objects look the same
2219 dupPtr->bytes = JimEmptyStringRep;
2220 dupPtr->length = 0;
2221 dupPtr->typePtr = NULL;
2222 return dupPtr;
2224 else {
2225 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2226 dupPtr->length = objPtr->length;
2227 /* Copy the null byte too */
2228 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2231 /* By default, the new object has the same type as the old object */
2232 dupPtr->typePtr = objPtr->typePtr;
2233 if (objPtr->typePtr != NULL) {
2234 if (objPtr->typePtr->dupIntRepProc == NULL) {
2235 dupPtr->internalRep = objPtr->internalRep;
2237 else {
2238 /* The dup proc may set a different type, e.g. NULL */
2239 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2242 return dupPtr;
2245 /* Return the string representation for objPtr. If the object's
2246 * string representation is invalid, calls the updateStringProc method to create
2247 * a new one from the internal representation of the object.
2249 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2251 if (objPtr->bytes == NULL) {
2252 /* Invalid string repr. Generate it. */
2253 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2254 objPtr->typePtr->updateStringProc(objPtr);
2256 if (lenPtr)
2257 *lenPtr = objPtr->length;
2258 return objPtr->bytes;
2261 /* Just returns the length (in bytes) of the object's string rep */
2262 int Jim_Length(Jim_Obj *objPtr)
2264 if (objPtr->bytes == NULL) {
2265 /* Invalid string repr. Generate it. */
2266 Jim_GetString(objPtr, NULL);
2268 return objPtr->length;
2271 /* Just returns object's string rep */
2272 const char *Jim_String(Jim_Obj *objPtr)
2274 if (objPtr->bytes == NULL) {
2275 /* Invalid string repr. Generate it. */
2276 Jim_GetString(objPtr, NULL);
2278 return objPtr->bytes;
2281 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2283 objPtr->bytes = Jim_StrDup(str);
2284 objPtr->length = strlen(str);
2287 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2288 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2290 static const Jim_ObjType dictSubstObjType = {
2291 "dict-substitution",
2292 FreeDictSubstInternalRep,
2293 DupDictSubstInternalRep,
2294 NULL,
2295 JIM_TYPE_NONE,
2298 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2299 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2301 static const Jim_ObjType interpolatedObjType = {
2302 "interpolated",
2303 FreeInterpolatedInternalRep,
2304 DupInterpolatedInternalRep,
2305 NULL,
2306 JIM_TYPE_NONE,
2309 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2311 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2314 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2316 /* Copy the interal rep */
2317 dupPtr->internalRep = srcPtr->internalRep;
2318 /* Need to increment the key ref count */
2319 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2322 /* -----------------------------------------------------------------------------
2323 * String Object
2324 * ---------------------------------------------------------------------------*/
2325 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2326 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2328 static const Jim_ObjType stringObjType = {
2329 "string",
2330 NULL,
2331 DupStringInternalRep,
2332 NULL,
2333 JIM_TYPE_REFERENCES,
2336 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2338 JIM_NOTUSED(interp);
2340 /* This is a bit subtle: the only caller of this function
2341 * should be Jim_DuplicateObj(), that will copy the
2342 * string representaion. After the copy, the duplicated
2343 * object will not have more room in the buffer than
2344 * srcPtr->length bytes. So we just set it to length. */
2345 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2346 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2349 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2351 if (objPtr->typePtr != &stringObjType) {
2352 /* Get a fresh string representation. */
2353 if (objPtr->bytes == NULL) {
2354 /* Invalid string repr. Generate it. */
2355 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2356 objPtr->typePtr->updateStringProc(objPtr);
2358 /* Free any other internal representation. */
2359 Jim_FreeIntRep(interp, objPtr);
2360 /* Set it as string, i.e. just set the maxLength field. */
2361 objPtr->typePtr = &stringObjType;
2362 objPtr->internalRep.strValue.maxLength = objPtr->length;
2363 /* Don't know the utf-8 length yet */
2364 objPtr->internalRep.strValue.charLength = -1;
2366 return JIM_OK;
2370 * Returns the length of the object string in chars, not bytes.
2372 * These may be different for a utf-8 string.
2374 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2376 #ifdef JIM_UTF8
2377 SetStringFromAny(interp, objPtr);
2379 if (objPtr->internalRep.strValue.charLength < 0) {
2380 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2382 return objPtr->internalRep.strValue.charLength;
2383 #else
2384 return Jim_Length(objPtr);
2385 #endif
2388 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2389 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2391 Jim_Obj *objPtr = Jim_NewObj(interp);
2393 /* Need to find out how many bytes the string requires */
2394 if (len == -1)
2395 len = strlen(s);
2396 /* Alloc/Set the string rep. */
2397 if (len == 0) {
2398 objPtr->bytes = JimEmptyStringRep;
2400 else {
2401 objPtr->bytes = Jim_StrDupLen(s, len);
2403 objPtr->length = len;
2405 /* No typePtr field for the vanilla string object. */
2406 objPtr->typePtr = NULL;
2407 return objPtr;
2410 /* charlen is in characters -- see also Jim_NewStringObj() */
2411 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2413 #ifdef JIM_UTF8
2414 /* Need to find out how many bytes the string requires */
2415 int bytelen = utf8_index(s, charlen);
2417 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2419 /* Remember the utf8 length, so set the type */
2420 objPtr->typePtr = &stringObjType;
2421 objPtr->internalRep.strValue.maxLength = bytelen;
2422 objPtr->internalRep.strValue.charLength = charlen;
2424 return objPtr;
2425 #else
2426 return Jim_NewStringObj(interp, s, charlen);
2427 #endif
2430 /* This version does not try to duplicate the 's' pointer, but
2431 * use it directly. */
2432 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2434 Jim_Obj *objPtr = Jim_NewObj(interp);
2436 objPtr->bytes = s;
2437 objPtr->length = (len == -1) ? strlen(s) : len;
2438 objPtr->typePtr = NULL;
2439 return objPtr;
2442 /* Low-level string append. Use it only against unshared objects
2443 * of type "string". */
2444 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2446 int needlen;
2448 if (len == -1)
2449 len = strlen(str);
2450 needlen = objPtr->length + len;
2451 if (objPtr->internalRep.strValue.maxLength < needlen ||
2452 objPtr->internalRep.strValue.maxLength == 0) {
2453 needlen *= 2;
2454 /* Inefficient to malloc() for less than 8 bytes */
2455 if (needlen < 7) {
2456 needlen = 7;
2458 if (objPtr->bytes == JimEmptyStringRep) {
2459 objPtr->bytes = Jim_Alloc(needlen + 1);
2461 else {
2462 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2464 objPtr->internalRep.strValue.maxLength = needlen;
2466 memcpy(objPtr->bytes + objPtr->length, str, len);
2467 objPtr->bytes[objPtr->length + len] = '\0';
2469 if (objPtr->internalRep.strValue.charLength >= 0) {
2470 /* Update the utf-8 char length */
2471 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2473 objPtr->length += len;
2476 /* Higher level API to append strings to objects.
2477 * Object must not be unshared for each of these.
2479 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2481 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2482 SetStringFromAny(interp, objPtr);
2483 StringAppendString(objPtr, str, len);
2486 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2488 int len;
2489 const char *str = Jim_GetString(appendObjPtr, &len);
2490 Jim_AppendString(interp, objPtr, str, len);
2493 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2495 va_list ap;
2497 SetStringFromAny(interp, objPtr);
2498 va_start(ap, objPtr);
2499 while (1) {
2500 const char *s = va_arg(ap, const char *);
2502 if (s == NULL)
2503 break;
2504 Jim_AppendString(interp, objPtr, s, -1);
2506 va_end(ap);
2509 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2511 if (aObjPtr == bObjPtr) {
2512 return 1;
2514 else {
2515 int Alen, Blen;
2516 const char *sA = Jim_GetString(aObjPtr, &Alen);
2517 const char *sB = Jim_GetString(bObjPtr, &Blen);
2519 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2524 * Note. Does not support embedded nulls in either the pattern or the object.
2526 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2528 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2531 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2533 const char *s1 = Jim_String(firstObjPtr);
2534 int l1 = Jim_Utf8Length(interp, firstObjPtr);
2535 const char *s2 = Jim_String(secondObjPtr);
2536 int l2 = Jim_Utf8Length(interp, secondObjPtr);
2537 return JimStringCompareUtf8(s1, l1, s2, l2, nocase);
2540 /* Convert a range, as returned by Jim_GetRange(), into
2541 * an absolute index into an object of the specified length.
2542 * This function may return negative values, or values
2543 * greater than or equal to the length of the list if the index
2544 * is out of range. */
2545 static int JimRelToAbsIndex(int len, int idx)
2547 if (idx < 0)
2548 return len + idx;
2549 return idx;
2552 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2553 * into a form suitable for implementation of commands like [string range] and [lrange].
2555 * The resulting range is guaranteed to address valid elements of
2556 * the structure.
2558 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2560 int rangeLen;
2562 if (*firstPtr > *lastPtr) {
2563 rangeLen = 0;
2565 else {
2566 rangeLen = *lastPtr - *firstPtr + 1;
2567 if (rangeLen) {
2568 if (*firstPtr < 0) {
2569 rangeLen += *firstPtr;
2570 *firstPtr = 0;
2572 if (*lastPtr >= len) {
2573 rangeLen -= (*lastPtr - (len - 1));
2574 *lastPtr = len - 1;
2578 if (rangeLen < 0)
2579 rangeLen = 0;
2581 *rangeLenPtr = rangeLen;
2584 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2585 int len, int *first, int *last, int *range)
2587 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2588 return JIM_ERR;
2590 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2591 return JIM_ERR;
2593 *first = JimRelToAbsIndex(len, *first);
2594 *last = JimRelToAbsIndex(len, *last);
2595 JimRelToAbsRange(len, first, last, range);
2596 return JIM_OK;
2599 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2600 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2602 int first, last;
2603 const char *str;
2604 int rangeLen;
2605 int bytelen;
2607 str = Jim_GetString(strObjPtr, &bytelen);
2609 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2610 return NULL;
2613 if (first == 0 && rangeLen == bytelen) {
2614 return strObjPtr;
2616 return Jim_NewStringObj(interp, str + first, rangeLen);
2619 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2620 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2622 #ifdef JIM_UTF8
2623 int first, last;
2624 const char *str;
2625 int len, rangeLen;
2626 int bytelen;
2628 str = Jim_GetString(strObjPtr, &bytelen);
2629 len = Jim_Utf8Length(interp, strObjPtr);
2631 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2632 return NULL;
2635 if (first == 0 && rangeLen == len) {
2636 return strObjPtr;
2638 if (len == bytelen) {
2639 /* ASCII optimisation */
2640 return Jim_NewStringObj(interp, str + first, rangeLen);
2642 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2643 #else
2644 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2645 #endif
2648 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2649 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2651 int first, last;
2652 const char *str;
2653 int len, rangeLen;
2654 Jim_Obj *objPtr;
2656 len = Jim_Utf8Length(interp, strObjPtr);
2658 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2659 return NULL;
2662 if (last < first) {
2663 return strObjPtr;
2666 str = Jim_String(strObjPtr);
2668 /* Before part */
2669 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2671 /* Replacement */
2672 if (newStrObj) {
2673 Jim_AppendObj(interp, objPtr, newStrObj);
2676 /* After part */
2677 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2679 return objPtr;
2683 * Note: does not support embedded nulls.
2685 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2687 while (*str) {
2688 int c;
2689 str += utf8_tounicode(str, &c);
2690 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2692 *dest = 0;
2696 * Note: does not support embedded nulls.
2698 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2700 char *buf;
2701 int len;
2702 const char *str;
2704 str = Jim_GetString(strObjPtr, &len);
2706 #ifdef JIM_UTF8
2707 /* Case mapping can change the utf-8 length of the string.
2708 * But at worst it will be by one extra byte per char
2710 len *= 2;
2711 #endif
2712 buf = Jim_Alloc(len + 1);
2713 JimStrCopyUpperLower(buf, str, 0);
2714 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2718 * Note: does not support embedded nulls.
2720 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2722 char *buf;
2723 const char *str;
2724 int len;
2726 str = Jim_GetString(strObjPtr, &len);
2728 #ifdef JIM_UTF8
2729 /* Case mapping can change the utf-8 length of the string.
2730 * But at worst it will be by one extra byte per char
2732 len *= 2;
2733 #endif
2734 buf = Jim_Alloc(len + 1);
2735 JimStrCopyUpperLower(buf, str, 1);
2736 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2740 * Note: does not support embedded nulls.
2742 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2744 char *buf, *p;
2745 int len;
2746 int c;
2747 const char *str;
2749 str = Jim_GetString(strObjPtr, &len);
2751 #ifdef JIM_UTF8
2752 /* Case mapping can change the utf-8 length of the string.
2753 * But at worst it will be by one extra byte per char
2755 len *= 2;
2756 #endif
2757 buf = p = Jim_Alloc(len + 1);
2759 str += utf8_tounicode(str, &c);
2760 p += utf8_getchars(p, utf8_title(c));
2762 JimStrCopyUpperLower(p, str, 0);
2764 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2767 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2768 * for unicode character 'c'.
2769 * Returns the position if found or NULL if not
2771 static const char *utf8_memchr(const char *str, int len, int c)
2773 #ifdef JIM_UTF8
2774 while (len) {
2775 int sc;
2776 int n = utf8_tounicode(str, &sc);
2777 if (sc == c) {
2778 return str;
2780 str += n;
2781 len -= n;
2783 return NULL;
2784 #else
2785 return memchr(str, c, len);
2786 #endif
2790 * Searches for the first non-trim char in string (str, len)
2792 * If none is found, returns just past the last char.
2794 * Lengths are in bytes.
2796 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2798 while (len) {
2799 int c;
2800 int n = utf8_tounicode(str, &c);
2802 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2803 /* Not a trim char, so stop */
2804 break;
2806 str += n;
2807 len -= n;
2809 return str;
2813 * Searches backwards for a non-trim char in string (str, len).
2815 * Returns a pointer to just after the non-trim char, or NULL if not found.
2817 * Lengths are in bytes.
2819 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2821 str += len;
2823 while (len) {
2824 int c;
2825 int n = utf8_prev_len(str, len);
2827 len -= n;
2828 str -= n;
2830 n = utf8_tounicode(str, &c);
2832 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2833 return str + n;
2837 return NULL;
2840 static const char default_trim_chars[] = " \t\n\r";
2841 /* sizeof() here includes the null byte */
2842 static int default_trim_chars_len = sizeof(default_trim_chars);
2844 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2846 int len;
2847 const char *str = Jim_GetString(strObjPtr, &len);
2848 const char *trimchars = default_trim_chars;
2849 int trimcharslen = default_trim_chars_len;
2850 const char *newstr;
2852 if (trimcharsObjPtr) {
2853 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2856 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2857 if (newstr == str) {
2858 return strObjPtr;
2861 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2864 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2866 int len;
2867 const char *trimchars = default_trim_chars;
2868 int trimcharslen = default_trim_chars_len;
2869 const char *nontrim;
2871 if (trimcharsObjPtr) {
2872 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2875 SetStringFromAny(interp, strObjPtr);
2877 len = Jim_Length(strObjPtr);
2878 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2880 if (nontrim == NULL) {
2881 /* All trim, so return a zero-length string */
2882 return Jim_NewEmptyStringObj(interp);
2884 if (nontrim == strObjPtr->bytes + len) {
2885 /* All non-trim, so return the original object */
2886 return strObjPtr;
2889 if (Jim_IsShared(strObjPtr)) {
2890 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2892 else {
2893 /* Can modify this string in place */
2894 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2895 strObjPtr->length = (nontrim - strObjPtr->bytes);
2898 return strObjPtr;
2901 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2903 /* First trim left. */
2904 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2906 /* Now trim right */
2907 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2909 /* Note: refCount check is needed since objPtr may be emptyObj */
2910 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2911 /* We don't want this object to be leaked */
2912 Jim_FreeNewObj(interp, objPtr);
2915 return strObjPtr;
2918 /* Some platforms don't have isascii - need a non-macro version */
2919 #ifdef HAVE_ISASCII
2920 #define jim_isascii isascii
2921 #else
2922 static int jim_isascii(int c)
2924 return !(c & ~0x7f);
2926 #endif
2928 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2930 static const char * const strclassnames[] = {
2931 "integer", "alpha", "alnum", "ascii", "digit",
2932 "double", "lower", "upper", "space", "xdigit",
2933 "control", "print", "graph", "punct", "boolean",
2934 NULL
2936 enum {
2937 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2938 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2939 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2941 int strclass;
2942 int len;
2943 int i;
2944 const char *str;
2945 int (*isclassfunc)(int c) = NULL;
2947 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2948 return JIM_ERR;
2951 str = Jim_GetString(strObjPtr, &len);
2952 if (len == 0) {
2953 Jim_SetResultBool(interp, !strict);
2954 return JIM_OK;
2957 switch (strclass) {
2958 case STR_IS_INTEGER:
2960 jim_wide w;
2961 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2962 return JIM_OK;
2965 case STR_IS_DOUBLE:
2967 double d;
2968 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
2969 return JIM_OK;
2972 case STR_IS_BOOLEAN:
2974 int b;
2975 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
2976 return JIM_OK;
2979 case STR_IS_ALPHA: isclassfunc = isalpha; break;
2980 case STR_IS_ALNUM: isclassfunc = isalnum; break;
2981 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
2982 case STR_IS_DIGIT: isclassfunc = isdigit; break;
2983 case STR_IS_LOWER: isclassfunc = islower; break;
2984 case STR_IS_UPPER: isclassfunc = isupper; break;
2985 case STR_IS_SPACE: isclassfunc = isspace; break;
2986 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
2987 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
2988 case STR_IS_PRINT: isclassfunc = isprint; break;
2989 case STR_IS_GRAPH: isclassfunc = isgraph; break;
2990 case STR_IS_PUNCT: isclassfunc = ispunct; break;
2991 default:
2992 return JIM_ERR;
2995 for (i = 0; i < len; i++) {
2996 if (!isclassfunc(UCHAR(str[i]))) {
2997 Jim_SetResultBool(interp, 0);
2998 return JIM_OK;
3001 Jim_SetResultBool(interp, 1);
3002 return JIM_OK;
3005 /* -----------------------------------------------------------------------------
3006 * Compared String Object
3007 * ---------------------------------------------------------------------------*/
3009 /* This is strange object that allows comparison of a C literal string
3010 * with a Jim object in a very short time if the same comparison is done
3011 * multiple times. For example every time the [if] command is executed,
3012 * Jim has to check if a given argument is "else".
3013 * If the code has no errors, this comparison is true most of the time,
3014 * so we can cache the pointer of the string of the last matching
3015 * comparison inside the object. Because most C compilers perform literal sharing,
3016 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3017 * this works pretty well even if comparisons are at different places
3018 * inside the C code. */
3020 static const Jim_ObjType comparedStringObjType = {
3021 "compared-string",
3022 NULL,
3023 NULL,
3024 NULL,
3025 JIM_TYPE_REFERENCES,
3028 /* The only way this object is exposed to the API is via the following
3029 * function. Returns true if the string and the object string repr.
3030 * are the same, otherwise zero is returned.
3032 * Note: this isn't binary safe, but it hardly needs to be.*/
3033 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3035 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3036 return 1;
3038 else {
3039 if (strcmp(str, Jim_String(objPtr)) != 0)
3040 return 0;
3042 if (objPtr->typePtr != &comparedStringObjType) {
3043 Jim_FreeIntRep(interp, objPtr);
3044 objPtr->typePtr = &comparedStringObjType;
3046 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3047 return 1;
3051 static int qsortCompareStringPointers(const void *a, const void *b)
3053 char *const *sa = (char *const *)a;
3054 char *const *sb = (char *const *)b;
3056 return strcmp(*sa, *sb);
3060 /* -----------------------------------------------------------------------------
3061 * Source Object
3063 * This object is just a string from the language point of view, but
3064 * the internal representation contains the filename and line number
3065 * where this token was read. This information is used by
3066 * Jim_EvalObj() if the object passed happens to be of type "source".
3068 * This allows propagation of the information about line numbers and file
3069 * names and gives error messages with absolute line numbers.
3071 * Note that this object uses the internal representation of the Jim_Object,
3072 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3074 * Also the object will be converted to something else if the given
3075 * token it represents in the source file is not something to be
3076 * evaluated (not a script), and will be specialized in some other way,
3077 * so the time overhead is also almost zero.
3078 * ---------------------------------------------------------------------------*/
3080 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3081 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3083 static const Jim_ObjType sourceObjType = {
3084 "source",
3085 FreeSourceInternalRep,
3086 DupSourceInternalRep,
3087 NULL,
3088 JIM_TYPE_REFERENCES,
3091 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3093 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3096 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3098 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3099 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3102 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3103 Jim_Obj *fileNameObj, int lineNumber)
3105 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3106 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3107 Jim_IncrRefCount(fileNameObj);
3108 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3109 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3110 objPtr->typePtr = &sourceObjType;
3113 /* -----------------------------------------------------------------------------
3114 * ScriptLine Object
3116 * This object is used only in the Script internal represenation.
3117 * For each line of the script, it holds the number of tokens on the line
3118 * and the source line number.
3120 static const Jim_ObjType scriptLineObjType = {
3121 "scriptline",
3122 NULL,
3123 NULL,
3124 NULL,
3125 JIM_NONE,
3128 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3130 Jim_Obj *objPtr;
3132 #ifdef DEBUG_SHOW_SCRIPT
3133 char buf[100];
3134 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3135 objPtr = Jim_NewStringObj(interp, buf, -1);
3136 #else
3137 objPtr = Jim_NewEmptyStringObj(interp);
3138 #endif
3139 objPtr->typePtr = &scriptLineObjType;
3140 objPtr->internalRep.scriptLineValue.argc = argc;
3141 objPtr->internalRep.scriptLineValue.line = line;
3143 return objPtr;
3146 /* -----------------------------------------------------------------------------
3147 * Script Object
3149 * This object holds the parsed internal representation of a script.
3150 * This representation is help within an allocated ScriptObj (see below)
3152 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3153 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3155 static const Jim_ObjType scriptObjType = {
3156 "script",
3157 FreeScriptInternalRep,
3158 DupScriptInternalRep,
3159 NULL,
3160 JIM_TYPE_REFERENCES,
3163 /* Each token of a script is represented by a ScriptToken.
3164 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3165 * can be specialized by commands operating on it.
3167 typedef struct ScriptToken
3169 Jim_Obj *objPtr;
3170 int type;
3171 } ScriptToken;
3173 /* This is the script object internal representation. An array of
3174 * ScriptToken structures, including a pre-computed representation of the
3175 * command length and arguments.
3177 * For example the script:
3179 * puts hello
3180 * set $i $x$y [foo]BAR
3182 * will produce a ScriptObj with the following ScriptToken's:
3184 * LIN 2
3185 * ESC puts
3186 * ESC hello
3187 * LIN 4
3188 * ESC set
3189 * VAR i
3190 * WRD 2
3191 * VAR x
3192 * VAR y
3193 * WRD 2
3194 * CMD foo
3195 * ESC BAR
3197 * "puts hello" has two args (LIN 2), composed of single tokens.
3198 * (Note that the WRD token is omitted for the common case of a single token.)
3200 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3201 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3203 * The precomputation of the command structure makes Jim_Eval() faster,
3204 * and simpler because there aren't dynamic lengths / allocations.
3206 * -- {expand}/{*} handling --
3208 * Expand is handled in a special way.
3210 * If a "word" begins with {*}, the word token count is -ve.
3212 * For example the command:
3214 * list {*}{a b}
3216 * Will produce the following cmdstruct array:
3218 * LIN 2
3219 * ESC list
3220 * WRD -1
3221 * STR a b
3223 * Note that the 'LIN' token also contains the source information for the
3224 * first word of the line for error reporting purposes
3226 * -- the substFlags field of the structure --
3228 * The scriptObj structure is used to represent both "script" objects
3229 * and "subst" objects. In the second case, there are no LIN and WRD
3230 * tokens. Instead SEP and EOL tokens are added as-is.
3231 * In addition, the field 'substFlags' is used to represent the flags used to turn
3232 * the string into the internal representation.
3233 * If these flags do not match what the application requires,
3234 * the scriptObj is created again. For example the script:
3236 * subst -nocommands $string
3237 * subst -novariables $string
3239 * Will (re)create the internal representation of the $string object
3240 * two times.
3242 typedef struct ScriptObj
3244 ScriptToken *token; /* Tokens array. */
3245 Jim_Obj *fileNameObj; /* Filename */
3246 int len; /* Length of token[] */
3247 int substFlags; /* flags used for the compilation of "subst" objects */
3248 int inUse; /* Used to share a ScriptObj. Currently
3249 only used by Jim_EvalObj() as protection against
3250 shimmering of the currently evaluated object. */
3251 int firstline; /* Line number of the first line */
3252 int linenr; /* Error line number, if any */
3253 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3254 } ScriptObj;
3256 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3257 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3258 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3260 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3262 int i;
3263 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3265 if (--script->inUse != 0)
3266 return;
3267 for (i = 0; i < script->len; i++) {
3268 Jim_DecrRefCount(interp, script->token[i].objPtr);
3270 Jim_Free(script->token);
3271 Jim_DecrRefCount(interp, script->fileNameObj);
3272 Jim_Free(script);
3275 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3277 JIM_NOTUSED(interp);
3278 JIM_NOTUSED(srcPtr);
3280 /* Just return a simple string. We don't try to preserve the source info
3281 * since in practice scripts are never duplicated
3283 dupPtr->typePtr = NULL;
3286 /* A simple parse token.
3287 * As the script is parsed, the created tokens point into the script string rep.
3289 typedef struct
3291 const char *token; /* Pointer to the start of the token */
3292 int len; /* Length of this token */
3293 int type; /* Token type */
3294 int line; /* Line number */
3295 } ParseToken;
3297 /* A list of parsed tokens representing a script.
3298 * Tokens are added to this list as the script is parsed.
3299 * It grows as needed.
3301 typedef struct
3303 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3304 ParseToken *list; /* Array of tokens */
3305 int size; /* Current size of the list */
3306 int count; /* Number of entries used */
3307 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3308 } ParseTokenList;
3310 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3312 tokenlist->list = tokenlist->static_list;
3313 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3314 tokenlist->count = 0;
3317 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3319 if (tokenlist->list != tokenlist->static_list) {
3320 Jim_Free(tokenlist->list);
3325 * Adds the new token to the tokenlist.
3326 * The token has the given length, type and line number.
3327 * The token list is resized as necessary.
3329 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3330 int line)
3332 ParseToken *t;
3334 if (tokenlist->count == tokenlist->size) {
3335 /* Resize the list */
3336 tokenlist->size *= 2;
3337 if (tokenlist->list != tokenlist->static_list) {
3338 tokenlist->list =
3339 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3341 else {
3342 /* The list needs to become allocated */
3343 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3344 memcpy(tokenlist->list, tokenlist->static_list,
3345 tokenlist->count * sizeof(*tokenlist->list));
3348 t = &tokenlist->list[tokenlist->count++];
3349 t->token = token;
3350 t->len = len;
3351 t->type = type;
3352 t->line = line;
3355 /* Counts the number of adjoining non-separator tokens.
3357 * Returns -ve if the first token is the expansion
3358 * operator (in which case the count doesn't include
3359 * that token).
3361 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3363 int expand = 1;
3364 int count = 0;
3366 /* Is the first word {*} or {expand}? */
3367 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3368 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3369 /* Create an expand token */
3370 expand = -1;
3371 t++;
3373 else {
3374 if (script->missing == ' ') {
3375 /* This is a "extra characters after close-brace" error. Report the first error */
3376 script->missing = '}';
3377 script->linenr = t[1].line;
3382 /* Now count non-separator words */
3383 while (!TOKEN_IS_SEP(t->type)) {
3384 t++;
3385 count++;
3388 return count * expand;
3392 * Create a script/subst object from the given token.
3394 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3396 Jim_Obj *objPtr;
3398 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3399 /* Convert backlash escapes. The result will never be longer than the original */
3400 int len = t->len;
3401 char *str = Jim_Alloc(len + 1);
3402 len = JimEscape(str, t->token, len);
3403 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3405 else {
3406 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3407 * with a single space.
3409 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3411 return objPtr;
3415 * Takes a tokenlist and creates the allocated list of script tokens
3416 * in script->token, of length script->len.
3418 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3419 * as required.
3421 * Also sets script->line to the line number of the first token
3423 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3424 ParseTokenList *tokenlist)
3426 int i;
3427 struct ScriptToken *token;
3428 /* Number of tokens so far for the current command */
3429 int lineargs = 0;
3430 /* This is the first token for the current command */
3431 ScriptToken *linefirst;
3432 int count;
3433 int linenr;
3435 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3436 printf("==== Tokens ====\n");
3437 for (i = 0; i < tokenlist->count; i++) {
3438 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3439 tokenlist->list[i].len, tokenlist->list[i].token);
3441 #endif
3443 /* May need up to one extra script token for each EOL in the worst case */
3444 count = tokenlist->count;
3445 for (i = 0; i < tokenlist->count; i++) {
3446 if (tokenlist->list[i].type == JIM_TT_EOL) {
3447 count++;
3450 linenr = script->firstline = tokenlist->list[0].line;
3452 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3454 /* This is the first token for the current command */
3455 linefirst = token++;
3457 for (i = 0; i < tokenlist->count; ) {
3458 /* Look ahead to find out how many tokens make up the next word */
3459 int wordtokens;
3461 /* Skip any leading separators */
3462 while (tokenlist->list[i].type == JIM_TT_SEP) {
3463 i++;
3466 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3468 if (wordtokens == 0) {
3469 /* None, so at end of line */
3470 if (lineargs) {
3471 linefirst->type = JIM_TT_LINE;
3472 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3473 Jim_IncrRefCount(linefirst->objPtr);
3475 /* Reset for new line */
3476 lineargs = 0;
3477 linefirst = token++;
3479 i++;
3480 continue;
3482 else if (wordtokens != 1) {
3483 /* More than 1, or {*}, so insert a WORD token */
3484 token->type = JIM_TT_WORD;
3485 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3486 Jim_IncrRefCount(token->objPtr);
3487 token++;
3488 if (wordtokens < 0) {
3489 /* Skip the expand token */
3490 i++;
3491 wordtokens = -wordtokens - 1;
3492 lineargs--;
3496 if (lineargs == 0) {
3497 /* First real token on the line, so record the line number */
3498 linenr = tokenlist->list[i].line;
3500 lineargs++;
3502 /* Add each non-separator word token to the line */
3503 while (wordtokens--) {
3504 const ParseToken *t = &tokenlist->list[i++];
3506 token->type = t->type;
3507 token->objPtr = JimMakeScriptObj(interp, t);
3508 Jim_IncrRefCount(token->objPtr);
3510 /* Every object is initially a string of type 'source', but the
3511 * internal type may be specialized during execution of the
3512 * script. */
3513 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3514 token++;
3518 if (lineargs == 0) {
3519 token--;
3522 script->len = token - script->token;
3524 JimPanic((script->len >= count, "allocated script array is too short"));
3526 #ifdef DEBUG_SHOW_SCRIPT
3527 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3528 for (i = 0; i < script->len; i++) {
3529 const ScriptToken *t = &script->token[i];
3530 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3532 #endif
3536 /* Parses the given string object to determine if it represents a complete script.
3538 * This is useful for interactive shells implementation, for [info complete].
3540 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3541 * '{' on scripts incomplete missing one or more '}' to be balanced.
3542 * '[' on scripts incomplete missing one or more ']' to be balanced.
3543 * '"' on scripts incomplete missing a '"' char.
3544 * '\\' on scripts with a trailing backslash.
3546 * If the script is complete, 1 is returned, otherwise 0.
3548 * If the script has extra characters after a close brace, this still returns 1,
3549 * but sets *stateCharPtr to '}'
3550 * Evaluating the script will give the error "extra characters after close-brace".
3552 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3554 ScriptObj *script = JimGetScript(interp, scriptObj);
3555 if (stateCharPtr) {
3556 *stateCharPtr = script->missing;
3558 return script->missing == ' ' || script->missing == '}';
3562 * Sets an appropriate error message for a missing script/expression terminator.
3564 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3566 * Note that a trailing backslash is not considered to be an error.
3568 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3570 const char *msg;
3572 switch (ch) {
3573 case '\\':
3574 case ' ':
3575 return JIM_OK;
3577 case '[':
3578 msg = "unmatched \"[\"";
3579 break;
3580 case '{':
3581 msg = "missing close-brace";
3582 break;
3583 case '}':
3584 msg = "extra characters after close-brace";
3585 break;
3586 case '"':
3587 default:
3588 msg = "missing quote";
3589 break;
3592 Jim_SetResultString(interp, msg, -1);
3593 return JIM_ERR;
3597 * Similar to ScriptObjAddTokens(), but for subst objects.
3599 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3600 ParseTokenList *tokenlist)
3602 int i;
3603 struct ScriptToken *token;
3605 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3607 for (i = 0; i < tokenlist->count; i++) {
3608 const ParseToken *t = &tokenlist->list[i];
3610 /* Create a token for 't' */
3611 token->type = t->type;
3612 token->objPtr = JimMakeScriptObj(interp, t);
3613 Jim_IncrRefCount(token->objPtr);
3614 token++;
3617 script->len = i;
3620 /* This method takes the string representation of an object
3621 * as a Tcl script, and generates the pre-parsed internal representation
3622 * of the script.
3624 * On parse error, sets an error message and returns JIM_ERR
3625 * (Note: the object is still converted to a script, even if an error occurs)
3627 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3629 int scriptTextLen;
3630 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3631 struct JimParserCtx parser;
3632 struct ScriptObj *script;
3633 ParseTokenList tokenlist;
3634 int line = 1;
3636 /* Try to get information about filename / line number */
3637 if (objPtr->typePtr == &sourceObjType) {
3638 line = objPtr->internalRep.sourceValue.lineNumber;
3641 /* Initially parse the script into tokens (in tokenlist) */
3642 ScriptTokenListInit(&tokenlist);
3644 JimParserInit(&parser, scriptText, scriptTextLen, line);
3645 while (!parser.eof) {
3646 JimParseScript(&parser);
3647 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3648 parser.tline);
3651 /* Add a final EOF token */
3652 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3654 /* Create the "real" script tokens from the parsed tokens */
3655 script = Jim_Alloc(sizeof(*script));
3656 memset(script, 0, sizeof(*script));
3657 script->inUse = 1;
3658 if (objPtr->typePtr == &sourceObjType) {
3659 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3661 else {
3662 script->fileNameObj = interp->emptyObj;
3664 Jim_IncrRefCount(script->fileNameObj);
3665 script->missing = parser.missing.ch;
3666 script->linenr = parser.missing.line;
3668 ScriptObjAddTokens(interp, script, &tokenlist);
3670 /* No longer need the token list */
3671 ScriptTokenListFree(&tokenlist);
3673 /* Free the old internal rep and set the new one. */
3674 Jim_FreeIntRep(interp, objPtr);
3675 Jim_SetIntRepPtr(objPtr, script);
3676 objPtr->typePtr = &scriptObjType;
3679 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3682 * Returns the parsed script.
3683 * Note that if there is any possibility that the script is not valid,
3684 * call JimScriptValid() to check
3686 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3688 if (objPtr == interp->emptyObj) {
3689 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3690 objPtr = interp->nullScriptObj;
3693 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3694 JimSetScriptFromAny(interp, objPtr);
3697 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3701 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3702 * and leaves an error message in the interp result.
3705 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3707 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3708 JimAddErrorToStack(interp, script);
3709 return 0;
3711 return 1;
3715 /* -----------------------------------------------------------------------------
3716 * Commands
3717 * ---------------------------------------------------------------------------*/
3718 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3720 cmdPtr->inUse++;
3723 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3725 if (--cmdPtr->inUse == 0) {
3726 if (cmdPtr->isproc) {
3727 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3728 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3729 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3730 if (cmdPtr->u.proc.staticVars) {
3731 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3732 Jim_Free(cmdPtr->u.proc.staticVars);
3735 else {
3736 /* native (C) */
3737 if (cmdPtr->u.native.delProc) {
3738 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3741 if (cmdPtr->prevCmd) {
3742 /* Delete any pushed command too */
3743 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3745 Jim_Free(cmdPtr);
3749 /* Variables HashTable Type.
3751 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3753 static void JimVariablesHTValDestructor(void *interp, void *val)
3755 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3756 Jim_Free(val);
3759 static const Jim_HashTableType JimVariablesHashTableType = {
3760 JimStringCopyHTHashFunction, /* hash function */
3761 JimStringCopyHTDup, /* key dup */
3762 NULL, /* val dup */
3763 JimStringCopyHTKeyCompare, /* key compare */
3764 JimStringCopyHTKeyDestructor, /* key destructor */
3765 JimVariablesHTValDestructor /* val destructor */
3768 /* Commands HashTable Type.
3770 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3772 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3774 JimDecrCmdRefCount(interp, val);
3777 static const Jim_HashTableType JimCommandsHashTableType = {
3778 JimStringCopyHTHashFunction, /* hash function */
3779 JimStringCopyHTDup, /* key dup */
3780 NULL, /* val dup */
3781 JimStringCopyHTKeyCompare, /* key compare */
3782 JimStringCopyHTKeyDestructor, /* key destructor */
3783 JimCommandsHT_ValDestructor /* val destructor */
3786 /* ------------------------- Commands related functions --------------------- */
3788 #ifdef jim_ext_namespace
3790 * Returns the "unscoped" version of the given namespace.
3791 * That is, the fully qualified name without the leading ::
3792 * The returned value is either nsObj, or an object with a zero ref count.
3794 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3796 const char *name = Jim_String(nsObj);
3797 if (name[0] == ':' && name[1] == ':') {
3798 /* This command is being defined in the global namespace */
3799 while (*++name == ':') {
3801 nsObj = Jim_NewStringObj(interp, name, -1);
3803 else if (Jim_Length(interp->framePtr->nsObj)) {
3804 /* This command is being defined in a non-global namespace */
3805 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3806 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3808 return nsObj;
3812 * If nameObjPtr starts with "::", returns it.
3813 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3814 * In this case, decrements the ref count of nameObjPtr.
3816 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3818 Jim_Obj *resultObj;
3820 const char *name = Jim_String(nameObjPtr);
3821 if (name[0] == ':' && name[1] == ':') {
3822 return nameObjPtr;
3824 Jim_IncrRefCount(nameObjPtr);
3825 resultObj = Jim_NewStringObj(interp, "::", -1);
3826 Jim_AppendObj(interp, resultObj, nameObjPtr);
3827 Jim_DecrRefCount(interp, nameObjPtr);
3829 return resultObj;
3833 * An efficient version of JimQualifyNameObj() where the name is
3834 * available (and needed) as a 'const char *'.
3835 * Avoids creating an object if not necessary.
3836 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3838 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3840 Jim_Obj *objPtr = interp->emptyObj;
3842 if (name[0] == ':' && name[1] == ':') {
3843 /* This command is being defined in the global namespace */
3844 while (*++name == ':') {
3847 else if (Jim_Length(interp->framePtr->nsObj)) {
3848 /* This command is being defined in a non-global namespace */
3849 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3850 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3851 name = Jim_String(objPtr);
3853 Jim_IncrRefCount(objPtr);
3854 *objPtrPtr = objPtr;
3855 return name;
3858 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3860 #else
3861 /* We can be more efficient in the no-namespace case */
3862 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3863 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3865 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3867 return nameObjPtr;
3869 #endif
3871 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3873 /* It may already exist, so we try to delete the old one.
3874 * Note that reference count means that it won't be deleted yet if
3875 * it exists in the call stack.
3877 * BUT, if 'local' is in force, instead of deleting the existing
3878 * proc, we stash a reference to the old proc here.
3880 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3881 if (he) {
3882 /* There was an old cmd with the same name,
3883 * so this requires a 'proc epoch' update. */
3885 /* If a procedure with the same name didn't exist there is no need
3886 * to increment the 'proc epoch' because creation of a new procedure
3887 * can never affect existing cached commands. We don't do
3888 * negative caching. */
3889 Jim_InterpIncrProcEpoch(interp);
3892 if (he && interp->local) {
3893 /* Push this command over the top of the previous one */
3894 cmd->prevCmd = Jim_GetHashEntryVal(he);
3895 Jim_SetHashVal(&interp->commands, he, cmd);
3897 else {
3898 if (he) {
3899 /* Replace the existing command */
3900 Jim_DeleteHashEntry(&interp->commands, name);
3903 Jim_AddHashEntry(&interp->commands, name, cmd);
3905 return JIM_OK;
3909 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3910 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3912 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3914 /* Store the new details for this command */
3915 memset(cmdPtr, 0, sizeof(*cmdPtr));
3916 cmdPtr->inUse = 1;
3917 cmdPtr->u.native.delProc = delProc;
3918 cmdPtr->u.native.cmdProc = cmdProc;
3919 cmdPtr->u.native.privData = privData;
3921 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3923 return JIM_OK;
3926 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3928 int len, i;
3930 len = Jim_ListLength(interp, staticsListObjPtr);
3931 if (len == 0) {
3932 return JIM_OK;
3935 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3936 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3937 for (i = 0; i < len; i++) {
3938 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3939 Jim_Var *varPtr;
3940 int subLen;
3942 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3943 /* Check if it's composed of two elements. */
3944 subLen = Jim_ListLength(interp, objPtr);
3945 if (subLen == 1 || subLen == 2) {
3946 /* Try to get the variable value from the current
3947 * environment. */
3948 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3949 if (subLen == 1) {
3950 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3951 if (initObjPtr == NULL) {
3952 Jim_SetResultFormatted(interp,
3953 "variable for initialization of static \"%#s\" not found in the local context",
3954 nameObjPtr);
3955 return JIM_ERR;
3958 else {
3959 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3961 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3962 return JIM_ERR;
3965 varPtr = Jim_Alloc(sizeof(*varPtr));
3966 varPtr->objPtr = initObjPtr;
3967 Jim_IncrRefCount(initObjPtr);
3968 varPtr->linkFramePtr = NULL;
3969 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3970 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3971 Jim_SetResultFormatted(interp,
3972 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3973 Jim_DecrRefCount(interp, initObjPtr);
3974 Jim_Free(varPtr);
3975 return JIM_ERR;
3978 else {
3979 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3980 objPtr);
3981 return JIM_ERR;
3984 return JIM_OK;
3988 * If the command is a proc, sets/updates the cached namespace (nsObj)
3989 * based on the command name.
3991 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3993 #ifdef jim_ext_namespace
3994 if (cmdPtr->isproc) {
3995 /* XXX: Really need JimNamespaceSplit() */
3996 const char *pt = strrchr(cmdname, ':');
3997 if (pt && pt != cmdname && pt[-1] == ':') {
3998 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3999 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4000 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4002 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4003 /* This command shadows a global command, so a proc epoch update is required */
4004 Jim_InterpIncrProcEpoch(interp);
4008 #endif
4011 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4012 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4014 Jim_Cmd *cmdPtr;
4015 int argListLen;
4016 int i;
4018 argListLen = Jim_ListLength(interp, argListObjPtr);
4020 /* Allocate space for both the command pointer and the arg list */
4021 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4022 memset(cmdPtr, 0, sizeof(*cmdPtr));
4023 cmdPtr->inUse = 1;
4024 cmdPtr->isproc = 1;
4025 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4026 cmdPtr->u.proc.argListLen = argListLen;
4027 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4028 cmdPtr->u.proc.argsPos = -1;
4029 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4030 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4031 Jim_IncrRefCount(argListObjPtr);
4032 Jim_IncrRefCount(bodyObjPtr);
4033 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4035 /* Create the statics hash table. */
4036 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4037 goto err;
4040 /* Parse the args out into arglist, validating as we go */
4041 /* Examine the argument list for default parameters and 'args' */
4042 for (i = 0; i < argListLen; i++) {
4043 Jim_Obj *argPtr;
4044 Jim_Obj *nameObjPtr;
4045 Jim_Obj *defaultObjPtr;
4046 int len;
4048 /* Examine a parameter */
4049 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4050 len = Jim_ListLength(interp, argPtr);
4051 if (len == 0) {
4052 Jim_SetResultString(interp, "argument with no name", -1);
4053 err:
4054 JimDecrCmdRefCount(interp, cmdPtr);
4055 return NULL;
4057 if (len > 2) {
4058 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4059 goto err;
4062 if (len == 2) {
4063 /* Optional parameter */
4064 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4065 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4067 else {
4068 /* Required parameter */
4069 nameObjPtr = argPtr;
4070 defaultObjPtr = NULL;
4074 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4075 if (cmdPtr->u.proc.argsPos >= 0) {
4076 Jim_SetResultString(interp, "'args' specified more than once", -1);
4077 goto err;
4079 cmdPtr->u.proc.argsPos = i;
4081 else {
4082 if (len == 2) {
4083 cmdPtr->u.proc.optArity++;
4085 else {
4086 cmdPtr->u.proc.reqArity++;
4090 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4091 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4094 return cmdPtr;
4097 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4099 int ret = JIM_OK;
4100 Jim_Obj *qualifiedNameObj;
4101 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4103 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4104 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4105 ret = JIM_ERR;
4107 else {
4108 Jim_InterpIncrProcEpoch(interp);
4111 JimFreeQualifiedName(interp, qualifiedNameObj);
4113 return ret;
4116 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4118 int ret = JIM_ERR;
4119 Jim_HashEntry *he;
4120 Jim_Cmd *cmdPtr;
4121 Jim_Obj *qualifiedOldNameObj;
4122 Jim_Obj *qualifiedNewNameObj;
4123 const char *fqold;
4124 const char *fqnew;
4126 if (newName[0] == 0) {
4127 return Jim_DeleteCommand(interp, oldName);
4130 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4131 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4133 /* Does it exist? */
4134 he = Jim_FindHashEntry(&interp->commands, fqold);
4135 if (he == NULL) {
4136 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4138 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4139 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4141 else {
4142 /* Add the new name first */
4143 cmdPtr = Jim_GetHashEntryVal(he);
4144 JimIncrCmdRefCount(cmdPtr);
4145 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4146 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4148 /* Now remove the old name */
4149 Jim_DeleteHashEntry(&interp->commands, fqold);
4151 /* Increment the epoch */
4152 Jim_InterpIncrProcEpoch(interp);
4154 ret = JIM_OK;
4157 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4158 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4160 return ret;
4163 /* -----------------------------------------------------------------------------
4164 * Command object
4165 * ---------------------------------------------------------------------------*/
4167 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4169 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4172 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4174 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4175 dupPtr->typePtr = srcPtr->typePtr;
4176 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4179 static const Jim_ObjType commandObjType = {
4180 "command",
4181 FreeCommandInternalRep,
4182 DupCommandInternalRep,
4183 NULL,
4184 JIM_TYPE_REFERENCES,
4187 /* This function returns the command structure for the command name
4188 * stored in objPtr. It specializes the objPtr to contain
4189 * cached info instead of performing the lookup into the hash table
4190 * every time. The information cached may not be up-to-date, in this
4191 * case the lookup is performed and the cache updated.
4193 * Respects the 'upcall' setting.
4195 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4197 Jim_Cmd *cmd;
4199 /* In order to be valid, the proc epoch must match and
4200 * the lookup must have occurred in the same namespace
4202 if (objPtr->typePtr != &commandObjType ||
4203 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4204 #ifdef jim_ext_namespace
4205 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4206 #endif
4208 /* Not cached or out of date, so lookup */
4210 /* Do we need to try the local namespace? */
4211 const char *name = Jim_String(objPtr);
4212 Jim_HashEntry *he;
4214 if (name[0] == ':' && name[1] == ':') {
4215 while (*++name == ':') {
4218 #ifdef jim_ext_namespace
4219 else if (Jim_Length(interp->framePtr->nsObj)) {
4220 /* This command is being defined in a non-global namespace */
4221 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4222 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4223 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4224 Jim_FreeNewObj(interp, nameObj);
4225 if (he) {
4226 goto found;
4229 #endif
4231 /* Lookup in the global namespace */
4232 he = Jim_FindHashEntry(&interp->commands, name);
4233 if (he == NULL) {
4234 if (flags & JIM_ERRMSG) {
4235 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4237 return NULL;
4239 #ifdef jim_ext_namespace
4240 found:
4241 #endif
4242 cmd = Jim_GetHashEntryVal(he);
4244 /* Free the old internal rep and set the new one. */
4245 Jim_FreeIntRep(interp, objPtr);
4246 objPtr->typePtr = &commandObjType;
4247 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4248 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4249 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4250 Jim_IncrRefCount(interp->framePtr->nsObj);
4252 else {
4253 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4255 while (cmd->u.proc.upcall) {
4256 cmd = cmd->prevCmd;
4258 return cmd;
4261 /* -----------------------------------------------------------------------------
4262 * Variables
4263 * ---------------------------------------------------------------------------*/
4265 /* -----------------------------------------------------------------------------
4266 * Variable object
4267 * ---------------------------------------------------------------------------*/
4269 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4271 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4273 static const Jim_ObjType variableObjType = {
4274 "variable",
4275 NULL,
4276 NULL,
4277 NULL,
4278 JIM_TYPE_REFERENCES,
4282 * Check that the name does not contain embedded nulls.
4284 * Variable and procedure names are manipulated as null terminated strings, so
4285 * don't allow names with embedded nulls.
4287 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4289 /* Variable names and proc names can't contain embedded nulls */
4290 if (nameObjPtr->typePtr != &variableObjType) {
4291 int len;
4292 const char *str = Jim_GetString(nameObjPtr, &len);
4293 if (memchr(str, '\0', len)) {
4294 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4295 return JIM_ERR;
4298 return JIM_OK;
4301 /* This method should be called only by the variable API.
4302 * It returns JIM_OK on success (variable already exists),
4303 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4304 * a variable name, but syntax glue for [dict] i.e. the last
4305 * character is ')' */
4306 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4308 const char *varName;
4309 Jim_CallFrame *framePtr;
4310 Jim_HashEntry *he;
4311 int global;
4312 int len;
4314 /* Check if the object is already an uptodate variable */
4315 if (objPtr->typePtr == &variableObjType) {
4316 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4317 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4318 /* nothing to do */
4319 return JIM_OK;
4321 /* Need to re-resolve the variable in the updated callframe */
4323 else if (objPtr->typePtr == &dictSubstObjType) {
4324 return JIM_DICT_SUGAR;
4326 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4327 return JIM_ERR;
4331 varName = Jim_GetString(objPtr, &len);
4333 /* Make sure it's not syntax glue to get/set dict. */
4334 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4335 return JIM_DICT_SUGAR;
4338 if (varName[0] == ':' && varName[1] == ':') {
4339 while (*++varName == ':') {
4341 global = 1;
4342 framePtr = interp->topFramePtr;
4344 else {
4345 global = 0;
4346 framePtr = interp->framePtr;
4349 /* Resolve this name in the variables hash table */
4350 he = Jim_FindHashEntry(&framePtr->vars, varName);
4351 if (he == NULL) {
4352 if (!global && framePtr->staticVars) {
4353 /* Try with static vars. */
4354 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4356 if (he == NULL) {
4357 return JIM_ERR;
4361 /* Free the old internal repr and set the new one. */
4362 Jim_FreeIntRep(interp, objPtr);
4363 objPtr->typePtr = &variableObjType;
4364 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4365 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4366 objPtr->internalRep.varValue.global = global;
4367 return JIM_OK;
4370 /* -------------------- Variables related functions ------------------------- */
4371 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4372 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4374 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4376 const char *name;
4377 Jim_CallFrame *framePtr;
4378 int global;
4380 /* New variable to create */
4381 Jim_Var *var = Jim_Alloc(sizeof(*var));
4383 var->objPtr = valObjPtr;
4384 Jim_IncrRefCount(valObjPtr);
4385 var->linkFramePtr = NULL;
4387 name = Jim_String(nameObjPtr);
4388 if (name[0] == ':' && name[1] == ':') {
4389 while (*++name == ':') {
4391 framePtr = interp->topFramePtr;
4392 global = 1;
4394 else {
4395 framePtr = interp->framePtr;
4396 global = 0;
4399 /* Insert the new variable */
4400 Jim_AddHashEntry(&framePtr->vars, name, var);
4402 /* Make the object int rep a variable */
4403 Jim_FreeIntRep(interp, nameObjPtr);
4404 nameObjPtr->typePtr = &variableObjType;
4405 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4406 nameObjPtr->internalRep.varValue.varPtr = var;
4407 nameObjPtr->internalRep.varValue.global = global;
4409 return var;
4412 /* For now that's dummy. Variables lookup should be optimized
4413 * in many ways, with caching of lookups, and possibly with
4414 * a table of pre-allocated vars in every CallFrame for local vars.
4415 * All the caching should also have an 'epoch' mechanism similar
4416 * to the one used by Tcl for procedures lookup caching. */
4419 * Set the variable nameObjPtr to value valObjptr.
4421 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4423 int err;
4424 Jim_Var *var;
4426 switch (SetVariableFromAny(interp, nameObjPtr)) {
4427 case JIM_DICT_SUGAR:
4428 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4430 case JIM_ERR:
4431 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4432 return JIM_ERR;
4434 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4435 break;
4437 case JIM_OK:
4438 var = nameObjPtr->internalRep.varValue.varPtr;
4439 if (var->linkFramePtr == NULL) {
4440 Jim_IncrRefCount(valObjPtr);
4441 Jim_DecrRefCount(interp, var->objPtr);
4442 var->objPtr = valObjPtr;
4444 else { /* Else handle the link */
4445 Jim_CallFrame *savedCallFrame;
4447 savedCallFrame = interp->framePtr;
4448 interp->framePtr = var->linkFramePtr;
4449 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4450 interp->framePtr = savedCallFrame;
4451 if (err != JIM_OK)
4452 return err;
4455 return JIM_OK;
4458 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4460 Jim_Obj *nameObjPtr;
4461 int result;
4463 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4464 Jim_IncrRefCount(nameObjPtr);
4465 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4466 Jim_DecrRefCount(interp, nameObjPtr);
4467 return result;
4470 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4472 Jim_CallFrame *savedFramePtr;
4473 int result;
4475 savedFramePtr = interp->framePtr;
4476 interp->framePtr = interp->topFramePtr;
4477 result = Jim_SetVariableStr(interp, name, objPtr);
4478 interp->framePtr = savedFramePtr;
4479 return result;
4482 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4484 Jim_Obj *valObjPtr;
4485 int result;
4487 valObjPtr = Jim_NewStringObj(interp, val, -1);
4488 Jim_IncrRefCount(valObjPtr);
4489 result = Jim_SetVariableStr(interp, name, valObjPtr);
4490 Jim_DecrRefCount(interp, valObjPtr);
4491 return result;
4494 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4495 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4497 const char *varName;
4498 const char *targetName;
4499 Jim_CallFrame *framePtr;
4500 Jim_Var *varPtr;
4502 /* Check for an existing variable or link */
4503 switch (SetVariableFromAny(interp, nameObjPtr)) {
4504 case JIM_DICT_SUGAR:
4505 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4506 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4507 return JIM_ERR;
4509 case JIM_OK:
4510 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4512 if (varPtr->linkFramePtr == NULL) {
4513 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4514 return JIM_ERR;
4517 /* It exists, but is a link, so first delete the link */
4518 varPtr->linkFramePtr = NULL;
4519 break;
4522 /* Resolve the call frames for both variables */
4523 /* XXX: SetVariableFromAny() already did this! */
4524 varName = Jim_String(nameObjPtr);
4526 if (varName[0] == ':' && varName[1] == ':') {
4527 while (*++varName == ':') {
4529 /* Linking a global var does nothing */
4530 framePtr = interp->topFramePtr;
4532 else {
4533 framePtr = interp->framePtr;
4536 targetName = Jim_String(targetNameObjPtr);
4537 if (targetName[0] == ':' && targetName[1] == ':') {
4538 while (*++targetName == ':') {
4540 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4541 targetCallFrame = interp->topFramePtr;
4543 Jim_IncrRefCount(targetNameObjPtr);
4545 if (framePtr->level < targetCallFrame->level) {
4546 Jim_SetResultFormatted(interp,
4547 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4548 nameObjPtr);
4549 Jim_DecrRefCount(interp, targetNameObjPtr);
4550 return JIM_ERR;
4553 /* Check for cycles. */
4554 if (framePtr == targetCallFrame) {
4555 Jim_Obj *objPtr = targetNameObjPtr;
4557 /* Cycles are only possible with 'uplevel 0' */
4558 while (1) {
4559 if (strcmp(Jim_String(objPtr), varName) == 0) {
4560 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4561 Jim_DecrRefCount(interp, targetNameObjPtr);
4562 return JIM_ERR;
4564 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4565 break;
4566 varPtr = objPtr->internalRep.varValue.varPtr;
4567 if (varPtr->linkFramePtr != targetCallFrame)
4568 break;
4569 objPtr = varPtr->objPtr;
4573 /* Perform the binding */
4574 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4575 /* We are now sure 'nameObjPtr' type is variableObjType */
4576 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4577 Jim_DecrRefCount(interp, targetNameObjPtr);
4578 return JIM_OK;
4581 /* Return the Jim_Obj pointer associated with a variable name,
4582 * or NULL if the variable was not found in the current context.
4583 * The same optimization discussed in the comment to the
4584 * 'SetVariable' function should apply here.
4586 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4587 * in a dictionary which is shared, the array variable value is duplicated first.
4588 * This allows the array element to be updated (e.g. append, lappend) without
4589 * affecting other references to the dictionary.
4591 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4593 switch (SetVariableFromAny(interp, nameObjPtr)) {
4594 case JIM_OK:{
4595 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4597 if (varPtr->linkFramePtr == NULL) {
4598 return varPtr->objPtr;
4600 else {
4601 Jim_Obj *objPtr;
4603 /* The variable is a link? Resolve it. */
4604 Jim_CallFrame *savedCallFrame = interp->framePtr;
4606 interp->framePtr = varPtr->linkFramePtr;
4607 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4608 interp->framePtr = savedCallFrame;
4609 if (objPtr) {
4610 return objPtr;
4612 /* Error, so fall through to the error message */
4615 break;
4617 case JIM_DICT_SUGAR:
4618 /* [dict] syntax sugar. */
4619 return JimDictSugarGet(interp, nameObjPtr, flags);
4621 if (flags & JIM_ERRMSG) {
4622 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4624 return NULL;
4627 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4629 Jim_CallFrame *savedFramePtr;
4630 Jim_Obj *objPtr;
4632 savedFramePtr = interp->framePtr;
4633 interp->framePtr = interp->topFramePtr;
4634 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4635 interp->framePtr = savedFramePtr;
4637 return objPtr;
4640 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4642 Jim_Obj *nameObjPtr, *varObjPtr;
4644 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4645 Jim_IncrRefCount(nameObjPtr);
4646 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4647 Jim_DecrRefCount(interp, nameObjPtr);
4648 return varObjPtr;
4651 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4653 Jim_CallFrame *savedFramePtr;
4654 Jim_Obj *objPtr;
4656 savedFramePtr = interp->framePtr;
4657 interp->framePtr = interp->topFramePtr;
4658 objPtr = Jim_GetVariableStr(interp, name, flags);
4659 interp->framePtr = savedFramePtr;
4661 return objPtr;
4664 /* Unset a variable.
4665 * Note: On success unset invalidates all the (cached) variable objects
4666 * by incrementing callFrameEpoch
4668 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4670 Jim_Var *varPtr;
4671 int retval;
4672 Jim_CallFrame *framePtr;
4674 retval = SetVariableFromAny(interp, nameObjPtr);
4675 if (retval == JIM_DICT_SUGAR) {
4676 /* [dict] syntax sugar. */
4677 return JimDictSugarSet(interp, nameObjPtr, NULL);
4679 else if (retval == JIM_OK) {
4680 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4682 /* If it's a link call UnsetVariable recursively */
4683 if (varPtr->linkFramePtr) {
4684 framePtr = interp->framePtr;
4685 interp->framePtr = varPtr->linkFramePtr;
4686 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4687 interp->framePtr = framePtr;
4689 else {
4690 const char *name = Jim_String(nameObjPtr);
4691 if (nameObjPtr->internalRep.varValue.global) {
4692 name += 2;
4693 framePtr = interp->topFramePtr;
4695 else {
4696 framePtr = interp->framePtr;
4699 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4700 if (retval == JIM_OK) {
4701 /* Change the callframe id, invalidating var lookup caching */
4702 framePtr->id = interp->callFrameEpoch++;
4706 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4707 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4709 return retval;
4712 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4714 /* Given a variable name for [dict] operation syntax sugar,
4715 * this function returns two objects, the first with the name
4716 * of the variable to set, and the second with the respective key.
4717 * For example "foo(bar)" will return objects with string repr. of
4718 * "foo" and "bar".
4720 * The returned objects have refcount = 1. The function can't fail. */
4721 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4722 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4724 const char *str, *p;
4725 int len, keyLen;
4726 Jim_Obj *varObjPtr, *keyObjPtr;
4728 str = Jim_GetString(objPtr, &len);
4730 p = strchr(str, '(');
4731 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4733 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4735 p++;
4736 keyLen = (str + len) - p;
4737 if (str[len - 1] == ')') {
4738 keyLen--;
4741 /* Create the objects with the variable name and key. */
4742 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4744 Jim_IncrRefCount(varObjPtr);
4745 Jim_IncrRefCount(keyObjPtr);
4746 *varPtrPtr = varObjPtr;
4747 *keyPtrPtr = keyObjPtr;
4750 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4751 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4752 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4754 int err;
4756 SetDictSubstFromAny(interp, objPtr);
4758 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4759 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4761 if (err == JIM_OK) {
4762 /* Don't keep an extra ref to the result */
4763 Jim_SetEmptyResult(interp);
4765 else {
4766 if (!valObjPtr) {
4767 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4768 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4769 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4770 objPtr);
4771 return err;
4774 /* Make the error more informative and Tcl-compatible */
4775 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4776 (valObjPtr ? "set" : "unset"), objPtr);
4778 return err;
4782 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4784 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4785 * and stored back to the variable before expansion.
4787 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4788 Jim_Obj *keyObjPtr, int flags)
4790 Jim_Obj *dictObjPtr;
4791 Jim_Obj *resObjPtr = NULL;
4792 int ret;
4794 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4795 if (!dictObjPtr) {
4796 return NULL;
4799 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4800 if (ret != JIM_OK) {
4801 Jim_SetResultFormatted(interp,
4802 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4803 ret < 0 ? "variable isn't" : "no such element in");
4805 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4806 /* Update the variable to have an unshared copy */
4807 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4810 return resObjPtr;
4813 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4814 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4816 SetDictSubstFromAny(interp, objPtr);
4818 return JimDictExpandArrayVariable(interp,
4819 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4820 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4823 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4825 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4827 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4828 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4831 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4833 /* Copy the internal rep */
4834 dupPtr->internalRep = srcPtr->internalRep;
4835 /* Need to increment the ref counts */
4836 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4837 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4840 /* Note: The object *must* be in dict-sugar format */
4841 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4843 if (objPtr->typePtr != &dictSubstObjType) {
4844 Jim_Obj *varObjPtr, *keyObjPtr;
4846 if (objPtr->typePtr == &interpolatedObjType) {
4847 /* An interpolated object in dict-sugar form */
4849 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4850 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4852 Jim_IncrRefCount(varObjPtr);
4853 Jim_IncrRefCount(keyObjPtr);
4855 else {
4856 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4859 Jim_FreeIntRep(interp, objPtr);
4860 objPtr->typePtr = &dictSubstObjType;
4861 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4862 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4866 /* This function is used to expand [dict get] sugar in the form
4867 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4868 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4869 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4870 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4871 * the [dict]ionary contained in variable VARNAME. */
4872 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4874 Jim_Obj *resObjPtr = NULL;
4875 Jim_Obj *substKeyObjPtr = NULL;
4877 SetDictSubstFromAny(interp, objPtr);
4879 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4880 &substKeyObjPtr, JIM_NONE)
4881 != JIM_OK) {
4882 return NULL;
4884 Jim_IncrRefCount(substKeyObjPtr);
4885 resObjPtr =
4886 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4887 substKeyObjPtr, 0);
4888 Jim_DecrRefCount(interp, substKeyObjPtr);
4890 return resObjPtr;
4893 /* -----------------------------------------------------------------------------
4894 * CallFrame
4895 * ---------------------------------------------------------------------------*/
4897 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4899 Jim_CallFrame *cf;
4901 if (interp->freeFramesList) {
4902 cf = interp->freeFramesList;
4903 interp->freeFramesList = cf->next;
4905 cf->argv = NULL;
4906 cf->argc = 0;
4907 cf->procArgsObjPtr = NULL;
4908 cf->procBodyObjPtr = NULL;
4909 cf->next = NULL;
4910 cf->staticVars = NULL;
4911 cf->localCommands = NULL;
4912 cf->tailcallObj = NULL;
4913 cf->tailcallCmd = NULL;
4915 else {
4916 cf = Jim_Alloc(sizeof(*cf));
4917 memset(cf, 0, sizeof(*cf));
4919 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4922 cf->id = interp->callFrameEpoch++;
4923 cf->parent = parent;
4924 cf->level = parent ? parent->level + 1 : 0;
4925 cf->nsObj = nsObj;
4926 Jim_IncrRefCount(nsObj);
4928 return cf;
4931 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4933 /* Delete any local procs */
4934 if (localCommands) {
4935 Jim_Obj *cmdNameObj;
4937 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4938 Jim_HashEntry *he;
4939 Jim_Obj *fqObjName;
4940 Jim_HashTable *ht = &interp->commands;
4942 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4944 he = Jim_FindHashEntry(ht, fqname);
4946 if (he) {
4947 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4948 if (cmd->prevCmd) {
4949 Jim_Cmd *prevCmd = cmd->prevCmd;
4950 cmd->prevCmd = NULL;
4952 /* Delete the old command */
4953 JimDecrCmdRefCount(interp, cmd);
4955 /* And restore the original */
4956 Jim_SetHashVal(ht, he, prevCmd);
4958 else {
4959 Jim_DeleteHashEntry(ht, fqname);
4961 Jim_InterpIncrProcEpoch(interp);
4963 Jim_DecrRefCount(interp, cmdNameObj);
4964 JimFreeQualifiedName(interp, fqObjName);
4966 Jim_FreeStack(localCommands);
4967 Jim_Free(localCommands);
4969 return JIM_OK;
4973 * Run any $jim::defer scripts for the current call frame.
4975 * retcode is the return code from the current proc.
4977 * Returns the new return code.
4979 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
4981 Jim_Obj *objPtr;
4983 /* Fast check for the likely case that the variable doesn't exist */
4984 if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
4985 return retcode;
4988 objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
4990 if (objPtr) {
4991 int ret = JIM_OK;
4992 int i;
4993 int listLen = Jim_ListLength(interp, objPtr);
4994 Jim_Obj *resultObjPtr;
4996 Jim_IncrRefCount(objPtr);
4998 /* Need to save away the current interp result and
4999 * restore it if appropriate
5001 resultObjPtr = Jim_GetResult(interp);
5002 Jim_IncrRefCount(resultObjPtr);
5003 Jim_SetEmptyResult(interp);
5005 /* Invoke in reverse order */
5006 for (i = listLen; i > 0; i--) {
5007 /* If a defer script returns an error, don't evaluate remaining scripts */
5008 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5009 ret = Jim_EvalObj(interp, scriptObjPtr);
5010 if (ret != JIM_OK) {
5011 break;
5015 if (ret == JIM_OK || retcode == JIM_ERR) {
5016 /* defer script had no error, or proc had an error so restore proc result */
5017 Jim_SetResult(interp, resultObjPtr);
5019 else {
5020 retcode = ret;
5023 Jim_DecrRefCount(interp, resultObjPtr);
5024 Jim_DecrRefCount(interp, objPtr);
5026 return retcode;
5029 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5030 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5031 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5033 JimDeleteLocalProcs(interp, cf->localCommands);
5035 if (cf->procArgsObjPtr)
5036 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5037 if (cf->procBodyObjPtr)
5038 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5039 Jim_DecrRefCount(interp, cf->nsObj);
5040 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5041 Jim_FreeHashTable(&cf->vars);
5042 else {
5043 int i;
5044 Jim_HashEntry **table = cf->vars.table, *he;
5046 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5047 he = table[i];
5048 while (he != NULL) {
5049 Jim_HashEntry *nextEntry = he->next;
5050 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5052 Jim_DecrRefCount(interp, varPtr->objPtr);
5053 Jim_Free(Jim_GetHashEntryKey(he));
5054 Jim_Free(varPtr);
5055 Jim_Free(he);
5056 table[i] = NULL;
5057 he = nextEntry;
5060 cf->vars.used = 0;
5062 cf->next = interp->freeFramesList;
5063 interp->freeFramesList = cf;
5067 /* -----------------------------------------------------------------------------
5068 * References
5069 * ---------------------------------------------------------------------------*/
5070 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5072 /* References HashTable Type.
5074 * Keys are unsigned long integers, dynamically allocated for now but in the
5075 * future it's worth to cache this 4 bytes objects. Values are pointers
5076 * to Jim_References. */
5077 static void JimReferencesHTValDestructor(void *interp, void *val)
5079 Jim_Reference *refPtr = (void *)val;
5081 Jim_DecrRefCount(interp, refPtr->objPtr);
5082 if (refPtr->finalizerCmdNamePtr != NULL) {
5083 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5085 Jim_Free(val);
5088 static unsigned int JimReferencesHTHashFunction(const void *key)
5090 /* Only the least significant bits are used. */
5091 const unsigned long *widePtr = key;
5092 unsigned int intValue = (unsigned int)*widePtr;
5094 return Jim_IntHashFunction(intValue);
5097 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5099 void *copy = Jim_Alloc(sizeof(unsigned long));
5101 JIM_NOTUSED(privdata);
5103 memcpy(copy, key, sizeof(unsigned long));
5104 return copy;
5107 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5109 JIM_NOTUSED(privdata);
5111 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5114 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5116 JIM_NOTUSED(privdata);
5118 Jim_Free(key);
5121 static const Jim_HashTableType JimReferencesHashTableType = {
5122 JimReferencesHTHashFunction, /* hash function */
5123 JimReferencesHTKeyDup, /* key dup */
5124 NULL, /* val dup */
5125 JimReferencesHTKeyCompare, /* key compare */
5126 JimReferencesHTKeyDestructor, /* key destructor */
5127 JimReferencesHTValDestructor /* val destructor */
5130 /* -----------------------------------------------------------------------------
5131 * Reference object type and References API
5132 * ---------------------------------------------------------------------------*/
5134 /* The string representation of references has two features in order
5135 * to make the GC faster. The first is that every reference starts
5136 * with a non common character '<', in order to make the string matching
5137 * faster. The second is that the reference string rep is 42 characters
5138 * in length, this means that it is not necessary to check any object with a string
5139 * repr < 42, and usually there aren't many of these objects. */
5141 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5143 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5145 const char *fmt = "<reference.<%s>.%020lu>";
5147 sprintf(buf, fmt, refPtr->tag, id);
5148 return JIM_REFERENCE_SPACE;
5151 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5153 static const Jim_ObjType referenceObjType = {
5154 "reference",
5155 NULL,
5156 NULL,
5157 UpdateStringOfReference,
5158 JIM_TYPE_REFERENCES,
5161 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5163 char buf[JIM_REFERENCE_SPACE + 1];
5165 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5166 JimSetStringBytes(objPtr, buf);
5169 /* returns true if 'c' is a valid reference tag character.
5170 * i.e. inside the range [_a-zA-Z0-9] */
5171 static int isrefchar(int c)
5173 return (c == '_' || isalnum(c));
5176 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5178 unsigned long value;
5179 int i, len;
5180 const char *str, *start, *end;
5181 char refId[21];
5182 Jim_Reference *refPtr;
5183 Jim_HashEntry *he;
5184 char *endptr;
5186 /* Get the string representation */
5187 str = Jim_GetString(objPtr, &len);
5188 /* Check if it looks like a reference */
5189 if (len < JIM_REFERENCE_SPACE)
5190 goto badformat;
5191 /* Trim spaces */
5192 start = str;
5193 end = str + len - 1;
5194 while (*start == ' ')
5195 start++;
5196 while (*end == ' ' && end > start)
5197 end--;
5198 if (end - start + 1 != JIM_REFERENCE_SPACE)
5199 goto badformat;
5200 /* <reference.<1234567>.%020> */
5201 if (memcmp(start, "<reference.<", 12) != 0)
5202 goto badformat;
5203 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5204 goto badformat;
5205 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5206 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5207 if (!isrefchar(start[12 + i]))
5208 goto badformat;
5210 /* Extract info from the reference. */
5211 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5212 refId[20] = '\0';
5213 /* Try to convert the ID into an unsigned long */
5214 value = strtoul(refId, &endptr, 10);
5215 if (JimCheckConversion(refId, endptr) != JIM_OK)
5216 goto badformat;
5217 /* Check if the reference really exists! */
5218 he = Jim_FindHashEntry(&interp->references, &value);
5219 if (he == NULL) {
5220 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5221 return JIM_ERR;
5223 refPtr = Jim_GetHashEntryVal(he);
5224 /* Free the old internal repr and set the new one. */
5225 Jim_FreeIntRep(interp, objPtr);
5226 objPtr->typePtr = &referenceObjType;
5227 objPtr->internalRep.refValue.id = value;
5228 objPtr->internalRep.refValue.refPtr = refPtr;
5229 return JIM_OK;
5231 badformat:
5232 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5233 return JIM_ERR;
5236 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5237 * as finalizer command (or NULL if there is no finalizer).
5238 * The returned reference object has refcount = 0. */
5239 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5241 struct Jim_Reference *refPtr;
5242 unsigned long id;
5243 Jim_Obj *refObjPtr;
5244 const char *tag;
5245 int tagLen, i;
5247 /* Perform the Garbage Collection if needed. */
5248 Jim_CollectIfNeeded(interp);
5250 refPtr = Jim_Alloc(sizeof(*refPtr));
5251 refPtr->objPtr = objPtr;
5252 Jim_IncrRefCount(objPtr);
5253 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5254 if (cmdNamePtr)
5255 Jim_IncrRefCount(cmdNamePtr);
5256 id = interp->referenceNextId++;
5257 Jim_AddHashEntry(&interp->references, &id, refPtr);
5258 refObjPtr = Jim_NewObj(interp);
5259 refObjPtr->typePtr = &referenceObjType;
5260 refObjPtr->bytes = NULL;
5261 refObjPtr->internalRep.refValue.id = id;
5262 refObjPtr->internalRep.refValue.refPtr = refPtr;
5263 interp->referenceNextId++;
5264 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5265 * that does not pass the 'isrefchar' test is replaced with '_' */
5266 tag = Jim_GetString(tagPtr, &tagLen);
5267 if (tagLen > JIM_REFERENCE_TAGLEN)
5268 tagLen = JIM_REFERENCE_TAGLEN;
5269 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5270 if (i < tagLen && isrefchar(tag[i]))
5271 refPtr->tag[i] = tag[i];
5272 else
5273 refPtr->tag[i] = '_';
5275 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5276 return refObjPtr;
5279 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5281 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5282 return NULL;
5283 return objPtr->internalRep.refValue.refPtr;
5286 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5288 Jim_Reference *refPtr;
5290 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5291 return JIM_ERR;
5292 Jim_IncrRefCount(cmdNamePtr);
5293 if (refPtr->finalizerCmdNamePtr)
5294 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5295 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5296 return JIM_OK;
5299 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5301 Jim_Reference *refPtr;
5303 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5304 return JIM_ERR;
5305 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5306 return JIM_OK;
5309 /* -----------------------------------------------------------------------------
5310 * References Garbage Collection
5311 * ---------------------------------------------------------------------------*/
5313 /* This the hash table type for the "MARK" phase of the GC */
5314 static const Jim_HashTableType JimRefMarkHashTableType = {
5315 JimReferencesHTHashFunction, /* hash function */
5316 JimReferencesHTKeyDup, /* key dup */
5317 NULL, /* val dup */
5318 JimReferencesHTKeyCompare, /* key compare */
5319 JimReferencesHTKeyDestructor, /* key destructor */
5320 NULL /* val destructor */
5323 /* Performs the garbage collection. */
5324 int Jim_Collect(Jim_Interp *interp)
5326 int collected = 0;
5327 Jim_HashTable marks;
5328 Jim_HashTableIterator htiter;
5329 Jim_HashEntry *he;
5330 Jim_Obj *objPtr;
5332 /* Avoid recursive calls */
5333 if (interp->lastCollectId == (unsigned long)~0) {
5334 /* Jim_Collect() already running. Return just now. */
5335 return 0;
5337 interp->lastCollectId = ~0;
5339 /* Mark all the references found into the 'mark' hash table.
5340 * The references are searched in every live object that
5341 * is of a type that can contain references. */
5342 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5343 objPtr = interp->liveList;
5344 while (objPtr) {
5345 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5346 const char *str, *p;
5347 int len;
5349 /* If the object is of type reference, to get the
5350 * Id is simple... */
5351 if (objPtr->typePtr == &referenceObjType) {
5352 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5353 #ifdef JIM_DEBUG_GC
5354 printf("MARK (reference): %d refcount: %d\n",
5355 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5356 #endif
5357 objPtr = objPtr->nextObjPtr;
5358 continue;
5360 /* Get the string repr of the object we want
5361 * to scan for references. */
5362 p = str = Jim_GetString(objPtr, &len);
5363 /* Skip objects too little to contain references. */
5364 if (len < JIM_REFERENCE_SPACE) {
5365 objPtr = objPtr->nextObjPtr;
5366 continue;
5368 /* Extract references from the object string repr. */
5369 while (1) {
5370 int i;
5371 unsigned long id;
5373 if ((p = strstr(p, "<reference.<")) == NULL)
5374 break;
5375 /* Check if it's a valid reference. */
5376 if (len - (p - str) < JIM_REFERENCE_SPACE)
5377 break;
5378 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5379 break;
5380 for (i = 21; i <= 40; i++)
5381 if (!isdigit(UCHAR(p[i])))
5382 break;
5383 /* Get the ID */
5384 id = strtoul(p + 21, NULL, 10);
5386 /* Ok, a reference for the given ID
5387 * was found. Mark it. */
5388 Jim_AddHashEntry(&marks, &id, NULL);
5389 #ifdef JIM_DEBUG_GC
5390 printf("MARK: %d\n", (int)id);
5391 #endif
5392 p += JIM_REFERENCE_SPACE;
5395 objPtr = objPtr->nextObjPtr;
5398 /* Run the references hash table to destroy every reference that
5399 * is not referenced outside (not present in the mark HT). */
5400 JimInitHashTableIterator(&interp->references, &htiter);
5401 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5402 const unsigned long *refId;
5403 Jim_Reference *refPtr;
5405 refId = he->key;
5406 /* Check if in the mark phase we encountered
5407 * this reference. */
5408 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5409 #ifdef JIM_DEBUG_GC
5410 printf("COLLECTING %d\n", (int)*refId);
5411 #endif
5412 collected++;
5413 /* Drop the reference, but call the
5414 * finalizer first if registered. */
5415 refPtr = Jim_GetHashEntryVal(he);
5416 if (refPtr->finalizerCmdNamePtr) {
5417 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5418 Jim_Obj *objv[3], *oldResult;
5420 JimFormatReference(refstr, refPtr, *refId);
5422 objv[0] = refPtr->finalizerCmdNamePtr;
5423 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5424 objv[2] = refPtr->objPtr;
5426 /* Drop the reference itself */
5427 /* Avoid the finaliser being freed here */
5428 Jim_IncrRefCount(objv[0]);
5429 /* Don't remove the reference from the hash table just yet
5430 * since that will free refPtr, and hence refPtr->objPtr
5433 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5434 oldResult = interp->result;
5435 Jim_IncrRefCount(oldResult);
5436 Jim_EvalObjVector(interp, 3, objv);
5437 Jim_SetResult(interp, oldResult);
5438 Jim_DecrRefCount(interp, oldResult);
5440 Jim_DecrRefCount(interp, objv[0]);
5442 Jim_DeleteHashEntry(&interp->references, refId);
5445 Jim_FreeHashTable(&marks);
5446 interp->lastCollectId = interp->referenceNextId;
5447 interp->lastCollectTime = JimClock();
5448 return collected;
5451 #define JIM_COLLECT_ID_PERIOD 5000000
5452 #define JIM_COLLECT_TIME_PERIOD 300000
5454 void Jim_CollectIfNeeded(Jim_Interp *interp)
5456 unsigned long elapsedId;
5457 jim_wide elapsedTime;
5459 elapsedId = interp->referenceNextId - interp->lastCollectId;
5460 elapsedTime = JimClock() - interp->lastCollectTime;
5463 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5464 Jim_Collect(interp);
5467 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5469 int Jim_IsBigEndian(void)
5471 union {
5472 unsigned short s;
5473 unsigned char c[2];
5474 } uval = {0x0102};
5476 return uval.c[0] == 1;
5479 /* -----------------------------------------------------------------------------
5480 * Interpreter related functions
5481 * ---------------------------------------------------------------------------*/
5483 Jim_Interp *Jim_CreateInterp(void)
5485 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5487 memset(i, 0, sizeof(*i));
5489 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5490 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5491 i->lastCollectTime = JimClock();
5493 /* Note that we can create objects only after the
5494 * interpreter liveList and freeList pointers are
5495 * initialized to NULL. */
5496 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5497 #ifdef JIM_REFERENCES
5498 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5499 #endif
5500 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5501 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5502 i->emptyObj = Jim_NewEmptyStringObj(i);
5503 i->trueObj = Jim_NewIntObj(i, 1);
5504 i->falseObj = Jim_NewIntObj(i, 0);
5505 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5506 i->errorFileNameObj = i->emptyObj;
5507 i->result = i->emptyObj;
5508 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5509 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5510 i->errorProc = i->emptyObj;
5511 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5512 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5513 Jim_IncrRefCount(i->emptyObj);
5514 Jim_IncrRefCount(i->errorFileNameObj);
5515 Jim_IncrRefCount(i->result);
5516 Jim_IncrRefCount(i->stackTrace);
5517 Jim_IncrRefCount(i->unknown);
5518 Jim_IncrRefCount(i->currentScriptObj);
5519 Jim_IncrRefCount(i->nullScriptObj);
5520 Jim_IncrRefCount(i->errorProc);
5521 Jim_IncrRefCount(i->trueObj);
5522 Jim_IncrRefCount(i->falseObj);
5524 /* Initialize key variables every interpreter should contain */
5525 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5526 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5528 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5529 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5530 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5531 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5532 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5533 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5534 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5535 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5537 return i;
5540 void Jim_FreeInterp(Jim_Interp *i)
5542 Jim_CallFrame *cf, *cfx;
5544 Jim_Obj *objPtr, *nextObjPtr;
5546 /* Free the active call frames list - must be done before i->commands is destroyed */
5547 for (cf = i->framePtr; cf; cf = cfx) {
5548 /* Note that we ignore any errors */
5549 JimInvokeDefer(i, JIM_OK);
5550 cfx = cf->parent;
5551 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5554 Jim_DecrRefCount(i, i->emptyObj);
5555 Jim_DecrRefCount(i, i->trueObj);
5556 Jim_DecrRefCount(i, i->falseObj);
5557 Jim_DecrRefCount(i, i->result);
5558 Jim_DecrRefCount(i, i->stackTrace);
5559 Jim_DecrRefCount(i, i->errorProc);
5560 Jim_DecrRefCount(i, i->unknown);
5561 Jim_DecrRefCount(i, i->errorFileNameObj);
5562 Jim_DecrRefCount(i, i->currentScriptObj);
5563 Jim_DecrRefCount(i, i->nullScriptObj);
5564 Jim_FreeHashTable(&i->commands);
5565 #ifdef JIM_REFERENCES
5566 Jim_FreeHashTable(&i->references);
5567 #endif
5568 Jim_FreeHashTable(&i->packages);
5569 Jim_Free(i->prngState);
5570 Jim_FreeHashTable(&i->assocData);
5572 /* Check that the live object list is empty, otherwise
5573 * there is a memory leak. */
5574 #ifdef JIM_MAINTAINER
5575 if (i->liveList != NULL) {
5576 objPtr = i->liveList;
5578 printf("\n-------------------------------------\n");
5579 printf("Objects still in the free list:\n");
5580 while (objPtr) {
5581 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5582 Jim_String(objPtr);
5584 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5585 printf("%p (%d) %-10s: '%.20s...'\n",
5586 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5588 else {
5589 printf("%p (%d) %-10s: '%s'\n",
5590 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5592 if (objPtr->typePtr == &sourceObjType) {
5593 printf("FILE %s LINE %d\n",
5594 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5595 objPtr->internalRep.sourceValue.lineNumber);
5597 objPtr = objPtr->nextObjPtr;
5599 printf("-------------------------------------\n\n");
5600 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5602 #endif
5604 /* Free all the freed objects. */
5605 objPtr = i->freeList;
5606 while (objPtr) {
5607 nextObjPtr = objPtr->nextObjPtr;
5608 Jim_Free(objPtr);
5609 objPtr = nextObjPtr;
5612 /* Free the free call frames list */
5613 for (cf = i->freeFramesList; cf; cf = cfx) {
5614 cfx = cf->next;
5615 if (cf->vars.table)
5616 Jim_FreeHashTable(&cf->vars);
5617 Jim_Free(cf);
5620 /* Free the interpreter structure. */
5621 Jim_Free(i);
5624 /* Returns the call frame relative to the level represented by
5625 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5627 * This function accepts the 'level' argument in the form
5628 * of the commands [uplevel] and [upvar].
5630 * Returns NULL on error.
5632 * Note: for a function accepting a relative integer as level suitable
5633 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5635 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5637 long level;
5638 const char *str;
5639 Jim_CallFrame *framePtr;
5641 if (levelObjPtr) {
5642 str = Jim_String(levelObjPtr);
5643 if (str[0] == '#') {
5644 char *endptr;
5646 level = jim_strtol(str + 1, &endptr);
5647 if (str[1] == '\0' || endptr[0] != '\0') {
5648 level = -1;
5651 else {
5652 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5653 level = -1;
5655 else {
5656 /* Convert from a relative to an absolute level */
5657 level = interp->framePtr->level - level;
5661 else {
5662 str = "1"; /* Needed to format the error message. */
5663 level = interp->framePtr->level - 1;
5666 if (level == 0) {
5667 return interp->topFramePtr;
5669 if (level > 0) {
5670 /* Lookup */
5671 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5672 if (framePtr->level == level) {
5673 return framePtr;
5678 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5679 return NULL;
5682 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5683 * as a relative integer like in the [info level ?level?] command.
5685 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5687 long level;
5688 Jim_CallFrame *framePtr;
5690 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5691 if (level <= 0) {
5692 /* Convert from a relative to an absolute level */
5693 level = interp->framePtr->level + level;
5696 if (level == 0) {
5697 return interp->topFramePtr;
5700 /* Lookup */
5701 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5702 if (framePtr->level == level) {
5703 return framePtr;
5708 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5709 return NULL;
5712 static void JimResetStackTrace(Jim_Interp *interp)
5714 Jim_DecrRefCount(interp, interp->stackTrace);
5715 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5716 Jim_IncrRefCount(interp->stackTrace);
5719 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5721 int len;
5723 /* Increment reference first in case these are the same object */
5724 Jim_IncrRefCount(stackTraceObj);
5725 Jim_DecrRefCount(interp, interp->stackTrace);
5726 interp->stackTrace = stackTraceObj;
5727 interp->errorFlag = 1;
5729 /* This is a bit ugly.
5730 * If the filename of the last entry of the stack trace is empty,
5731 * the next stack level should be added.
5733 len = Jim_ListLength(interp, interp->stackTrace);
5734 if (len >= 3) {
5735 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5736 interp->addStackTrace = 1;
5741 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5742 Jim_Obj *fileNameObj, int linenr)
5744 if (strcmp(procname, "unknown") == 0) {
5745 procname = "";
5747 if (!*procname && !Jim_Length(fileNameObj)) {
5748 /* No useful info here */
5749 return;
5752 if (Jim_IsShared(interp->stackTrace)) {
5753 Jim_DecrRefCount(interp, interp->stackTrace);
5754 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5755 Jim_IncrRefCount(interp->stackTrace);
5758 /* If we have no procname but the previous element did, merge with that frame */
5759 if (!*procname && Jim_Length(fileNameObj)) {
5760 /* Just a filename. Check the previous entry */
5761 int len = Jim_ListLength(interp, interp->stackTrace);
5763 if (len >= 3) {
5764 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5765 if (Jim_Length(objPtr)) {
5766 /* Yes, the previous level had procname */
5767 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5768 if (Jim_Length(objPtr) == 0) {
5769 /* But no filename, so merge the new info with that frame */
5770 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5771 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5772 return;
5778 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5779 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5780 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5783 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5784 void *data)
5786 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5788 assocEntryPtr->delProc = delProc;
5789 assocEntryPtr->data = data;
5790 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5793 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5795 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5797 if (entryPtr != NULL) {
5798 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5799 return assocEntryPtr->data;
5801 return NULL;
5804 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5806 return Jim_DeleteHashEntry(&interp->assocData, key);
5809 int Jim_GetExitCode(Jim_Interp *interp)
5811 return interp->exitCode;
5814 /* -----------------------------------------------------------------------------
5815 * Integer object
5816 * ---------------------------------------------------------------------------*/
5817 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5818 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5820 static const Jim_ObjType intObjType = {
5821 "int",
5822 NULL,
5823 NULL,
5824 UpdateStringOfInt,
5825 JIM_TYPE_NONE,
5828 /* A coerced double is closer to an int than a double.
5829 * It is an int value temporarily masquerading as a double value.
5830 * i.e. it has the same string value as an int and Jim_GetWide()
5831 * succeeds, but also Jim_GetDouble() returns the value directly.
5833 static const Jim_ObjType coercedDoubleObjType = {
5834 "coerced-double",
5835 NULL,
5836 NULL,
5837 UpdateStringOfInt,
5838 JIM_TYPE_NONE,
5842 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5844 char buf[JIM_INTEGER_SPACE + 1];
5845 jim_wide wideValue = JimWideValue(objPtr);
5846 int pos = 0;
5848 if (wideValue == 0) {
5849 buf[pos++] = '0';
5851 else {
5852 char tmp[JIM_INTEGER_SPACE];
5853 int num = 0;
5854 int i;
5856 if (wideValue < 0) {
5857 buf[pos++] = '-';
5858 i = wideValue % 10;
5859 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5860 * whereas C99 is always -6
5861 * coverity[dead_error_line]
5863 tmp[num++] = (i > 0) ? (10 - i) : -i;
5864 wideValue /= -10;
5867 while (wideValue) {
5868 tmp[num++] = wideValue % 10;
5869 wideValue /= 10;
5872 for (i = 0; i < num; i++) {
5873 buf[pos++] = '0' + tmp[num - i - 1];
5876 buf[pos] = 0;
5878 JimSetStringBytes(objPtr, buf);
5881 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5883 jim_wide wideValue;
5884 const char *str;
5886 if (objPtr->typePtr == &coercedDoubleObjType) {
5887 /* Simple switch */
5888 objPtr->typePtr = &intObjType;
5889 return JIM_OK;
5892 /* Get the string representation */
5893 str = Jim_String(objPtr);
5894 /* Try to convert into a jim_wide */
5895 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5896 if (flags & JIM_ERRMSG) {
5897 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5899 return JIM_ERR;
5901 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5902 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5903 return JIM_ERR;
5905 /* Free the old internal repr and set the new one. */
5906 Jim_FreeIntRep(interp, objPtr);
5907 objPtr->typePtr = &intObjType;
5908 objPtr->internalRep.wideValue = wideValue;
5909 return JIM_OK;
5912 #ifdef JIM_OPTIMIZATION
5913 static int JimIsWide(Jim_Obj *objPtr)
5915 return objPtr->typePtr == &intObjType;
5917 #endif
5919 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5921 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5922 return JIM_ERR;
5923 *widePtr = JimWideValue(objPtr);
5924 return JIM_OK;
5927 /* Get a wide but does not set an error if the format is bad. */
5928 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5930 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5931 return JIM_ERR;
5932 *widePtr = JimWideValue(objPtr);
5933 return JIM_OK;
5936 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5938 jim_wide wideValue;
5939 int retval;
5941 retval = Jim_GetWide(interp, objPtr, &wideValue);
5942 if (retval == JIM_OK) {
5943 *longPtr = (long)wideValue;
5944 return JIM_OK;
5946 return JIM_ERR;
5949 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5951 Jim_Obj *objPtr;
5953 objPtr = Jim_NewObj(interp);
5954 objPtr->typePtr = &intObjType;
5955 objPtr->bytes = NULL;
5956 objPtr->internalRep.wideValue = wideValue;
5957 return objPtr;
5960 /* -----------------------------------------------------------------------------
5961 * Double object
5962 * ---------------------------------------------------------------------------*/
5963 #define JIM_DOUBLE_SPACE 30
5965 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5966 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5968 static const Jim_ObjType doubleObjType = {
5969 "double",
5970 NULL,
5971 NULL,
5972 UpdateStringOfDouble,
5973 JIM_TYPE_NONE,
5976 #ifndef HAVE_ISNAN
5977 #undef isnan
5978 #define isnan(X) ((X) != (X))
5979 #endif
5980 #ifndef HAVE_ISINF
5981 #undef isinf
5982 #define isinf(X) (1.0 / (X) == 0.0)
5983 #endif
5985 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5987 double value = objPtr->internalRep.doubleValue;
5989 if (isnan(value)) {
5990 JimSetStringBytes(objPtr, "NaN");
5991 return;
5993 if (isinf(value)) {
5994 if (value < 0) {
5995 JimSetStringBytes(objPtr, "-Inf");
5997 else {
5998 JimSetStringBytes(objPtr, "Inf");
6000 return;
6003 char buf[JIM_DOUBLE_SPACE + 1];
6004 int i;
6005 int len = sprintf(buf, "%.12g", value);
6007 /* Add a final ".0" if necessary */
6008 for (i = 0; i < len; i++) {
6009 if (buf[i] == '.' || buf[i] == 'e') {
6010 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6011 /* If 'buf' ends in e-0nn or e+0nn, remove
6012 * the 0 after the + or - and reduce the length by 1
6014 char *e = strchr(buf, 'e');
6015 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6016 /* Move it up */
6017 e += 2;
6018 memmove(e, e + 1, len - (e - buf));
6020 #endif
6021 break;
6024 if (buf[i] == '\0') {
6025 buf[i++] = '.';
6026 buf[i++] = '0';
6027 buf[i] = '\0';
6029 JimSetStringBytes(objPtr, buf);
6033 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6035 double doubleValue;
6036 jim_wide wideValue;
6037 const char *str;
6039 #ifdef HAVE_LONG_LONG
6040 /* Assume a 53 bit mantissa */
6041 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6042 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6044 if (objPtr->typePtr == &intObjType
6045 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6046 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6048 /* Direct conversion to coerced double */
6049 objPtr->typePtr = &coercedDoubleObjType;
6050 return JIM_OK;
6052 #endif
6053 /* Preserve the string representation.
6054 * Needed so we can convert back to int without loss
6056 str = Jim_String(objPtr);
6058 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6059 /* Managed to convert to an int, so we can use this as a cooerced double */
6060 Jim_FreeIntRep(interp, objPtr);
6061 objPtr->typePtr = &coercedDoubleObjType;
6062 objPtr->internalRep.wideValue = wideValue;
6063 return JIM_OK;
6065 else {
6066 /* Try to convert into a double */
6067 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6068 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6069 return JIM_ERR;
6071 /* Free the old internal repr and set the new one. */
6072 Jim_FreeIntRep(interp, objPtr);
6074 objPtr->typePtr = &doubleObjType;
6075 objPtr->internalRep.doubleValue = doubleValue;
6076 return JIM_OK;
6079 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6081 if (objPtr->typePtr == &coercedDoubleObjType) {
6082 *doublePtr = JimWideValue(objPtr);
6083 return JIM_OK;
6085 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6086 return JIM_ERR;
6088 if (objPtr->typePtr == &coercedDoubleObjType) {
6089 *doublePtr = JimWideValue(objPtr);
6091 else {
6092 *doublePtr = objPtr->internalRep.doubleValue;
6094 return JIM_OK;
6097 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6099 Jim_Obj *objPtr;
6101 objPtr = Jim_NewObj(interp);
6102 objPtr->typePtr = &doubleObjType;
6103 objPtr->bytes = NULL;
6104 objPtr->internalRep.doubleValue = doubleValue;
6105 return objPtr;
6108 /* -----------------------------------------------------------------------------
6109 * Boolean conversion
6110 * ---------------------------------------------------------------------------*/
6111 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6113 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6115 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6116 return JIM_ERR;
6117 *booleanPtr = (int) JimWideValue(objPtr);
6118 return JIM_OK;
6121 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6123 static const char * const falses[] = {
6124 "0", "false", "no", "off", NULL
6126 static const char * const trues[] = {
6127 "1", "true", "yes", "on", NULL
6130 int boolean;
6132 int index;
6133 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6134 boolean = 0;
6135 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6136 boolean = 1;
6137 } else {
6138 if (flags & JIM_ERRMSG) {
6139 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6141 return JIM_ERR;
6144 /* Free the old internal repr and set the new one. */
6145 Jim_FreeIntRep(interp, objPtr);
6146 objPtr->typePtr = &intObjType;
6147 objPtr->internalRep.wideValue = boolean;
6148 return JIM_OK;
6151 /* -----------------------------------------------------------------------------
6152 * List object
6153 * ---------------------------------------------------------------------------*/
6154 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6155 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6156 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6157 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6158 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6159 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6161 /* Note that while the elements of the list may contain references,
6162 * the list object itself can't. This basically means that the
6163 * list object string representation as a whole can't contain references
6164 * that are not presents in the single elements. */
6165 static const Jim_ObjType listObjType = {
6166 "list",
6167 FreeListInternalRep,
6168 DupListInternalRep,
6169 UpdateStringOfList,
6170 JIM_TYPE_NONE,
6173 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6175 int i;
6177 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6178 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6180 Jim_Free(objPtr->internalRep.listValue.ele);
6183 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6185 int i;
6187 JIM_NOTUSED(interp);
6189 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6190 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6191 dupPtr->internalRep.listValue.ele =
6192 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6193 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6194 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6195 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6196 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6198 dupPtr->typePtr = &listObjType;
6201 /* The following function checks if a given string can be encoded
6202 * into a list element without any kind of quoting, surrounded by braces,
6203 * or using escapes to quote. */
6204 #define JIM_ELESTR_SIMPLE 0
6205 #define JIM_ELESTR_BRACE 1
6206 #define JIM_ELESTR_QUOTE 2
6207 static unsigned char ListElementQuotingType(const char *s, int len)
6209 int i, level, blevel, trySimple = 1;
6211 /* Try with the SIMPLE case */
6212 if (len == 0)
6213 return JIM_ELESTR_BRACE;
6214 if (s[0] == '"' || s[0] == '{') {
6215 trySimple = 0;
6216 goto testbrace;
6218 for (i = 0; i < len; i++) {
6219 switch (s[i]) {
6220 case ' ':
6221 case '$':
6222 case '"':
6223 case '[':
6224 case ']':
6225 case ';':
6226 case '\\':
6227 case '\r':
6228 case '\n':
6229 case '\t':
6230 case '\f':
6231 case '\v':
6232 trySimple = 0;
6233 /* fall through */
6234 case '{':
6235 case '}':
6236 goto testbrace;
6239 return JIM_ELESTR_SIMPLE;
6241 testbrace:
6242 /* Test if it's possible to do with braces */
6243 if (s[len - 1] == '\\')
6244 return JIM_ELESTR_QUOTE;
6245 level = 0;
6246 blevel = 0;
6247 for (i = 0; i < len; i++) {
6248 switch (s[i]) {
6249 case '{':
6250 level++;
6251 break;
6252 case '}':
6253 level--;
6254 if (level < 0)
6255 return JIM_ELESTR_QUOTE;
6256 break;
6257 case '[':
6258 blevel++;
6259 break;
6260 case ']':
6261 blevel--;
6262 break;
6263 case '\\':
6264 if (s[i + 1] == '\n')
6265 return JIM_ELESTR_QUOTE;
6266 else if (s[i + 1] != '\0')
6267 i++;
6268 break;
6271 if (blevel < 0) {
6272 return JIM_ELESTR_QUOTE;
6275 if (level == 0) {
6276 if (!trySimple)
6277 return JIM_ELESTR_BRACE;
6278 for (i = 0; i < len; i++) {
6279 switch (s[i]) {
6280 case ' ':
6281 case '$':
6282 case '"':
6283 case '[':
6284 case ']':
6285 case ';':
6286 case '\\':
6287 case '\r':
6288 case '\n':
6289 case '\t':
6290 case '\f':
6291 case '\v':
6292 return JIM_ELESTR_BRACE;
6293 break;
6296 return JIM_ELESTR_SIMPLE;
6298 return JIM_ELESTR_QUOTE;
6301 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6302 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6303 * scenario.
6304 * Returns the length of the result.
6306 static int BackslashQuoteString(const char *s, int len, char *q)
6308 char *p = q;
6310 while (len--) {
6311 switch (*s) {
6312 case ' ':
6313 case '$':
6314 case '"':
6315 case '[':
6316 case ']':
6317 case '{':
6318 case '}':
6319 case ';':
6320 case '\\':
6321 *p++ = '\\';
6322 *p++ = *s++;
6323 break;
6324 case '\n':
6325 *p++ = '\\';
6326 *p++ = 'n';
6327 s++;
6328 break;
6329 case '\r':
6330 *p++ = '\\';
6331 *p++ = 'r';
6332 s++;
6333 break;
6334 case '\t':
6335 *p++ = '\\';
6336 *p++ = 't';
6337 s++;
6338 break;
6339 case '\f':
6340 *p++ = '\\';
6341 *p++ = 'f';
6342 s++;
6343 break;
6344 case '\v':
6345 *p++ = '\\';
6346 *p++ = 'v';
6347 s++;
6348 break;
6349 default:
6350 *p++ = *s++;
6351 break;
6354 *p = '\0';
6356 return p - q;
6359 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6361 #define STATIC_QUOTING_LEN 32
6362 int i, bufLen, realLength;
6363 const char *strRep;
6364 char *p;
6365 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6367 /* Estimate the space needed. */
6368 if (objc > STATIC_QUOTING_LEN) {
6369 quotingType = Jim_Alloc(objc);
6371 else {
6372 quotingType = staticQuoting;
6374 bufLen = 0;
6375 for (i = 0; i < objc; i++) {
6376 int len;
6378 strRep = Jim_GetString(objv[i], &len);
6379 quotingType[i] = ListElementQuotingType(strRep, len);
6380 switch (quotingType[i]) {
6381 case JIM_ELESTR_SIMPLE:
6382 if (i != 0 || strRep[0] != '#') {
6383 bufLen += len;
6384 break;
6386 /* Special case '#' on first element needs braces */
6387 quotingType[i] = JIM_ELESTR_BRACE;
6388 /* fall through */
6389 case JIM_ELESTR_BRACE:
6390 bufLen += len + 2;
6391 break;
6392 case JIM_ELESTR_QUOTE:
6393 bufLen += len * 2;
6394 break;
6396 bufLen++; /* elements separator. */
6398 bufLen++;
6400 /* Generate the string rep. */
6401 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6402 realLength = 0;
6403 for (i = 0; i < objc; i++) {
6404 int len, qlen;
6406 strRep = Jim_GetString(objv[i], &len);
6408 switch (quotingType[i]) {
6409 case JIM_ELESTR_SIMPLE:
6410 memcpy(p, strRep, len);
6411 p += len;
6412 realLength += len;
6413 break;
6414 case JIM_ELESTR_BRACE:
6415 *p++ = '{';
6416 memcpy(p, strRep, len);
6417 p += len;
6418 *p++ = '}';
6419 realLength += len + 2;
6420 break;
6421 case JIM_ELESTR_QUOTE:
6422 if (i == 0 && strRep[0] == '#') {
6423 *p++ = '\\';
6424 realLength++;
6426 qlen = BackslashQuoteString(strRep, len, p);
6427 p += qlen;
6428 realLength += qlen;
6429 break;
6431 /* Add a separating space */
6432 if (i + 1 != objc) {
6433 *p++ = ' ';
6434 realLength++;
6437 *p = '\0'; /* nul term. */
6438 objPtr->length = realLength;
6440 if (quotingType != staticQuoting) {
6441 Jim_Free(quotingType);
6445 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6447 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6450 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6452 struct JimParserCtx parser;
6453 const char *str;
6454 int strLen;
6455 Jim_Obj *fileNameObj;
6456 int linenr;
6458 if (objPtr->typePtr == &listObjType) {
6459 return JIM_OK;
6462 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6463 * it also preserves any source location of the dict elements
6464 * which can be very useful
6466 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6467 Jim_Obj **listObjPtrPtr;
6468 int len;
6469 int i;
6471 listObjPtrPtr = JimDictPairs(objPtr, &len);
6472 for (i = 0; i < len; i++) {
6473 Jim_IncrRefCount(listObjPtrPtr[i]);
6476 /* Now just switch the internal rep */
6477 Jim_FreeIntRep(interp, objPtr);
6478 objPtr->typePtr = &listObjType;
6479 objPtr->internalRep.listValue.len = len;
6480 objPtr->internalRep.listValue.maxLen = len;
6481 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6483 return JIM_OK;
6486 /* Try to preserve information about filename / line number */
6487 if (objPtr->typePtr == &sourceObjType) {
6488 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6489 linenr = objPtr->internalRep.sourceValue.lineNumber;
6491 else {
6492 fileNameObj = interp->emptyObj;
6493 linenr = 1;
6495 Jim_IncrRefCount(fileNameObj);
6497 /* Get the string representation */
6498 str = Jim_GetString(objPtr, &strLen);
6500 /* Free the old internal repr just now and initialize the
6501 * new one just now. The string->list conversion can't fail. */
6502 Jim_FreeIntRep(interp, objPtr);
6503 objPtr->typePtr = &listObjType;
6504 objPtr->internalRep.listValue.len = 0;
6505 objPtr->internalRep.listValue.maxLen = 0;
6506 objPtr->internalRep.listValue.ele = NULL;
6508 /* Convert into a list */
6509 if (strLen) {
6510 JimParserInit(&parser, str, strLen, linenr);
6511 while (!parser.eof) {
6512 Jim_Obj *elementPtr;
6514 JimParseList(&parser);
6515 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6516 continue;
6517 elementPtr = JimParserGetTokenObj(interp, &parser);
6518 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6519 ListAppendElement(objPtr, elementPtr);
6522 Jim_DecrRefCount(interp, fileNameObj);
6523 return JIM_OK;
6526 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6528 Jim_Obj *objPtr;
6530 objPtr = Jim_NewObj(interp);
6531 objPtr->typePtr = &listObjType;
6532 objPtr->bytes = NULL;
6533 objPtr->internalRep.listValue.ele = NULL;
6534 objPtr->internalRep.listValue.len = 0;
6535 objPtr->internalRep.listValue.maxLen = 0;
6537 if (len) {
6538 ListInsertElements(objPtr, 0, len, elements);
6541 return objPtr;
6544 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6545 * length of the vector. Note that the user of this function should make
6546 * sure that the list object can't shimmer while the vector returned
6547 * is in use, this vector is the one stored inside the internal representation
6548 * of the list object. This function is not exported, extensions should
6549 * always access to the List object elements using Jim_ListIndex(). */
6550 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6551 Jim_Obj ***listVec)
6553 *listLen = Jim_ListLength(interp, listObj);
6554 *listVec = listObj->internalRep.listValue.ele;
6557 /* Sorting uses ints, but commands may return wide */
6558 static int JimSign(jim_wide w)
6560 if (w == 0) {
6561 return 0;
6563 else if (w < 0) {
6564 return -1;
6566 return 1;
6569 /* ListSortElements type values */
6570 struct lsort_info {
6571 jmp_buf jmpbuf;
6572 Jim_Obj *command;
6573 Jim_Interp *interp;
6574 enum {
6575 JIM_LSORT_ASCII,
6576 JIM_LSORT_NOCASE,
6577 JIM_LSORT_INTEGER,
6578 JIM_LSORT_REAL,
6579 JIM_LSORT_COMMAND
6580 } type;
6581 int order;
6582 int index;
6583 int indexed;
6584 int unique;
6585 int (*subfn)(Jim_Obj **, Jim_Obj **);
6588 static struct lsort_info *sort_info;
6590 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6592 Jim_Obj *lObj, *rObj;
6594 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6595 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6596 longjmp(sort_info->jmpbuf, JIM_ERR);
6598 return sort_info->subfn(&lObj, &rObj);
6601 /* Sort the internal rep of a list. */
6602 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6604 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6607 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6609 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6612 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6614 jim_wide lhs = 0, rhs = 0;
6616 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6617 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6618 longjmp(sort_info->jmpbuf, JIM_ERR);
6621 return JimSign(lhs - rhs) * sort_info->order;
6624 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6626 double lhs = 0, rhs = 0;
6628 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6629 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6630 longjmp(sort_info->jmpbuf, JIM_ERR);
6632 if (lhs == rhs) {
6633 return 0;
6635 if (lhs > rhs) {
6636 return sort_info->order;
6638 return -sort_info->order;
6641 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6643 Jim_Obj *compare_script;
6644 int rc;
6646 jim_wide ret = 0;
6648 /* This must be a valid list */
6649 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6650 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6651 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6653 rc = Jim_EvalObj(sort_info->interp, compare_script);
6655 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6656 longjmp(sort_info->jmpbuf, rc);
6659 return JimSign(ret) * sort_info->order;
6662 /* Remove duplicate elements from the (sorted) list in-place, according to the
6663 * comparison function, comp.
6665 * Note that the last unique value is kept, not the first
6667 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6669 int src;
6670 int dst = 0;
6671 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6673 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6674 if (comp(&ele[dst], &ele[src]) == 0) {
6675 /* Match, so replace the dest with the current source */
6676 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6678 else {
6679 /* No match, so keep the current source and move to the next destination */
6680 dst++;
6682 ele[dst] = ele[src];
6685 /* At end of list, keep the final element unless all elements were kept */
6686 dst++;
6687 if (dst < listObjPtr->internalRep.listValue.len) {
6688 ele[dst] = ele[src];
6691 /* Set the new length */
6692 listObjPtr->internalRep.listValue.len = dst;
6695 /* Sort a list *in place*. MUST be called with a non-shared list. */
6696 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6698 struct lsort_info *prev_info;
6700 typedef int (qsort_comparator) (const void *, const void *);
6701 int (*fn) (Jim_Obj **, Jim_Obj **);
6702 Jim_Obj **vector;
6703 int len;
6704 int rc;
6706 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6707 SetListFromAny(interp, listObjPtr);
6709 /* Allow lsort to be called reentrantly */
6710 prev_info = sort_info;
6711 sort_info = info;
6713 vector = listObjPtr->internalRep.listValue.ele;
6714 len = listObjPtr->internalRep.listValue.len;
6715 switch (info->type) {
6716 case JIM_LSORT_ASCII:
6717 fn = ListSortString;
6718 break;
6719 case JIM_LSORT_NOCASE:
6720 fn = ListSortStringNoCase;
6721 break;
6722 case JIM_LSORT_INTEGER:
6723 fn = ListSortInteger;
6724 break;
6725 case JIM_LSORT_REAL:
6726 fn = ListSortReal;
6727 break;
6728 case JIM_LSORT_COMMAND:
6729 fn = ListSortCommand;
6730 break;
6731 default:
6732 fn = NULL; /* avoid warning */
6733 JimPanic((1, "ListSort called with invalid sort type"));
6734 return -1; /* Should not be run but keeps static analysers happy */
6737 if (info->indexed) {
6738 /* Need to interpose a "list index" function */
6739 info->subfn = fn;
6740 fn = ListSortIndexHelper;
6743 if ((rc = setjmp(info->jmpbuf)) == 0) {
6744 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6746 if (info->unique && len > 1) {
6747 ListRemoveDuplicates(listObjPtr, fn);
6750 Jim_InvalidateStringRep(listObjPtr);
6752 sort_info = prev_info;
6754 return rc;
6757 /* This is the low-level function to insert elements into a list.
6758 * The higher-level Jim_ListInsertElements() performs shared object
6759 * check and invalidates the string repr. This version is used
6760 * in the internals of the List Object and is not exported.
6762 * NOTE: this function can be called only against objects
6763 * with internal type of List.
6765 * An insertion point (idx) of -1 means end-of-list.
6767 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6769 int currentLen = listPtr->internalRep.listValue.len;
6770 int requiredLen = currentLen + elemc;
6771 int i;
6772 Jim_Obj **point;
6774 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6775 if (requiredLen < 2) {
6776 /* Don't do allocations of under 4 pointers. */
6777 requiredLen = 4;
6779 else {
6780 requiredLen *= 2;
6783 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6784 sizeof(Jim_Obj *) * requiredLen);
6786 listPtr->internalRep.listValue.maxLen = requiredLen;
6788 if (idx < 0) {
6789 idx = currentLen;
6791 point = listPtr->internalRep.listValue.ele + idx;
6792 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6793 for (i = 0; i < elemc; ++i) {
6794 point[i] = elemVec[i];
6795 Jim_IncrRefCount(point[i]);
6797 listPtr->internalRep.listValue.len += elemc;
6800 /* Convenience call to ListInsertElements() to append a single element.
6802 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6804 ListInsertElements(listPtr, -1, 1, &objPtr);
6807 /* Appends every element of appendListPtr into listPtr.
6808 * Both have to be of the list type.
6809 * Convenience call to ListInsertElements()
6811 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6813 ListInsertElements(listPtr, -1,
6814 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6817 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6819 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6820 SetListFromAny(interp, listPtr);
6821 Jim_InvalidateStringRep(listPtr);
6822 ListAppendElement(listPtr, objPtr);
6825 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6827 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6828 SetListFromAny(interp, listPtr);
6829 SetListFromAny(interp, appendListPtr);
6830 Jim_InvalidateStringRep(listPtr);
6831 ListAppendList(listPtr, appendListPtr);
6834 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6836 SetListFromAny(interp, objPtr);
6837 return objPtr->internalRep.listValue.len;
6840 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6841 int objc, Jim_Obj *const *objVec)
6843 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6844 SetListFromAny(interp, listPtr);
6845 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6846 idx = listPtr->internalRep.listValue.len;
6847 else if (idx < 0)
6848 idx = 0;
6849 Jim_InvalidateStringRep(listPtr);
6850 ListInsertElements(listPtr, idx, objc, objVec);
6853 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6855 SetListFromAny(interp, listPtr);
6856 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6857 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6858 return NULL;
6860 if (idx < 0)
6861 idx = listPtr->internalRep.listValue.len + idx;
6862 return listPtr->internalRep.listValue.ele[idx];
6865 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6867 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6868 if (*objPtrPtr == NULL) {
6869 if (flags & JIM_ERRMSG) {
6870 Jim_SetResultString(interp, "list index out of range", -1);
6872 return JIM_ERR;
6874 return JIM_OK;
6877 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6878 Jim_Obj *newObjPtr, int flags)
6880 SetListFromAny(interp, listPtr);
6881 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6882 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6883 if (flags & JIM_ERRMSG) {
6884 Jim_SetResultString(interp, "list index out of range", -1);
6886 return JIM_ERR;
6888 if (idx < 0)
6889 idx = listPtr->internalRep.listValue.len + idx;
6890 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6891 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6892 Jim_IncrRefCount(newObjPtr);
6893 return JIM_OK;
6896 /* Modify the list stored in the variable named 'varNamePtr'
6897 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6898 * with the new element 'newObjptr'. (implements the [lset] command) */
6899 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6900 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6902 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6903 int shared, i, idx;
6905 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6906 if (objPtr == NULL)
6907 return JIM_ERR;
6908 if ((shared = Jim_IsShared(objPtr)))
6909 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6910 for (i = 0; i < indexc - 1; i++) {
6911 listObjPtr = objPtr;
6912 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6913 goto err;
6914 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6915 goto err;
6917 if (Jim_IsShared(objPtr)) {
6918 objPtr = Jim_DuplicateObj(interp, objPtr);
6919 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6921 Jim_InvalidateStringRep(listObjPtr);
6923 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6924 goto err;
6925 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6926 goto err;
6927 Jim_InvalidateStringRep(objPtr);
6928 Jim_InvalidateStringRep(varObjPtr);
6929 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6930 goto err;
6931 Jim_SetResult(interp, varObjPtr);
6932 return JIM_OK;
6933 err:
6934 if (shared) {
6935 Jim_FreeNewObj(interp, varObjPtr);
6937 return JIM_ERR;
6940 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6942 int i;
6943 int listLen = Jim_ListLength(interp, listObjPtr);
6944 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6946 for (i = 0; i < listLen; ) {
6947 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6948 if (++i != listLen) {
6949 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6952 return resObjPtr;
6955 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6957 int i;
6959 /* If all the objects in objv are lists,
6960 * it's possible to return a list as result, that's the
6961 * concatenation of all the lists. */
6962 for (i = 0; i < objc; i++) {
6963 if (!Jim_IsList(objv[i]))
6964 break;
6966 if (i == objc) {
6967 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6969 for (i = 0; i < objc; i++)
6970 ListAppendList(objPtr, objv[i]);
6971 return objPtr;
6973 else {
6974 /* Else... we have to glue strings together */
6975 int len = 0, objLen;
6976 char *bytes, *p;
6978 /* Compute the length */
6979 for (i = 0; i < objc; i++) {
6980 len += Jim_Length(objv[i]);
6982 if (objc)
6983 len += objc - 1;
6984 /* Create the string rep, and a string object holding it. */
6985 p = bytes = Jim_Alloc(len + 1);
6986 for (i = 0; i < objc; i++) {
6987 const char *s = Jim_GetString(objv[i], &objLen);
6989 /* Remove leading space */
6990 while (objLen && isspace(UCHAR(*s))) {
6991 s++;
6992 objLen--;
6993 len--;
6995 /* And trailing space */
6996 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6997 /* Handle trailing backslash-space case */
6998 if (objLen > 1 && s[objLen - 2] == '\\') {
6999 break;
7001 objLen--;
7002 len--;
7004 memcpy(p, s, objLen);
7005 p += objLen;
7006 if (i + 1 != objc) {
7007 if (objLen)
7008 *p++ = ' ';
7009 else {
7010 /* Drop the space calculated for this
7011 * element that is instead null. */
7012 len--;
7016 *p = '\0';
7017 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7021 /* Returns a list composed of the elements in the specified range.
7022 * first and start are directly accepted as Jim_Objects and
7023 * processed for the end?-index? case. */
7024 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7025 Jim_Obj *lastObjPtr)
7027 int first, last;
7028 int len, rangeLen;
7030 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7031 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7032 return NULL;
7033 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7034 first = JimRelToAbsIndex(len, first);
7035 last = JimRelToAbsIndex(len, last);
7036 JimRelToAbsRange(len, &first, &last, &rangeLen);
7037 if (first == 0 && last == len) {
7038 return listObjPtr;
7040 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7043 /* -----------------------------------------------------------------------------
7044 * Dict object
7045 * ---------------------------------------------------------------------------*/
7046 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7047 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7048 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7049 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7051 /* Dict HashTable Type.
7053 * Keys and Values are Jim objects. */
7055 static unsigned int JimObjectHTHashFunction(const void *key)
7057 int len;
7058 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7059 return Jim_GenHashFunction((const unsigned char *)str, len);
7062 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7064 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7067 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7069 Jim_IncrRefCount((Jim_Obj *)val);
7070 return (void *)val;
7073 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7075 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7078 static const Jim_HashTableType JimDictHashTableType = {
7079 JimObjectHTHashFunction, /* hash function */
7080 JimObjectHTKeyValDup, /* key dup */
7081 JimObjectHTKeyValDup, /* val dup */
7082 JimObjectHTKeyCompare, /* key compare */
7083 JimObjectHTKeyValDestructor, /* key destructor */
7084 JimObjectHTKeyValDestructor /* val destructor */
7087 /* Note that while the elements of the dict may contain references,
7088 * the list object itself can't. This basically means that the
7089 * dict object string representation as a whole can't contain references
7090 * that are not presents in the single elements. */
7091 static const Jim_ObjType dictObjType = {
7092 "dict",
7093 FreeDictInternalRep,
7094 DupDictInternalRep,
7095 UpdateStringOfDict,
7096 JIM_TYPE_NONE,
7099 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7101 JIM_NOTUSED(interp);
7103 Jim_FreeHashTable(objPtr->internalRep.ptr);
7104 Jim_Free(objPtr->internalRep.ptr);
7107 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7109 Jim_HashTable *ht, *dupHt;
7110 Jim_HashTableIterator htiter;
7111 Jim_HashEntry *he;
7113 /* Create a new hash table */
7114 ht = srcPtr->internalRep.ptr;
7115 dupHt = Jim_Alloc(sizeof(*dupHt));
7116 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7117 if (ht->size != 0)
7118 Jim_ExpandHashTable(dupHt, ht->size);
7119 /* Copy every element from the source to the dup hash table */
7120 JimInitHashTableIterator(ht, &htiter);
7121 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7122 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7125 dupPtr->internalRep.ptr = dupHt;
7126 dupPtr->typePtr = &dictObjType;
7129 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7131 Jim_HashTable *ht;
7132 Jim_HashTableIterator htiter;
7133 Jim_HashEntry *he;
7134 Jim_Obj **objv;
7135 int i;
7137 ht = dictPtr->internalRep.ptr;
7139 /* Turn the hash table into a flat vector of Jim_Objects. */
7140 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7141 JimInitHashTableIterator(ht, &htiter);
7142 i = 0;
7143 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7144 objv[i++] = Jim_GetHashEntryKey(he);
7145 objv[i++] = Jim_GetHashEntryVal(he);
7147 *len = i;
7148 return objv;
7151 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7153 /* Turn the hash table into a flat vector of Jim_Objects. */
7154 int len;
7155 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7157 /* And now generate the string rep as a list */
7158 JimMakeListStringRep(objPtr, objv, len);
7160 Jim_Free(objv);
7163 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7165 int listlen;
7167 if (objPtr->typePtr == &dictObjType) {
7168 return JIM_OK;
7171 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7172 /* A shared list, so get the string representation now to avoid
7173 * changing the order in case of fast conversion to dict.
7175 Jim_String(objPtr);
7178 /* For simplicity, convert a non-list object to a list and then to a dict */
7179 listlen = Jim_ListLength(interp, objPtr);
7180 if (listlen % 2) {
7181 Jim_SetResultString(interp, "missing value to go with key", -1);
7182 return JIM_ERR;
7184 else {
7185 /* Converting from a list to a dict can't fail */
7186 Jim_HashTable *ht;
7187 int i;
7189 ht = Jim_Alloc(sizeof(*ht));
7190 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7192 for (i = 0; i < listlen; i += 2) {
7193 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7194 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7196 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7199 Jim_FreeIntRep(interp, objPtr);
7200 objPtr->typePtr = &dictObjType;
7201 objPtr->internalRep.ptr = ht;
7203 return JIM_OK;
7207 /* Dict object API */
7209 /* Add an element to a dict. objPtr must be of the "dict" type.
7210 * The higher-level exported function is Jim_DictAddElement().
7211 * If an element with the specified key already exists, the value
7212 * associated is replaced with the new one.
7214 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7215 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7216 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7218 Jim_HashTable *ht = objPtr->internalRep.ptr;
7220 if (valueObjPtr == NULL) { /* unset */
7221 return Jim_DeleteHashEntry(ht, keyObjPtr);
7223 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7224 return JIM_OK;
7227 /* Add an element, higher-level interface for DictAddElement().
7228 * If valueObjPtr == NULL, the key is removed if it exists. */
7229 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7230 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7232 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7233 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7234 return JIM_ERR;
7236 Jim_InvalidateStringRep(objPtr);
7237 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7240 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7242 Jim_Obj *objPtr;
7243 int i;
7245 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7247 objPtr = Jim_NewObj(interp);
7248 objPtr->typePtr = &dictObjType;
7249 objPtr->bytes = NULL;
7250 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7251 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7252 for (i = 0; i < len; i += 2)
7253 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7254 return objPtr;
7257 /* Return the value associated to the specified dict key
7258 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7260 * Sets *objPtrPtr to non-NULL only upon success.
7262 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7263 Jim_Obj **objPtrPtr, int flags)
7265 Jim_HashEntry *he;
7266 Jim_HashTable *ht;
7268 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7269 return -1;
7271 ht = dictPtr->internalRep.ptr;
7272 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7273 if (flags & JIM_ERRMSG) {
7274 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7276 return JIM_ERR;
7278 else {
7279 *objPtrPtr = Jim_GetHashEntryVal(he);
7280 return JIM_OK;
7284 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7285 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7287 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7288 return JIM_ERR;
7290 *objPtrPtr = JimDictPairs(dictPtr, len);
7292 return JIM_OK;
7296 /* Return the value associated to the specified dict keys */
7297 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7298 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7300 int i;
7302 if (keyc == 0) {
7303 *objPtrPtr = dictPtr;
7304 return JIM_OK;
7307 for (i = 0; i < keyc; i++) {
7308 Jim_Obj *objPtr;
7310 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7311 if (rc != JIM_OK) {
7312 return rc;
7314 dictPtr = objPtr;
7316 *objPtrPtr = dictPtr;
7317 return JIM_OK;
7320 /* Modify the dict stored into the variable named 'varNamePtr'
7321 * setting the element specified by the 'keyc' keys objects in 'keyv',
7322 * with the new value of the element 'newObjPtr'.
7324 * If newObjPtr == NULL the operation is to remove the given key
7325 * from the dictionary.
7327 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7328 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7330 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7331 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7333 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7334 int shared, i;
7336 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7337 if (objPtr == NULL) {
7338 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7339 /* Cannot remove a key from non existing var */
7340 return JIM_ERR;
7342 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7343 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7344 Jim_FreeNewObj(interp, varObjPtr);
7345 return JIM_ERR;
7348 if ((shared = Jim_IsShared(objPtr)))
7349 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7350 for (i = 0; i < keyc; i++) {
7351 dictObjPtr = objPtr;
7353 /* Check if it's a valid dictionary */
7354 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7355 goto err;
7358 if (i == keyc - 1) {
7359 /* Last key: Note that error on unset with missing last key is OK */
7360 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7361 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7362 goto err;
7365 break;
7368 /* Check if the given key exists. */
7369 Jim_InvalidateStringRep(dictObjPtr);
7370 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7371 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7372 /* This key exists at the current level.
7373 * Make sure it's not shared!. */
7374 if (Jim_IsShared(objPtr)) {
7375 objPtr = Jim_DuplicateObj(interp, objPtr);
7376 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7379 else {
7380 /* Key not found. If it's an [unset] operation
7381 * this is an error. Only the last key may not
7382 * exist. */
7383 if (newObjPtr == NULL) {
7384 goto err;
7386 /* Otherwise set an empty dictionary
7387 * as key's value. */
7388 objPtr = Jim_NewDictObj(interp, NULL, 0);
7389 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7392 /* XXX: Is this necessary? */
7393 Jim_InvalidateStringRep(objPtr);
7394 Jim_InvalidateStringRep(varObjPtr);
7395 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7396 goto err;
7398 Jim_SetResult(interp, varObjPtr);
7399 return JIM_OK;
7400 err:
7401 if (shared) {
7402 Jim_FreeNewObj(interp, varObjPtr);
7404 return JIM_ERR;
7407 /* -----------------------------------------------------------------------------
7408 * Index object
7409 * ---------------------------------------------------------------------------*/
7410 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7411 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7413 static const Jim_ObjType indexObjType = {
7414 "index",
7415 NULL,
7416 NULL,
7417 UpdateStringOfIndex,
7418 JIM_TYPE_NONE,
7421 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7423 if (objPtr->internalRep.intValue == -1) {
7424 JimSetStringBytes(objPtr, "end");
7426 else {
7427 char buf[JIM_INTEGER_SPACE + 1];
7428 if (objPtr->internalRep.intValue >= 0) {
7429 sprintf(buf, "%d", objPtr->internalRep.intValue);
7431 else {
7432 /* Must be <= -2 */
7433 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7435 JimSetStringBytes(objPtr, buf);
7439 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7441 int idx, end = 0;
7442 const char *str;
7443 char *endptr;
7445 /* Get the string representation */
7446 str = Jim_String(objPtr);
7448 /* Try to convert into an index */
7449 if (strncmp(str, "end", 3) == 0) {
7450 end = 1;
7451 str += 3;
7452 idx = 0;
7454 else {
7455 idx = jim_strtol(str, &endptr);
7457 if (endptr == str) {
7458 goto badindex;
7460 str = endptr;
7463 /* Now str may include or +<num> or -<num> */
7464 if (*str == '+' || *str == '-') {
7465 int sign = (*str == '+' ? 1 : -1);
7467 idx += sign * jim_strtol(++str, &endptr);
7468 if (str == endptr || *endptr) {
7469 goto badindex;
7471 str = endptr;
7473 /* The only thing left should be spaces */
7474 while (isspace(UCHAR(*str))) {
7475 str++;
7477 if (*str) {
7478 goto badindex;
7480 if (end) {
7481 if (idx > 0) {
7482 idx = INT_MAX;
7484 else {
7485 /* end-1 is repesented as -2 */
7486 idx--;
7489 else if (idx < 0) {
7490 idx = -INT_MAX;
7493 /* Free the old internal repr and set the new one. */
7494 Jim_FreeIntRep(interp, objPtr);
7495 objPtr->typePtr = &indexObjType;
7496 objPtr->internalRep.intValue = idx;
7497 return JIM_OK;
7499 badindex:
7500 Jim_SetResultFormatted(interp,
7501 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7502 return JIM_ERR;
7505 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7507 /* Avoid shimmering if the object is an integer. */
7508 if (objPtr->typePtr == &intObjType) {
7509 jim_wide val = JimWideValue(objPtr);
7511 if (val < 0)
7512 *indexPtr = -INT_MAX;
7513 else if (val > INT_MAX)
7514 *indexPtr = INT_MAX;
7515 else
7516 *indexPtr = (int)val;
7517 return JIM_OK;
7519 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7520 return JIM_ERR;
7521 *indexPtr = objPtr->internalRep.intValue;
7522 return JIM_OK;
7525 /* -----------------------------------------------------------------------------
7526 * Return Code Object.
7527 * ---------------------------------------------------------------------------*/
7529 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7530 static const char * const jimReturnCodes[] = {
7531 "ok",
7532 "error",
7533 "return",
7534 "break",
7535 "continue",
7536 "signal",
7537 "exit",
7538 "eval",
7539 NULL
7542 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7544 static const Jim_ObjType returnCodeObjType = {
7545 "return-code",
7546 NULL,
7547 NULL,
7548 NULL,
7549 JIM_TYPE_NONE,
7552 /* Converts a (standard) return code to a string. Returns "?" for
7553 * non-standard return codes.
7555 const char *Jim_ReturnCode(int code)
7557 if (code < 0 || code >= (int)jimReturnCodesSize) {
7558 return "?";
7560 else {
7561 return jimReturnCodes[code];
7565 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7567 int returnCode;
7568 jim_wide wideValue;
7570 /* Try to convert into an integer */
7571 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7572 returnCode = (int)wideValue;
7573 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7574 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7575 return JIM_ERR;
7577 /* Free the old internal repr and set the new one. */
7578 Jim_FreeIntRep(interp, objPtr);
7579 objPtr->typePtr = &returnCodeObjType;
7580 objPtr->internalRep.intValue = returnCode;
7581 return JIM_OK;
7584 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7586 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7587 return JIM_ERR;
7588 *intPtr = objPtr->internalRep.intValue;
7589 return JIM_OK;
7592 /* -----------------------------------------------------------------------------
7593 * Expression Parsing
7594 * ---------------------------------------------------------------------------*/
7595 static int JimParseExprOperator(struct JimParserCtx *pc);
7596 static int JimParseExprNumber(struct JimParserCtx *pc);
7597 static int JimParseExprIrrational(struct JimParserCtx *pc);
7598 static int JimParseExprBoolean(struct JimParserCtx *pc);
7600 /* expr operator opcodes. */
7601 enum
7603 /* Continues on from the JIM_TT_ space */
7605 /* Binary operators (numbers) */
7606 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7607 JIM_EXPROP_DIV,
7608 JIM_EXPROP_MOD,
7609 JIM_EXPROP_SUB,
7610 JIM_EXPROP_ADD,
7611 JIM_EXPROP_LSHIFT,
7612 JIM_EXPROP_RSHIFT,
7613 JIM_EXPROP_ROTL,
7614 JIM_EXPROP_ROTR,
7615 JIM_EXPROP_LT,
7616 JIM_EXPROP_GT,
7617 JIM_EXPROP_LTE,
7618 JIM_EXPROP_GTE,
7619 JIM_EXPROP_NUMEQ,
7620 JIM_EXPROP_NUMNE,
7621 JIM_EXPROP_BITAND, /* 35 */
7622 JIM_EXPROP_BITXOR,
7623 JIM_EXPROP_BITOR,
7624 JIM_EXPROP_LOGICAND, /* 38 */
7625 JIM_EXPROP_LOGICOR, /* 39 */
7626 JIM_EXPROP_TERNARY, /* 40 */
7627 JIM_EXPROP_COLON, /* 41 */
7628 JIM_EXPROP_POW, /* 42 */
7630 /* Binary operators (strings) */
7631 JIM_EXPROP_STREQ, /* 43 */
7632 JIM_EXPROP_STRNE,
7633 JIM_EXPROP_STRIN,
7634 JIM_EXPROP_STRNI,
7636 /* Unary operators (numbers) */
7637 JIM_EXPROP_NOT, /* 47 */
7638 JIM_EXPROP_BITNOT,
7639 JIM_EXPROP_UNARYMINUS,
7640 JIM_EXPROP_UNARYPLUS,
7642 /* Functions */
7643 JIM_EXPROP_FUNC_INT, /* 51 */
7644 JIM_EXPROP_FUNC_WIDE,
7645 JIM_EXPROP_FUNC_ABS,
7646 JIM_EXPROP_FUNC_DOUBLE,
7647 JIM_EXPROP_FUNC_ROUND,
7648 JIM_EXPROP_FUNC_RAND,
7649 JIM_EXPROP_FUNC_SRAND,
7651 /* math functions from libm */
7652 JIM_EXPROP_FUNC_SIN, /* 65 */
7653 JIM_EXPROP_FUNC_COS,
7654 JIM_EXPROP_FUNC_TAN,
7655 JIM_EXPROP_FUNC_ASIN,
7656 JIM_EXPROP_FUNC_ACOS,
7657 JIM_EXPROP_FUNC_ATAN,
7658 JIM_EXPROP_FUNC_ATAN2,
7659 JIM_EXPROP_FUNC_SINH,
7660 JIM_EXPROP_FUNC_COSH,
7661 JIM_EXPROP_FUNC_TANH,
7662 JIM_EXPROP_FUNC_CEIL,
7663 JIM_EXPROP_FUNC_FLOOR,
7664 JIM_EXPROP_FUNC_EXP,
7665 JIM_EXPROP_FUNC_LOG,
7666 JIM_EXPROP_FUNC_LOG10,
7667 JIM_EXPROP_FUNC_SQRT,
7668 JIM_EXPROP_FUNC_POW,
7669 JIM_EXPROP_FUNC_HYPOT,
7670 JIM_EXPROP_FUNC_FMOD,
7673 /* A expression node is either a term or an operator
7674 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7676 struct JimExprNode {
7677 int type; /* JIM_TT_xxx */
7678 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7680 struct JimExprNode *left; /* For all operators */
7681 struct JimExprNode *right; /* For binary operators */
7682 struct JimExprNode *ternary; /* For ternary operator only */
7685 /* Operators table */
7686 typedef struct Jim_ExprOperator
7688 const char *name;
7689 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7690 unsigned char precedence;
7691 unsigned char arity;
7692 unsigned char attr;
7693 unsigned char namelen;
7694 } Jim_ExprOperator;
7696 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7697 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7698 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7700 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7702 int intresult = 1;
7703 int rc;
7704 double dA, dC = 0;
7705 jim_wide wA, wC = 0;
7706 Jim_Obj *A;
7708 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7709 return rc;
7712 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7713 switch (node->type) {
7714 case JIM_EXPROP_FUNC_INT:
7715 case JIM_EXPROP_FUNC_WIDE:
7716 case JIM_EXPROP_FUNC_ROUND:
7717 case JIM_EXPROP_UNARYPLUS:
7718 wC = wA;
7719 break;
7720 case JIM_EXPROP_FUNC_DOUBLE:
7721 dC = wA;
7722 intresult = 0;
7723 break;
7724 case JIM_EXPROP_FUNC_ABS:
7725 wC = wA >= 0 ? wA : -wA;
7726 break;
7727 case JIM_EXPROP_UNARYMINUS:
7728 wC = -wA;
7729 break;
7730 case JIM_EXPROP_NOT:
7731 wC = !wA;
7732 break;
7733 default:
7734 abort();
7737 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7738 switch (node->type) {
7739 case JIM_EXPROP_FUNC_INT:
7740 case JIM_EXPROP_FUNC_WIDE:
7741 wC = dA;
7742 break;
7743 case JIM_EXPROP_FUNC_ROUND:
7744 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7745 break;
7746 case JIM_EXPROP_FUNC_DOUBLE:
7747 case JIM_EXPROP_UNARYPLUS:
7748 dC = dA;
7749 intresult = 0;
7750 break;
7751 case JIM_EXPROP_FUNC_ABS:
7752 #ifdef JIM_MATH_FUNCTIONS
7753 dC = fabs(dA);
7754 #else
7755 dC = dA >= 0 ? dA : -dA;
7756 #endif
7757 intresult = 0;
7758 break;
7759 case JIM_EXPROP_UNARYMINUS:
7760 dC = -dA;
7761 intresult = 0;
7762 break;
7763 case JIM_EXPROP_NOT:
7764 wC = !dA;
7765 break;
7766 default:
7767 abort();
7771 if (rc == JIM_OK) {
7772 if (intresult) {
7773 Jim_SetResultInt(interp, wC);
7775 else {
7776 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7780 Jim_DecrRefCount(interp, A);
7782 return rc;
7785 static double JimRandDouble(Jim_Interp *interp)
7787 unsigned long x;
7788 JimRandomBytes(interp, &x, sizeof(x));
7790 return (double)x / (unsigned long)~0;
7793 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7795 jim_wide wA;
7796 Jim_Obj *A;
7797 int rc;
7799 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7800 return rc;
7803 rc = Jim_GetWide(interp, A, &wA);
7804 if (rc == JIM_OK) {
7805 switch (node->type) {
7806 case JIM_EXPROP_BITNOT:
7807 Jim_SetResultInt(interp, ~wA);
7808 break;
7809 case JIM_EXPROP_FUNC_SRAND:
7810 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7811 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7812 break;
7813 default:
7814 abort();
7818 Jim_DecrRefCount(interp, A);
7820 return rc;
7823 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7825 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7827 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7829 return JIM_OK;
7832 #ifdef JIM_MATH_FUNCTIONS
7833 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7835 int rc;
7836 double dA, dC;
7837 Jim_Obj *A;
7839 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7840 return rc;
7843 rc = Jim_GetDouble(interp, A, &dA);
7844 if (rc == JIM_OK) {
7845 switch (node->type) {
7846 case JIM_EXPROP_FUNC_SIN:
7847 dC = sin(dA);
7848 break;
7849 case JIM_EXPROP_FUNC_COS:
7850 dC = cos(dA);
7851 break;
7852 case JIM_EXPROP_FUNC_TAN:
7853 dC = tan(dA);
7854 break;
7855 case JIM_EXPROP_FUNC_ASIN:
7856 dC = asin(dA);
7857 break;
7858 case JIM_EXPROP_FUNC_ACOS:
7859 dC = acos(dA);
7860 break;
7861 case JIM_EXPROP_FUNC_ATAN:
7862 dC = atan(dA);
7863 break;
7864 case JIM_EXPROP_FUNC_SINH:
7865 dC = sinh(dA);
7866 break;
7867 case JIM_EXPROP_FUNC_COSH:
7868 dC = cosh(dA);
7869 break;
7870 case JIM_EXPROP_FUNC_TANH:
7871 dC = tanh(dA);
7872 break;
7873 case JIM_EXPROP_FUNC_CEIL:
7874 dC = ceil(dA);
7875 break;
7876 case JIM_EXPROP_FUNC_FLOOR:
7877 dC = floor(dA);
7878 break;
7879 case JIM_EXPROP_FUNC_EXP:
7880 dC = exp(dA);
7881 break;
7882 case JIM_EXPROP_FUNC_LOG:
7883 dC = log(dA);
7884 break;
7885 case JIM_EXPROP_FUNC_LOG10:
7886 dC = log10(dA);
7887 break;
7888 case JIM_EXPROP_FUNC_SQRT:
7889 dC = sqrt(dA);
7890 break;
7891 default:
7892 abort();
7894 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7897 Jim_DecrRefCount(interp, A);
7899 return rc;
7901 #endif
7903 /* A binary operation on two ints */
7904 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7906 jim_wide wA, wB;
7907 int rc;
7908 Jim_Obj *A, *B;
7910 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7911 return rc;
7913 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7914 Jim_DecrRefCount(interp, A);
7915 return rc;
7918 rc = JIM_ERR;
7920 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7921 jim_wide wC;
7923 rc = JIM_OK;
7925 switch (node->type) {
7926 case JIM_EXPROP_LSHIFT:
7927 wC = wA << wB;
7928 break;
7929 case JIM_EXPROP_RSHIFT:
7930 wC = wA >> wB;
7931 break;
7932 case JIM_EXPROP_BITAND:
7933 wC = wA & wB;
7934 break;
7935 case JIM_EXPROP_BITXOR:
7936 wC = wA ^ wB;
7937 break;
7938 case JIM_EXPROP_BITOR:
7939 wC = wA | wB;
7940 break;
7941 case JIM_EXPROP_MOD:
7942 if (wB == 0) {
7943 wC = 0;
7944 Jim_SetResultString(interp, "Division by zero", -1);
7945 rc = JIM_ERR;
7947 else {
7949 * From Tcl 8.x
7951 * This code is tricky: C doesn't guarantee much
7952 * about the quotient or remainder, but Tcl does.
7953 * The remainder always has the same sign as the
7954 * divisor and a smaller absolute value.
7956 int negative = 0;
7958 if (wB < 0) {
7959 wB = -wB;
7960 wA = -wA;
7961 negative = 1;
7963 wC = wA % wB;
7964 if (wC < 0) {
7965 wC += wB;
7967 if (negative) {
7968 wC = -wC;
7971 break;
7972 case JIM_EXPROP_ROTL:
7973 case JIM_EXPROP_ROTR:{
7974 /* uint32_t would be better. But not everyone has inttypes.h? */
7975 unsigned long uA = (unsigned long)wA;
7976 unsigned long uB = (unsigned long)wB;
7977 const unsigned int S = sizeof(unsigned long) * 8;
7979 /* Shift left by the word size or more is undefined. */
7980 uB %= S;
7982 if (node->type == JIM_EXPROP_ROTR) {
7983 uB = S - uB;
7985 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7986 break;
7988 default:
7989 abort();
7991 Jim_SetResultInt(interp, wC);
7994 Jim_DecrRefCount(interp, A);
7995 Jim_DecrRefCount(interp, B);
7997 return rc;
8001 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8002 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8004 int rc = JIM_OK;
8005 double dA, dB, dC = 0;
8006 jim_wide wA, wB, wC = 0;
8007 Jim_Obj *A, *B;
8009 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8010 return rc;
8012 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8013 Jim_DecrRefCount(interp, A);
8014 return rc;
8017 if ((A->typePtr != &doubleObjType || A->bytes) &&
8018 (B->typePtr != &doubleObjType || B->bytes) &&
8019 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8021 /* Both are ints */
8023 switch (node->type) {
8024 case JIM_EXPROP_POW:
8025 case JIM_EXPROP_FUNC_POW:
8026 if (wA == 0 && wB < 0) {
8027 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8028 rc = JIM_ERR;
8029 goto done;
8031 wC = JimPowWide(wA, wB);
8032 goto intresult;
8033 case JIM_EXPROP_ADD:
8034 wC = wA + wB;
8035 goto intresult;
8036 case JIM_EXPROP_SUB:
8037 wC = wA - wB;
8038 goto intresult;
8039 case JIM_EXPROP_MUL:
8040 wC = wA * wB;
8041 goto intresult;
8042 case JIM_EXPROP_DIV:
8043 if (wB == 0) {
8044 Jim_SetResultString(interp, "Division by zero", -1);
8045 rc = JIM_ERR;
8046 goto done;
8048 else {
8050 * From Tcl 8.x
8052 * This code is tricky: C doesn't guarantee much
8053 * about the quotient or remainder, but Tcl does.
8054 * The remainder always has the same sign as the
8055 * divisor and a smaller absolute value.
8057 if (wB < 0) {
8058 wB = -wB;
8059 wA = -wA;
8061 wC = wA / wB;
8062 if (wA % wB < 0) {
8063 wC--;
8065 goto intresult;
8067 case JIM_EXPROP_LT:
8068 wC = wA < wB;
8069 goto intresult;
8070 case JIM_EXPROP_GT:
8071 wC = wA > wB;
8072 goto intresult;
8073 case JIM_EXPROP_LTE:
8074 wC = wA <= wB;
8075 goto intresult;
8076 case JIM_EXPROP_GTE:
8077 wC = wA >= wB;
8078 goto intresult;
8079 case JIM_EXPROP_NUMEQ:
8080 wC = wA == wB;
8081 goto intresult;
8082 case JIM_EXPROP_NUMNE:
8083 wC = wA != wB;
8084 goto intresult;
8087 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8088 switch (node->type) {
8089 #ifndef JIM_MATH_FUNCTIONS
8090 case JIM_EXPROP_POW:
8091 case JIM_EXPROP_FUNC_POW:
8092 case JIM_EXPROP_FUNC_ATAN2:
8093 case JIM_EXPROP_FUNC_HYPOT:
8094 case JIM_EXPROP_FUNC_FMOD:
8095 Jim_SetResultString(interp, "unsupported", -1);
8096 rc = JIM_ERR;
8097 goto done;
8098 #else
8099 case JIM_EXPROP_POW:
8100 case JIM_EXPROP_FUNC_POW:
8101 dC = pow(dA, dB);
8102 goto doubleresult;
8103 case JIM_EXPROP_FUNC_ATAN2:
8104 dC = atan2(dA, dB);
8105 goto doubleresult;
8106 case JIM_EXPROP_FUNC_HYPOT:
8107 dC = hypot(dA, dB);
8108 goto doubleresult;
8109 case JIM_EXPROP_FUNC_FMOD:
8110 dC = fmod(dA, dB);
8111 goto doubleresult;
8112 #endif
8113 case JIM_EXPROP_ADD:
8114 dC = dA + dB;
8115 goto doubleresult;
8116 case JIM_EXPROP_SUB:
8117 dC = dA - dB;
8118 goto doubleresult;
8119 case JIM_EXPROP_MUL:
8120 dC = dA * dB;
8121 goto doubleresult;
8122 case JIM_EXPROP_DIV:
8123 if (dB == 0) {
8124 #ifdef INFINITY
8125 dC = dA < 0 ? -INFINITY : INFINITY;
8126 #else
8127 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8128 #endif
8130 else {
8131 dC = dA / dB;
8133 goto doubleresult;
8134 case JIM_EXPROP_LT:
8135 wC = dA < dB;
8136 goto intresult;
8137 case JIM_EXPROP_GT:
8138 wC = dA > dB;
8139 goto intresult;
8140 case JIM_EXPROP_LTE:
8141 wC = dA <= dB;
8142 goto intresult;
8143 case JIM_EXPROP_GTE:
8144 wC = dA >= dB;
8145 goto intresult;
8146 case JIM_EXPROP_NUMEQ:
8147 wC = dA == dB;
8148 goto intresult;
8149 case JIM_EXPROP_NUMNE:
8150 wC = dA != dB;
8151 goto intresult;
8154 else {
8155 /* Handle the string case */
8157 /* XXX: Could optimise the eq/ne case by checking lengths */
8158 int i = Jim_StringCompareObj(interp, A, B, 0);
8160 switch (node->type) {
8161 case JIM_EXPROP_LT:
8162 wC = i < 0;
8163 goto intresult;
8164 case JIM_EXPROP_GT:
8165 wC = i > 0;
8166 goto intresult;
8167 case JIM_EXPROP_LTE:
8168 wC = i <= 0;
8169 goto intresult;
8170 case JIM_EXPROP_GTE:
8171 wC = i >= 0;
8172 goto intresult;
8173 case JIM_EXPROP_NUMEQ:
8174 wC = i == 0;
8175 goto intresult;
8176 case JIM_EXPROP_NUMNE:
8177 wC = i != 0;
8178 goto intresult;
8181 /* If we get here, it is an error */
8182 rc = JIM_ERR;
8183 done:
8184 Jim_DecrRefCount(interp, A);
8185 Jim_DecrRefCount(interp, B);
8186 return rc;
8187 intresult:
8188 Jim_SetResultInt(interp, wC);
8189 goto done;
8190 doubleresult:
8191 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8192 goto done;
8195 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8197 int listlen;
8198 int i;
8200 listlen = Jim_ListLength(interp, listObjPtr);
8201 for (i = 0; i < listlen; i++) {
8202 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8203 return 1;
8206 return 0;
8211 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8213 Jim_Obj *A, *B;
8214 jim_wide wC;
8215 int rc;
8217 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8218 return rc;
8220 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8221 Jim_DecrRefCount(interp, A);
8222 return rc;
8225 switch (node->type) {
8226 case JIM_EXPROP_STREQ:
8227 case JIM_EXPROP_STRNE:
8228 wC = Jim_StringEqObj(A, B);
8229 if (node->type == JIM_EXPROP_STRNE) {
8230 wC = !wC;
8232 break;
8233 case JIM_EXPROP_STRIN:
8234 wC = JimSearchList(interp, B, A);
8235 break;
8236 case JIM_EXPROP_STRNI:
8237 wC = !JimSearchList(interp, B, A);
8238 break;
8239 default:
8240 abort();
8242 Jim_SetResultInt(interp, wC);
8244 Jim_DecrRefCount(interp, A);
8245 Jim_DecrRefCount(interp, B);
8247 return rc;
8250 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8252 long l;
8253 double d;
8254 int b;
8255 int ret = -1;
8257 /* In case the object is interp->result with refcount 1*/
8258 Jim_IncrRefCount(obj);
8260 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8261 ret = (l != 0);
8263 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8264 ret = (d != 0);
8266 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8267 ret = (b != 0);
8270 Jim_DecrRefCount(interp, obj);
8271 return ret;
8274 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8276 /* evaluate left */
8277 int result = JimExprGetTermBoolean(interp, node->left);
8279 if (result == 1) {
8280 /* true so evaluate right */
8281 result = JimExprGetTermBoolean(interp, node->right);
8283 if (result == -1) {
8284 return JIM_ERR;
8286 Jim_SetResultInt(interp, result);
8287 return JIM_OK;
8290 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8292 /* evaluate left */
8293 int result = JimExprGetTermBoolean(interp, node->left);
8295 if (result == 0) {
8296 /* false so evaluate right */
8297 result = JimExprGetTermBoolean(interp, node->right);
8299 if (result == -1) {
8300 return JIM_ERR;
8302 Jim_SetResultInt(interp, result);
8303 return JIM_OK;
8306 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8308 /* evaluate left */
8309 int result = JimExprGetTermBoolean(interp, node->left);
8311 if (result == 1) {
8312 /* true so select right */
8313 return JimExprEvalTermNode(interp, node->right);
8315 else if (result == 0) {
8316 /* false so select ternary */
8317 return JimExprEvalTermNode(interp, node->ternary);
8319 /* error */
8320 return JIM_ERR;
8323 enum
8325 OP_FUNC = 0x0001, /* function syntax */
8326 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8329 /* name - precedence - arity - opcode
8331 * This array *must* be kept in sync with the JIM_EXPROP enum.
8333 * The following macros pre-compute the string length at compile time.
8335 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8336 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8338 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8339 OPRINIT("*", 110, 2, JimExprOpBin),
8340 OPRINIT("/", 110, 2, JimExprOpBin),
8341 OPRINIT("%", 110, 2, JimExprOpIntBin),
8343 OPRINIT("-", 100, 2, JimExprOpBin),
8344 OPRINIT("+", 100, 2, JimExprOpBin),
8346 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8347 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8349 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8350 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8352 OPRINIT("<", 80, 2, JimExprOpBin),
8353 OPRINIT(">", 80, 2, JimExprOpBin),
8354 OPRINIT("<=", 80, 2, JimExprOpBin),
8355 OPRINIT(">=", 80, 2, JimExprOpBin),
8357 OPRINIT("==", 70, 2, JimExprOpBin),
8358 OPRINIT("!=", 70, 2, JimExprOpBin),
8360 OPRINIT("&", 50, 2, JimExprOpIntBin),
8361 OPRINIT("^", 49, 2, JimExprOpIntBin),
8362 OPRINIT("|", 48, 2, JimExprOpIntBin),
8364 OPRINIT("&&", 10, 2, JimExprOpAnd),
8365 OPRINIT("||", 9, 2, JimExprOpOr),
8366 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8367 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8369 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8370 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8372 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8373 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8375 OPRINIT("in", 55, 2, JimExprOpStrBin),
8376 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8378 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8379 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8380 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8381 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8385 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8386 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8387 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8388 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8389 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8390 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8391 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8393 #ifdef JIM_MATH_FUNCTIONS
8394 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8395 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8396 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8397 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8398 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8399 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8400 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8401 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8402 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8403 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8404 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8405 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8406 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8407 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8408 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8409 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8410 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8411 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8412 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8413 #endif
8415 #undef OPRINIT
8416 #undef OPRINIT_ATTR
8418 #define JIM_EXPR_OPERATORS_NUM \
8419 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8421 static int JimParseExpression(struct JimParserCtx *pc)
8423 /* Discard spaces and quoted newline */
8424 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8425 if (*pc->p == '\n') {
8426 pc->linenr++;
8428 pc->p++;
8429 pc->len--;
8432 /* Common case */
8433 pc->tline = pc->linenr;
8434 pc->tstart = pc->p;
8436 if (pc->len == 0) {
8437 pc->tend = pc->p;
8438 pc->tt = JIM_TT_EOL;
8439 pc->eof = 1;
8440 return JIM_OK;
8442 switch (*(pc->p)) {
8443 case '(':
8444 pc->tt = JIM_TT_SUBEXPR_START;
8445 goto singlechar;
8446 case ')':
8447 pc->tt = JIM_TT_SUBEXPR_END;
8448 goto singlechar;
8449 case ',':
8450 pc->tt = JIM_TT_SUBEXPR_COMMA;
8451 singlechar:
8452 pc->tend = pc->p;
8453 pc->p++;
8454 pc->len--;
8455 break;
8456 case '[':
8457 return JimParseCmd(pc);
8458 case '$':
8459 if (JimParseVar(pc) == JIM_ERR)
8460 return JimParseExprOperator(pc);
8461 else {
8462 /* Don't allow expr sugar in expressions */
8463 if (pc->tt == JIM_TT_EXPRSUGAR) {
8464 return JIM_ERR;
8466 return JIM_OK;
8468 break;
8469 case '0':
8470 case '1':
8471 case '2':
8472 case '3':
8473 case '4':
8474 case '5':
8475 case '6':
8476 case '7':
8477 case '8':
8478 case '9':
8479 case '.':
8480 return JimParseExprNumber(pc);
8481 case '"':
8482 return JimParseQuote(pc);
8483 case '{':
8484 return JimParseBrace(pc);
8486 case 'N':
8487 case 'I':
8488 case 'n':
8489 case 'i':
8490 if (JimParseExprIrrational(pc) == JIM_ERR)
8491 if (JimParseExprBoolean(pc) == JIM_ERR)
8492 return JimParseExprOperator(pc);
8493 break;
8494 case 't':
8495 case 'f':
8496 case 'o':
8497 case 'y':
8498 if (JimParseExprBoolean(pc) == JIM_ERR)
8499 return JimParseExprOperator(pc);
8500 break;
8501 default:
8502 return JimParseExprOperator(pc);
8503 break;
8505 return JIM_OK;
8508 static int JimParseExprNumber(struct JimParserCtx *pc)
8510 char *end;
8512 /* Assume an integer for now */
8513 pc->tt = JIM_TT_EXPR_INT;
8515 jim_strtoull(pc->p, (char **)&pc->p);
8516 /* Tried as an integer, but perhaps it parses as a double */
8517 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8518 /* Some stupid compilers insist they are cleverer that
8519 * we are. Even a (void) cast doesn't prevent this warning!
8521 if (strtod(pc->tstart, &end)) { /* nothing */ }
8522 if (end == pc->tstart)
8523 return JIM_ERR;
8524 if (end > pc->p) {
8525 /* Yes, double captured more chars */
8526 pc->tt = JIM_TT_EXPR_DOUBLE;
8527 pc->p = end;
8530 pc->tend = pc->p - 1;
8531 pc->len -= (pc->p - pc->tstart);
8532 return JIM_OK;
8535 static int JimParseExprIrrational(struct JimParserCtx *pc)
8537 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8538 int i;
8540 for (i = 0; irrationals[i]; i++) {
8541 const char *irr = irrationals[i];
8543 if (strncmp(irr, pc->p, 3) == 0) {
8544 pc->p += 3;
8545 pc->len -= 3;
8546 pc->tend = pc->p - 1;
8547 pc->tt = JIM_TT_EXPR_DOUBLE;
8548 return JIM_OK;
8551 return JIM_ERR;
8554 static int JimParseExprBoolean(struct JimParserCtx *pc)
8556 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8557 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8558 int i;
8560 for (i = 0; booleans[i]; i++) {
8561 const char *boolean = booleans[i];
8562 int length = lengths[i];
8564 if (strncmp(boolean, pc->p, length) == 0) {
8565 pc->p += length;
8566 pc->len -= length;
8567 pc->tend = pc->p - 1;
8568 pc->tt = JIM_TT_EXPR_BOOLEAN;
8569 return JIM_OK;
8572 return JIM_ERR;
8575 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8577 static Jim_ExprOperator dummy_op;
8578 if (opcode < JIM_TT_EXPR_OP) {
8579 return &dummy_op;
8581 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8584 static int JimParseExprOperator(struct JimParserCtx *pc)
8586 int i;
8587 const struct Jim_ExprOperator *bestOp = NULL;
8588 int bestLen = 0;
8590 /* Try to get the longest match. */
8591 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8592 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8594 if (op->name[0] != pc->p[0]) {
8595 continue;
8598 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8599 bestOp = op;
8600 bestLen = op->namelen;
8603 if (bestOp == NULL) {
8604 return JIM_ERR;
8607 /* Validate paretheses around function arguments */
8608 if (bestOp->attr & OP_FUNC) {
8609 const char *p = pc->p + bestLen;
8610 int len = pc->len - bestLen;
8612 while (len && isspace(UCHAR(*p))) {
8613 len--;
8614 p++;
8616 if (*p != '(') {
8617 return JIM_ERR;
8620 pc->tend = pc->p + bestLen - 1;
8621 pc->p += bestLen;
8622 pc->len -= bestLen;
8624 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8625 return JIM_OK;
8628 const char *jim_tt_name(int type)
8630 static const char * const tt_names[JIM_TT_EXPR_OP] =
8631 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8632 "DBL", "BOO", "$()" };
8633 if (type < JIM_TT_EXPR_OP) {
8634 return tt_names[type];
8636 else if (type == JIM_EXPROP_UNARYMINUS) {
8637 return "-VE";
8639 else if (type == JIM_EXPROP_UNARYPLUS) {
8640 return "+VE";
8642 else {
8643 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8644 static char buf[20];
8646 if (op->name) {
8647 return op->name;
8649 sprintf(buf, "(%d)", type);
8650 return buf;
8654 /* -----------------------------------------------------------------------------
8655 * Expression Object
8656 * ---------------------------------------------------------------------------*/
8657 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8658 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8659 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8661 static const Jim_ObjType exprObjType = {
8662 "expression",
8663 FreeExprInternalRep,
8664 DupExprInternalRep,
8665 NULL,
8666 JIM_TYPE_REFERENCES,
8669 /* expr tree structure */
8670 struct ExprTree
8672 struct JimExprNode *expr; /* The first operator or term */
8673 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8674 int len; /* Number of nodes in use */
8675 int inUse; /* Used for sharing. */
8678 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8680 int i;
8681 for (i = 0; i < num; i++) {
8682 if (nodes[i].objPtr) {
8683 Jim_DecrRefCount(interp, nodes[i].objPtr);
8686 Jim_Free(nodes);
8689 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8691 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8692 Jim_Free(expr);
8695 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8697 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8699 if (expr) {
8700 if (--expr->inUse != 0) {
8701 return;
8704 ExprTreeFree(interp, expr);
8708 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8710 JIM_NOTUSED(interp);
8711 JIM_NOTUSED(srcPtr);
8713 /* Just returns an simple string. */
8714 dupPtr->typePtr = NULL;
8717 struct ExprBuilder {
8718 int parencount; /* count of outstanding parentheses */
8719 int level; /* recursion depth */
8720 ParseToken *token; /* The current token */
8721 ParseToken *first_token; /* The first token */
8722 Jim_Stack stack; /* stack of pending terms */
8723 Jim_Obj *exprObjPtr; /* the original expression */
8724 Jim_Obj *fileNameObj; /* filename of the original expression */
8725 struct JimExprNode *nodes; /* storage for all nodes */
8726 struct JimExprNode *next; /* storage for the next node */
8729 #ifdef DEBUG_SHOW_EXPR
8730 static void JimShowExprNode(struct JimExprNode *node, int level)
8732 int i;
8733 for (i = 0; i < level; i++) {
8734 printf(" ");
8736 if (TOKEN_IS_EXPR_OP(node->type)) {
8737 printf("%s\n", jim_tt_name(node->type));
8738 if (node->left) {
8739 JimShowExprNode(node->left, level + 1);
8741 if (node->right) {
8742 JimShowExprNode(node->right, level + 1);
8744 if (node->ternary) {
8745 JimShowExprNode(node->ternary, level + 1);
8748 else {
8749 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8752 #endif
8754 #define EXPR_UNTIL_CLOSE 0x0001
8755 #define EXPR_FUNC_ARGS 0x0002
8756 #define EXPR_TERNARY 0x0004
8759 * Parse the subexpression at builder->token and return with the node on the stack.
8760 * builder->token is advanced to the next unconsumed token.
8761 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8763 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8764 * with an equal or lower precedence is reached (or strictly lower if right associative).
8766 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8767 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8768 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8770 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8772 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8774 int rc;
8775 struct JimExprNode *node;
8776 /* Calculate the stack length expected after pushing the number of expected terms */
8777 int exp_stacklen = builder->stack.len + exp_numterms;
8779 if (builder->level++ > 200) {
8780 Jim_SetResultString(interp, "Expression too complex", -1);
8781 return JIM_ERR;
8784 while (builder->token->type != JIM_TT_EOL) {
8785 ParseToken *t = builder->token++;
8786 int prevtt;
8788 if (t == builder->first_token) {
8789 prevtt = JIM_TT_NONE;
8791 else {
8792 prevtt = t[-1].type;
8795 if (t->type == JIM_TT_SUBEXPR_START) {
8796 if (builder->stack.len == exp_stacklen) {
8797 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8798 return JIM_ERR;
8800 builder->parencount++;
8801 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8802 if (rc != JIM_OK) {
8803 return rc;
8805 /* A complete subexpression is on the stack */
8807 else if (t->type == JIM_TT_SUBEXPR_END) {
8808 if (!(flags & EXPR_UNTIL_CLOSE)) {
8809 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8810 builder->token--;
8811 builder->level--;
8812 return JIM_OK;
8814 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8815 return JIM_ERR;
8817 builder->parencount--;
8818 if (builder->stack.len == exp_stacklen) {
8819 /* Return with the expected number of subexpressions on the stack */
8820 break;
8823 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8824 if (!(flags & EXPR_FUNC_ARGS)) {
8825 if (builder->stack.len == exp_stacklen) {
8826 /* handle the comma back at the parent level */
8827 builder->token--;
8828 builder->level--;
8829 return JIM_OK;
8831 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8832 return JIM_ERR;
8834 else {
8835 /* If we see more terms than expected, it is an error */
8836 if (builder->stack.len > exp_stacklen) {
8837 Jim_SetResultFormatted(interp, "too many arguments to math function");
8838 return JIM_ERR;
8841 /* just go onto the next arg */
8843 else if (t->type == JIM_EXPROP_COLON) {
8844 if (!(flags & EXPR_TERNARY)) {
8845 if (builder->level != 1) {
8846 /* handle the comma back at the parent level */
8847 builder->token--;
8848 builder->level--;
8849 return JIM_OK;
8851 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8852 return JIM_ERR;
8854 if (builder->stack.len == exp_stacklen) {
8855 /* handle the comma back at the parent level */
8856 builder->token--;
8857 builder->level--;
8858 return JIM_OK;
8860 /* just go onto the next term */
8862 else if (TOKEN_IS_EXPR_OP(t->type)) {
8863 const struct Jim_ExprOperator *op;
8865 /* Convert -/+ to unary minus or unary plus if necessary */
8866 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8867 if (t->type == JIM_EXPROP_SUB) {
8868 t->type = JIM_EXPROP_UNARYMINUS;
8870 else if (t->type == JIM_EXPROP_ADD) {
8871 t->type = JIM_EXPROP_UNARYPLUS;
8875 op = JimExprOperatorInfoByOpcode(t->type);
8877 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8878 /* next op is lower precedence, or equal and left associative, so done here */
8879 builder->token--;
8880 break;
8883 if (op->attr & OP_FUNC) {
8884 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8885 Jim_SetResultString(interp, "missing arguments for math function", -1);
8886 return JIM_ERR;
8888 builder->token++;
8889 if (op->arity == 0) {
8890 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8891 Jim_SetResultString(interp, "too many arguments for math function", -1);
8892 return JIM_ERR;
8894 builder->token++;
8895 goto noargs;
8897 builder->parencount++;
8899 /* This will push left and return right */
8900 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8902 else if (t->type == JIM_EXPROP_TERNARY) {
8903 /* Collect the two arguments to the ternary operator */
8904 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8906 else {
8907 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8908 * and push that on the term stack
8910 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8913 if (rc != JIM_OK) {
8914 return rc;
8917 noargs:
8918 node = builder->next++;
8919 node->type = t->type;
8921 if (op->arity >= 3) {
8922 node->ternary = Jim_StackPop(&builder->stack);
8923 if (node->ternary == NULL) {
8924 goto missingoperand;
8927 if (op->arity >= 2) {
8928 node->right = Jim_StackPop(&builder->stack);
8929 if (node->right == NULL) {
8930 goto missingoperand;
8933 if (op->arity >= 1) {
8934 node->left = Jim_StackPop(&builder->stack);
8935 if (node->left == NULL) {
8936 missingoperand:
8937 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8938 builder->next--;
8939 return JIM_ERR;
8944 /* Now push the node */
8945 Jim_StackPush(&builder->stack, node);
8947 else {
8948 Jim_Obj *objPtr = NULL;
8950 /* This is a simple non-operator term, so create and push the appropriate object */
8952 /* Two consecutive terms without an operator is invalid */
8953 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
8954 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
8955 return JIM_ERR;
8958 /* Immediately create a double or int object? */
8959 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
8960 char *endptr;
8961 if (t->type == JIM_TT_EXPR_INT) {
8962 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8964 else {
8965 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8967 if (endptr != t->token + t->len) {
8968 /* Conversion failed, so just store it as a string */
8969 Jim_FreeNewObj(interp, objPtr);
8970 objPtr = NULL;
8974 if (!objPtr) {
8975 /* Everything else is stored a simple string term */
8976 objPtr = Jim_NewStringObj(interp, t->token, t->len);
8977 if (t->type == JIM_TT_CMD) {
8978 /* Only commands need source info */
8979 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
8983 /* Now push a term node */
8984 node = builder->next++;
8985 node->objPtr = objPtr;
8986 Jim_IncrRefCount(node->objPtr);
8987 node->type = t->type;
8988 Jim_StackPush(&builder->stack, node);
8992 if (builder->stack.len == exp_stacklen) {
8993 builder->level--;
8994 return JIM_OK;
8997 if ((flags & EXPR_FUNC_ARGS)) {
8998 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9000 else {
9001 if (builder->stack.len < exp_stacklen) {
9002 if (builder->level == 0) {
9003 Jim_SetResultFormatted(interp, "empty expression");
9005 else {
9006 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9009 else {
9010 Jim_SetResultFormatted(interp, "extra terms after expression");
9014 return JIM_ERR;
9017 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9019 struct ExprTree *expr;
9020 struct ExprBuilder builder;
9021 int rc;
9022 struct JimExprNode *top = NULL;
9024 builder.parencount = 0;
9025 builder.level = 0;
9026 builder.token = builder.first_token = tokenlist->list;
9027 builder.exprObjPtr = exprObjPtr;
9028 builder.fileNameObj = fileNameObj;
9029 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9030 builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9031 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9032 builder.next = builder.nodes;
9033 Jim_InitStack(&builder.stack);
9035 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9037 if (rc == JIM_OK) {
9038 top = Jim_StackPop(&builder.stack);
9040 if (builder.parencount) {
9041 Jim_SetResultString(interp, "missing close parenthesis", -1);
9042 rc = JIM_ERR;
9046 /* Free the stack used for the compilation. */
9047 Jim_FreeStack(&builder.stack);
9049 if (rc != JIM_OK) {
9050 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9051 return NULL;
9054 expr = Jim_Alloc(sizeof(*expr));
9055 expr->inUse = 1;
9056 expr->expr = top;
9057 expr->nodes = builder.nodes;
9058 expr->len = builder.next - builder.nodes;
9060 assert(expr->len <= tokenlist->count - 1);
9062 return expr;
9065 /* This method takes the string representation of an expression
9066 * and generates a program for the expr engine */
9067 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9069 int exprTextLen;
9070 const char *exprText;
9071 struct JimParserCtx parser;
9072 struct ExprTree *expr;
9073 ParseTokenList tokenlist;
9074 int line;
9075 Jim_Obj *fileNameObj;
9076 int rc = JIM_ERR;
9078 /* Try to get information about filename / line number */
9079 if (objPtr->typePtr == &sourceObjType) {
9080 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9081 line = objPtr->internalRep.sourceValue.lineNumber;
9083 else {
9084 fileNameObj = interp->emptyObj;
9085 line = 1;
9087 Jim_IncrRefCount(fileNameObj);
9089 exprText = Jim_GetString(objPtr, &exprTextLen);
9091 /* Initially tokenise the expression into tokenlist */
9092 ScriptTokenListInit(&tokenlist);
9094 JimParserInit(&parser, exprText, exprTextLen, line);
9095 while (!parser.eof) {
9096 if (JimParseExpression(&parser) != JIM_OK) {
9097 ScriptTokenListFree(&tokenlist);
9098 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9099 expr = NULL;
9100 goto err;
9103 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9104 parser.tline);
9107 #ifdef DEBUG_SHOW_EXPR_TOKENS
9109 int i;
9110 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9111 for (i = 0; i < tokenlist.count; i++) {
9112 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9113 tokenlist.list[i].len, tokenlist.list[i].token);
9116 #endif
9118 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9119 ScriptTokenListFree(&tokenlist);
9120 Jim_DecrRefCount(interp, fileNameObj);
9121 return JIM_ERR;
9124 /* Now create the expression bytecode from the tokenlist */
9125 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9127 /* No longer need the token list */
9128 ScriptTokenListFree(&tokenlist);
9130 if (!expr) {
9131 goto err;
9134 #ifdef DEBUG_SHOW_EXPR
9135 printf("==== Expr ====\n");
9136 JimShowExprNode(expr->expr, 0);
9137 #endif
9139 rc = JIM_OK;
9141 err:
9142 /* Free the old internal rep and set the new one. */
9143 Jim_DecrRefCount(interp, fileNameObj);
9144 Jim_FreeIntRep(interp, objPtr);
9145 Jim_SetIntRepPtr(objPtr, expr);
9146 objPtr->typePtr = &exprObjType;
9147 return rc;
9150 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9152 if (objPtr->typePtr != &exprObjType) {
9153 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9154 return NULL;
9157 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9160 #ifdef JIM_OPTIMIZATION
9161 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9163 if (node->type == JIM_TT_EXPR_INT)
9164 return node->objPtr;
9165 else if (node->type == JIM_TT_VAR)
9166 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9167 else if (node->type == JIM_TT_DICTSUGAR)
9168 return JimExpandDictSugar(interp, node->objPtr);
9169 else
9170 return NULL;
9172 #endif
9174 /* -----------------------------------------------------------------------------
9175 * Expressions evaluation.
9176 * Jim uses a recursive evaluation engine for expressions,
9177 * that takes advantage of the fact that expr's operators
9178 * can't be redefined.
9180 * Jim_EvalExpression() uses the expression tree compiled by
9181 * SetExprFromAny() method of the "expression" object.
9183 * On success a Tcl Object containing the result of the evaluation
9184 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9185 * returned.
9186 * On error the function returns a retcode != to JIM_OK and set a suitable
9187 * error on the interp.
9188 * ---------------------------------------------------------------------------*/
9190 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9192 if (TOKEN_IS_EXPR_OP(node->type)) {
9193 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9194 return op->funcop(interp, node);
9196 else {
9197 Jim_Obj *objPtr;
9199 /* A term */
9200 switch (node->type) {
9201 case JIM_TT_EXPR_INT:
9202 case JIM_TT_EXPR_DOUBLE:
9203 case JIM_TT_EXPR_BOOLEAN:
9204 case JIM_TT_STR:
9205 Jim_SetResult(interp, node->objPtr);
9206 return JIM_OK;
9208 case JIM_TT_VAR:
9209 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9210 if (objPtr) {
9211 Jim_SetResult(interp, objPtr);
9212 return JIM_OK;
9214 return JIM_ERR;
9216 case JIM_TT_DICTSUGAR:
9217 objPtr = JimExpandDictSugar(interp, node->objPtr);
9218 if (objPtr) {
9219 Jim_SetResult(interp, objPtr);
9220 return JIM_OK;
9222 return JIM_ERR;
9224 case JIM_TT_ESC:
9225 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9226 Jim_SetResult(interp, objPtr);
9227 return JIM_OK;
9229 return JIM_ERR;
9231 case JIM_TT_CMD:
9232 return Jim_EvalObj(interp, node->objPtr);
9234 default:
9235 /* Should never get here */
9236 return JIM_ERR;
9241 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9243 int rc = JimExprEvalTermNode(interp, node);
9244 if (rc == JIM_OK) {
9245 *objPtrPtr = Jim_GetResult(interp);
9246 Jim_IncrRefCount(*objPtrPtr);
9248 return rc;
9251 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9253 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9254 return ExprBool(interp, Jim_GetResult(interp));
9256 return -1;
9259 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9261 struct ExprTree *expr;
9262 int retcode = JIM_OK;
9264 expr = JimGetExpression(interp, exprObjPtr);
9265 if (!expr) {
9266 return JIM_ERR; /* error in expression. */
9269 #ifdef JIM_OPTIMIZATION
9270 /* Check for one of the following common expressions used by while/for
9272 * CONST
9273 * $a
9274 * !$a
9275 * $a < CONST, $a < $b
9276 * $a <= CONST, $a <= $b
9277 * $a > CONST, $a > $b
9278 * $a >= CONST, $a >= $b
9279 * $a != CONST, $a != $b
9280 * $a == CONST, $a == $b
9283 Jim_Obj *objPtr;
9285 /* STEP 1 -- Check if there are the conditions to run the specialized
9286 * version of while */
9288 switch (expr->len) {
9289 case 1:
9290 objPtr = JimExprIntValOrVar(interp, expr->expr);
9291 if (objPtr) {
9292 Jim_SetResult(interp, objPtr);
9293 return JIM_OK;
9295 break;
9297 case 2:
9298 if (expr->expr->type == JIM_EXPROP_NOT) {
9299 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9301 if (objPtr && JimIsWide(objPtr)) {
9302 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9303 return JIM_OK;
9306 break;
9308 case 3:
9309 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9310 if (objPtr && JimIsWide(objPtr)) {
9311 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9312 if (objPtr2 && JimIsWide(objPtr2)) {
9313 jim_wide wideValueA = JimWideValue(objPtr);
9314 jim_wide wideValueB = JimWideValue(objPtr2);
9315 int cmpRes;
9316 switch (expr->expr->type) {
9317 case JIM_EXPROP_LT:
9318 cmpRes = wideValueA < wideValueB;
9319 break;
9320 case JIM_EXPROP_LTE:
9321 cmpRes = wideValueA <= wideValueB;
9322 break;
9323 case JIM_EXPROP_GT:
9324 cmpRes = wideValueA > wideValueB;
9325 break;
9326 case JIM_EXPROP_GTE:
9327 cmpRes = wideValueA >= wideValueB;
9328 break;
9329 case JIM_EXPROP_NUMEQ:
9330 cmpRes = wideValueA == wideValueB;
9331 break;
9332 case JIM_EXPROP_NUMNE:
9333 cmpRes = wideValueA != wideValueB;
9334 break;
9335 default:
9336 goto noopt;
9338 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9339 return JIM_OK;
9342 break;
9345 noopt:
9346 #endif
9348 /* In order to avoid the internal repr being freed due to
9349 * shimmering of the exprObjPtr's object, we make the internal rep
9350 * shared. */
9351 expr->inUse++;
9353 /* Evaluate with the recursive expr engine */
9354 retcode = JimExprEvalTermNode(interp, expr->expr);
9356 expr->inUse--;
9358 return retcode;
9361 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9363 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9365 if (retcode == JIM_OK) {
9366 switch (ExprBool(interp, Jim_GetResult(interp))) {
9367 case 0:
9368 *boolPtr = 0;
9369 break;
9371 case 1:
9372 *boolPtr = 1;
9373 break;
9375 case -1:
9376 retcode = JIM_ERR;
9377 break;
9380 return retcode;
9383 /* -----------------------------------------------------------------------------
9384 * ScanFormat String Object
9385 * ---------------------------------------------------------------------------*/
9387 /* This Jim_Obj will held a parsed representation of a format string passed to
9388 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9389 * to be parsed in its entirely first and then, if correct, can be used for
9390 * scanning. To avoid endless re-parsing, the parsed representation will be
9391 * stored in an internal representation and re-used for performance reason. */
9393 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9394 * scanformat string. This part will later be used to extract information
9395 * out from the string to be parsed by Jim_ScanString */
9397 typedef struct ScanFmtPartDescr
9399 const char *arg; /* Specification of a CHARSET conversion */
9400 const char *prefix; /* Prefix to be scanned literally before conversion */
9401 size_t width; /* Maximal width of input to be converted */
9402 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9403 char type; /* Type of conversion (e.g. c, d, f) */
9404 char modifier; /* Modify type (e.g. l - long, h - short */
9405 } ScanFmtPartDescr;
9407 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9408 * string parsed and separated in part descriptions. Furthermore it contains
9409 * the original string representation of the scanformat string to allow for
9410 * fast update of the Jim_Obj's string representation part.
9412 * As an add-on the internal object representation adds some scratch pad area
9413 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9414 * memory for purpose of string scanning.
9416 * The error member points to a static allocated string in case of a mal-
9417 * formed scanformat string or it contains '0' (NULL) in case of a valid
9418 * parse representation.
9420 * The whole memory of the internal representation is allocated as a single
9421 * area of memory that will be internally separated. So freeing and duplicating
9422 * of such an object is cheap */
9424 typedef struct ScanFmtStringObj
9426 jim_wide size; /* Size of internal repr in bytes */
9427 char *stringRep; /* Original string representation */
9428 size_t count; /* Number of ScanFmtPartDescr contained */
9429 size_t convCount; /* Number of conversions that will assign */
9430 size_t maxPos; /* Max position index if XPG3 is used */
9431 const char *error; /* Ptr to error text (NULL if no error */
9432 char *scratch; /* Some scratch pad used by Jim_ScanString */
9433 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9434 } ScanFmtStringObj;
9437 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9438 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9439 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9441 static const Jim_ObjType scanFmtStringObjType = {
9442 "scanformatstring",
9443 FreeScanFmtInternalRep,
9444 DupScanFmtInternalRep,
9445 UpdateStringOfScanFmt,
9446 JIM_TYPE_NONE,
9449 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9451 JIM_NOTUSED(interp);
9452 Jim_Free((char *)objPtr->internalRep.ptr);
9453 objPtr->internalRep.ptr = 0;
9456 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9458 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9459 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9461 JIM_NOTUSED(interp);
9462 memcpy(newVec, srcPtr->internalRep.ptr, size);
9463 dupPtr->internalRep.ptr = newVec;
9464 dupPtr->typePtr = &scanFmtStringObjType;
9467 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9469 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9472 /* SetScanFmtFromAny will parse a given string and create the internal
9473 * representation of the format specification. In case of an error
9474 * the error data member of the internal representation will be set
9475 * to an descriptive error text and the function will be left with
9476 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9477 * specification */
9479 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9481 ScanFmtStringObj *fmtObj;
9482 char *buffer;
9483 int maxCount, i, approxSize, lastPos = -1;
9484 const char *fmt = Jim_String(objPtr);
9485 int maxFmtLen = Jim_Length(objPtr);
9486 const char *fmtEnd = fmt + maxFmtLen;
9487 int curr;
9489 Jim_FreeIntRep(interp, objPtr);
9490 /* Count how many conversions could take place maximally */
9491 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9492 if (fmt[i] == '%')
9493 ++maxCount;
9494 /* Calculate an approximation of the memory necessary */
9495 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9496 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9497 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9498 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9499 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9500 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9501 +1; /* safety byte */
9502 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9503 memset(fmtObj, 0, approxSize);
9504 fmtObj->size = approxSize;
9505 fmtObj->maxPos = 0;
9506 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9507 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9508 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9509 buffer = fmtObj->stringRep + maxFmtLen + 1;
9510 objPtr->internalRep.ptr = fmtObj;
9511 objPtr->typePtr = &scanFmtStringObjType;
9512 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9513 int width = 0, skip;
9514 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9516 fmtObj->count++;
9517 descr->width = 0; /* Assume width unspecified */
9518 /* Overread and store any "literal" prefix */
9519 if (*fmt != '%' || fmt[1] == '%') {
9520 descr->type = 0;
9521 descr->prefix = &buffer[i];
9522 for (; fmt < fmtEnd; ++fmt) {
9523 if (*fmt == '%') {
9524 if (fmt[1] != '%')
9525 break;
9526 ++fmt;
9528 buffer[i++] = *fmt;
9530 buffer[i++] = 0;
9532 /* Skip the conversion introducing '%' sign */
9533 ++fmt;
9534 /* End reached due to non-conversion literal only? */
9535 if (fmt >= fmtEnd)
9536 goto done;
9537 descr->pos = 0; /* Assume "natural" positioning */
9538 if (*fmt == '*') {
9539 descr->pos = -1; /* Okay, conversion will not be assigned */
9540 ++fmt;
9542 else
9543 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9544 /* Check if next token is a number (could be width or pos */
9545 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9546 fmt += skip;
9547 /* Was the number a XPG3 position specifier? */
9548 if (descr->pos != -1 && *fmt == '$') {
9549 int prev;
9551 ++fmt;
9552 descr->pos = width;
9553 width = 0;
9554 /* Look if "natural" postioning and XPG3 one was mixed */
9555 if ((lastPos == 0 && descr->pos > 0)
9556 || (lastPos > 0 && descr->pos == 0)) {
9557 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9558 return JIM_ERR;
9560 /* Look if this position was already used */
9561 for (prev = 0; prev < curr; ++prev) {
9562 if (fmtObj->descr[prev].pos == -1)
9563 continue;
9564 if (fmtObj->descr[prev].pos == descr->pos) {
9565 fmtObj->error =
9566 "variable is assigned by multiple \"%n$\" conversion specifiers";
9567 return JIM_ERR;
9570 if (descr->pos < 0) {
9571 fmtObj->error =
9572 "\"%n$\" conversion specifier is negative";
9573 return JIM_ERR;
9575 /* Try to find a width after the XPG3 specifier */
9576 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9577 descr->width = width;
9578 fmt += skip;
9580 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9581 fmtObj->maxPos = descr->pos;
9583 else {
9584 /* Number was not a XPG3, so it has to be a width */
9585 descr->width = width;
9588 /* If positioning mode was undetermined yet, fix this */
9589 if (lastPos == -1)
9590 lastPos = descr->pos;
9591 /* Handle CHARSET conversion type ... */
9592 if (*fmt == '[') {
9593 int swapped = 1, beg = i, end, j;
9595 descr->type = '[';
9596 descr->arg = &buffer[i];
9597 ++fmt;
9598 if (*fmt == '^')
9599 buffer[i++] = *fmt++;
9600 if (*fmt == ']')
9601 buffer[i++] = *fmt++;
9602 while (*fmt && *fmt != ']')
9603 buffer[i++] = *fmt++;
9604 if (*fmt != ']') {
9605 fmtObj->error = "unmatched [ in format string";
9606 return JIM_ERR;
9608 end = i;
9609 buffer[i++] = 0;
9610 /* In case a range fence was given "backwards", swap it */
9611 while (swapped) {
9612 swapped = 0;
9613 for (j = beg + 1; j < end - 1; ++j) {
9614 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9615 char tmp = buffer[j - 1];
9617 buffer[j - 1] = buffer[j + 1];
9618 buffer[j + 1] = tmp;
9619 swapped = 1;
9624 else {
9625 /* Remember any valid modifier if given */
9626 if (fmt < fmtEnd && strchr("hlL", *fmt))
9627 descr->modifier = tolower((int)*fmt++);
9629 if (fmt >= fmtEnd) {
9630 fmtObj->error = "missing scan conversion character";
9631 return JIM_ERR;
9634 descr->type = *fmt;
9635 if (strchr("efgcsndoxui", *fmt) == 0) {
9636 fmtObj->error = "bad scan conversion character";
9637 return JIM_ERR;
9639 else if (*fmt == 'c' && descr->width != 0) {
9640 fmtObj->error = "field width may not be specified in %c " "conversion";
9641 return JIM_ERR;
9643 else if (*fmt == 'u' && descr->modifier == 'l') {
9644 fmtObj->error = "unsigned wide not supported";
9645 return JIM_ERR;
9648 curr++;
9650 done:
9651 return JIM_OK;
9654 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9656 #define FormatGetCnvCount(_fo_) \
9657 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9658 #define FormatGetMaxPos(_fo_) \
9659 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9660 #define FormatGetError(_fo_) \
9661 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9663 /* JimScanAString is used to scan an unspecified string that ends with
9664 * next WS, or a string that is specified via a charset.
9667 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9669 char *buffer = Jim_StrDup(str);
9670 char *p = buffer;
9672 while (*str) {
9673 int c;
9674 int n;
9676 if (!sdescr && isspace(UCHAR(*str)))
9677 break; /* EOS via WS if unspecified */
9679 n = utf8_tounicode(str, &c);
9680 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9681 break;
9682 while (n--)
9683 *p++ = *str++;
9685 *p = 0;
9686 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9689 /* ScanOneEntry will scan one entry out of the string passed as argument.
9690 * It use the sscanf() function for this task. After extracting and
9691 * converting of the value, the count of scanned characters will be
9692 * returned of -1 in case of no conversion tool place and string was
9693 * already scanned thru */
9695 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9696 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9698 const char *tok;
9699 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9700 size_t scanned = 0;
9701 size_t anchor = pos;
9702 int i;
9703 Jim_Obj *tmpObj = NULL;
9705 /* First pessimistically assume, we will not scan anything :-) */
9706 *valObjPtr = 0;
9707 if (descr->prefix) {
9708 /* There was a prefix given before the conversion, skip it and adjust
9709 * the string-to-be-parsed accordingly */
9710 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9711 /* If prefix require, skip WS */
9712 if (isspace(UCHAR(descr->prefix[i])))
9713 while (pos < strLen && isspace(UCHAR(str[pos])))
9714 ++pos;
9715 else if (descr->prefix[i] != str[pos])
9716 break; /* Prefix do not match here, leave the loop */
9717 else
9718 ++pos; /* Prefix matched so far, next round */
9720 if (pos >= strLen) {
9721 return -1; /* All of str consumed: EOF condition */
9723 else if (descr->prefix[i] != 0)
9724 return 0; /* Not whole prefix consumed, no conversion possible */
9726 /* For all but following conversion, skip leading WS */
9727 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9728 while (isspace(UCHAR(str[pos])))
9729 ++pos;
9730 /* Determine how much skipped/scanned so far */
9731 scanned = pos - anchor;
9733 /* %c is a special, simple case. no width */
9734 if (descr->type == 'n') {
9735 /* Return pseudo conversion means: how much scanned so far? */
9736 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9738 else if (pos >= strLen) {
9739 /* Cannot scan anything, as str is totally consumed */
9740 return -1;
9742 else if (descr->type == 'c') {
9743 int c;
9744 scanned += utf8_tounicode(&str[pos], &c);
9745 *valObjPtr = Jim_NewIntObj(interp, c);
9746 return scanned;
9748 else {
9749 /* Processing of conversions follows ... */
9750 if (descr->width > 0) {
9751 /* Do not try to scan as fas as possible but only the given width.
9752 * To ensure this, we copy the part that should be scanned. */
9753 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9754 size_t tLen = descr->width > sLen ? sLen : descr->width;
9756 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9757 tok = tmpObj->bytes;
9759 else {
9760 /* As no width was given, simply refer to the original string */
9761 tok = &str[pos];
9763 switch (descr->type) {
9764 case 'd':
9765 case 'o':
9766 case 'x':
9767 case 'u':
9768 case 'i':{
9769 char *endp; /* Position where the number finished */
9770 jim_wide w;
9772 int base = descr->type == 'o' ? 8
9773 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9775 /* Try to scan a number with the given base */
9776 if (base == 0) {
9777 w = jim_strtoull(tok, &endp);
9779 else {
9780 w = strtoull(tok, &endp, base);
9783 if (endp != tok) {
9784 /* There was some number sucessfully scanned! */
9785 *valObjPtr = Jim_NewIntObj(interp, w);
9787 /* Adjust the number-of-chars scanned so far */
9788 scanned += endp - tok;
9790 else {
9791 /* Nothing was scanned. We have to determine if this
9792 * happened due to e.g. prefix mismatch or input str
9793 * exhausted */
9794 scanned = *tok ? 0 : -1;
9796 break;
9798 case 's':
9799 case '[':{
9800 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9801 scanned += Jim_Length(*valObjPtr);
9802 break;
9804 case 'e':
9805 case 'f':
9806 case 'g':{
9807 char *endp;
9808 double value = strtod(tok, &endp);
9810 if (endp != tok) {
9811 /* There was some number sucessfully scanned! */
9812 *valObjPtr = Jim_NewDoubleObj(interp, value);
9813 /* Adjust the number-of-chars scanned so far */
9814 scanned += endp - tok;
9816 else {
9817 /* Nothing was scanned. We have to determine if this
9818 * happened due to e.g. prefix mismatch or input str
9819 * exhausted */
9820 scanned = *tok ? 0 : -1;
9822 break;
9825 /* If a substring was allocated (due to pre-defined width) do not
9826 * forget to free it */
9827 if (tmpObj) {
9828 Jim_FreeNewObj(interp, tmpObj);
9831 return scanned;
9834 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9835 * string and returns all converted (and not ignored) values in a list back
9836 * to the caller. If an error occured, a NULL pointer will be returned */
9838 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9840 size_t i, pos;
9841 int scanned = 1;
9842 const char *str = Jim_String(strObjPtr);
9843 int strLen = Jim_Utf8Length(interp, strObjPtr);
9844 Jim_Obj *resultList = 0;
9845 Jim_Obj **resultVec = 0;
9846 int resultc;
9847 Jim_Obj *emptyStr = 0;
9848 ScanFmtStringObj *fmtObj;
9850 /* This should never happen. The format object should already be of the correct type */
9851 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9853 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9854 /* Check if format specification was valid */
9855 if (fmtObj->error != 0) {
9856 if (flags & JIM_ERRMSG)
9857 Jim_SetResultString(interp, fmtObj->error, -1);
9858 return 0;
9860 /* Allocate a new "shared" empty string for all unassigned conversions */
9861 emptyStr = Jim_NewEmptyStringObj(interp);
9862 Jim_IncrRefCount(emptyStr);
9863 /* Create a list and fill it with empty strings up to max specified XPG3 */
9864 resultList = Jim_NewListObj(interp, NULL, 0);
9865 if (fmtObj->maxPos > 0) {
9866 for (i = 0; i < fmtObj->maxPos; ++i)
9867 Jim_ListAppendElement(interp, resultList, emptyStr);
9868 JimListGetElements(interp, resultList, &resultc, &resultVec);
9870 /* Now handle every partial format description */
9871 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9872 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9873 Jim_Obj *value = 0;
9875 /* Only last type may be "literal" w/o conversion - skip it! */
9876 if (descr->type == 0)
9877 continue;
9878 /* As long as any conversion could be done, we will proceed */
9879 if (scanned > 0)
9880 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9881 /* In case our first try results in EOF, we will leave */
9882 if (scanned == -1 && i == 0)
9883 goto eof;
9884 /* Advance next pos-to-be-scanned for the amount scanned already */
9885 pos += scanned;
9887 /* value == 0 means no conversion took place so take empty string */
9888 if (value == 0)
9889 value = Jim_NewEmptyStringObj(interp);
9890 /* If value is a non-assignable one, skip it */
9891 if (descr->pos == -1) {
9892 Jim_FreeNewObj(interp, value);
9894 else if (descr->pos == 0)
9895 /* Otherwise append it to the result list if no XPG3 was given */
9896 Jim_ListAppendElement(interp, resultList, value);
9897 else if (resultVec[descr->pos - 1] == emptyStr) {
9898 /* But due to given XPG3, put the value into the corr. slot */
9899 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9900 Jim_IncrRefCount(value);
9901 resultVec[descr->pos - 1] = value;
9903 else {
9904 /* Otherwise, the slot was already used - free obj and ERROR */
9905 Jim_FreeNewObj(interp, value);
9906 goto err;
9909 Jim_DecrRefCount(interp, emptyStr);
9910 return resultList;
9911 eof:
9912 Jim_DecrRefCount(interp, emptyStr);
9913 Jim_FreeNewObj(interp, resultList);
9914 return (Jim_Obj *)EOF;
9915 err:
9916 Jim_DecrRefCount(interp, emptyStr);
9917 Jim_FreeNewObj(interp, resultList);
9918 return 0;
9921 /* -----------------------------------------------------------------------------
9922 * Pseudo Random Number Generation
9923 * ---------------------------------------------------------------------------*/
9924 /* Initialize the sbox with the numbers from 0 to 255 */
9925 static void JimPrngInit(Jim_Interp *interp)
9927 #define PRNG_SEED_SIZE 256
9928 int i;
9929 unsigned int *seed;
9930 time_t t = time(NULL);
9932 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9934 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9935 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9936 seed[i] = (rand() ^ t ^ clock());
9938 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9939 Jim_Free(seed);
9942 /* Generates N bytes of random data */
9943 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9945 Jim_PrngState *prng;
9946 unsigned char *destByte = (unsigned char *)dest;
9947 unsigned int si, sj, x;
9949 /* initialization, only needed the first time */
9950 if (interp->prngState == NULL)
9951 JimPrngInit(interp);
9952 prng = interp->prngState;
9953 /* generates 'len' bytes of pseudo-random numbers */
9954 for (x = 0; x < len; x++) {
9955 prng->i = (prng->i + 1) & 0xff;
9956 si = prng->sbox[prng->i];
9957 prng->j = (prng->j + si) & 0xff;
9958 sj = prng->sbox[prng->j];
9959 prng->sbox[prng->i] = sj;
9960 prng->sbox[prng->j] = si;
9961 *destByte++ = prng->sbox[(si + sj) & 0xff];
9965 /* Re-seed the generator with user-provided bytes */
9966 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
9968 int i;
9969 Jim_PrngState *prng;
9971 /* initialization, only needed the first time */
9972 if (interp->prngState == NULL)
9973 JimPrngInit(interp);
9974 prng = interp->prngState;
9976 /* Set the sbox[i] with i */
9977 for (i = 0; i < 256; i++)
9978 prng->sbox[i] = i;
9979 /* Now use the seed to perform a random permutation of the sbox */
9980 for (i = 0; i < seedLen; i++) {
9981 unsigned char t;
9983 t = prng->sbox[i & 0xFF];
9984 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
9985 prng->sbox[seed[i]] = t;
9987 prng->i = prng->j = 0;
9989 /* discard at least the first 256 bytes of stream.
9990 * borrow the seed buffer for this
9992 for (i = 0; i < 256; i += seedLen) {
9993 JimRandomBytes(interp, seed, seedLen);
9997 /* [incr] */
9998 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10000 jim_wide wideValue, increment = 1;
10001 Jim_Obj *intObjPtr;
10003 if (argc != 2 && argc != 3) {
10004 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10005 return JIM_ERR;
10007 if (argc == 3) {
10008 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10009 return JIM_ERR;
10011 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10012 if (!intObjPtr) {
10013 /* Set missing variable to 0 */
10014 wideValue = 0;
10016 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10017 return JIM_ERR;
10019 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10020 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10021 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10022 Jim_FreeNewObj(interp, intObjPtr);
10023 return JIM_ERR;
10026 else {
10027 /* Can do it the quick way */
10028 Jim_InvalidateStringRep(intObjPtr);
10029 JimWideValue(intObjPtr) = wideValue + increment;
10031 /* The following step is required in order to invalidate the
10032 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10033 if (argv[1]->typePtr != &variableObjType) {
10034 /* Note that this can't fail since GetVariable already succeeded */
10035 Jim_SetVariable(interp, argv[1], intObjPtr);
10038 Jim_SetResult(interp, intObjPtr);
10039 return JIM_OK;
10043 /* -----------------------------------------------------------------------------
10044 * Eval
10045 * ---------------------------------------------------------------------------*/
10046 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10047 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10049 /* Handle calls to the [unknown] command */
10050 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10052 int retcode;
10054 /* If JimUnknown() is recursively called too many times...
10055 * done here
10057 if (interp->unknown_called > 50) {
10058 return JIM_ERR;
10061 /* The object interp->unknown just contains
10062 * the "unknown" string, it is used in order to
10063 * avoid to lookup the unknown command every time
10064 * but instead to cache the result. */
10066 /* If the [unknown] command does not exist ... */
10067 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10068 return JIM_ERR;
10070 interp->unknown_called++;
10071 /* XXX: Are we losing fileNameObj and linenr? */
10072 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10073 interp->unknown_called--;
10075 return retcode;
10078 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10080 int retcode;
10081 Jim_Cmd *cmdPtr;
10082 void *prevPrivData;
10083 Jim_Obj *tailcallObj = NULL;
10085 #if 0
10086 printf("invoke");
10087 int j;
10088 for (j = 0; j < objc; j++) {
10089 printf(" '%s'", Jim_String(objv[j]));
10091 printf("\n");
10092 #endif
10094 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10095 if (cmdPtr == NULL) {
10096 return JimUnknown(interp, objc, objv);
10098 JimIncrCmdRefCount(cmdPtr);
10100 if (interp->evalDepth == interp->maxEvalDepth) {
10101 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10102 retcode = JIM_ERR;
10103 goto out;
10105 interp->evalDepth++;
10106 prevPrivData = interp->cmdPrivData;
10108 tailcall:
10110 /* Call it -- Make sure result is an empty object. */
10111 Jim_SetEmptyResult(interp);
10112 if (cmdPtr->isproc) {
10113 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10115 /* Handle the JIM_RETURN return code */
10116 if (retcode == JIM_RETURN) {
10117 if (--interp->returnLevel <= 0) {
10118 retcode = interp->returnCode;
10119 interp->returnCode = JIM_OK;
10120 interp->returnLevel = 0;
10123 else if (retcode == JIM_ERR) {
10124 interp->addStackTrace++;
10125 Jim_DecrRefCount(interp, interp->errorProc);
10126 interp->errorProc = objv[0];
10127 Jim_IncrRefCount(interp->errorProc);
10130 else {
10131 interp->cmdPrivData = cmdPtr->u.native.privData;
10132 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10135 if (tailcallObj) {
10136 /* clean up previous tailcall if we were invoking one */
10137 Jim_DecrRefCount(interp, tailcallObj);
10138 tailcallObj = NULL;
10141 /* If a tailcall is returned for this frame, loop to invoke the new command */
10142 if (retcode == JIM_EVAL && interp->framePtr->tailcallObj) {
10143 JimDecrCmdRefCount(interp, cmdPtr);
10145 /* Replace the current command with the new tailcall command */
10146 cmdPtr = interp->framePtr->tailcallCmd;
10147 interp->framePtr->tailcallCmd = NULL;
10148 tailcallObj = interp->framePtr->tailcallObj;
10149 interp->framePtr->tailcallObj = NULL;
10150 /* We can access the internal rep here because the object can only
10151 * be constructed by the tailcall command
10153 objc = tailcallObj->internalRep.listValue.len;
10154 objv = tailcallObj->internalRep.listValue.ele;
10155 goto tailcall;
10158 interp->cmdPrivData = prevPrivData;
10159 interp->evalDepth--;
10161 out:
10162 JimDecrCmdRefCount(interp, cmdPtr);
10164 if (interp->framePtr->tailcallObj) {
10165 /* We might have skipped invoking a tailcall, perhaps because of an error
10166 * in defer handling so cleanup now
10168 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10169 Jim_DecrRefCount(interp, interp->framePtr->tailcallObj);
10170 interp->framePtr->tailcallCmd = NULL;
10171 interp->framePtr->tailcallObj = NULL;
10174 return retcode;
10177 /* Eval the object vector 'objv' composed of 'objc' elements.
10178 * Every element is used as single argument.
10179 * Jim_EvalObj() will call this function every time its object
10180 * argument is of "list" type, with no string representation.
10182 * This is possible because the string representation of a
10183 * list object generated by the UpdateStringOfList is made
10184 * in a way that ensures that every list element is a different
10185 * command argument. */
10186 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10188 int i, retcode;
10190 /* Incr refcount of arguments. */
10191 for (i = 0; i < objc; i++)
10192 Jim_IncrRefCount(objv[i]);
10194 retcode = JimInvokeCommand(interp, objc, objv);
10196 /* Decr refcount of arguments and return the retcode */
10197 for (i = 0; i < objc; i++)
10198 Jim_DecrRefCount(interp, objv[i]);
10200 return retcode;
10204 * Invokes 'prefix' as a command with the objv array as arguments.
10206 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10208 int ret;
10209 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10211 nargv[0] = prefix;
10212 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10213 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10214 Jim_Free(nargv);
10215 return ret;
10218 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10220 if (!interp->errorFlag) {
10221 /* This is the first error, so save the file/line information and reset the stack */
10222 interp->errorFlag = 1;
10223 Jim_IncrRefCount(script->fileNameObj);
10224 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10225 interp->errorFileNameObj = script->fileNameObj;
10226 interp->errorLine = script->linenr;
10228 JimResetStackTrace(interp);
10229 /* Always add a level where the error first occurs */
10230 interp->addStackTrace++;
10233 /* Now if this is an "interesting" level, add it to the stack trace */
10234 if (interp->addStackTrace > 0) {
10235 /* Add the stack info for the current level */
10237 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10239 /* Note: if we didn't have a filename for this level,
10240 * don't clear the addStackTrace flag
10241 * so we can pick it up at the next level
10243 if (Jim_Length(script->fileNameObj)) {
10244 interp->addStackTrace = 0;
10247 Jim_DecrRefCount(interp, interp->errorProc);
10248 interp->errorProc = interp->emptyObj;
10249 Jim_IncrRefCount(interp->errorProc);
10253 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10255 Jim_Obj *objPtr;
10256 int ret = JIM_ERR;
10258 switch (token->type) {
10259 case JIM_TT_STR:
10260 case JIM_TT_ESC:
10261 objPtr = token->objPtr;
10262 break;
10263 case JIM_TT_VAR:
10264 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10265 break;
10266 case JIM_TT_DICTSUGAR:
10267 objPtr = JimExpandDictSugar(interp, token->objPtr);
10268 break;
10269 case JIM_TT_EXPRSUGAR:
10270 ret = Jim_EvalExpression(interp, token->objPtr);
10271 if (ret == JIM_OK) {
10272 objPtr = Jim_GetResult(interp);
10274 else {
10275 objPtr = NULL;
10277 break;
10278 case JIM_TT_CMD:
10279 ret = Jim_EvalObj(interp, token->objPtr);
10280 if (ret == JIM_OK || ret == JIM_RETURN) {
10281 objPtr = interp->result;
10282 } else {
10283 /* includes JIM_BREAK, JIM_CONTINUE */
10284 objPtr = NULL;
10286 break;
10287 default:
10288 JimPanic((1,
10289 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10290 objPtr = NULL;
10291 break;
10293 if (objPtr) {
10294 *objPtrPtr = objPtr;
10295 return JIM_OK;
10297 return ret;
10300 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10301 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10302 * The returned object has refcount = 0.
10304 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10306 int totlen = 0, i;
10307 Jim_Obj **intv;
10308 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10309 Jim_Obj *objPtr;
10310 char *s;
10312 if (tokens <= JIM_EVAL_SINTV_LEN)
10313 intv = sintv;
10314 else
10315 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10317 /* Compute every token forming the argument
10318 * in the intv objects vector. */
10319 for (i = 0; i < tokens; i++) {
10320 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10321 case JIM_OK:
10322 case JIM_RETURN:
10323 break;
10324 case JIM_BREAK:
10325 if (flags & JIM_SUBST_FLAG) {
10326 /* Stop here */
10327 tokens = i;
10328 continue;
10330 /* XXX: Should probably set an error about break outside loop */
10331 /* fall through to error */
10332 case JIM_CONTINUE:
10333 if (flags & JIM_SUBST_FLAG) {
10334 intv[i] = NULL;
10335 continue;
10337 /* XXX: Ditto continue outside loop */
10338 /* fall through to error */
10339 default:
10340 while (i--) {
10341 Jim_DecrRefCount(interp, intv[i]);
10343 if (intv != sintv) {
10344 Jim_Free(intv);
10346 return NULL;
10348 Jim_IncrRefCount(intv[i]);
10349 Jim_String(intv[i]);
10350 totlen += intv[i]->length;
10353 /* Fast path return for a single token */
10354 if (tokens == 1 && intv[0] && intv == sintv) {
10355 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10356 intv[0]->refCount--;
10357 return intv[0];
10360 /* Concatenate every token in an unique
10361 * object. */
10362 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10364 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10365 && token[2].type == JIM_TT_VAR) {
10366 /* May be able to do fast interpolated object -> dictSubst */
10367 objPtr->typePtr = &interpolatedObjType;
10368 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10369 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10370 Jim_IncrRefCount(intv[2]);
10372 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10373 /* The first interpolated token is source, so preserve the source info */
10374 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10378 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10379 objPtr->length = totlen;
10380 for (i = 0; i < tokens; i++) {
10381 if (intv[i]) {
10382 memcpy(s, intv[i]->bytes, intv[i]->length);
10383 s += intv[i]->length;
10384 Jim_DecrRefCount(interp, intv[i]);
10387 objPtr->bytes[totlen] = '\0';
10388 /* Free the intv vector if not static. */
10389 if (intv != sintv) {
10390 Jim_Free(intv);
10393 return objPtr;
10397 /* listPtr *must* be a list.
10398 * The contents of the list is evaluated with the first element as the command and
10399 * the remaining elements as the arguments.
10401 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10403 int retcode = JIM_OK;
10405 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10407 if (listPtr->internalRep.listValue.len) {
10408 Jim_IncrRefCount(listPtr);
10409 retcode = JimInvokeCommand(interp,
10410 listPtr->internalRep.listValue.len,
10411 listPtr->internalRep.listValue.ele);
10412 Jim_DecrRefCount(interp, listPtr);
10414 return retcode;
10417 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10419 SetListFromAny(interp, listPtr);
10420 return JimEvalObjList(interp, listPtr);
10423 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10425 int i;
10426 ScriptObj *script;
10427 ScriptToken *token;
10428 int retcode = JIM_OK;
10429 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10430 Jim_Obj *prevScriptObj;
10432 /* If the object is of type "list", with no string rep we can call
10433 * a specialized version of Jim_EvalObj() */
10434 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10435 return JimEvalObjList(interp, scriptObjPtr);
10438 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10439 script = JimGetScript(interp, scriptObjPtr);
10440 if (!JimScriptValid(interp, script)) {
10441 Jim_DecrRefCount(interp, scriptObjPtr);
10442 return JIM_ERR;
10445 /* Reset the interpreter result. This is useful to
10446 * return the empty result in the case of empty program. */
10447 Jim_SetEmptyResult(interp);
10449 token = script->token;
10451 #ifdef JIM_OPTIMIZATION
10452 /* Check for one of the following common scripts used by for, while
10454 * {}
10455 * incr a
10457 if (script->len == 0) {
10458 Jim_DecrRefCount(interp, scriptObjPtr);
10459 return JIM_OK;
10461 if (script->len == 3
10462 && token[1].objPtr->typePtr == &commandObjType
10463 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10464 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10465 && token[2].objPtr->typePtr == &variableObjType) {
10467 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10469 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10470 JimWideValue(objPtr)++;
10471 Jim_InvalidateStringRep(objPtr);
10472 Jim_DecrRefCount(interp, scriptObjPtr);
10473 Jim_SetResult(interp, objPtr);
10474 return JIM_OK;
10477 #endif
10479 /* Now we have to make sure the internal repr will not be
10480 * freed on shimmering.
10482 * Think for example to this:
10484 * set x {llength $x; ... some more code ...}; eval $x
10486 * In order to preserve the internal rep, we increment the
10487 * inUse field of the script internal rep structure. */
10488 script->inUse++;
10490 /* Stash the current script */
10491 prevScriptObj = interp->currentScriptObj;
10492 interp->currentScriptObj = scriptObjPtr;
10494 interp->errorFlag = 0;
10495 argv = sargv;
10497 /* Execute every command sequentially until the end of the script
10498 * or an error occurs.
10500 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10501 int argc;
10502 int j;
10504 /* First token of the line is always JIM_TT_LINE */
10505 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10506 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10508 /* Allocate the arguments vector if required */
10509 if (argc > JIM_EVAL_SARGV_LEN)
10510 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10512 /* Skip the JIM_TT_LINE token */
10513 i++;
10515 /* Populate the arguments objects.
10516 * If an error occurs, retcode will be set and
10517 * 'j' will be set to the number of args expanded
10519 for (j = 0; j < argc; j++) {
10520 long wordtokens = 1;
10521 int expand = 0;
10522 Jim_Obj *wordObjPtr = NULL;
10524 if (token[i].type == JIM_TT_WORD) {
10525 wordtokens = JimWideValue(token[i++].objPtr);
10526 if (wordtokens < 0) {
10527 expand = 1;
10528 wordtokens = -wordtokens;
10532 if (wordtokens == 1) {
10533 /* Fast path if the token does not
10534 * need interpolation */
10536 switch (token[i].type) {
10537 case JIM_TT_ESC:
10538 case JIM_TT_STR:
10539 wordObjPtr = token[i].objPtr;
10540 break;
10541 case JIM_TT_VAR:
10542 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10543 break;
10544 case JIM_TT_EXPRSUGAR:
10545 retcode = Jim_EvalExpression(interp, token[i].objPtr);
10546 if (retcode == JIM_OK) {
10547 wordObjPtr = Jim_GetResult(interp);
10549 else {
10550 wordObjPtr = NULL;
10552 break;
10553 case JIM_TT_DICTSUGAR:
10554 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10555 break;
10556 case JIM_TT_CMD:
10557 retcode = Jim_EvalObj(interp, token[i].objPtr);
10558 if (retcode == JIM_OK) {
10559 wordObjPtr = Jim_GetResult(interp);
10561 break;
10562 default:
10563 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10566 else {
10567 /* For interpolation we call a helper
10568 * function to do the work for us. */
10569 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10572 if (!wordObjPtr) {
10573 if (retcode == JIM_OK) {
10574 retcode = JIM_ERR;
10576 break;
10579 Jim_IncrRefCount(wordObjPtr);
10580 i += wordtokens;
10582 if (!expand) {
10583 argv[j] = wordObjPtr;
10585 else {
10586 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10587 int len = Jim_ListLength(interp, wordObjPtr);
10588 int newargc = argc + len - 1;
10589 int k;
10591 if (len > 1) {
10592 if (argv == sargv) {
10593 if (newargc > JIM_EVAL_SARGV_LEN) {
10594 argv = Jim_Alloc(sizeof(*argv) * newargc);
10595 memcpy(argv, sargv, sizeof(*argv) * j);
10598 else {
10599 /* Need to realloc to make room for (len - 1) more entries */
10600 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10604 /* Now copy in the expanded version */
10605 for (k = 0; k < len; k++) {
10606 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10607 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10610 /* The original object reference is no longer needed,
10611 * after the expansion it is no longer present on
10612 * the argument vector, but the single elements are
10613 * in its place. */
10614 Jim_DecrRefCount(interp, wordObjPtr);
10616 /* And update the indexes */
10617 j--;
10618 argc += len - 1;
10622 if (retcode == JIM_OK && argc) {
10623 /* Invoke the command */
10624 retcode = JimInvokeCommand(interp, argc, argv);
10625 /* Check for a signal after each command */
10626 if (Jim_CheckSignal(interp)) {
10627 retcode = JIM_SIGNAL;
10631 /* Finished with the command, so decrement ref counts of each argument */
10632 while (j-- > 0) {
10633 Jim_DecrRefCount(interp, argv[j]);
10636 if (argv != sargv) {
10637 Jim_Free(argv);
10638 argv = sargv;
10642 /* Possibly add to the error stack trace */
10643 if (retcode == JIM_ERR) {
10644 JimAddErrorToStack(interp, script);
10646 /* Propagate the addStackTrace value through 'return -code error' */
10647 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10648 /* No need to add stack trace */
10649 interp->addStackTrace = 0;
10652 /* Restore the current script */
10653 interp->currentScriptObj = prevScriptObj;
10655 /* Note that we don't have to decrement inUse, because the
10656 * following code transfers our use of the reference again to
10657 * the script object. */
10658 Jim_FreeIntRep(interp, scriptObjPtr);
10659 scriptObjPtr->typePtr = &scriptObjType;
10660 Jim_SetIntRepPtr(scriptObjPtr, script);
10661 Jim_DecrRefCount(interp, scriptObjPtr);
10663 return retcode;
10666 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10668 int retcode;
10669 /* If argObjPtr begins with '&', do an automatic upvar */
10670 const char *varname = Jim_String(argNameObj);
10671 if (*varname == '&') {
10672 /* First check that the target variable exists */
10673 Jim_Obj *objPtr;
10674 Jim_CallFrame *savedCallFrame = interp->framePtr;
10676 interp->framePtr = interp->framePtr->parent;
10677 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10678 interp->framePtr = savedCallFrame;
10679 if (!objPtr) {
10680 return JIM_ERR;
10683 /* It exists, so perform the binding. */
10684 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10685 Jim_IncrRefCount(objPtr);
10686 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10687 Jim_DecrRefCount(interp, objPtr);
10689 else {
10690 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10692 return retcode;
10696 * Sets the interp result to be an error message indicating the required proc args.
10698 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10700 /* Create a nice error message, consistent with Tcl 8.5 */
10701 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10702 int i;
10704 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10705 Jim_AppendString(interp, argmsg, " ", 1);
10707 if (i == cmd->u.proc.argsPos) {
10708 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10709 /* Renamed args */
10710 Jim_AppendString(interp, argmsg, "?", 1);
10711 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10712 Jim_AppendString(interp, argmsg, " ...?", -1);
10714 else {
10715 /* We have plain args */
10716 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10719 else {
10720 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10721 Jim_AppendString(interp, argmsg, "?", 1);
10722 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10723 Jim_AppendString(interp, argmsg, "?", 1);
10725 else {
10726 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10727 if (*arg == '&') {
10728 arg++;
10730 Jim_AppendString(interp, argmsg, arg, -1);
10734 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10737 #ifdef jim_ext_namespace
10739 * [namespace eval]
10741 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10743 Jim_CallFrame *callFramePtr;
10744 int retcode;
10746 /* Create a new callframe */
10747 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10748 callFramePtr->argv = &interp->emptyObj;
10749 callFramePtr->argc = 0;
10750 callFramePtr->procArgsObjPtr = NULL;
10751 callFramePtr->procBodyObjPtr = scriptObj;
10752 callFramePtr->staticVars = NULL;
10753 callFramePtr->fileNameObj = interp->emptyObj;
10754 callFramePtr->line = 0;
10755 Jim_IncrRefCount(scriptObj);
10756 interp->framePtr = callFramePtr;
10758 /* Check if there are too nested calls */
10759 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10760 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10761 retcode = JIM_ERR;
10763 else {
10764 /* Eval the body */
10765 retcode = Jim_EvalObj(interp, scriptObj);
10768 /* Destroy the callframe */
10769 interp->framePtr = interp->framePtr->parent;
10770 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10772 return retcode;
10774 #endif
10776 /* Call a procedure implemented in Tcl.
10777 * It's possible to speed-up a lot this function, currently
10778 * the callframes are not cached, but allocated and
10779 * destroied every time. What is expecially costly is
10780 * to create/destroy the local vars hash table every time.
10782 * This can be fixed just implementing callframes caching
10783 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10784 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10786 Jim_CallFrame *callFramePtr;
10787 int i, d, retcode, optargs;
10788 ScriptObj *script;
10790 /* Check arity */
10791 if (argc - 1 < cmd->u.proc.reqArity ||
10792 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10793 JimSetProcWrongArgs(interp, argv[0], cmd);
10794 return JIM_ERR;
10797 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10798 /* Optimise for procedure with no body - useful for optional debugging */
10799 return JIM_OK;
10802 /* Check if there are too nested calls */
10803 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10804 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10805 return JIM_ERR;
10808 /* Create a new callframe */
10809 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10810 callFramePtr->argv = argv;
10811 callFramePtr->argc = argc;
10812 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10813 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10814 callFramePtr->staticVars = cmd->u.proc.staticVars;
10816 /* Remember where we were called from. */
10817 script = JimGetScript(interp, interp->currentScriptObj);
10818 callFramePtr->fileNameObj = script->fileNameObj;
10819 callFramePtr->line = script->linenr;
10821 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10822 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10823 interp->framePtr = callFramePtr;
10825 /* How many optional args are available */
10826 optargs = (argc - 1 - cmd->u.proc.reqArity);
10828 /* Step 'i' along the actual args, and step 'd' along the formal args */
10829 i = 1;
10830 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10831 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10832 if (d == cmd->u.proc.argsPos) {
10833 /* assign $args */
10834 Jim_Obj *listObjPtr;
10835 int argsLen = 0;
10836 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10837 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10839 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10841 /* It is possible to rename args. */
10842 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10843 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10845 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10846 if (retcode != JIM_OK) {
10847 goto badargset;
10850 i += argsLen;
10851 continue;
10854 /* Optional or required? */
10855 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10856 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10858 else {
10859 /* Ran out, so use the default */
10860 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10862 if (retcode != JIM_OK) {
10863 goto badargset;
10867 /* Eval the body */
10868 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10870 badargset:
10872 /* Invoke $jim::defer then destroy the callframe */
10873 retcode = JimInvokeDefer(interp, retcode);
10874 interp->framePtr = interp->framePtr->parent;
10875 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10877 return retcode;
10880 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10882 int retval;
10883 Jim_Obj *scriptObjPtr;
10885 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10886 Jim_IncrRefCount(scriptObjPtr);
10888 if (filename) {
10889 Jim_Obj *prevScriptObj;
10891 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10893 prevScriptObj = interp->currentScriptObj;
10894 interp->currentScriptObj = scriptObjPtr;
10896 retval = Jim_EvalObj(interp, scriptObjPtr);
10898 interp->currentScriptObj = prevScriptObj;
10900 else {
10901 retval = Jim_EvalObj(interp, scriptObjPtr);
10903 Jim_DecrRefCount(interp, scriptObjPtr);
10904 return retval;
10907 int Jim_Eval(Jim_Interp *interp, const char *script)
10909 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10912 /* Execute script in the scope of the global level */
10913 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10915 int retval;
10916 Jim_CallFrame *savedFramePtr = interp->framePtr;
10918 interp->framePtr = interp->topFramePtr;
10919 retval = Jim_Eval(interp, script);
10920 interp->framePtr = savedFramePtr;
10922 return retval;
10925 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10927 int retval;
10928 Jim_CallFrame *savedFramePtr = interp->framePtr;
10930 interp->framePtr = interp->topFramePtr;
10931 retval = Jim_EvalFile(interp, filename);
10932 interp->framePtr = savedFramePtr;
10934 return retval;
10937 #include <sys/stat.h>
10939 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10941 FILE *fp;
10942 char *buf;
10943 Jim_Obj *scriptObjPtr;
10944 Jim_Obj *prevScriptObj;
10945 struct stat sb;
10946 int retcode;
10947 int readlen;
10949 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10950 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10951 return JIM_ERR;
10953 if (sb.st_size == 0) {
10954 fclose(fp);
10955 return JIM_OK;
10958 buf = Jim_Alloc(sb.st_size + 1);
10959 readlen = fread(buf, 1, sb.st_size, fp);
10960 if (ferror(fp)) {
10961 fclose(fp);
10962 Jim_Free(buf);
10963 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10964 return JIM_ERR;
10966 fclose(fp);
10967 buf[readlen] = 0;
10969 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10970 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
10971 Jim_IncrRefCount(scriptObjPtr);
10973 prevScriptObj = interp->currentScriptObj;
10974 interp->currentScriptObj = scriptObjPtr;
10976 retcode = Jim_EvalObj(interp, scriptObjPtr);
10978 /* Handle the JIM_RETURN return code */
10979 if (retcode == JIM_RETURN) {
10980 if (--interp->returnLevel <= 0) {
10981 retcode = interp->returnCode;
10982 interp->returnCode = JIM_OK;
10983 interp->returnLevel = 0;
10986 if (retcode == JIM_ERR) {
10987 /* EvalFile changes context, so add a stack frame here */
10988 interp->addStackTrace++;
10991 interp->currentScriptObj = prevScriptObj;
10993 Jim_DecrRefCount(interp, scriptObjPtr);
10995 return retcode;
10998 /* -----------------------------------------------------------------------------
10999 * Subst
11000 * ---------------------------------------------------------------------------*/
11001 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11003 pc->tstart = pc->p;
11004 pc->tline = pc->linenr;
11006 if (pc->len == 0) {
11007 pc->tend = pc->p;
11008 pc->tt = JIM_TT_EOL;
11009 pc->eof = 1;
11010 return;
11012 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11013 JimParseCmd(pc);
11014 return;
11016 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11017 if (JimParseVar(pc) == JIM_OK) {
11018 return;
11020 /* Not a var, so treat as a string */
11021 pc->tstart = pc->p;
11022 flags |= JIM_SUBST_NOVAR;
11024 while (pc->len) {
11025 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11026 break;
11028 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11029 break;
11031 if (*pc->p == '\\' && pc->len > 1) {
11032 pc->p++;
11033 pc->len--;
11035 pc->p++;
11036 pc->len--;
11038 pc->tend = pc->p - 1;
11039 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11042 /* The subst object type reuses most of the data structures and functions
11043 * of the script object. Script's data structures are a bit more complex
11044 * for what is needed for [subst]itution tasks, but the reuse helps to
11045 * deal with a single data structure at the cost of some more memory
11046 * usage for substitutions. */
11048 /* This method takes the string representation of an object
11049 * as a Tcl string where to perform [subst]itution, and generates
11050 * the pre-parsed internal representation. */
11051 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11053 int scriptTextLen;
11054 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11055 struct JimParserCtx parser;
11056 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11057 ParseTokenList tokenlist;
11059 /* Initially parse the subst into tokens (in tokenlist) */
11060 ScriptTokenListInit(&tokenlist);
11062 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11063 while (1) {
11064 JimParseSubst(&parser, flags);
11065 if (parser.eof) {
11066 /* Note that subst doesn't need the EOL token */
11067 break;
11069 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11070 parser.tline);
11073 /* Create the "real" subst/script tokens from the initial token list */
11074 script->inUse = 1;
11075 script->substFlags = flags;
11076 script->fileNameObj = interp->emptyObj;
11077 Jim_IncrRefCount(script->fileNameObj);
11078 SubstObjAddTokens(interp, script, &tokenlist);
11080 /* No longer need the token list */
11081 ScriptTokenListFree(&tokenlist);
11083 #ifdef DEBUG_SHOW_SUBST
11085 int i;
11087 printf("==== Subst ====\n");
11088 for (i = 0; i < script->len; i++) {
11089 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11090 Jim_String(script->token[i].objPtr));
11093 #endif
11095 /* Free the old internal rep and set the new one. */
11096 Jim_FreeIntRep(interp, objPtr);
11097 Jim_SetIntRepPtr(objPtr, script);
11098 objPtr->typePtr = &scriptObjType;
11099 return JIM_OK;
11102 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11104 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11105 SetSubstFromAny(interp, objPtr, flags);
11106 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11109 /* Performs commands,variables,blackslashes substitution,
11110 * storing the result object (with refcount 0) into
11111 * resObjPtrPtr. */
11112 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11114 ScriptObj *script;
11116 JimPanic((substObjPtr->refCount == 0, "Jim_SubstObj() called with zero refcount object"));
11118 script = Jim_GetSubst(interp, substObjPtr, flags);
11120 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11121 /* In order to preserve the internal rep, we increment the
11122 * inUse field of the script internal rep structure. */
11123 script->inUse++;
11125 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11127 script->inUse--;
11128 Jim_DecrRefCount(interp, substObjPtr);
11129 if (*resObjPtrPtr == NULL) {
11130 return JIM_ERR;
11132 return JIM_OK;
11135 /* -----------------------------------------------------------------------------
11136 * Core commands utility functions
11137 * ---------------------------------------------------------------------------*/
11138 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11140 Jim_Obj *objPtr;
11141 Jim_Obj *listObjPtr;
11143 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11145 listObjPtr = Jim_NewListObj(interp, argv, argc);
11147 if (msg && *msg) {
11148 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11150 Jim_IncrRefCount(listObjPtr);
11151 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11152 Jim_DecrRefCount(interp, listObjPtr);
11154 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11158 * May add the key and/or value to the list.
11160 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11161 Jim_HashEntry *he, int type);
11163 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11166 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11167 * invoke the callback to add entries to a list.
11168 * Returns the list.
11170 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11171 JimHashtableIteratorCallbackType *callback, int type)
11173 Jim_HashEntry *he;
11174 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11176 /* Check for the non-pattern case. We can do this much more efficiently. */
11177 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11178 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11179 if (he) {
11180 callback(interp, listObjPtr, he, type);
11183 else {
11184 Jim_HashTableIterator htiter;
11185 JimInitHashTableIterator(ht, &htiter);
11186 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11187 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11188 callback(interp, listObjPtr, he, type);
11192 return listObjPtr;
11195 /* Keep these in order */
11196 #define JIM_CMDLIST_COMMANDS 0
11197 #define JIM_CMDLIST_PROCS 1
11198 #define JIM_CMDLIST_CHANNELS 2
11201 * Adds matching command names (procs, channels) to the list.
11203 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11204 Jim_HashEntry *he, int type)
11206 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11207 Jim_Obj *objPtr;
11209 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11210 /* not a proc */
11211 return;
11214 objPtr = Jim_NewStringObj(interp, he->key, -1);
11215 Jim_IncrRefCount(objPtr);
11217 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11218 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11220 Jim_DecrRefCount(interp, objPtr);
11223 /* type is JIM_CMDLIST_xxx */
11224 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11226 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11229 /* Keep these in order */
11230 #define JIM_VARLIST_GLOBALS 0
11231 #define JIM_VARLIST_LOCALS 1
11232 #define JIM_VARLIST_VARS 2
11234 #define JIM_VARLIST_VALUES 0x1000
11237 * Adds matching variable names to the list.
11239 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11240 Jim_HashEntry *he, int type)
11242 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11244 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11245 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11246 if (type & JIM_VARLIST_VALUES) {
11247 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11252 /* mode is JIM_VARLIST_xxx */
11253 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11255 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11256 /* For [info locals], if we are at top level an emtpy list
11257 * is returned. I don't agree, but we aim at compatibility (SS) */
11258 return interp->emptyObj;
11260 else {
11261 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11262 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11266 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11267 Jim_Obj **objPtrPtr, int info_level_cmd)
11269 Jim_CallFrame *targetCallFrame;
11271 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11272 if (targetCallFrame == NULL) {
11273 return JIM_ERR;
11275 /* No proc call at toplevel callframe */
11276 if (targetCallFrame == interp->topFramePtr) {
11277 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11278 return JIM_ERR;
11280 if (info_level_cmd) {
11281 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11283 else {
11284 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11286 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11287 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11288 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11289 *objPtrPtr = listObj;
11291 return JIM_OK;
11294 /* -----------------------------------------------------------------------------
11295 * Core commands
11296 * ---------------------------------------------------------------------------*/
11298 /* fake [puts] -- not the real puts, just for debugging. */
11299 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11301 if (argc != 2 && argc != 3) {
11302 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11303 return JIM_ERR;
11305 if (argc == 3) {
11306 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11307 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11308 return JIM_ERR;
11310 else {
11311 fputs(Jim_String(argv[2]), stdout);
11314 else {
11315 puts(Jim_String(argv[1]));
11317 return JIM_OK;
11320 /* Helper for [+] and [*] */
11321 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11323 jim_wide wideValue, res;
11324 double doubleValue, doubleRes;
11325 int i;
11327 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11329 for (i = 1; i < argc; i++) {
11330 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11331 goto trydouble;
11332 if (op == JIM_EXPROP_ADD)
11333 res += wideValue;
11334 else
11335 res *= wideValue;
11337 Jim_SetResultInt(interp, res);
11338 return JIM_OK;
11339 trydouble:
11340 doubleRes = (double)res;
11341 for (; i < argc; i++) {
11342 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11343 return JIM_ERR;
11344 if (op == JIM_EXPROP_ADD)
11345 doubleRes += doubleValue;
11346 else
11347 doubleRes *= doubleValue;
11349 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11350 return JIM_OK;
11353 /* Helper for [-] and [/] */
11354 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11356 jim_wide wideValue, res = 0;
11357 double doubleValue, doubleRes = 0;
11358 int i = 2;
11360 if (argc < 2) {
11361 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11362 return JIM_ERR;
11364 else if (argc == 2) {
11365 /* The arity = 2 case is different. For [- x] returns -x,
11366 * while [/ x] returns 1/x. */
11367 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11368 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11369 return JIM_ERR;
11371 else {
11372 if (op == JIM_EXPROP_SUB)
11373 doubleRes = -doubleValue;
11374 else
11375 doubleRes = 1.0 / doubleValue;
11376 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11377 return JIM_OK;
11380 if (op == JIM_EXPROP_SUB) {
11381 res = -wideValue;
11382 Jim_SetResultInt(interp, res);
11384 else {
11385 doubleRes = 1.0 / wideValue;
11386 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11388 return JIM_OK;
11390 else {
11391 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11392 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11393 != JIM_OK) {
11394 return JIM_ERR;
11396 else {
11397 goto trydouble;
11401 for (i = 2; i < argc; i++) {
11402 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11403 doubleRes = (double)res;
11404 goto trydouble;
11406 if (op == JIM_EXPROP_SUB)
11407 res -= wideValue;
11408 else {
11409 if (wideValue == 0) {
11410 Jim_SetResultString(interp, "Division by zero", -1);
11411 return JIM_ERR;
11413 res /= wideValue;
11416 Jim_SetResultInt(interp, res);
11417 return JIM_OK;
11418 trydouble:
11419 for (; i < argc; i++) {
11420 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11421 return JIM_ERR;
11422 if (op == JIM_EXPROP_SUB)
11423 doubleRes -= doubleValue;
11424 else
11425 doubleRes /= doubleValue;
11427 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11428 return JIM_OK;
11432 /* [+] */
11433 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11435 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11438 /* [*] */
11439 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11441 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11444 /* [-] */
11445 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11447 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11450 /* [/] */
11451 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11453 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11456 /* [set] */
11457 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11459 if (argc != 2 && argc != 3) {
11460 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11461 return JIM_ERR;
11463 if (argc == 2) {
11464 Jim_Obj *objPtr;
11466 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11467 if (!objPtr)
11468 return JIM_ERR;
11469 Jim_SetResult(interp, objPtr);
11470 return JIM_OK;
11472 /* argc == 3 case. */
11473 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11474 return JIM_ERR;
11475 Jim_SetResult(interp, argv[2]);
11476 return JIM_OK;
11479 /* [unset]
11481 * unset ?-nocomplain? ?--? ?varName ...?
11483 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11485 int i = 1;
11486 int complain = 1;
11488 while (i < argc) {
11489 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11490 i++;
11491 break;
11493 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11494 complain = 0;
11495 i++;
11496 continue;
11498 break;
11501 while (i < argc) {
11502 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11503 && complain) {
11504 return JIM_ERR;
11506 i++;
11508 return JIM_OK;
11511 /* [while] */
11512 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11514 if (argc != 3) {
11515 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11516 return JIM_ERR;
11519 /* The general purpose implementation of while starts here */
11520 while (1) {
11521 int boolean, retval;
11523 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11524 return retval;
11525 if (!boolean)
11526 break;
11528 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11529 switch (retval) {
11530 case JIM_BREAK:
11531 goto out;
11532 break;
11533 case JIM_CONTINUE:
11534 continue;
11535 break;
11536 default:
11537 return retval;
11541 out:
11542 Jim_SetEmptyResult(interp);
11543 return JIM_OK;
11546 /* [for] */
11547 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11549 int retval;
11550 int boolean = 1;
11551 Jim_Obj *varNamePtr = NULL;
11552 Jim_Obj *stopVarNamePtr = NULL;
11554 if (argc != 5) {
11555 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11556 return JIM_ERR;
11559 /* Do the initialisation */
11560 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11561 return retval;
11564 /* And do the first test now. Better for optimisation
11565 * if we can do next/test at the bottom of the loop
11567 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11569 /* Ready to do the body as follows:
11570 * while (1) {
11571 * body // check retcode
11572 * next // check retcode
11573 * test // check retcode/test bool
11577 #ifdef JIM_OPTIMIZATION
11578 /* Check if the for is on the form:
11579 * for ... {$i < CONST} {incr i}
11580 * for ... {$i < $j} {incr i}
11582 if (retval == JIM_OK && boolean) {
11583 ScriptObj *incrScript;
11584 struct ExprTree *expr;
11585 jim_wide stop, currentVal;
11586 Jim_Obj *objPtr;
11587 int cmpOffset;
11589 /* Do it only if there aren't shared arguments */
11590 expr = JimGetExpression(interp, argv[2]);
11591 incrScript = JimGetScript(interp, argv[3]);
11593 /* Ensure proper lengths to start */
11594 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11595 goto evalstart;
11597 /* Ensure proper token types. */
11598 if (incrScript->token[1].type != JIM_TT_ESC) {
11599 goto evalstart;
11602 if (expr->expr->type == JIM_EXPROP_LT) {
11603 cmpOffset = 0;
11605 else if (expr->expr->type == JIM_EXPROP_LTE) {
11606 cmpOffset = 1;
11608 else {
11609 goto evalstart;
11612 if (expr->expr->left->type != JIM_TT_VAR) {
11613 goto evalstart;
11616 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11617 goto evalstart;
11620 /* Update command must be incr */
11621 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11622 goto evalstart;
11625 /* incr, expression must be about the same variable */
11626 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11627 goto evalstart;
11630 /* Get the stop condition (must be a variable or integer) */
11631 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11632 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11633 goto evalstart;
11636 else {
11637 stopVarNamePtr = expr->expr->right->objPtr;
11638 Jim_IncrRefCount(stopVarNamePtr);
11639 /* Keep the compiler happy */
11640 stop = 0;
11643 /* Initialization */
11644 varNamePtr = expr->expr->left->objPtr;
11645 Jim_IncrRefCount(varNamePtr);
11647 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11648 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11649 goto testcond;
11652 /* --- OPTIMIZED FOR --- */
11653 while (retval == JIM_OK) {
11654 /* === Check condition === */
11655 /* Note that currentVal is already set here */
11657 /* Immediate or Variable? get the 'stop' value if the latter. */
11658 if (stopVarNamePtr) {
11659 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11660 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11661 goto testcond;
11665 if (currentVal >= stop + cmpOffset) {
11666 break;
11669 /* Eval body */
11670 retval = Jim_EvalObj(interp, argv[4]);
11671 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11672 retval = JIM_OK;
11674 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11676 /* Increment */
11677 if (objPtr == NULL) {
11678 retval = JIM_ERR;
11679 goto out;
11681 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11682 currentVal = ++JimWideValue(objPtr);
11683 Jim_InvalidateStringRep(objPtr);
11685 else {
11686 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11687 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11688 ++currentVal)) != JIM_OK) {
11689 goto evalnext;
11694 goto out;
11696 evalstart:
11697 #endif
11699 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11700 /* Body */
11701 retval = Jim_EvalObj(interp, argv[4]);
11703 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11704 /* increment */
11705 JIM_IF_OPTIM(evalnext:)
11706 retval = Jim_EvalObj(interp, argv[3]);
11707 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11708 /* test */
11709 JIM_IF_OPTIM(testcond:)
11710 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11714 JIM_IF_OPTIM(out:)
11715 if (stopVarNamePtr) {
11716 Jim_DecrRefCount(interp, stopVarNamePtr);
11718 if (varNamePtr) {
11719 Jim_DecrRefCount(interp, varNamePtr);
11722 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11723 Jim_SetEmptyResult(interp);
11724 return JIM_OK;
11727 return retval;
11730 /* [loop] */
11731 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11733 int retval;
11734 jim_wide i;
11735 jim_wide limit;
11736 jim_wide incr = 1;
11737 Jim_Obj *bodyObjPtr;
11739 if (argc != 5 && argc != 6) {
11740 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11741 return JIM_ERR;
11744 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11745 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11746 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11747 return JIM_ERR;
11749 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11751 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11753 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11754 retval = Jim_EvalObj(interp, bodyObjPtr);
11755 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11756 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11758 retval = JIM_OK;
11760 /* Increment */
11761 i += incr;
11763 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11764 if (argv[1]->typePtr != &variableObjType) {
11765 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11766 return JIM_ERR;
11769 JimWideValue(objPtr) = i;
11770 Jim_InvalidateStringRep(objPtr);
11772 /* The following step is required in order to invalidate the
11773 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11774 if (argv[1]->typePtr != &variableObjType) {
11775 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11776 retval = JIM_ERR;
11777 break;
11781 else {
11782 objPtr = Jim_NewIntObj(interp, i);
11783 retval = Jim_SetVariable(interp, argv[1], objPtr);
11784 if (retval != JIM_OK) {
11785 Jim_FreeNewObj(interp, objPtr);
11791 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11792 Jim_SetEmptyResult(interp);
11793 return JIM_OK;
11795 return retval;
11798 /* List iterators make it easy to iterate over a list.
11799 * At some point iterators will be expanded to support generators.
11801 typedef struct {
11802 Jim_Obj *objPtr;
11803 int idx;
11804 } Jim_ListIter;
11807 * Initialise the iterator at the start of the list.
11809 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11811 iter->objPtr = objPtr;
11812 iter->idx = 0;
11816 * Returns the next object from the list, or NULL on end-of-list.
11818 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11820 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11821 return NULL;
11823 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11827 * Returns 1 if end-of-list has been reached.
11829 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11831 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11834 /* foreach + lmap implementation. */
11835 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11837 int result = JIM_OK;
11838 int i, numargs;
11839 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11840 Jim_ListIter *iters;
11841 Jim_Obj *script;
11842 Jim_Obj *resultObj;
11844 if (argc < 4 || argc % 2 != 0) {
11845 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11846 return JIM_ERR;
11848 script = argv[argc - 1]; /* Last argument is a script */
11849 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11851 if (numargs == 2) {
11852 iters = twoiters;
11854 else {
11855 iters = Jim_Alloc(numargs * sizeof(*iters));
11857 for (i = 0; i < numargs; i++) {
11858 JimListIterInit(&iters[i], argv[i + 1]);
11859 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11860 result = JIM_ERR;
11863 if (result != JIM_OK) {
11864 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11865 goto empty_varlist;
11868 if (doMap) {
11869 resultObj = Jim_NewListObj(interp, NULL, 0);
11871 else {
11872 resultObj = interp->emptyObj;
11874 Jim_IncrRefCount(resultObj);
11876 while (1) {
11877 /* Have we expired all lists? */
11878 for (i = 0; i < numargs; i += 2) {
11879 if (!JimListIterDone(interp, &iters[i + 1])) {
11880 break;
11883 if (i == numargs) {
11884 /* All done */
11885 break;
11888 /* For each list */
11889 for (i = 0; i < numargs; i += 2) {
11890 Jim_Obj *varName;
11892 /* foreach var */
11893 JimListIterInit(&iters[i], argv[i + 1]);
11894 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11895 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11896 if (!valObj) {
11897 /* Ran out, so store the empty string */
11898 valObj = interp->emptyObj;
11900 /* Avoid shimmering */
11901 Jim_IncrRefCount(valObj);
11902 result = Jim_SetVariable(interp, varName, valObj);
11903 Jim_DecrRefCount(interp, valObj);
11904 if (result != JIM_OK) {
11905 goto err;
11909 switch (result = Jim_EvalObj(interp, script)) {
11910 case JIM_OK:
11911 if (doMap) {
11912 Jim_ListAppendElement(interp, resultObj, interp->result);
11914 break;
11915 case JIM_CONTINUE:
11916 break;
11917 case JIM_BREAK:
11918 goto out;
11919 default:
11920 goto err;
11923 out:
11924 result = JIM_OK;
11925 Jim_SetResult(interp, resultObj);
11926 err:
11927 Jim_DecrRefCount(interp, resultObj);
11928 empty_varlist:
11929 if (numargs > 2) {
11930 Jim_Free(iters);
11932 return result;
11935 /* [foreach] */
11936 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11938 return JimForeachMapHelper(interp, argc, argv, 0);
11941 /* [lmap] */
11942 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11944 return JimForeachMapHelper(interp, argc, argv, 1);
11947 /* [lassign] */
11948 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11950 int result = JIM_ERR;
11951 int i;
11952 Jim_ListIter iter;
11953 Jim_Obj *resultObj;
11955 if (argc < 2) {
11956 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11957 return JIM_ERR;
11960 JimListIterInit(&iter, argv[1]);
11962 for (i = 2; i < argc; i++) {
11963 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11964 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11965 if (result != JIM_OK) {
11966 return result;
11970 resultObj = Jim_NewListObj(interp, NULL, 0);
11971 while (!JimListIterDone(interp, &iter)) {
11972 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
11975 Jim_SetResult(interp, resultObj);
11977 return JIM_OK;
11980 /* [if] */
11981 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11983 int boolean, retval, current = 1, falsebody = 0;
11985 if (argc >= 3) {
11986 while (1) {
11987 /* Far not enough arguments given! */
11988 if (current >= argc)
11989 goto err;
11990 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
11991 != JIM_OK)
11992 return retval;
11993 /* There lacks something, isn't it? */
11994 if (current >= argc)
11995 goto err;
11996 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
11997 current++;
11998 /* Tsk tsk, no then-clause? */
11999 if (current >= argc)
12000 goto err;
12001 if (boolean)
12002 return Jim_EvalObj(interp, argv[current]);
12003 /* Ok: no else-clause follows */
12004 if (++current >= argc) {
12005 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12006 return JIM_OK;
12008 falsebody = current++;
12009 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12010 /* IIICKS - else-clause isn't last cmd? */
12011 if (current != argc - 1)
12012 goto err;
12013 return Jim_EvalObj(interp, argv[current]);
12015 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12016 /* Ok: elseif follows meaning all the stuff
12017 * again (how boring...) */
12018 continue;
12019 /* OOPS - else-clause is not last cmd? */
12020 else if (falsebody != argc - 1)
12021 goto err;
12022 return Jim_EvalObj(interp, argv[falsebody]);
12024 return JIM_OK;
12026 err:
12027 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12028 return JIM_ERR;
12032 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12033 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12034 Jim_Obj *stringObj, int nocase)
12036 Jim_Obj *parms[4];
12037 int argc = 0;
12038 long eq;
12039 int rc;
12041 parms[argc++] = commandObj;
12042 if (nocase) {
12043 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12045 parms[argc++] = patternObj;
12046 parms[argc++] = stringObj;
12048 rc = Jim_EvalObjVector(interp, argc, parms);
12050 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12051 eq = -rc;
12054 return eq;
12057 /* [switch] */
12058 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12060 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12061 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12062 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12063 Jim_Obj **caseList;
12065 if (argc < 3) {
12066 wrongnumargs:
12067 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12068 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12069 return JIM_ERR;
12071 for (opt = 1; opt < argc; ++opt) {
12072 const char *option = Jim_String(argv[opt]);
12074 if (*option != '-')
12075 break;
12076 else if (strncmp(option, "--", 2) == 0) {
12077 ++opt;
12078 break;
12080 else if (strncmp(option, "-exact", 2) == 0)
12081 matchOpt = SWITCH_EXACT;
12082 else if (strncmp(option, "-glob", 2) == 0)
12083 matchOpt = SWITCH_GLOB;
12084 else if (strncmp(option, "-regexp", 2) == 0)
12085 matchOpt = SWITCH_RE;
12086 else if (strncmp(option, "-command", 2) == 0) {
12087 matchOpt = SWITCH_CMD;
12088 if ((argc - opt) < 2)
12089 goto wrongnumargs;
12090 command = argv[++opt];
12092 else {
12093 Jim_SetResultFormatted(interp,
12094 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12095 argv[opt]);
12096 return JIM_ERR;
12098 if ((argc - opt) < 2)
12099 goto wrongnumargs;
12101 strObj = argv[opt++];
12102 patCount = argc - opt;
12103 if (patCount == 1) {
12104 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12106 else
12107 caseList = (Jim_Obj **)&argv[opt];
12108 if (patCount == 0 || patCount % 2 != 0)
12109 goto wrongnumargs;
12110 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12111 Jim_Obj *patObj = caseList[i];
12113 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12114 || i < (patCount - 2)) {
12115 switch (matchOpt) {
12116 case SWITCH_EXACT:
12117 if (Jim_StringEqObj(strObj, patObj))
12118 scriptObj = caseList[i + 1];
12119 break;
12120 case SWITCH_GLOB:
12121 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12122 scriptObj = caseList[i + 1];
12123 break;
12124 case SWITCH_RE:
12125 command = Jim_NewStringObj(interp, "regexp", -1);
12126 /* Fall thru intentionally */
12127 case SWITCH_CMD:{
12128 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12130 /* After the execution of a command we need to
12131 * make sure to reconvert the object into a list
12132 * again. Only for the single-list style [switch]. */
12133 if (argc - opt == 1) {
12134 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12136 /* command is here already decref'd */
12137 if (rc < 0) {
12138 return -rc;
12140 if (rc)
12141 scriptObj = caseList[i + 1];
12142 break;
12146 else {
12147 scriptObj = caseList[i + 1];
12150 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12151 scriptObj = caseList[i + 1];
12152 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12153 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12154 return JIM_ERR;
12156 Jim_SetEmptyResult(interp);
12157 if (scriptObj) {
12158 return Jim_EvalObj(interp, scriptObj);
12160 return JIM_OK;
12163 /* [list] */
12164 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12166 Jim_Obj *listObjPtr;
12168 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12169 Jim_SetResult(interp, listObjPtr);
12170 return JIM_OK;
12173 /* [lindex] */
12174 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12176 Jim_Obj *objPtr, *listObjPtr;
12177 int i;
12178 int idx;
12180 if (argc < 2) {
12181 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12182 return JIM_ERR;
12184 objPtr = argv[1];
12185 Jim_IncrRefCount(objPtr);
12186 for (i = 2; i < argc; i++) {
12187 listObjPtr = objPtr;
12188 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12189 Jim_DecrRefCount(interp, listObjPtr);
12190 return JIM_ERR;
12192 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12193 /* Returns an empty object if the index
12194 * is out of range. */
12195 Jim_DecrRefCount(interp, listObjPtr);
12196 Jim_SetEmptyResult(interp);
12197 return JIM_OK;
12199 Jim_IncrRefCount(objPtr);
12200 Jim_DecrRefCount(interp, listObjPtr);
12202 Jim_SetResult(interp, objPtr);
12203 Jim_DecrRefCount(interp, objPtr);
12204 return JIM_OK;
12207 /* [llength] */
12208 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12210 if (argc != 2) {
12211 Jim_WrongNumArgs(interp, 1, argv, "list");
12212 return JIM_ERR;
12214 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12215 return JIM_OK;
12218 /* [lsearch] */
12219 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12221 static const char * const options[] = {
12222 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12223 NULL
12225 enum
12226 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12227 OPT_COMMAND };
12228 int i;
12229 int opt_bool = 0;
12230 int opt_not = 0;
12231 int opt_nocase = 0;
12232 int opt_all = 0;
12233 int opt_inline = 0;
12234 int opt_match = OPT_EXACT;
12235 int listlen;
12236 int rc = JIM_OK;
12237 Jim_Obj *listObjPtr = NULL;
12238 Jim_Obj *commandObj = NULL;
12240 if (argc < 3) {
12241 wrongargs:
12242 Jim_WrongNumArgs(interp, 1, argv,
12243 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12244 return JIM_ERR;
12247 for (i = 1; i < argc - 2; i++) {
12248 int option;
12250 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12251 return JIM_ERR;
12253 switch (option) {
12254 case OPT_BOOL:
12255 opt_bool = 1;
12256 opt_inline = 0;
12257 break;
12258 case OPT_NOT:
12259 opt_not = 1;
12260 break;
12261 case OPT_NOCASE:
12262 opt_nocase = 1;
12263 break;
12264 case OPT_INLINE:
12265 opt_inline = 1;
12266 opt_bool = 0;
12267 break;
12268 case OPT_ALL:
12269 opt_all = 1;
12270 break;
12271 case OPT_COMMAND:
12272 if (i >= argc - 2) {
12273 goto wrongargs;
12275 commandObj = argv[++i];
12276 /* fallthru */
12277 case OPT_EXACT:
12278 case OPT_GLOB:
12279 case OPT_REGEXP:
12280 opt_match = option;
12281 break;
12285 argv += i;
12287 if (opt_all) {
12288 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12290 if (opt_match == OPT_REGEXP) {
12291 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12293 if (commandObj) {
12294 Jim_IncrRefCount(commandObj);
12297 listlen = Jim_ListLength(interp, argv[0]);
12298 for (i = 0; i < listlen; i++) {
12299 int eq = 0;
12300 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12302 switch (opt_match) {
12303 case OPT_EXACT:
12304 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12305 break;
12307 case OPT_GLOB:
12308 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12309 break;
12311 case OPT_REGEXP:
12312 case OPT_COMMAND:
12313 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12314 if (eq < 0) {
12315 if (listObjPtr) {
12316 Jim_FreeNewObj(interp, listObjPtr);
12318 rc = JIM_ERR;
12319 goto done;
12321 break;
12324 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12325 if (!eq && opt_bool && opt_not && !opt_all) {
12326 continue;
12329 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12330 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12331 Jim_Obj *resultObj;
12333 if (opt_bool) {
12334 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12336 else if (!opt_inline) {
12337 resultObj = Jim_NewIntObj(interp, i);
12339 else {
12340 resultObj = objPtr;
12343 if (opt_all) {
12344 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12346 else {
12347 Jim_SetResult(interp, resultObj);
12348 goto done;
12353 if (opt_all) {
12354 Jim_SetResult(interp, listObjPtr);
12356 else {
12357 /* No match */
12358 if (opt_bool) {
12359 Jim_SetResultBool(interp, opt_not);
12361 else if (!opt_inline) {
12362 Jim_SetResultInt(interp, -1);
12366 done:
12367 if (commandObj) {
12368 Jim_DecrRefCount(interp, commandObj);
12370 return rc;
12373 /* [lappend] */
12374 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12376 Jim_Obj *listObjPtr;
12377 int new_obj = 0;
12378 int i;
12380 if (argc < 2) {
12381 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12382 return JIM_ERR;
12384 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12385 if (!listObjPtr) {
12386 /* Create the list if it does not exist */
12387 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12388 new_obj = 1;
12390 else if (Jim_IsShared(listObjPtr)) {
12391 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12392 new_obj = 1;
12394 for (i = 2; i < argc; i++)
12395 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12396 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12397 if (new_obj)
12398 Jim_FreeNewObj(interp, listObjPtr);
12399 return JIM_ERR;
12401 Jim_SetResult(interp, listObjPtr);
12402 return JIM_OK;
12405 /* [linsert] */
12406 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12408 int idx, len;
12409 Jim_Obj *listPtr;
12411 if (argc < 3) {
12412 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12413 return JIM_ERR;
12415 listPtr = argv[1];
12416 if (Jim_IsShared(listPtr))
12417 listPtr = Jim_DuplicateObj(interp, listPtr);
12418 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12419 goto err;
12420 len = Jim_ListLength(interp, listPtr);
12421 if (idx >= len)
12422 idx = len;
12423 else if (idx < 0)
12424 idx = len + idx + 1;
12425 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12426 Jim_SetResult(interp, listPtr);
12427 return JIM_OK;
12428 err:
12429 if (listPtr != argv[1]) {
12430 Jim_FreeNewObj(interp, listPtr);
12432 return JIM_ERR;
12435 /* [lreplace] */
12436 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12438 int first, last, len, rangeLen;
12439 Jim_Obj *listObj;
12440 Jim_Obj *newListObj;
12442 if (argc < 4) {
12443 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12444 return JIM_ERR;
12446 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12447 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12448 return JIM_ERR;
12451 listObj = argv[1];
12452 len = Jim_ListLength(interp, listObj);
12454 first = JimRelToAbsIndex(len, first);
12455 last = JimRelToAbsIndex(len, last);
12456 JimRelToAbsRange(len, &first, &last, &rangeLen);
12458 /* Now construct a new list which consists of:
12459 * <elements before first> <supplied elements> <elements after last>
12462 /* Trying to replace past the end of the list means end of list
12463 * See TIP #505
12465 if (first > len) {
12466 first = len;
12469 /* Add the first set of elements */
12470 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12472 /* Add supplied elements */
12473 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12475 /* Add the remaining elements */
12476 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12478 Jim_SetResult(interp, newListObj);
12479 return JIM_OK;
12482 /* [lset] */
12483 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12485 if (argc < 3) {
12486 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12487 return JIM_ERR;
12489 else if (argc == 3) {
12490 /* With no indexes, simply implements [set] */
12491 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12492 return JIM_ERR;
12493 Jim_SetResult(interp, argv[2]);
12494 return JIM_OK;
12496 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12499 /* [lsort] */
12500 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12502 static const char * const options[] = {
12503 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12505 enum
12506 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12507 Jim_Obj *resObj;
12508 int i;
12509 int retCode;
12510 int shared;
12512 struct lsort_info info;
12514 if (argc < 2) {
12515 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12516 return JIM_ERR;
12519 info.type = JIM_LSORT_ASCII;
12520 info.order = 1;
12521 info.indexed = 0;
12522 info.unique = 0;
12523 info.command = NULL;
12524 info.interp = interp;
12526 for (i = 1; i < (argc - 1); i++) {
12527 int option;
12529 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12530 != JIM_OK)
12531 return JIM_ERR;
12532 switch (option) {
12533 case OPT_ASCII:
12534 info.type = JIM_LSORT_ASCII;
12535 break;
12536 case OPT_NOCASE:
12537 info.type = JIM_LSORT_NOCASE;
12538 break;
12539 case OPT_INTEGER:
12540 info.type = JIM_LSORT_INTEGER;
12541 break;
12542 case OPT_REAL:
12543 info.type = JIM_LSORT_REAL;
12544 break;
12545 case OPT_INCREASING:
12546 info.order = 1;
12547 break;
12548 case OPT_DECREASING:
12549 info.order = -1;
12550 break;
12551 case OPT_UNIQUE:
12552 info.unique = 1;
12553 break;
12554 case OPT_COMMAND:
12555 if (i >= (argc - 2)) {
12556 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12557 return JIM_ERR;
12559 info.type = JIM_LSORT_COMMAND;
12560 info.command = argv[i + 1];
12561 i++;
12562 break;
12563 case OPT_INDEX:
12564 if (i >= (argc - 2)) {
12565 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12566 return JIM_ERR;
12568 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12569 return JIM_ERR;
12571 info.indexed = 1;
12572 i++;
12573 break;
12576 resObj = argv[argc - 1];
12577 if ((shared = Jim_IsShared(resObj)))
12578 resObj = Jim_DuplicateObj(interp, resObj);
12579 retCode = ListSortElements(interp, resObj, &info);
12580 if (retCode == JIM_OK) {
12581 Jim_SetResult(interp, resObj);
12583 else if (shared) {
12584 Jim_FreeNewObj(interp, resObj);
12586 return retCode;
12589 /* [append] */
12590 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12592 Jim_Obj *stringObjPtr;
12593 int i;
12595 if (argc < 2) {
12596 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12597 return JIM_ERR;
12599 if (argc == 2) {
12600 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12601 if (!stringObjPtr)
12602 return JIM_ERR;
12604 else {
12605 int new_obj = 0;
12606 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12607 if (!stringObjPtr) {
12608 /* Create the string if it doesn't exist */
12609 stringObjPtr = Jim_NewEmptyStringObj(interp);
12610 new_obj = 1;
12612 else if (Jim_IsShared(stringObjPtr)) {
12613 new_obj = 1;
12614 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12616 for (i = 2; i < argc; i++) {
12617 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12619 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12620 if (new_obj) {
12621 Jim_FreeNewObj(interp, stringObjPtr);
12623 return JIM_ERR;
12626 Jim_SetResult(interp, stringObjPtr);
12627 return JIM_OK;
12630 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12632 * Returns a zero-refcount list describing the expression at 'node'
12634 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12636 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12638 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12639 if (TOKEN_IS_EXPR_OP(node->type)) {
12640 if (node->left) {
12641 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12643 if (node->right) {
12644 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12646 if (node->ternary) {
12647 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12650 else {
12651 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12653 return listObjPtr;
12655 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12657 /* [debug] */
12658 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12660 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12661 static const char * const options[] = {
12662 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12663 "exprbc", "show",
12664 NULL
12666 enum
12668 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12669 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12671 int option;
12673 if (argc < 2) {
12674 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12675 return JIM_ERR;
12677 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12678 return Jim_CheckShowCommands(interp, argv[1], options);
12679 if (option == OPT_REFCOUNT) {
12680 if (argc != 3) {
12681 Jim_WrongNumArgs(interp, 2, argv, "object");
12682 return JIM_ERR;
12684 Jim_SetResultInt(interp, argv[2]->refCount);
12685 return JIM_OK;
12687 else if (option == OPT_OBJCOUNT) {
12688 int freeobj = 0, liveobj = 0;
12689 char buf[256];
12690 Jim_Obj *objPtr;
12692 if (argc != 2) {
12693 Jim_WrongNumArgs(interp, 2, argv, "");
12694 return JIM_ERR;
12696 /* Count the number of free objects. */
12697 objPtr = interp->freeList;
12698 while (objPtr) {
12699 freeobj++;
12700 objPtr = objPtr->nextObjPtr;
12702 /* Count the number of live objects. */
12703 objPtr = interp->liveList;
12704 while (objPtr) {
12705 liveobj++;
12706 objPtr = objPtr->nextObjPtr;
12708 /* Set the result string and return. */
12709 sprintf(buf, "free %d used %d", freeobj, liveobj);
12710 Jim_SetResultString(interp, buf, -1);
12711 return JIM_OK;
12713 else if (option == OPT_OBJECTS) {
12714 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12716 /* Count the number of live objects. */
12717 objPtr = interp->liveList;
12718 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12719 while (objPtr) {
12720 char buf[128];
12721 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12723 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12724 sprintf(buf, "%p", objPtr);
12725 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12726 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12727 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12728 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12729 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12730 objPtr = objPtr->nextObjPtr;
12732 Jim_SetResult(interp, listObjPtr);
12733 return JIM_OK;
12735 else if (option == OPT_INVSTR) {
12736 Jim_Obj *objPtr;
12738 if (argc != 3) {
12739 Jim_WrongNumArgs(interp, 2, argv, "object");
12740 return JIM_ERR;
12742 objPtr = argv[2];
12743 if (objPtr->typePtr != NULL)
12744 Jim_InvalidateStringRep(objPtr);
12745 Jim_SetEmptyResult(interp);
12746 return JIM_OK;
12748 else if (option == OPT_SHOW) {
12749 const char *s;
12750 int len, charlen;
12752 if (argc != 3) {
12753 Jim_WrongNumArgs(interp, 2, argv, "object");
12754 return JIM_ERR;
12756 s = Jim_GetString(argv[2], &len);
12757 #ifdef JIM_UTF8
12758 charlen = utf8_strlen(s, len);
12759 #else
12760 charlen = len;
12761 #endif
12762 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12763 printf("chars (%d): <<%s>>\n", charlen, s);
12764 printf("bytes (%d):", len);
12765 while (len--) {
12766 printf(" %02x", (unsigned char)*s++);
12768 printf("\n");
12769 return JIM_OK;
12771 else if (option == OPT_SCRIPTLEN) {
12772 ScriptObj *script;
12774 if (argc != 3) {
12775 Jim_WrongNumArgs(interp, 2, argv, "script");
12776 return JIM_ERR;
12778 script = JimGetScript(interp, argv[2]);
12779 if (script == NULL)
12780 return JIM_ERR;
12781 Jim_SetResultInt(interp, script->len);
12782 return JIM_OK;
12784 else if (option == OPT_EXPRLEN) {
12785 struct ExprTree *expr;
12787 if (argc != 3) {
12788 Jim_WrongNumArgs(interp, 2, argv, "expression");
12789 return JIM_ERR;
12791 expr = JimGetExpression(interp, argv[2]);
12792 if (expr == NULL)
12793 return JIM_ERR;
12794 Jim_SetResultInt(interp, expr->len);
12795 return JIM_OK;
12797 else if (option == OPT_EXPRBC) {
12798 struct ExprTree *expr;
12800 if (argc != 3) {
12801 Jim_WrongNumArgs(interp, 2, argv, "expression");
12802 return JIM_ERR;
12804 expr = JimGetExpression(interp, argv[2]);
12805 if (expr == NULL)
12806 return JIM_ERR;
12807 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12808 return JIM_OK;
12810 else {
12811 Jim_SetResultString(interp,
12812 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12813 return JIM_ERR;
12815 /* unreached */
12816 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12817 #if !defined(JIM_DEBUG_COMMAND)
12818 Jim_SetResultString(interp, "unsupported", -1);
12819 return JIM_ERR;
12820 #endif
12823 /* [eval] */
12824 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12826 int rc;
12828 if (argc < 2) {
12829 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12830 return JIM_ERR;
12833 if (argc == 2) {
12834 rc = Jim_EvalObj(interp, argv[1]);
12836 else {
12837 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12840 if (rc == JIM_ERR) {
12841 /* eval is "interesting", so add a stack frame here */
12842 interp->addStackTrace++;
12844 return rc;
12847 /* [uplevel] */
12848 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12850 if (argc >= 2) {
12851 int retcode;
12852 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12853 const char *str;
12855 /* Save the old callframe pointer */
12856 savedCallFrame = interp->framePtr;
12858 /* Lookup the target frame pointer */
12859 str = Jim_String(argv[1]);
12860 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12861 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12862 argc--;
12863 argv++;
12865 else {
12866 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12868 if (targetCallFrame == NULL) {
12869 return JIM_ERR;
12871 if (argc < 2) {
12872 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12873 return JIM_ERR;
12875 /* Eval the code in the target callframe. */
12876 interp->framePtr = targetCallFrame;
12877 if (argc == 2) {
12878 retcode = Jim_EvalObj(interp, argv[1]);
12880 else {
12881 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12883 interp->framePtr = savedCallFrame;
12884 return retcode;
12886 else {
12887 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12888 return JIM_ERR;
12892 /* [expr] */
12893 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12895 int retcode;
12897 if (argc == 2) {
12898 retcode = Jim_EvalExpression(interp, argv[1]);
12900 else if (argc > 2) {
12901 Jim_Obj *objPtr;
12903 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12904 Jim_IncrRefCount(objPtr);
12905 retcode = Jim_EvalExpression(interp, objPtr);
12906 Jim_DecrRefCount(interp, objPtr);
12908 else {
12909 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12910 return JIM_ERR;
12912 if (retcode != JIM_OK)
12913 return retcode;
12914 return JIM_OK;
12917 /* [break] */
12918 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12920 if (argc != 1) {
12921 Jim_WrongNumArgs(interp, 1, argv, "");
12922 return JIM_ERR;
12924 return JIM_BREAK;
12927 /* [continue] */
12928 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12930 if (argc != 1) {
12931 Jim_WrongNumArgs(interp, 1, argv, "");
12932 return JIM_ERR;
12934 return JIM_CONTINUE;
12937 /* [return] */
12938 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12940 int i;
12941 Jim_Obj *stackTraceObj = NULL;
12942 Jim_Obj *errorCodeObj = NULL;
12943 int returnCode = JIM_OK;
12944 long level = 1;
12946 for (i = 1; i < argc - 1; i += 2) {
12947 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12948 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12949 return JIM_ERR;
12952 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12953 stackTraceObj = argv[i + 1];
12955 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12956 errorCodeObj = argv[i + 1];
12958 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12959 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12960 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12961 return JIM_ERR;
12964 else {
12965 break;
12969 if (i != argc - 1 && i != argc) {
12970 Jim_WrongNumArgs(interp, 1, argv,
12971 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
12974 /* If a stack trace is supplied and code is error, set the stack trace */
12975 if (stackTraceObj && returnCode == JIM_ERR) {
12976 JimSetStackTrace(interp, stackTraceObj);
12978 /* If an error code list is supplied, set the global $errorCode */
12979 if (errorCodeObj && returnCode == JIM_ERR) {
12980 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
12982 interp->returnCode = returnCode;
12983 interp->returnLevel = level;
12985 if (i == argc - 1) {
12986 Jim_SetResult(interp, argv[i]);
12988 return level == 0 ? returnCode : JIM_RETURN;
12991 /* [tailcall] */
12992 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12994 if (interp->framePtr->level == 0) {
12995 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
12996 return JIM_ERR;
12998 else if (argc >= 2) {
12999 /* Need to resolve the tailcall command in the current context */
13000 Jim_CallFrame *cf = interp->framePtr->parent;
13002 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13003 if (cmdPtr == NULL) {
13004 return JIM_ERR;
13007 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13009 /* And stash this pre-resolved command */
13010 JimIncrCmdRefCount(cmdPtr);
13011 cf->tailcallCmd = cmdPtr;
13013 /* And stash the command list */
13014 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13016 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13017 Jim_IncrRefCount(cf->tailcallObj);
13019 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13020 return JIM_EVAL;
13022 return JIM_OK;
13025 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13027 Jim_Obj *cmdList;
13028 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13030 /* prefixListObj is a list to which the args need to be appended */
13031 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13032 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13034 return JimEvalObjList(interp, cmdList);
13037 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13039 Jim_Obj *prefixListObj = privData;
13040 Jim_DecrRefCount(interp, prefixListObj);
13043 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13045 Jim_Obj *prefixListObj;
13046 const char *newname;
13048 if (argc < 3) {
13049 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13050 return JIM_ERR;
13053 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13054 Jim_IncrRefCount(prefixListObj);
13055 newname = Jim_String(argv[1]);
13056 if (newname[0] == ':' && newname[1] == ':') {
13057 while (*++newname == ':') {
13061 Jim_SetResult(interp, argv[1]);
13063 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13066 /* [proc] */
13067 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13069 Jim_Cmd *cmd;
13071 if (argc != 4 && argc != 5) {
13072 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13073 return JIM_ERR;
13076 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13077 return JIM_ERR;
13080 if (argc == 4) {
13081 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13083 else {
13084 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13087 if (cmd) {
13088 /* Add the new command */
13089 Jim_Obj *qualifiedCmdNameObj;
13090 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13092 JimCreateCommand(interp, cmdname, cmd);
13094 /* Calculate and set the namespace for this proc */
13095 JimUpdateProcNamespace(interp, cmd, cmdname);
13097 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13099 /* Unlike Tcl, set the name of the proc as the result */
13100 Jim_SetResult(interp, argv[1]);
13101 return JIM_OK;
13103 return JIM_ERR;
13106 /* [local] */
13107 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13109 int retcode;
13111 if (argc < 2) {
13112 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13113 return JIM_ERR;
13116 /* Evaluate the arguments with 'local' in force */
13117 interp->local++;
13118 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13119 interp->local--;
13122 /* If OK, and the result is a proc, add it to the list of local procs */
13123 if (retcode == 0) {
13124 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13126 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13127 return JIM_ERR;
13129 if (interp->framePtr->localCommands == NULL) {
13130 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13131 Jim_InitStack(interp->framePtr->localCommands);
13133 Jim_IncrRefCount(cmdNameObj);
13134 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13137 return retcode;
13140 /* [upcall] */
13141 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13143 if (argc < 2) {
13144 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13145 return JIM_ERR;
13147 else {
13148 int retcode;
13150 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13151 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13152 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13153 return JIM_ERR;
13155 /* OK. Mark this command as being in an upcall */
13156 cmdPtr->u.proc.upcall++;
13157 JimIncrCmdRefCount(cmdPtr);
13159 /* Invoke the command as normal */
13160 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13162 /* No longer in an upcall */
13163 cmdPtr->u.proc.upcall--;
13164 JimDecrCmdRefCount(interp, cmdPtr);
13166 return retcode;
13170 /* [apply] */
13171 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13173 if (argc < 2) {
13174 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13175 return JIM_ERR;
13177 else {
13178 int ret;
13179 Jim_Cmd *cmd;
13180 Jim_Obj *argListObjPtr;
13181 Jim_Obj *bodyObjPtr;
13182 Jim_Obj *nsObj = NULL;
13183 Jim_Obj **nargv;
13185 int len = Jim_ListLength(interp, argv[1]);
13186 if (len != 2 && len != 3) {
13187 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13188 return JIM_ERR;
13191 if (len == 3) {
13192 #ifdef jim_ext_namespace
13193 /* Need to canonicalise the given namespace. */
13194 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13195 #else
13196 Jim_SetResultString(interp, "namespaces not enabled", -1);
13197 return JIM_ERR;
13198 #endif
13200 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13201 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13203 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13205 if (cmd) {
13206 /* Create a new argv array with a dummy argv[0], for error messages */
13207 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13208 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13209 Jim_IncrRefCount(nargv[0]);
13210 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13211 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13212 Jim_DecrRefCount(interp, nargv[0]);
13213 Jim_Free(nargv);
13215 JimDecrCmdRefCount(interp, cmd);
13216 return ret;
13218 return JIM_ERR;
13223 /* [concat] */
13224 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13226 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13227 return JIM_OK;
13230 /* [upvar] */
13231 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13233 int i;
13234 Jim_CallFrame *targetCallFrame;
13236 /* Lookup the target frame pointer */
13237 if (argc > 3 && (argc % 2 == 0)) {
13238 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13239 argc--;
13240 argv++;
13242 else {
13243 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13245 if (targetCallFrame == NULL) {
13246 return JIM_ERR;
13249 /* Check for arity */
13250 if (argc < 3) {
13251 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13252 return JIM_ERR;
13255 /* Now... for every other/local couple: */
13256 for (i = 1; i < argc; i += 2) {
13257 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13258 return JIM_ERR;
13260 return JIM_OK;
13263 /* [global] */
13264 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13266 int i;
13268 if (argc < 2) {
13269 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13270 return JIM_ERR;
13272 /* Link every var to the toplevel having the same name */
13273 if (interp->framePtr->level == 0)
13274 return JIM_OK; /* global at toplevel... */
13275 for (i = 1; i < argc; i++) {
13276 /* global ::blah does nothing */
13277 const char *name = Jim_String(argv[i]);
13278 if (name[0] != ':' || name[1] != ':') {
13279 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13280 return JIM_ERR;
13283 return JIM_OK;
13286 /* does the [string map] operation. On error NULL is returned,
13287 * otherwise a new string object with the result, having refcount = 0,
13288 * is returned. */
13289 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13290 Jim_Obj *objPtr, int nocase)
13292 int numMaps;
13293 const char *str, *noMatchStart = NULL;
13294 int strLen, i;
13295 Jim_Obj *resultObjPtr;
13297 numMaps = Jim_ListLength(interp, mapListObjPtr);
13298 if (numMaps % 2) {
13299 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13300 return NULL;
13303 str = Jim_String(objPtr);
13304 strLen = Jim_Utf8Length(interp, objPtr);
13306 /* Map it */
13307 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13308 while (strLen) {
13309 for (i = 0; i < numMaps; i += 2) {
13310 Jim_Obj *eachObjPtr;
13311 const char *k;
13312 int kl;
13314 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13315 k = Jim_String(eachObjPtr);
13316 kl = Jim_Utf8Length(interp, eachObjPtr);
13318 if (strLen >= kl && kl) {
13319 int rc;
13320 rc = JimStringCompareUtf8(str, kl, k, kl, nocase);
13321 if (rc == 0) {
13322 if (noMatchStart) {
13323 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13324 noMatchStart = NULL;
13326 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13327 str += utf8_index(str, kl);
13328 strLen -= kl;
13329 break;
13333 if (i == numMaps) { /* no match */
13334 int c;
13335 if (noMatchStart == NULL)
13336 noMatchStart = str;
13337 str += utf8_tounicode(str, &c);
13338 strLen--;
13341 if (noMatchStart) {
13342 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13344 return resultObjPtr;
13347 /* [string] */
13348 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13350 int len;
13351 int opt_case = 1;
13352 int option;
13353 static const char * const options[] = {
13354 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13355 "map", "repeat", "reverse", "index", "first", "last", "cat",
13356 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13358 enum
13360 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13361 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13362 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13364 static const char * const nocase_options[] = {
13365 "-nocase", NULL
13367 static const char * const nocase_length_options[] = {
13368 "-nocase", "-length", NULL
13371 if (argc < 2) {
13372 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13373 return JIM_ERR;
13375 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13376 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13377 return Jim_CheckShowCommands(interp, argv[1], options);
13379 switch (option) {
13380 case OPT_LENGTH:
13381 case OPT_BYTELENGTH:
13382 if (argc != 3) {
13383 Jim_WrongNumArgs(interp, 2, argv, "string");
13384 return JIM_ERR;
13386 if (option == OPT_LENGTH) {
13387 len = Jim_Utf8Length(interp, argv[2]);
13389 else {
13390 len = Jim_Length(argv[2]);
13392 Jim_SetResultInt(interp, len);
13393 return JIM_OK;
13395 case OPT_CAT:{
13396 Jim_Obj *objPtr;
13397 if (argc == 3) {
13398 /* optimise the one-arg case */
13399 objPtr = argv[2];
13401 else {
13402 int i;
13404 objPtr = Jim_NewStringObj(interp, "", 0);
13406 for (i = 2; i < argc; i++) {
13407 Jim_AppendObj(interp, objPtr, argv[i]);
13410 Jim_SetResult(interp, objPtr);
13411 return JIM_OK;
13414 case OPT_COMPARE:
13415 case OPT_EQUAL:
13417 /* n is the number of remaining option args */
13418 long opt_length = -1;
13419 int n = argc - 4;
13420 int i = 2;
13421 while (n > 0) {
13422 int subopt;
13423 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13424 JIM_ENUM_ABBREV) != JIM_OK) {
13425 badcompareargs:
13426 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13427 return JIM_ERR;
13429 if (subopt == 0) {
13430 /* -nocase */
13431 opt_case = 0;
13432 n--;
13434 else {
13435 /* -length */
13436 if (n < 2) {
13437 goto badcompareargs;
13439 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13440 return JIM_ERR;
13442 n -= 2;
13445 if (n) {
13446 goto badcompareargs;
13448 argv += argc - 2;
13449 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13450 /* Fast version - [string equal], case sensitive, no length */
13451 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13453 else {
13454 const char *s1 = Jim_String(argv[0]);
13455 int l1 = Jim_Utf8Length(interp, argv[0]);
13456 const char *s2 = Jim_String(argv[1]);
13457 int l2 = Jim_Utf8Length(interp, argv[1]);
13458 if (opt_length >= 0) {
13459 if (l1 > opt_length) {
13460 l1 = opt_length;
13462 if (l2 > opt_length) {
13463 l2 = opt_length;
13466 n = JimStringCompareUtf8(s1, l1, s2, l2, !opt_case);
13467 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13469 return JIM_OK;
13472 case OPT_MATCH:
13473 if (argc != 4 &&
13474 (argc != 5 ||
13475 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13476 JIM_ENUM_ABBREV) != JIM_OK)) {
13477 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13478 return JIM_ERR;
13480 if (opt_case == 0) {
13481 argv++;
13483 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13484 return JIM_OK;
13486 case OPT_MAP:{
13487 Jim_Obj *objPtr;
13489 if (argc != 4 &&
13490 (argc != 5 ||
13491 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13492 JIM_ENUM_ABBREV) != JIM_OK)) {
13493 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13494 return JIM_ERR;
13497 if (opt_case == 0) {
13498 argv++;
13500 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13501 if (objPtr == NULL) {
13502 return JIM_ERR;
13504 Jim_SetResult(interp, objPtr);
13505 return JIM_OK;
13508 case OPT_RANGE:
13509 case OPT_BYTERANGE:{
13510 Jim_Obj *objPtr;
13512 if (argc != 5) {
13513 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13514 return JIM_ERR;
13516 if (option == OPT_RANGE) {
13517 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13519 else
13521 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13524 if (objPtr == NULL) {
13525 return JIM_ERR;
13527 Jim_SetResult(interp, objPtr);
13528 return JIM_OK;
13531 case OPT_REPLACE:{
13532 Jim_Obj *objPtr;
13534 if (argc != 5 && argc != 6) {
13535 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13536 return JIM_ERR;
13538 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13539 if (objPtr == NULL) {
13540 return JIM_ERR;
13542 Jim_SetResult(interp, objPtr);
13543 return JIM_OK;
13547 case OPT_REPEAT:{
13548 Jim_Obj *objPtr;
13549 jim_wide count;
13551 if (argc != 4) {
13552 Jim_WrongNumArgs(interp, 2, argv, "string count");
13553 return JIM_ERR;
13555 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13556 return JIM_ERR;
13558 objPtr = Jim_NewStringObj(interp, "", 0);
13559 if (count > 0) {
13560 while (count--) {
13561 Jim_AppendObj(interp, objPtr, argv[2]);
13564 Jim_SetResult(interp, objPtr);
13565 return JIM_OK;
13568 case OPT_REVERSE:{
13569 char *buf, *p;
13570 const char *str;
13571 int i;
13573 if (argc != 3) {
13574 Jim_WrongNumArgs(interp, 2, argv, "string");
13575 return JIM_ERR;
13578 str = Jim_GetString(argv[2], &len);
13579 buf = Jim_Alloc(len + 1);
13580 p = buf + len;
13581 *p = 0;
13582 for (i = 0; i < len; ) {
13583 int c;
13584 int l = utf8_tounicode(str, &c);
13585 memcpy(p - l, str, l);
13586 p -= l;
13587 i += l;
13588 str += l;
13590 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13591 return JIM_OK;
13594 case OPT_INDEX:{
13595 int idx;
13596 const char *str;
13598 if (argc != 4) {
13599 Jim_WrongNumArgs(interp, 2, argv, "string index");
13600 return JIM_ERR;
13602 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13603 return JIM_ERR;
13605 str = Jim_String(argv[2]);
13606 len = Jim_Utf8Length(interp, argv[2]);
13607 if (idx != INT_MIN && idx != INT_MAX) {
13608 idx = JimRelToAbsIndex(len, idx);
13610 if (idx < 0 || idx >= len || str == NULL) {
13611 Jim_SetResultString(interp, "", 0);
13613 else if (len == Jim_Length(argv[2])) {
13614 /* ASCII optimisation */
13615 Jim_SetResultString(interp, str + idx, 1);
13617 else {
13618 int c;
13619 int i = utf8_index(str, idx);
13620 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13622 return JIM_OK;
13625 case OPT_FIRST:
13626 case OPT_LAST:{
13627 int idx = 0, l1, l2;
13628 const char *s1, *s2;
13630 if (argc != 4 && argc != 5) {
13631 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13632 return JIM_ERR;
13634 s1 = Jim_String(argv[2]);
13635 s2 = Jim_String(argv[3]);
13636 l1 = Jim_Utf8Length(interp, argv[2]);
13637 l2 = Jim_Utf8Length(interp, argv[3]);
13638 if (argc == 5) {
13639 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13640 return JIM_ERR;
13642 idx = JimRelToAbsIndex(l2, idx);
13644 else if (option == OPT_LAST) {
13645 idx = l2;
13647 if (option == OPT_FIRST) {
13648 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13650 else {
13651 #ifdef JIM_UTF8
13652 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13653 #else
13654 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13655 #endif
13657 return JIM_OK;
13660 case OPT_TRIM:
13661 case OPT_TRIMLEFT:
13662 case OPT_TRIMRIGHT:{
13663 Jim_Obj *trimchars;
13665 if (argc != 3 && argc != 4) {
13666 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13667 return JIM_ERR;
13669 trimchars = (argc == 4 ? argv[3] : NULL);
13670 if (option == OPT_TRIM) {
13671 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13673 else if (option == OPT_TRIMLEFT) {
13674 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13676 else if (option == OPT_TRIMRIGHT) {
13677 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13679 return JIM_OK;
13682 case OPT_TOLOWER:
13683 case OPT_TOUPPER:
13684 case OPT_TOTITLE:
13685 if (argc != 3) {
13686 Jim_WrongNumArgs(interp, 2, argv, "string");
13687 return JIM_ERR;
13689 if (option == OPT_TOLOWER) {
13690 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13692 else if (option == OPT_TOUPPER) {
13693 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13695 else {
13696 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13698 return JIM_OK;
13700 case OPT_IS:
13701 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13702 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13704 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13705 return JIM_ERR;
13707 return JIM_OK;
13710 /* [time] */
13711 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13713 long i, count = 1;
13714 jim_wide start, elapsed;
13715 char buf[60];
13716 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13718 if (argc < 2) {
13719 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13720 return JIM_ERR;
13722 if (argc == 3) {
13723 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13724 return JIM_ERR;
13726 if (count < 0)
13727 return JIM_OK;
13728 i = count;
13729 start = JimClock();
13730 while (i-- > 0) {
13731 int retval;
13733 retval = Jim_EvalObj(interp, argv[1]);
13734 if (retval != JIM_OK) {
13735 return retval;
13738 elapsed = JimClock() - start;
13739 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13740 Jim_SetResultString(interp, buf, -1);
13741 return JIM_OK;
13744 /* [exit] */
13745 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13747 long exitCode = 0;
13749 if (argc > 2) {
13750 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13751 return JIM_ERR;
13753 if (argc == 2) {
13754 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13755 return JIM_ERR;
13757 interp->exitCode = exitCode;
13758 return JIM_EXIT;
13761 /* [catch] */
13762 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13764 int exitCode = 0;
13765 int i;
13766 int sig = 0;
13768 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13769 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13770 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13772 /* Reset the error code before catch.
13773 * Note that this is not strictly correct.
13775 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13777 for (i = 1; i < argc - 1; i++) {
13778 const char *arg = Jim_String(argv[i]);
13779 jim_wide option;
13780 int ignore;
13782 /* It's a pity we can't use Jim_GetEnum here :-( */
13783 if (strcmp(arg, "--") == 0) {
13784 i++;
13785 break;
13787 if (*arg != '-') {
13788 break;
13791 if (strncmp(arg, "-no", 3) == 0) {
13792 arg += 3;
13793 ignore = 1;
13795 else {
13796 arg++;
13797 ignore = 0;
13800 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13801 option = -1;
13803 if (option < 0) {
13804 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13806 if (option < 0) {
13807 goto wrongargs;
13810 if (ignore) {
13811 ignore_mask |= ((jim_wide)1 << option);
13813 else {
13814 ignore_mask &= (~((jim_wide)1 << option));
13818 argc -= i;
13819 if (argc < 1 || argc > 3) {
13820 wrongargs:
13821 Jim_WrongNumArgs(interp, 1, argv,
13822 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13823 return JIM_ERR;
13825 argv += i;
13827 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13828 sig++;
13831 interp->signal_level += sig;
13832 if (Jim_CheckSignal(interp)) {
13833 /* If a signal is set, don't even try to execute the body */
13834 exitCode = JIM_SIGNAL;
13836 else {
13837 exitCode = Jim_EvalObj(interp, argv[0]);
13838 /* Don't want any caught error included in a later stack trace */
13839 interp->errorFlag = 0;
13841 interp->signal_level -= sig;
13843 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13844 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13845 /* Not caught, pass it up */
13846 return exitCode;
13849 if (sig && exitCode == JIM_SIGNAL) {
13850 /* Catch the signal at this level */
13851 if (interp->signal_set_result) {
13852 interp->signal_set_result(interp, interp->sigmask);
13854 else {
13855 Jim_SetResultInt(interp, interp->sigmask);
13857 interp->sigmask = 0;
13860 if (argc >= 2) {
13861 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13862 return JIM_ERR;
13864 if (argc == 3) {
13865 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13867 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13868 Jim_ListAppendElement(interp, optListObj,
13869 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13870 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13871 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13872 if (exitCode == JIM_ERR) {
13873 Jim_Obj *errorCode;
13874 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13875 -1));
13876 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13878 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13879 if (errorCode) {
13880 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13881 Jim_ListAppendElement(interp, optListObj, errorCode);
13884 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13885 return JIM_ERR;
13889 Jim_SetResultInt(interp, exitCode);
13890 return JIM_OK;
13893 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13895 /* [ref] */
13896 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13898 if (argc != 3 && argc != 4) {
13899 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13900 return JIM_ERR;
13902 if (argc == 3) {
13903 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13905 else {
13906 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13908 return JIM_OK;
13911 /* [getref] */
13912 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13914 Jim_Reference *refPtr;
13916 if (argc != 2) {
13917 Jim_WrongNumArgs(interp, 1, argv, "reference");
13918 return JIM_ERR;
13920 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13921 return JIM_ERR;
13922 Jim_SetResult(interp, refPtr->objPtr);
13923 return JIM_OK;
13926 /* [setref] */
13927 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13929 Jim_Reference *refPtr;
13931 if (argc != 3) {
13932 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13933 return JIM_ERR;
13935 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13936 return JIM_ERR;
13937 Jim_IncrRefCount(argv[2]);
13938 Jim_DecrRefCount(interp, refPtr->objPtr);
13939 refPtr->objPtr = argv[2];
13940 Jim_SetResult(interp, argv[2]);
13941 return JIM_OK;
13944 /* [collect] */
13945 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13947 if (argc != 1) {
13948 Jim_WrongNumArgs(interp, 1, argv, "");
13949 return JIM_ERR;
13951 Jim_SetResultInt(interp, Jim_Collect(interp));
13953 /* Free all the freed objects. */
13954 while (interp->freeList) {
13955 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13956 Jim_Free(interp->freeList);
13957 interp->freeList = nextObjPtr;
13960 return JIM_OK;
13963 /* [finalize] reference ?newValue? */
13964 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13966 if (argc != 2 && argc != 3) {
13967 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13968 return JIM_ERR;
13970 if (argc == 2) {
13971 Jim_Obj *cmdNamePtr;
13973 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13974 return JIM_ERR;
13975 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13976 Jim_SetResult(interp, cmdNamePtr);
13978 else {
13979 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
13980 return JIM_ERR;
13981 Jim_SetResult(interp, argv[2]);
13983 return JIM_OK;
13986 /* [info references] */
13987 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13989 Jim_Obj *listObjPtr;
13990 Jim_HashTableIterator htiter;
13991 Jim_HashEntry *he;
13993 listObjPtr = Jim_NewListObj(interp, NULL, 0);
13995 JimInitHashTableIterator(&interp->references, &htiter);
13996 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
13997 char buf[JIM_REFERENCE_SPACE + 1];
13998 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
13999 const unsigned long *refId = he->key;
14001 JimFormatReference(buf, refPtr, *refId);
14002 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14004 Jim_SetResult(interp, listObjPtr);
14005 return JIM_OK;
14007 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14009 /* [rename] */
14010 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14012 if (argc != 3) {
14013 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14014 return JIM_ERR;
14017 if (JimValidName(interp, "new procedure", argv[2])) {
14018 return JIM_ERR;
14021 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14024 #define JIM_DICTMATCH_KEYS 0x0001
14025 #define JIM_DICTMATCH_VALUES 0x002
14028 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14029 * return_types should be either or both
14031 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14033 Jim_HashEntry *he;
14034 Jim_Obj *listObjPtr;
14035 Jim_HashTableIterator htiter;
14037 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14038 return JIM_ERR;
14041 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14043 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14044 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14045 if (patternObj) {
14046 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14047 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14048 /* no match */
14049 continue;
14052 if (return_types & JIM_DICTMATCH_KEYS) {
14053 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14055 if (return_types & JIM_DICTMATCH_VALUES) {
14056 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14060 Jim_SetResult(interp, listObjPtr);
14061 return JIM_OK;
14064 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14066 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14067 return -1;
14069 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14073 * Must be called with at least one object.
14074 * Returns the new dictionary, or NULL on error.
14076 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14078 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14079 int i;
14081 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14083 /* Note that we don't optimise the trivial case of a single argument */
14085 for (i = 0; i < objc; i++) {
14086 Jim_HashTable *ht;
14087 Jim_HashTableIterator htiter;
14088 Jim_HashEntry *he;
14090 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14091 Jim_FreeNewObj(interp, objPtr);
14092 return NULL;
14094 ht = objv[i]->internalRep.ptr;
14095 JimInitHashTableIterator(ht, &htiter);
14096 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14097 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14100 return objPtr;
14103 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14105 Jim_HashTable *ht;
14106 unsigned int i;
14107 char buffer[100];
14108 int sum = 0;
14109 int nonzero_count = 0;
14110 Jim_Obj *output;
14111 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14113 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14114 return JIM_ERR;
14117 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14119 /* Note that this uses internal knowledge of the hash table */
14120 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14121 output = Jim_NewStringObj(interp, buffer, -1);
14123 for (i = 0; i < ht->size; i++) {
14124 Jim_HashEntry *he = ht->table[i];
14125 int entries = 0;
14126 while (he) {
14127 entries++;
14128 he = he->next;
14130 if (entries > 9) {
14131 bucket_counts[10]++;
14133 else {
14134 bucket_counts[entries]++;
14136 if (entries) {
14137 sum += entries;
14138 nonzero_count++;
14141 for (i = 0; i < 10; i++) {
14142 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14143 Jim_AppendString(interp, output, buffer, -1);
14145 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14146 Jim_AppendString(interp, output, buffer, -1);
14147 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14148 Jim_AppendString(interp, output, buffer, -1);
14149 Jim_SetResult(interp, output);
14150 return JIM_OK;
14153 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14155 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14157 Jim_AppendString(interp, prefixObj, " ", 1);
14158 Jim_AppendString(interp, prefixObj, subcmd, -1);
14160 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14164 * Implements the [dict with] command
14166 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14168 int i;
14169 Jim_Obj *objPtr;
14170 Jim_Obj *dictObj;
14171 Jim_Obj **dictValues;
14172 int len;
14173 int ret = JIM_OK;
14175 /* Open up the appropriate level of the dictionary */
14176 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14177 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14178 return JIM_ERR;
14180 /* Set the local variables */
14181 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14182 return JIM_ERR;
14184 for (i = 0; i < len; i += 2) {
14185 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14186 Jim_Free(dictValues);
14187 return JIM_ERR;
14191 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14192 if (Jim_Length(scriptObj)) {
14193 ret = Jim_EvalObj(interp, scriptObj);
14195 /* Now if the dictionary still exists, update it based on the local variables */
14196 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14197 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14198 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14199 for (i = 0; i < keyc; i++) {
14200 newkeyv[i] = keyv[i];
14203 for (i = 0; i < len; i += 2) {
14204 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14205 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14206 newkeyv[keyc] = dictValues[i];
14207 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14209 Jim_Free(newkeyv);
14213 Jim_Free(dictValues);
14215 return ret;
14218 /* [dict] */
14219 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14221 Jim_Obj *objPtr;
14222 int types = JIM_DICTMATCH_KEYS;
14223 int option;
14224 static const char * const options[] = {
14225 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14226 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14227 "replace", "update", NULL
14229 enum
14231 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14232 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14233 OPT_REPLACE, OPT_UPDATE,
14236 if (argc < 2) {
14237 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14238 return JIM_ERR;
14241 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14242 return Jim_CheckShowCommands(interp, argv[1], options);
14245 switch (option) {
14246 case OPT_GET:
14247 if (argc < 3) {
14248 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14249 return JIM_ERR;
14251 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14252 JIM_ERRMSG) != JIM_OK) {
14253 return JIM_ERR;
14255 Jim_SetResult(interp, objPtr);
14256 return JIM_OK;
14258 case OPT_SET:
14259 if (argc < 5) {
14260 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14261 return JIM_ERR;
14263 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14265 case OPT_EXISTS:
14266 if (argc < 4) {
14267 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14268 return JIM_ERR;
14270 else {
14271 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14272 if (rc < 0) {
14273 return JIM_ERR;
14275 Jim_SetResultBool(interp, rc == JIM_OK);
14276 return JIM_OK;
14279 case OPT_UNSET:
14280 if (argc < 4) {
14281 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14282 return JIM_ERR;
14284 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14285 return JIM_ERR;
14287 return JIM_OK;
14289 case OPT_VALUES:
14290 types = JIM_DICTMATCH_VALUES;
14291 /* fallthru */
14292 case OPT_KEYS:
14293 if (argc != 3 && argc != 4) {
14294 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14295 return JIM_ERR;
14297 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14299 case OPT_SIZE:
14300 if (argc != 3) {
14301 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14302 return JIM_ERR;
14304 else if (Jim_DictSize(interp, argv[2]) < 0) {
14305 return JIM_ERR;
14307 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14308 return JIM_OK;
14310 case OPT_MERGE:
14311 if (argc == 2) {
14312 return JIM_OK;
14314 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14315 if (objPtr == NULL) {
14316 return JIM_ERR;
14318 Jim_SetResult(interp, objPtr);
14319 return JIM_OK;
14321 case OPT_UPDATE:
14322 if (argc < 6 || argc % 2) {
14323 /* Better error message */
14324 argc = 2;
14326 break;
14328 case OPT_CREATE:
14329 if (argc % 2) {
14330 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14331 return JIM_ERR;
14333 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14334 Jim_SetResult(interp, objPtr);
14335 return JIM_OK;
14337 case OPT_INFO:
14338 if (argc != 3) {
14339 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14340 return JIM_ERR;
14342 return Jim_DictInfo(interp, argv[2]);
14344 case OPT_WITH:
14345 if (argc < 4) {
14346 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14347 return JIM_ERR;
14349 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14351 /* Handle command as an ensemble */
14352 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14355 /* [subst] */
14356 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14358 static const char * const options[] = {
14359 "-nobackslashes", "-nocommands", "-novariables", NULL
14361 enum
14362 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14363 int i;
14364 int flags = JIM_SUBST_FLAG;
14365 Jim_Obj *objPtr;
14367 if (argc < 2) {
14368 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14369 return JIM_ERR;
14371 for (i = 1; i < (argc - 1); i++) {
14372 int option;
14374 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14375 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14376 return JIM_ERR;
14378 switch (option) {
14379 case OPT_NOBACKSLASHES:
14380 flags |= JIM_SUBST_NOESC;
14381 break;
14382 case OPT_NOCOMMANDS:
14383 flags |= JIM_SUBST_NOCMD;
14384 break;
14385 case OPT_NOVARIABLES:
14386 flags |= JIM_SUBST_NOVAR;
14387 break;
14390 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14391 return JIM_ERR;
14393 Jim_SetResult(interp, objPtr);
14394 return JIM_OK;
14397 /* [info] */
14398 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14400 int cmd;
14401 Jim_Obj *objPtr;
14402 int mode = 0;
14404 static const char * const commands[] = {
14405 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14406 "vars", "version", "patchlevel", "complete", "args", "hostname",
14407 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14408 "references", "alias", NULL
14410 enum
14411 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14412 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14413 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14414 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14417 #ifdef jim_ext_namespace
14418 int nons = 0;
14420 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14421 /* This is for internal use only */
14422 argc--;
14423 argv++;
14424 nons = 1;
14426 #endif
14428 if (argc < 2) {
14429 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14430 return JIM_ERR;
14432 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14433 return Jim_CheckShowCommands(interp, argv[1], commands);
14436 /* Test for the most common commands first, just in case it makes a difference */
14437 switch (cmd) {
14438 case INFO_EXISTS:
14439 if (argc != 3) {
14440 Jim_WrongNumArgs(interp, 2, argv, "varName");
14441 return JIM_ERR;
14443 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14444 break;
14446 case INFO_ALIAS:{
14447 Jim_Cmd *cmdPtr;
14449 if (argc != 3) {
14450 Jim_WrongNumArgs(interp, 2, argv, "command");
14451 return JIM_ERR;
14453 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14454 return JIM_ERR;
14456 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14457 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14458 return JIM_ERR;
14460 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14461 return JIM_OK;
14464 case INFO_CHANNELS:
14465 mode++; /* JIM_CMDLIST_CHANNELS */
14466 #ifndef jim_ext_aio
14467 Jim_SetResultString(interp, "aio not enabled", -1);
14468 return JIM_ERR;
14469 #endif
14470 /* fall through */
14471 case INFO_PROCS:
14472 mode++; /* JIM_CMDLIST_PROCS */
14473 /* fall through */
14474 case INFO_COMMANDS:
14475 /* mode 0 => JIM_CMDLIST_COMMANDS */
14476 if (argc != 2 && argc != 3) {
14477 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14478 return JIM_ERR;
14480 #ifdef jim_ext_namespace
14481 if (!nons) {
14482 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14483 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14486 #endif
14487 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14488 break;
14490 case INFO_VARS:
14491 mode++; /* JIM_VARLIST_VARS */
14492 /* fall through */
14493 case INFO_LOCALS:
14494 mode++; /* JIM_VARLIST_LOCALS */
14495 /* fall through */
14496 case INFO_GLOBALS:
14497 /* mode 0 => JIM_VARLIST_GLOBALS */
14498 if (argc != 2 && argc != 3) {
14499 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14500 return JIM_ERR;
14502 #ifdef jim_ext_namespace
14503 if (!nons) {
14504 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14505 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14508 #endif
14509 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14510 break;
14512 case INFO_SCRIPT:
14513 if (argc != 2) {
14514 Jim_WrongNumArgs(interp, 2, argv, "");
14515 return JIM_ERR;
14517 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14518 break;
14520 case INFO_SOURCE:{
14521 jim_wide line;
14522 Jim_Obj *resObjPtr;
14523 Jim_Obj *fileNameObj;
14525 if (argc != 3 && argc != 5) {
14526 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14527 return JIM_ERR;
14529 if (argc == 5) {
14530 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14531 return JIM_ERR;
14533 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14534 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14536 else {
14537 if (argv[2]->typePtr == &sourceObjType) {
14538 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14539 line = argv[2]->internalRep.sourceValue.lineNumber;
14541 else if (argv[2]->typePtr == &scriptObjType) {
14542 ScriptObj *script = JimGetScript(interp, argv[2]);
14543 fileNameObj = script->fileNameObj;
14544 line = script->firstline;
14546 else {
14547 fileNameObj = interp->emptyObj;
14548 line = 1;
14550 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14551 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14552 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14554 Jim_SetResult(interp, resObjPtr);
14555 break;
14558 case INFO_STACKTRACE:
14559 Jim_SetResult(interp, interp->stackTrace);
14560 break;
14562 case INFO_LEVEL:
14563 case INFO_FRAME:
14564 switch (argc) {
14565 case 2:
14566 Jim_SetResultInt(interp, interp->framePtr->level);
14567 break;
14569 case 3:
14570 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14571 return JIM_ERR;
14573 Jim_SetResult(interp, objPtr);
14574 break;
14576 default:
14577 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14578 return JIM_ERR;
14580 break;
14582 case INFO_BODY:
14583 case INFO_STATICS:
14584 case INFO_ARGS:{
14585 Jim_Cmd *cmdPtr;
14587 if (argc != 3) {
14588 Jim_WrongNumArgs(interp, 2, argv, "procname");
14589 return JIM_ERR;
14591 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14592 return JIM_ERR;
14594 if (!cmdPtr->isproc) {
14595 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14596 return JIM_ERR;
14598 switch (cmd) {
14599 case INFO_BODY:
14600 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14601 break;
14602 case INFO_ARGS:
14603 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14604 break;
14605 case INFO_STATICS:
14606 if (cmdPtr->u.proc.staticVars) {
14607 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14608 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14610 break;
14612 break;
14615 case INFO_VERSION:
14616 case INFO_PATCHLEVEL:{
14617 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14619 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14620 Jim_SetResultString(interp, buf, -1);
14621 break;
14624 case INFO_COMPLETE:
14625 if (argc != 3 && argc != 4) {
14626 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14627 return JIM_ERR;
14629 else {
14630 char missing;
14632 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14633 if (missing != ' ' && argc == 4) {
14634 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14637 break;
14639 case INFO_HOSTNAME:
14640 /* Redirect to os.gethostname if it exists */
14641 return Jim_Eval(interp, "os.gethostname");
14643 case INFO_NAMEOFEXECUTABLE:
14644 /* Redirect to Tcl proc */
14645 return Jim_Eval(interp, "{info nameofexecutable}");
14647 case INFO_RETURNCODES:
14648 if (argc == 2) {
14649 int i;
14650 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14652 for (i = 0; jimReturnCodes[i]; i++) {
14653 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14654 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14655 jimReturnCodes[i], -1));
14658 Jim_SetResult(interp, listObjPtr);
14660 else if (argc == 3) {
14661 long code;
14662 const char *name;
14664 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14665 return JIM_ERR;
14667 name = Jim_ReturnCode(code);
14668 if (*name == '?') {
14669 Jim_SetResultInt(interp, code);
14671 else {
14672 Jim_SetResultString(interp, name, -1);
14675 else {
14676 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14677 return JIM_ERR;
14679 break;
14680 case INFO_REFERENCES:
14681 #ifdef JIM_REFERENCES
14682 return JimInfoReferences(interp, argc, argv);
14683 #else
14684 Jim_SetResultString(interp, "not supported", -1);
14685 return JIM_ERR;
14686 #endif
14688 return JIM_OK;
14691 /* [exists] */
14692 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14694 Jim_Obj *objPtr;
14695 int result = 0;
14697 static const char * const options[] = {
14698 "-command", "-proc", "-alias", "-var", NULL
14700 enum
14702 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14704 int option;
14706 if (argc == 2) {
14707 option = OPT_VAR;
14708 objPtr = argv[1];
14710 else if (argc == 3) {
14711 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14712 return JIM_ERR;
14714 objPtr = argv[2];
14716 else {
14717 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14718 return JIM_ERR;
14721 if (option == OPT_VAR) {
14722 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14724 else {
14725 /* Now different kinds of commands */
14726 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14728 if (cmd) {
14729 switch (option) {
14730 case OPT_COMMAND:
14731 result = 1;
14732 break;
14734 case OPT_ALIAS:
14735 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14736 break;
14738 case OPT_PROC:
14739 result = cmd->isproc;
14740 break;
14744 Jim_SetResultBool(interp, result);
14745 return JIM_OK;
14748 /* [split] */
14749 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14751 const char *str, *splitChars, *noMatchStart;
14752 int splitLen, strLen;
14753 Jim_Obj *resObjPtr;
14754 int c;
14755 int len;
14757 if (argc != 2 && argc != 3) {
14758 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14759 return JIM_ERR;
14762 str = Jim_GetString(argv[1], &len);
14763 if (len == 0) {
14764 return JIM_OK;
14766 strLen = Jim_Utf8Length(interp, argv[1]);
14768 /* Init */
14769 if (argc == 2) {
14770 splitChars = " \n\t\r";
14771 splitLen = 4;
14773 else {
14774 splitChars = Jim_String(argv[2]);
14775 splitLen = Jim_Utf8Length(interp, argv[2]);
14778 noMatchStart = str;
14779 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14781 /* Split */
14782 if (splitLen) {
14783 Jim_Obj *objPtr;
14784 while (strLen--) {
14785 const char *sc = splitChars;
14786 int scLen = splitLen;
14787 int sl = utf8_tounicode(str, &c);
14788 while (scLen--) {
14789 int pc;
14790 sc += utf8_tounicode(sc, &pc);
14791 if (c == pc) {
14792 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14793 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14794 noMatchStart = str + sl;
14795 break;
14798 str += sl;
14800 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14801 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14803 else {
14804 /* This handles the special case of splitchars eq {}
14805 * Optimise by sharing common (ASCII) characters
14807 Jim_Obj **commonObj = NULL;
14808 #define NUM_COMMON (128 - 9)
14809 while (strLen--) {
14810 int n = utf8_tounicode(str, &c);
14811 #ifdef JIM_OPTIMIZATION
14812 if (c >= 9 && c < 128) {
14813 /* Common ASCII char. Note that 9 is the tab character */
14814 c -= 9;
14815 if (!commonObj) {
14816 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14817 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14819 if (!commonObj[c]) {
14820 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14822 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14823 str++;
14824 continue;
14826 #endif
14827 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14828 str += n;
14830 Jim_Free(commonObj);
14833 Jim_SetResult(interp, resObjPtr);
14834 return JIM_OK;
14837 /* [join] */
14838 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14840 const char *joinStr;
14841 int joinStrLen;
14843 if (argc != 2 && argc != 3) {
14844 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14845 return JIM_ERR;
14847 /* Init */
14848 if (argc == 2) {
14849 joinStr = " ";
14850 joinStrLen = 1;
14852 else {
14853 joinStr = Jim_GetString(argv[2], &joinStrLen);
14855 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14856 return JIM_OK;
14859 /* [format] */
14860 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14862 Jim_Obj *objPtr;
14864 if (argc < 2) {
14865 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14866 return JIM_ERR;
14868 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14869 if (objPtr == NULL)
14870 return JIM_ERR;
14871 Jim_SetResult(interp, objPtr);
14872 return JIM_OK;
14875 /* [scan] */
14876 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14878 Jim_Obj *listPtr, **outVec;
14879 int outc, i;
14881 if (argc < 3) {
14882 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14883 return JIM_ERR;
14885 if (argv[2]->typePtr != &scanFmtStringObjType)
14886 SetScanFmtFromAny(interp, argv[2]);
14887 if (FormatGetError(argv[2]) != 0) {
14888 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14889 return JIM_ERR;
14891 if (argc > 3) {
14892 int maxPos = FormatGetMaxPos(argv[2]);
14893 int count = FormatGetCnvCount(argv[2]);
14895 if (maxPos > argc - 3) {
14896 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14897 return JIM_ERR;
14899 else if (count > argc - 3) {
14900 Jim_SetResultString(interp, "different numbers of variable names and "
14901 "field specifiers", -1);
14902 return JIM_ERR;
14904 else if (count < argc - 3) {
14905 Jim_SetResultString(interp, "variable is not assigned by any "
14906 "conversion specifiers", -1);
14907 return JIM_ERR;
14910 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14911 if (listPtr == 0)
14912 return JIM_ERR;
14913 if (argc > 3) {
14914 int rc = JIM_OK;
14915 int count = 0;
14917 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14918 int len = Jim_ListLength(interp, listPtr);
14920 if (len != 0) {
14921 JimListGetElements(interp, listPtr, &outc, &outVec);
14922 for (i = 0; i < outc; ++i) {
14923 if (Jim_Length(outVec[i]) > 0) {
14924 ++count;
14925 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14926 rc = JIM_ERR;
14931 Jim_FreeNewObj(interp, listPtr);
14933 else {
14934 count = -1;
14936 if (rc == JIM_OK) {
14937 Jim_SetResultInt(interp, count);
14939 return rc;
14941 else {
14942 if (listPtr == (Jim_Obj *)EOF) {
14943 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14944 return JIM_OK;
14946 Jim_SetResult(interp, listPtr);
14948 return JIM_OK;
14951 /* [error] */
14952 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14954 if (argc != 2 && argc != 3) {
14955 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14956 return JIM_ERR;
14958 Jim_SetResult(interp, argv[1]);
14959 if (argc == 3) {
14960 JimSetStackTrace(interp, argv[2]);
14961 return JIM_ERR;
14963 interp->addStackTrace++;
14964 return JIM_ERR;
14967 /* [lrange] */
14968 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14970 Jim_Obj *objPtr;
14972 if (argc != 4) {
14973 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14974 return JIM_ERR;
14976 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14977 return JIM_ERR;
14978 Jim_SetResult(interp, objPtr);
14979 return JIM_OK;
14982 /* [lrepeat] */
14983 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14985 Jim_Obj *objPtr;
14986 long count;
14988 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14989 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14990 return JIM_ERR;
14993 if (count == 0 || argc == 2) {
14994 return JIM_OK;
14997 argc -= 2;
14998 argv += 2;
15000 objPtr = Jim_NewListObj(interp, argv, argc);
15001 while (--count) {
15002 ListInsertElements(objPtr, -1, argc, argv);
15005 Jim_SetResult(interp, objPtr);
15006 return JIM_OK;
15009 char **Jim_GetEnviron(void)
15011 #if defined(HAVE__NSGETENVIRON)
15012 return *_NSGetEnviron();
15013 #else
15014 #if !defined(NO_ENVIRON_EXTERN)
15015 extern char **environ;
15016 #endif
15018 return environ;
15019 #endif
15022 void Jim_SetEnviron(char **env)
15024 #if defined(HAVE__NSGETENVIRON)
15025 *_NSGetEnviron() = env;
15026 #else
15027 #if !defined(NO_ENVIRON_EXTERN)
15028 extern char **environ;
15029 #endif
15031 environ = env;
15032 #endif
15035 /* [env] */
15036 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15038 const char *key;
15039 const char *val;
15041 if (argc == 1) {
15042 char **e = Jim_GetEnviron();
15044 int i;
15045 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15047 for (i = 0; e[i]; i++) {
15048 const char *equals = strchr(e[i], '=');
15050 if (equals) {
15051 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15052 equals - e[i]));
15053 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15057 Jim_SetResult(interp, listObjPtr);
15058 return JIM_OK;
15061 if (argc < 2) {
15062 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15063 return JIM_ERR;
15065 key = Jim_String(argv[1]);
15066 val = getenv(key);
15067 if (val == NULL) {
15068 if (argc < 3) {
15069 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15070 return JIM_ERR;
15072 val = Jim_String(argv[2]);
15074 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15075 return JIM_OK;
15078 /* [source] */
15079 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15081 int retval;
15083 if (argc != 2) {
15084 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15085 return JIM_ERR;
15087 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15088 if (retval == JIM_RETURN)
15089 return JIM_OK;
15090 return retval;
15093 /* [lreverse] */
15094 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15096 Jim_Obj *revObjPtr, **ele;
15097 int len;
15099 if (argc != 2) {
15100 Jim_WrongNumArgs(interp, 1, argv, "list");
15101 return JIM_ERR;
15103 JimListGetElements(interp, argv[1], &len, &ele);
15104 len--;
15105 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15106 while (len >= 0)
15107 ListAppendElement(revObjPtr, ele[len--]);
15108 Jim_SetResult(interp, revObjPtr);
15109 return JIM_OK;
15112 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15114 jim_wide len;
15116 if (step == 0)
15117 return -1;
15118 if (start == end)
15119 return 0;
15120 else if (step > 0 && start > end)
15121 return -1;
15122 else if (step < 0 && end > start)
15123 return -1;
15124 len = end - start;
15125 if (len < 0)
15126 len = -len; /* abs(len) */
15127 if (step < 0)
15128 step = -step; /* abs(step) */
15129 len = 1 + ((len - 1) / step);
15130 /* We can truncate safely to INT_MAX, the range command
15131 * will always return an error for a such long range
15132 * because Tcl lists can't be so long. */
15133 if (len > INT_MAX)
15134 len = INT_MAX;
15135 return (int)((len < 0) ? -1 : len);
15138 /* [range] */
15139 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15141 jim_wide start = 0, end, step = 1;
15142 int len, i;
15143 Jim_Obj *objPtr;
15145 if (argc < 2 || argc > 4) {
15146 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15147 return JIM_ERR;
15149 if (argc == 2) {
15150 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15151 return JIM_ERR;
15153 else {
15154 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15155 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15156 return JIM_ERR;
15157 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15158 return JIM_ERR;
15160 if ((len = JimRangeLen(start, end, step)) == -1) {
15161 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15162 return JIM_ERR;
15164 objPtr = Jim_NewListObj(interp, NULL, 0);
15165 for (i = 0; i < len; i++)
15166 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15167 Jim_SetResult(interp, objPtr);
15168 return JIM_OK;
15171 /* [rand] */
15172 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15174 jim_wide min = 0, max = 0, len, maxMul;
15176 if (argc < 1 || argc > 3) {
15177 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15178 return JIM_ERR;
15180 if (argc == 1) {
15181 max = JIM_WIDE_MAX;
15182 } else if (argc == 2) {
15183 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15184 return JIM_ERR;
15185 } else if (argc == 3) {
15186 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15187 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15188 return JIM_ERR;
15190 len = max-min;
15191 if (len < 0) {
15192 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15193 return JIM_ERR;
15195 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15196 while (1) {
15197 jim_wide r;
15199 JimRandomBytes(interp, &r, sizeof(jim_wide));
15200 if (r < 0 || r >= maxMul) continue;
15201 r = (len == 0) ? 0 : r%len;
15202 Jim_SetResultInt(interp, min+r);
15203 return JIM_OK;
15207 static const struct {
15208 const char *name;
15209 Jim_CmdProc *cmdProc;
15210 } Jim_CoreCommandsTable[] = {
15211 {"alias", Jim_AliasCoreCommand},
15212 {"set", Jim_SetCoreCommand},
15213 {"unset", Jim_UnsetCoreCommand},
15214 {"puts", Jim_PutsCoreCommand},
15215 {"+", Jim_AddCoreCommand},
15216 {"*", Jim_MulCoreCommand},
15217 {"-", Jim_SubCoreCommand},
15218 {"/", Jim_DivCoreCommand},
15219 {"incr", Jim_IncrCoreCommand},
15220 {"while", Jim_WhileCoreCommand},
15221 {"loop", Jim_LoopCoreCommand},
15222 {"for", Jim_ForCoreCommand},
15223 {"foreach", Jim_ForeachCoreCommand},
15224 {"lmap", Jim_LmapCoreCommand},
15225 {"lassign", Jim_LassignCoreCommand},
15226 {"if", Jim_IfCoreCommand},
15227 {"switch", Jim_SwitchCoreCommand},
15228 {"list", Jim_ListCoreCommand},
15229 {"lindex", Jim_LindexCoreCommand},
15230 {"lset", Jim_LsetCoreCommand},
15231 {"lsearch", Jim_LsearchCoreCommand},
15232 {"llength", Jim_LlengthCoreCommand},
15233 {"lappend", Jim_LappendCoreCommand},
15234 {"linsert", Jim_LinsertCoreCommand},
15235 {"lreplace", Jim_LreplaceCoreCommand},
15236 {"lsort", Jim_LsortCoreCommand},
15237 {"append", Jim_AppendCoreCommand},
15238 {"debug", Jim_DebugCoreCommand},
15239 {"eval", Jim_EvalCoreCommand},
15240 {"uplevel", Jim_UplevelCoreCommand},
15241 {"expr", Jim_ExprCoreCommand},
15242 {"break", Jim_BreakCoreCommand},
15243 {"continue", Jim_ContinueCoreCommand},
15244 {"proc", Jim_ProcCoreCommand},
15245 {"concat", Jim_ConcatCoreCommand},
15246 {"return", Jim_ReturnCoreCommand},
15247 {"upvar", Jim_UpvarCoreCommand},
15248 {"global", Jim_GlobalCoreCommand},
15249 {"string", Jim_StringCoreCommand},
15250 {"time", Jim_TimeCoreCommand},
15251 {"exit", Jim_ExitCoreCommand},
15252 {"catch", Jim_CatchCoreCommand},
15253 #ifdef JIM_REFERENCES
15254 {"ref", Jim_RefCoreCommand},
15255 {"getref", Jim_GetrefCoreCommand},
15256 {"setref", Jim_SetrefCoreCommand},
15257 {"finalize", Jim_FinalizeCoreCommand},
15258 {"collect", Jim_CollectCoreCommand},
15259 #endif
15260 {"rename", Jim_RenameCoreCommand},
15261 {"dict", Jim_DictCoreCommand},
15262 {"subst", Jim_SubstCoreCommand},
15263 {"info", Jim_InfoCoreCommand},
15264 {"exists", Jim_ExistsCoreCommand},
15265 {"split", Jim_SplitCoreCommand},
15266 {"join", Jim_JoinCoreCommand},
15267 {"format", Jim_FormatCoreCommand},
15268 {"scan", Jim_ScanCoreCommand},
15269 {"error", Jim_ErrorCoreCommand},
15270 {"lrange", Jim_LrangeCoreCommand},
15271 {"lrepeat", Jim_LrepeatCoreCommand},
15272 {"env", Jim_EnvCoreCommand},
15273 {"source", Jim_SourceCoreCommand},
15274 {"lreverse", Jim_LreverseCoreCommand},
15275 {"range", Jim_RangeCoreCommand},
15276 {"rand", Jim_RandCoreCommand},
15277 {"tailcall", Jim_TailcallCoreCommand},
15278 {"local", Jim_LocalCoreCommand},
15279 {"upcall", Jim_UpcallCoreCommand},
15280 {"apply", Jim_ApplyCoreCommand},
15281 {NULL, NULL},
15284 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15286 int i = 0;
15288 while (Jim_CoreCommandsTable[i].name != NULL) {
15289 Jim_CreateCommand(interp,
15290 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15291 i++;
15295 /* -----------------------------------------------------------------------------
15296 * Interactive prompt
15297 * ---------------------------------------------------------------------------*/
15298 void Jim_MakeErrorMessage(Jim_Interp *interp)
15300 Jim_Obj *argv[2];
15302 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15303 argv[1] = interp->result;
15305 Jim_EvalObjVector(interp, 2, argv);
15309 * Given a null terminated array of strings, returns an allocated, sorted
15310 * copy of the array.
15312 static char **JimSortStringTable(const char *const *tablePtr)
15314 int count;
15315 char **tablePtrSorted;
15317 /* Find the size of the table */
15318 for (count = 0; tablePtr[count]; count++) {
15321 /* Allocate one extra for the terminating NULL pointer */
15322 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15323 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15324 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15325 tablePtrSorted[count] = NULL;
15327 return tablePtrSorted;
15330 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15331 const char *prefix, const char *const *tablePtr, const char *name)
15333 char **tablePtrSorted;
15334 int i;
15336 if (name == NULL) {
15337 name = "option";
15340 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15341 tablePtrSorted = JimSortStringTable(tablePtr);
15342 for (i = 0; tablePtrSorted[i]; i++) {
15343 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15344 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15346 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15347 if (tablePtrSorted[i + 1]) {
15348 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15351 Jim_Free(tablePtrSorted);
15356 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15357 * and returns JIM_OK.
15359 * Otherwise returns JIM_ERR.
15361 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15363 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15364 int i;
15365 char **tablePtrSorted = JimSortStringTable(tablePtr);
15366 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15367 for (i = 0; tablePtrSorted[i]; i++) {
15368 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15370 Jim_Free(tablePtrSorted);
15371 return JIM_OK;
15373 return JIM_ERR;
15376 /* internal rep is stored in ptrIntvalue
15377 * ptr = tablePtr
15378 * int1 = flags
15379 * int2 = index
15381 static const Jim_ObjType getEnumObjType = {
15382 "get-enum",
15383 NULL,
15384 NULL,
15385 NULL,
15386 JIM_TYPE_REFERENCES
15389 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15390 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15392 const char *bad = "bad ";
15393 const char *const *entryPtr = NULL;
15394 int i;
15395 int match = -1;
15396 int arglen;
15397 const char *arg;
15399 if (objPtr->typePtr == &getEnumObjType) {
15400 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15401 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15402 return JIM_OK;
15406 arg = Jim_GetString(objPtr, &arglen);
15408 *indexPtr = -1;
15410 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15411 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15412 /* Found an exact match */
15413 match = i;
15414 goto found;
15416 if (flags & JIM_ENUM_ABBREV) {
15417 /* Accept an unambiguous abbreviation.
15418 * Note that '-' doesnt' consitute a valid abbreviation
15420 if (strncmp(arg, *entryPtr, arglen) == 0) {
15421 if (*arg == '-' && arglen == 1) {
15422 break;
15424 if (match >= 0) {
15425 bad = "ambiguous ";
15426 goto ambiguous;
15428 match = i;
15433 /* If we had an unambiguous partial match */
15434 if (match >= 0) {
15435 found:
15436 /* Record the match in the object */
15437 Jim_FreeIntRep(interp, objPtr);
15438 objPtr->typePtr = &getEnumObjType;
15439 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15440 objPtr->internalRep.ptrIntValue.int1 = flags;
15441 objPtr->internalRep.ptrIntValue.int2 = match;
15442 /* Return the result */
15443 *indexPtr = match;
15444 return JIM_OK;
15447 ambiguous:
15448 if (flags & JIM_ERRMSG) {
15449 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15451 return JIM_ERR;
15454 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15456 int i;
15458 for (i = 0; i < (int)len; i++) {
15459 if (array[i] && strcmp(array[i], name) == 0) {
15460 return i;
15463 return -1;
15466 int Jim_IsDict(Jim_Obj *objPtr)
15468 return objPtr->typePtr == &dictObjType;
15471 int Jim_IsList(Jim_Obj *objPtr)
15473 return objPtr->typePtr == &listObjType;
15477 * Very simple printf-like formatting, designed for error messages.
15479 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15480 * The resulting string is created and set as the result.
15482 * Each '%s' should correspond to a regular string parameter.
15483 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15484 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15486 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15488 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15490 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15492 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15494 /* Initial space needed */
15495 int len = strlen(format);
15496 int extra = 0;
15497 int n = 0;
15498 const char *params[5];
15499 int nobjparam = 0;
15500 Jim_Obj *objparam[5];
15501 char *buf;
15502 va_list args;
15503 int i;
15505 va_start(args, format);
15507 for (i = 0; i < len && n < 5; i++) {
15508 int l;
15510 if (strncmp(format + i, "%s", 2) == 0) {
15511 params[n] = va_arg(args, char *);
15513 l = strlen(params[n]);
15515 else if (strncmp(format + i, "%#s", 3) == 0) {
15516 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15518 params[n] = Jim_GetString(objPtr, &l);
15519 objparam[nobjparam++] = objPtr;
15520 Jim_IncrRefCount(objPtr);
15522 else {
15523 if (format[i] == '%') {
15524 i++;
15526 continue;
15528 n++;
15529 extra += l;
15532 len += extra;
15533 buf = Jim_Alloc(len + 1);
15534 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15536 va_end(args);
15538 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15540 for (i = 0; i < nobjparam; i++) {
15541 Jim_DecrRefCount(interp, objparam[i]);
15545 /* stubs */
15546 #ifndef jim_ext_package
15547 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15549 return JIM_OK;
15551 #endif
15552 #ifndef jim_ext_aio
15553 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15555 Jim_SetResultString(interp, "aio not enabled", -1);
15556 return NULL;
15558 #endif
15562 * Local Variables: ***
15563 * c-basic-offset: 4 ***
15564 * tab-width: 4 ***
15565 * End: ***