clock scan: Unspecified fields use the current date/time
[jimtcl.git] / jim.c
blobb12056ffdd9d5e5a6b9e9b2403b0c636314f0707
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44 #ifndef _GNU_SOURCE
45 #define _GNU_SOURCE /* Mostly just for environ */
46 #endif
48 #include <stdio.h>
49 #include <stdlib.h>
51 #include <string.h>
52 #include <stdarg.h>
53 #include <ctype.h>
54 #include <limits.h>
55 #include <assert.h>
56 #include <errno.h>
57 #include <time.h>
58 #include <setjmp.h>
60 #include "jim.h"
61 #include "jimautoconf.h"
62 #include "utf8.h"
64 #ifdef HAVE_SYS_TIME_H
65 #include <sys/time.h>
66 #endif
67 #ifdef HAVE_BACKTRACE
68 #include <execinfo.h>
69 #endif
70 #ifdef HAVE_CRT_EXTERNS_H
71 #include <crt_externs.h>
72 #endif
74 /* For INFINITY, even if math functions are not enabled */
75 #include <math.h>
77 /* We may decide to switch to using $[...] after all, so leave it as an option */
78 /*#define EXPRSUGAR_BRACKET*/
80 /* For the no-autoconf case */
81 #ifndef TCL_LIBRARY
82 #define TCL_LIBRARY "."
83 #endif
84 #ifndef TCL_PLATFORM_OS
85 #define TCL_PLATFORM_OS "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PLATFORM
88 #define TCL_PLATFORM_PLATFORM "unknown"
89 #endif
90 #ifndef TCL_PLATFORM_PATH_SEPARATOR
91 #define TCL_PLATFORM_PATH_SEPARATOR ":"
92 #endif
94 /*#define DEBUG_SHOW_SCRIPT*/
95 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
96 /*#define DEBUG_SHOW_SUBST*/
97 /*#define DEBUG_SHOW_EXPR*/
98 /*#define DEBUG_SHOW_EXPR_TOKENS*/
99 /*#define JIM_DEBUG_GC*/
100 #ifdef JIM_MAINTAINER
101 #define JIM_DEBUG_COMMAND
102 #define JIM_DEBUG_PANIC
103 #endif
104 /* Enable this (in conjunction with valgrind) to help debug
105 * reference counting issues
107 /*#define JIM_DISABLE_OBJECT_POOL*/
109 /* Maximum size of an integer */
110 #define JIM_INTEGER_SPACE 24
112 const char *jim_tt_name(int type);
114 #ifdef JIM_DEBUG_PANIC
115 static void JimPanicDump(int fail_condition, const char *fmt, ...);
116 #define JimPanic(X) JimPanicDump X
117 #else
118 #define JimPanic(X)
119 #endif
121 #ifdef JIM_OPTIMIZATION
122 #define JIM_IF_OPTIM(X) X
123 #else
124 #define JIM_IF_OPTIM(X)
125 #endif
127 /* -----------------------------------------------------------------------------
128 * Global variables
129 * ---------------------------------------------------------------------------*/
131 /* A shared empty string for the objects string representation.
132 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
133 static char JimEmptyStringRep[] = "";
135 /* -----------------------------------------------------------------------------
136 * Required prototypes of not exported functions
137 * ---------------------------------------------------------------------------*/
138 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
139 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
140 int flags);
141 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
142 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
143 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
144 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
145 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
146 const char *prefix, const char *const *tablePtr, const char *name);
147 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
148 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
149 static int JimSign(jim_wide w);
150 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
151 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
152 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
155 /* Fast access to the int (wide) value of an object which is known to be of int type */
156 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
158 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
160 static int utf8_tounicode_case(const char *s, int *uc, int upper)
162 int l = utf8_tounicode(s, uc);
163 if (upper) {
164 *uc = utf8_upper(*uc);
166 return l;
169 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
170 #define JIM_CHARSET_SCAN 2
171 #define JIM_CHARSET_GLOB 0
174 * pattern points to a string like "[^a-z\ub5]"
176 * The pattern may contain trailing chars, which are ignored.
178 * The pattern is matched against unicode char 'c'.
180 * If (flags & JIM_NOCASE), case is ignored when matching.
181 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
182 * of the charset, per scan, rather than glob/string match.
184 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
185 * or the null character if the ']' is missing.
187 * Returns NULL on no match.
189 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
191 int not = 0;
192 int pchar;
193 int match = 0;
194 int nocase = 0;
196 if (flags & JIM_NOCASE) {
197 nocase++;
198 c = utf8_upper(c);
201 if (flags & JIM_CHARSET_SCAN) {
202 if (*pattern == '^') {
203 not++;
204 pattern++;
207 /* Special case. If the first char is ']', it is part of the set */
208 if (*pattern == ']') {
209 goto first;
213 while (*pattern && *pattern != ']') {
214 /* Exact match */
215 if (pattern[0] == '\\') {
216 first:
217 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
219 else {
220 /* Is this a range? a-z */
221 int start;
222 int end;
224 pattern += utf8_tounicode_case(pattern, &start, nocase);
225 if (pattern[0] == '-' && pattern[1]) {
226 /* skip '-' */
227 pattern++;
228 pattern += utf8_tounicode_case(pattern, &end, nocase);
230 /* Handle reversed range too */
231 if ((c >= start && c <= end) || (c >= end && c <= start)) {
232 match = 1;
234 continue;
236 pchar = start;
239 if (pchar == c) {
240 match = 1;
243 if (not) {
244 match = !match;
247 return match ? pattern : NULL;
250 /* Glob-style pattern matching. */
252 /* Note: string *must* be valid UTF-8 sequences
254 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
256 int c;
257 int pchar;
258 while (*pattern) {
259 switch (pattern[0]) {
260 case '*':
261 while (pattern[1] == '*') {
262 pattern++;
264 pattern++;
265 if (!pattern[0]) {
266 return 1; /* match */
268 while (*string) {
269 /* Recursive call - Does the remaining pattern match anywhere? */
270 if (JimGlobMatch(pattern, string, nocase))
271 return 1; /* match */
272 string += utf8_tounicode(string, &c);
274 return 0; /* no match */
276 case '?':
277 string += utf8_tounicode(string, &c);
278 break;
280 case '[': {
281 string += utf8_tounicode(string, &c);
282 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
283 if (!pattern) {
284 return 0;
286 if (!*pattern) {
287 /* Ran out of pattern (no ']') */
288 continue;
290 break;
292 case '\\':
293 if (pattern[1]) {
294 pattern++;
296 /* fall through */
297 default:
298 string += utf8_tounicode_case(string, &c, nocase);
299 utf8_tounicode_case(pattern, &pchar, nocase);
300 if (pchar != c) {
301 return 0;
303 break;
305 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
306 if (!*string) {
307 while (*pattern == '*') {
308 pattern++;
310 break;
313 if (!*pattern && !*string) {
314 return 1;
316 return 0;
320 * string comparison. Works on binary data.
322 * Returns -1, 0 or 1
324 * Note that the lengths are byte lengths, not char lengths.
326 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
328 if (l1 < l2) {
329 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
331 else if (l2 < l1) {
332 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
334 else {
335 return JimSign(memcmp(s1, s2, l1));
340 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
341 * (or end of string if 'maxchars' is -1).
343 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
345 * Note: does not support embedded nulls.
347 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
349 while (*s1 && *s2 && maxchars) {
350 int c1, c2;
351 s1 += utf8_tounicode_case(s1, &c1, nocase);
352 s2 += utf8_tounicode_case(s2, &c2, nocase);
353 if (c1 != c2) {
354 return JimSign(c1 - c2);
356 maxchars--;
358 if (!maxchars) {
359 return 0;
361 /* One string or both terminated */
362 if (*s1) {
363 return 1;
365 if (*s2) {
366 return -1;
368 return 0;
371 /* Search for 's1' inside 's2', starting to search from char 'index' of 's2'.
372 * The index of the first occurrence of s1 in s2 is returned.
373 * If s1 is not found inside s2, -1 is returned.
375 * Note: Lengths and return value are in bytes, not chars.
377 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
379 int i;
380 int l1bytelen;
382 if (!l1 || !l2 || l1 > l2) {
383 return -1;
385 if (idx < 0)
386 idx = 0;
387 s2 += utf8_index(s2, idx);
389 l1bytelen = utf8_index(s1, l1);
391 for (i = idx; i <= l2 - l1; i++) {
392 int c;
393 if (memcmp(s2, s1, l1bytelen) == 0) {
394 return i;
396 s2 += utf8_tounicode(s2, &c);
398 return -1;
401 /* Search for the last occurrence 's1' inside 's2', starting to search from char 'index' of 's2'.
402 * The index of the last occurrence of s1 in s2 is returned.
403 * If s1 is not found inside s2, -1 is returned.
405 * Note: Lengths and return value are in bytes, not chars.
407 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
409 const char *p;
411 if (!l1 || !l2 || l1 > l2)
412 return -1;
414 /* Now search for the needle */
415 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
416 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
417 return p - s2;
420 return -1;
423 #ifdef JIM_UTF8
425 * Per JimStringLast but lengths and return value are in chars, not bytes.
427 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
429 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
430 if (n > 0) {
431 n = utf8_strlen(s2, n);
433 return n;
435 #endif
438 * After an strtol()/strtod()-like conversion,
439 * check whether something was converted and that
440 * the only thing left is white space.
442 * Returns JIM_OK or JIM_ERR.
444 static int JimCheckConversion(const char *str, const char *endptr)
446 if (str[0] == '\0' || str == endptr) {
447 return JIM_ERR;
450 if (endptr[0] != '\0') {
451 while (*endptr) {
452 if (!isspace(UCHAR(*endptr))) {
453 return JIM_ERR;
455 endptr++;
458 return JIM_OK;
461 /* Parses the front of a number to determine its sign and base.
462 * Returns the index to start parsing according to the given base
464 static int JimNumberBase(const char *str, int *base, int *sign)
466 int i = 0;
468 *base = 10;
470 while (isspace(UCHAR(str[i]))) {
471 i++;
474 if (str[i] == '-') {
475 *sign = -1;
476 i++;
478 else {
479 if (str[i] == '+') {
480 i++;
482 *sign = 1;
485 if (str[i] != '0') {
486 /* base 10 */
487 return 0;
490 /* We have 0<x>, so see if we can convert it */
491 switch (str[i + 1]) {
492 case 'x': case 'X': *base = 16; break;
493 case 'o': case 'O': *base = 8; break;
494 case 'b': case 'B': *base = 2; break;
495 default: return 0;
497 i += 2;
498 /* Ensure that (e.g.) 0x-5 fails to parse */
499 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
500 /* Parse according to this base */
501 return i;
503 /* Parse as base 10 */
504 *base = 10;
505 return 0;
508 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
509 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
511 static long jim_strtol(const char *str, char **endptr)
513 int sign;
514 int base;
515 int i = JimNumberBase(str, &base, &sign);
517 if (base != 10) {
518 long value = strtol(str + i, endptr, base);
519 if (endptr == NULL || *endptr != str + i) {
520 return value * sign;
524 /* Can just do a regular base-10 conversion */
525 return strtol(str, endptr, 10);
529 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
530 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
532 static jim_wide jim_strtoull(const char *str, char **endptr)
534 #ifdef HAVE_LONG_LONG
535 int sign;
536 int base;
537 int i = JimNumberBase(str, &base, &sign);
539 if (base != 10) {
540 jim_wide value = strtoull(str + i, endptr, base);
541 if (endptr == NULL || *endptr != str + i) {
542 return value * sign;
546 /* Can just do a regular base-10 conversion */
547 return strtoull(str, endptr, 10);
548 #else
549 return (unsigned long)jim_strtol(str, endptr);
550 #endif
553 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
555 char *endptr;
557 if (base) {
558 *widePtr = strtoull(str, &endptr, base);
560 else {
561 *widePtr = jim_strtoull(str, &endptr);
564 return JimCheckConversion(str, endptr);
567 int Jim_StringToDouble(const char *str, double *doublePtr)
569 char *endptr;
571 /* Callers can check for underflow via ERANGE */
572 errno = 0;
574 *doublePtr = strtod(str, &endptr);
576 return JimCheckConversion(str, endptr);
579 static jim_wide JimPowWide(jim_wide b, jim_wide e)
581 jim_wide res = 1;
583 /* Special cases */
584 if (b == 1) {
585 /* 1 ^ any = 1 */
586 return 1;
588 if (e < 0) {
589 if (b != -1) {
590 return 0;
592 /* Only special case is -1 ^ -n
593 * -1^-1 = -1
594 * -1^-2 = 1
595 * i.e. same as +ve n
597 e = -e;
599 while (e)
601 if (e & 1) {
602 res *= b;
604 e >>= 1;
605 b *= b;
607 return res;
610 /* -----------------------------------------------------------------------------
611 * Special functions
612 * ---------------------------------------------------------------------------*/
613 #ifdef JIM_DEBUG_PANIC
614 static void JimPanicDump(int condition, const char *fmt, ...)
616 va_list ap;
618 if (!condition) {
619 return;
622 va_start(ap, fmt);
624 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
625 vfprintf(stderr, fmt, ap);
626 fprintf(stderr, "\n\n");
627 va_end(ap);
629 #ifdef HAVE_BACKTRACE
631 void *array[40];
632 int size, i;
633 char **strings;
635 size = backtrace(array, 40);
636 strings = backtrace_symbols(array, size);
637 for (i = 0; i < size; i++)
638 fprintf(stderr, "[backtrace] %s\n", strings[i]);
639 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
640 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
642 #endif
644 exit(1);
646 #endif
648 /* -----------------------------------------------------------------------------
649 * Memory allocation
650 * ---------------------------------------------------------------------------*/
652 void *Jim_Alloc(int size)
654 return size ? malloc(size) : NULL;
657 void Jim_Free(void *ptr)
659 free(ptr);
662 void *Jim_Realloc(void *ptr, int size)
664 return realloc(ptr, size);
667 char *Jim_StrDup(const char *s)
669 return strdup(s);
672 char *Jim_StrDupLen(const char *s, int l)
674 char *copy = Jim_Alloc(l + 1);
676 memcpy(copy, s, l + 1);
677 copy[l] = 0; /* Just to be sure, original could be substring */
678 return copy;
681 /* -----------------------------------------------------------------------------
682 * Time related functions
683 * ---------------------------------------------------------------------------*/
685 /* Returns current time in microseconds */
686 static jim_wide JimClock(void)
688 struct timeval tv;
690 gettimeofday(&tv, NULL);
691 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
694 /* -----------------------------------------------------------------------------
695 * Hash Tables
696 * ---------------------------------------------------------------------------*/
698 /* -------------------------- private prototypes ---------------------------- */
699 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
700 static unsigned int JimHashTableNextPower(unsigned int size);
701 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
703 /* -------------------------- hash functions -------------------------------- */
705 /* Thomas Wang's 32 bit Mix Function */
706 unsigned int Jim_IntHashFunction(unsigned int key)
708 key += ~(key << 15);
709 key ^= (key >> 10);
710 key += (key << 3);
711 key ^= (key >> 6);
712 key += ~(key << 11);
713 key ^= (key >> 16);
714 return key;
717 /* Generic hash function (we are using to multiply by 9 and add the byte
718 * as Tcl) */
719 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
721 unsigned int h = 0;
723 while (len--)
724 h += (h << 3) + *buf++;
725 return h;
728 /* ----------------------------- API implementation ------------------------- */
730 /* reset a hashtable already initialized */
731 static void JimResetHashTable(Jim_HashTable *ht)
733 ht->table = NULL;
734 ht->size = 0;
735 ht->sizemask = 0;
736 ht->used = 0;
737 ht->collisions = 0;
738 #ifdef JIM_RANDOMISE_HASH
739 /* This is initialised to a random value to avoid a hash collision attack.
740 * See: n.runs-SA-2011.004
742 ht->uniq = (rand() ^ time(NULL) ^ clock());
743 #else
744 ht->uniq = 0;
745 #endif
748 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
750 iter->ht = ht;
751 iter->index = -1;
752 iter->entry = NULL;
753 iter->nextEntry = NULL;
756 /* Initialize the hash table */
757 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
759 JimResetHashTable(ht);
760 ht->type = type;
761 ht->privdata = privDataPtr;
762 return JIM_OK;
765 /* Resize the table to the minimal size that contains all the elements,
766 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
767 void Jim_ResizeHashTable(Jim_HashTable *ht)
769 int minimal = ht->used;
771 if (minimal < JIM_HT_INITIAL_SIZE)
772 minimal = JIM_HT_INITIAL_SIZE;
773 Jim_ExpandHashTable(ht, minimal);
776 /* Expand or create the hashtable */
777 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
779 Jim_HashTable n; /* the new hashtable */
780 unsigned int realsize = JimHashTableNextPower(size), i;
782 /* the size is invalid if it is smaller than the number of
783 * elements already inside the hashtable */
784 if (size <= ht->used)
785 return;
787 Jim_InitHashTable(&n, ht->type, ht->privdata);
788 n.size = realsize;
789 n.sizemask = realsize - 1;
790 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
791 /* Keep the same 'uniq' as the original */
792 n.uniq = ht->uniq;
794 /* Initialize all the pointers to NULL */
795 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
797 /* Copy all the elements from the old to the new table:
798 * note that if the old hash table is empty ht->used is zero,
799 * so Jim_ExpandHashTable just creates an empty hash table. */
800 n.used = ht->used;
801 for (i = 0; ht->used > 0; i++) {
802 Jim_HashEntry *he, *nextHe;
804 if (ht->table[i] == NULL)
805 continue;
807 /* For each hash entry on this slot... */
808 he = ht->table[i];
809 while (he) {
810 unsigned int h;
812 nextHe = he->next;
813 /* Get the new element index */
814 h = Jim_HashKey(ht, he->key) & n.sizemask;
815 he->next = n.table[h];
816 n.table[h] = he;
817 ht->used--;
818 /* Pass to the next element */
819 he = nextHe;
822 assert(ht->used == 0);
823 Jim_Free(ht->table);
825 /* Remap the new hashtable in the old */
826 *ht = n;
829 /* Add an element to the target hash table */
830 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
832 Jim_HashEntry *entry;
834 /* Get the index of the new element, or -1 if
835 * the element already exists. */
836 entry = JimInsertHashEntry(ht, key, 0);
837 if (entry == NULL)
838 return JIM_ERR;
840 /* Set the hash entry fields. */
841 Jim_SetHashKey(ht, entry, key);
842 Jim_SetHashVal(ht, entry, val);
843 return JIM_OK;
846 /* Add an element, discarding the old if the key already exists */
847 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
849 int existed;
850 Jim_HashEntry *entry;
852 /* Get the index of the new element, or -1 if
853 * the element already exists. */
854 entry = JimInsertHashEntry(ht, key, 1);
855 if (entry->key) {
856 /* It already exists, so only replace the value.
857 * Note if both a destructor and a duplicate function exist,
858 * need to dup before destroy. perhaps they are the same
859 * reference counted object
861 if (ht->type->valDestructor && ht->type->valDup) {
862 void *newval = ht->type->valDup(ht->privdata, val);
863 ht->type->valDestructor(ht->privdata, entry->u.val);
864 entry->u.val = newval;
866 else {
867 Jim_FreeEntryVal(ht, entry);
868 Jim_SetHashVal(ht, entry, val);
870 existed = 1;
872 else {
873 /* Doesn't exist, so set the key */
874 Jim_SetHashKey(ht, entry, key);
875 Jim_SetHashVal(ht, entry, val);
876 existed = 0;
879 return existed;
882 /* Search and remove an element */
883 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
885 unsigned int h;
886 Jim_HashEntry *he, *prevHe;
888 if (ht->used == 0)
889 return JIM_ERR;
890 h = Jim_HashKey(ht, key) & ht->sizemask;
891 he = ht->table[h];
893 prevHe = NULL;
894 while (he) {
895 if (Jim_CompareHashKeys(ht, key, he->key)) {
896 /* Unlink the element from the list */
897 if (prevHe)
898 prevHe->next = he->next;
899 else
900 ht->table[h] = he->next;
901 Jim_FreeEntryKey(ht, he);
902 Jim_FreeEntryVal(ht, he);
903 Jim_Free(he);
904 ht->used--;
905 return JIM_OK;
907 prevHe = he;
908 he = he->next;
910 return JIM_ERR; /* not found */
913 /* Destroy an entire hash table and leave it ready for reuse */
914 int Jim_FreeHashTable(Jim_HashTable *ht)
916 unsigned int i;
918 /* Free all the elements */
919 for (i = 0; ht->used > 0; i++) {
920 Jim_HashEntry *he, *nextHe;
922 if ((he = ht->table[i]) == NULL)
923 continue;
924 while (he) {
925 nextHe = he->next;
926 Jim_FreeEntryKey(ht, he);
927 Jim_FreeEntryVal(ht, he);
928 Jim_Free(he);
929 ht->used--;
930 he = nextHe;
933 /* Free the table and the allocated cache structure */
934 Jim_Free(ht->table);
935 /* Re-initialize the table */
936 JimResetHashTable(ht);
937 return JIM_OK; /* never fails */
940 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
942 Jim_HashEntry *he;
943 unsigned int h;
945 if (ht->used == 0)
946 return NULL;
947 h = Jim_HashKey(ht, key) & ht->sizemask;
948 he = ht->table[h];
949 while (he) {
950 if (Jim_CompareHashKeys(ht, key, he->key))
951 return he;
952 he = he->next;
954 return NULL;
957 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
959 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
960 JimInitHashTableIterator(ht, iter);
961 return iter;
964 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
966 while (1) {
967 if (iter->entry == NULL) {
968 iter->index++;
969 if (iter->index >= (signed)iter->ht->size)
970 break;
971 iter->entry = iter->ht->table[iter->index];
973 else {
974 iter->entry = iter->nextEntry;
976 if (iter->entry) {
977 /* We need to save the 'next' here, the iterator user
978 * may delete the entry we are returning. */
979 iter->nextEntry = iter->entry->next;
980 return iter->entry;
983 return NULL;
986 /* ------------------------- private functions ------------------------------ */
988 /* Expand the hash table if needed */
989 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
991 /* If the hash table is empty expand it to the intial size,
992 * if the table is "full" double its size. */
993 if (ht->size == 0)
994 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
995 if (ht->size == ht->used)
996 Jim_ExpandHashTable(ht, ht->size * 2);
999 /* Our hash table capability is a power of two */
1000 static unsigned int JimHashTableNextPower(unsigned int size)
1002 unsigned int i = JIM_HT_INITIAL_SIZE;
1004 if (size >= 2147483648U)
1005 return 2147483648U;
1006 while (1) {
1007 if (i >= size)
1008 return i;
1009 i *= 2;
1013 /* Returns the index of a free slot that can be populated with
1014 * a hash entry for the given 'key'.
1015 * If the key already exists, -1 is returned. */
1016 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1018 unsigned int h;
1019 Jim_HashEntry *he;
1021 /* Expand the hashtable if needed */
1022 JimExpandHashTableIfNeeded(ht);
1024 /* Compute the key hash value */
1025 h = Jim_HashKey(ht, key) & ht->sizemask;
1026 /* Search if this slot does not already contain the given key */
1027 he = ht->table[h];
1028 while (he) {
1029 if (Jim_CompareHashKeys(ht, key, he->key))
1030 return replace ? he : NULL;
1031 he = he->next;
1034 /* Allocates the memory and stores key */
1035 he = Jim_Alloc(sizeof(*he));
1036 he->next = ht->table[h];
1037 ht->table[h] = he;
1038 ht->used++;
1039 he->key = NULL;
1041 return he;
1044 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1046 static unsigned int JimStringCopyHTHashFunction(const void *key)
1048 return Jim_GenHashFunction(key, strlen(key));
1051 static void *JimStringCopyHTDup(void *privdata, const void *key)
1053 return Jim_StrDup(key);
1056 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1058 return strcmp(key1, key2) == 0;
1061 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1063 Jim_Free(key);
1066 static const Jim_HashTableType JimPackageHashTableType = {
1067 JimStringCopyHTHashFunction, /* hash function */
1068 JimStringCopyHTDup, /* key dup */
1069 NULL, /* val dup */
1070 JimStringCopyHTKeyCompare, /* key compare */
1071 JimStringCopyHTKeyDestructor, /* key destructor */
1072 NULL /* val destructor */
1075 typedef struct AssocDataValue
1077 Jim_InterpDeleteProc *delProc;
1078 void *data;
1079 } AssocDataValue;
1081 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1083 AssocDataValue *assocPtr = (AssocDataValue *) data;
1085 if (assocPtr->delProc != NULL)
1086 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1087 Jim_Free(data);
1090 static const Jim_HashTableType JimAssocDataHashTableType = {
1091 JimStringCopyHTHashFunction, /* hash function */
1092 JimStringCopyHTDup, /* key dup */
1093 NULL, /* val dup */
1094 JimStringCopyHTKeyCompare, /* key compare */
1095 JimStringCopyHTKeyDestructor, /* key destructor */
1096 JimAssocDataHashTableValueDestructor /* val destructor */
1099 /* -----------------------------------------------------------------------------
1100 * Stack - This is a simple generic stack implementation. It is used for
1101 * example in the 'expr' expression compiler.
1102 * ---------------------------------------------------------------------------*/
1103 void Jim_InitStack(Jim_Stack *stack)
1105 stack->len = 0;
1106 stack->maxlen = 0;
1107 stack->vector = NULL;
1110 void Jim_FreeStack(Jim_Stack *stack)
1112 Jim_Free(stack->vector);
1115 int Jim_StackLen(Jim_Stack *stack)
1117 return stack->len;
1120 void Jim_StackPush(Jim_Stack *stack, void *element)
1122 int neededLen = stack->len + 1;
1124 if (neededLen > stack->maxlen) {
1125 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1126 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1128 stack->vector[stack->len] = element;
1129 stack->len++;
1132 void *Jim_StackPop(Jim_Stack *stack)
1134 if (stack->len == 0)
1135 return NULL;
1136 stack->len--;
1137 return stack->vector[stack->len];
1140 void *Jim_StackPeek(Jim_Stack *stack)
1142 if (stack->len == 0)
1143 return NULL;
1144 return stack->vector[stack->len - 1];
1147 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1149 int i;
1151 for (i = 0; i < stack->len; i++)
1152 freeFunc(stack->vector[i]);
1155 /* -----------------------------------------------------------------------------
1156 * Tcl Parser
1157 * ---------------------------------------------------------------------------*/
1159 /* Token types */
1160 #define JIM_TT_NONE 0 /* No token returned */
1161 #define JIM_TT_STR 1 /* simple string */
1162 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1163 #define JIM_TT_VAR 3 /* var substitution */
1164 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1165 #define JIM_TT_CMD 5 /* command substitution */
1166 /* Note: Keep these three together for TOKEN_IS_SEP() */
1167 #define JIM_TT_SEP 6 /* word separator (white space) */
1168 #define JIM_TT_EOL 7 /* line separator */
1169 #define JIM_TT_EOF 8 /* end of script */
1171 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1172 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1174 /* Additional token types needed for expressions */
1175 #define JIM_TT_SUBEXPR_START 11
1176 #define JIM_TT_SUBEXPR_END 12
1177 #define JIM_TT_SUBEXPR_COMMA 13
1178 #define JIM_TT_EXPR_INT 14
1179 #define JIM_TT_EXPR_DOUBLE 15
1180 #define JIM_TT_EXPR_BOOLEAN 16
1182 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1184 /* Operator token types start here */
1185 #define JIM_TT_EXPR_OP 20
1187 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1188 /* Can this token start an expression? */
1189 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1190 /* Is this token an expression operator? */
1191 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1194 * Results of missing quotes, braces, etc. from parsing.
1196 struct JimParseMissing {
1197 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\', '}' if incomplete */
1198 int line; /* Line number starting the missing token */
1201 /* Parser context structure. The same context is used to parse
1202 * Tcl scripts, expressions and lists. */
1203 struct JimParserCtx
1205 const char *p; /* Pointer to the point of the program we are parsing */
1206 int len; /* Remaining length */
1207 int linenr; /* Current line number */
1208 const char *tstart;
1209 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1210 int tline; /* Line number of the returned token */
1211 int tt; /* Token type */
1212 int eof; /* Non zero if EOF condition is true. */
1213 int inquote; /* Parsing a quoted string */
1214 int comment; /* Non zero if the next chars may be a comment. */
1215 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1218 static int JimParseScript(struct JimParserCtx *pc);
1219 static int JimParseSep(struct JimParserCtx *pc);
1220 static int JimParseEol(struct JimParserCtx *pc);
1221 static int JimParseCmd(struct JimParserCtx *pc);
1222 static int JimParseQuote(struct JimParserCtx *pc);
1223 static int JimParseVar(struct JimParserCtx *pc);
1224 static int JimParseBrace(struct JimParserCtx *pc);
1225 static int JimParseStr(struct JimParserCtx *pc);
1226 static int JimParseComment(struct JimParserCtx *pc);
1227 static void JimParseSubCmd(struct JimParserCtx *pc);
1228 static int JimParseSubQuote(struct JimParserCtx *pc);
1229 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1231 /* Initialize a parser context.
1232 * 'prg' is a pointer to the program text, linenr is the line
1233 * number of the first line contained in the program. */
1234 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1236 pc->p = prg;
1237 pc->len = len;
1238 pc->tstart = NULL;
1239 pc->tend = NULL;
1240 pc->tline = 0;
1241 pc->tt = JIM_TT_NONE;
1242 pc->eof = 0;
1243 pc->inquote = 0;
1244 pc->linenr = linenr;
1245 pc->comment = 1;
1246 pc->missing.ch = ' ';
1247 pc->missing.line = linenr;
1250 static int JimParseScript(struct JimParserCtx *pc)
1252 while (1) { /* the while is used to reiterate with continue if needed */
1253 if (!pc->len) {
1254 pc->tstart = pc->p;
1255 pc->tend = pc->p - 1;
1256 pc->tline = pc->linenr;
1257 pc->tt = JIM_TT_EOL;
1258 pc->eof = 1;
1259 return JIM_OK;
1261 switch (*(pc->p)) {
1262 case '\\':
1263 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1264 return JimParseSep(pc);
1266 pc->comment = 0;
1267 return JimParseStr(pc);
1268 case ' ':
1269 case '\t':
1270 case '\r':
1271 case '\f':
1272 if (!pc->inquote)
1273 return JimParseSep(pc);
1274 pc->comment = 0;
1275 return JimParseStr(pc);
1276 case '\n':
1277 case ';':
1278 pc->comment = 1;
1279 if (!pc->inquote)
1280 return JimParseEol(pc);
1281 return JimParseStr(pc);
1282 case '[':
1283 pc->comment = 0;
1284 return JimParseCmd(pc);
1285 case '$':
1286 pc->comment = 0;
1287 if (JimParseVar(pc) == JIM_ERR) {
1288 /* An orphan $. Create as a separate token */
1289 pc->tstart = pc->tend = pc->p++;
1290 pc->len--;
1291 pc->tt = JIM_TT_ESC;
1293 return JIM_OK;
1294 case '#':
1295 if (pc->comment) {
1296 JimParseComment(pc);
1297 continue;
1299 return JimParseStr(pc);
1300 default:
1301 pc->comment = 0;
1302 return JimParseStr(pc);
1304 return JIM_OK;
1308 static int JimParseSep(struct JimParserCtx *pc)
1310 pc->tstart = pc->p;
1311 pc->tline = pc->linenr;
1312 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1313 if (*pc->p == '\n') {
1314 break;
1316 if (*pc->p == '\\') {
1317 pc->p++;
1318 pc->len--;
1319 pc->linenr++;
1321 pc->p++;
1322 pc->len--;
1324 pc->tend = pc->p - 1;
1325 pc->tt = JIM_TT_SEP;
1326 return JIM_OK;
1329 static int JimParseEol(struct JimParserCtx *pc)
1331 pc->tstart = pc->p;
1332 pc->tline = pc->linenr;
1333 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1334 if (*pc->p == '\n')
1335 pc->linenr++;
1336 pc->p++;
1337 pc->len--;
1339 pc->tend = pc->p - 1;
1340 pc->tt = JIM_TT_EOL;
1341 return JIM_OK;
1345 ** Here are the rules for parsing:
1346 ** {braced expression}
1347 ** - Count open and closing braces
1348 ** - Backslash escapes meaning of braces but doesn't remove the backslash
1350 ** "quoted expression"
1351 ** - Unescaped double quote terminates the expression
1352 ** - Backslash escapes next char
1353 ** - [commands brackets] are counted/nested
1354 ** - command rules apply within [brackets], not quoting rules (i.e. brackets have their own rules)
1356 ** [command expression]
1357 ** - Count open and closing brackets
1358 ** - Backslash escapes next char
1359 ** - [commands brackets] are counted/nested
1360 ** - "quoted expressions" are parsed according to quoting rules
1361 ** - {braced expressions} are parsed according to brace rules
1363 ** For everything, backslash escapes the next char, newline increments current line
1367 * Parses a braced expression starting at pc->p.
1369 * Positions the parser at the end of the braced expression,
1370 * sets pc->tend and possibly pc->missing.
1372 static void JimParseSubBrace(struct JimParserCtx *pc)
1374 int level = 1;
1376 /* Skip the brace */
1377 pc->p++;
1378 pc->len--;
1379 while (pc->len) {
1380 switch (*pc->p) {
1381 case '\\':
1382 if (pc->len > 1) {
1383 if (*++pc->p == '\n') {
1384 pc->linenr++;
1386 pc->len--;
1388 break;
1390 case '{':
1391 level++;
1392 break;
1394 case '}':
1395 if (--level == 0) {
1396 pc->tend = pc->p - 1;
1397 pc->p++;
1398 pc->len--;
1399 return;
1401 break;
1403 case '\n':
1404 pc->linenr++;
1405 break;
1407 pc->p++;
1408 pc->len--;
1410 pc->missing.ch = '{';
1411 pc->missing.line = pc->tline;
1412 pc->tend = pc->p - 1;
1416 * Parses a quoted expression starting at pc->p.
1418 * Positions the parser at the end of the quoted expression,
1419 * sets pc->tend and possibly pc->missing.
1421 * Returns the type of the token of the string,
1422 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1423 * or JIM_TT_STR.
1425 static int JimParseSubQuote(struct JimParserCtx *pc)
1427 int tt = JIM_TT_STR;
1428 int line = pc->tline;
1430 /* Skip the quote */
1431 pc->p++;
1432 pc->len--;
1433 while (pc->len) {
1434 switch (*pc->p) {
1435 case '\\':
1436 if (pc->len > 1) {
1437 if (*++pc->p == '\n') {
1438 pc->linenr++;
1440 pc->len--;
1441 tt = JIM_TT_ESC;
1443 break;
1445 case '"':
1446 pc->tend = pc->p - 1;
1447 pc->p++;
1448 pc->len--;
1449 return tt;
1451 case '[':
1452 JimParseSubCmd(pc);
1453 tt = JIM_TT_ESC;
1454 continue;
1456 case '\n':
1457 pc->linenr++;
1458 break;
1460 case '$':
1461 tt = JIM_TT_ESC;
1462 break;
1464 pc->p++;
1465 pc->len--;
1467 pc->missing.ch = '"';
1468 pc->missing.line = line;
1469 pc->tend = pc->p - 1;
1470 return tt;
1474 * Parses a [command] expression starting at pc->p.
1476 * Positions the parser at the end of the command expression,
1477 * sets pc->tend and possibly pc->missing.
1479 static void JimParseSubCmd(struct JimParserCtx *pc)
1481 int level = 1;
1482 int startofword = 1;
1483 int line = pc->tline;
1485 /* Skip the bracket */
1486 pc->p++;
1487 pc->len--;
1488 while (pc->len) {
1489 switch (*pc->p) {
1490 case '\\':
1491 if (pc->len > 1) {
1492 if (*++pc->p == '\n') {
1493 pc->linenr++;
1495 pc->len--;
1497 break;
1499 case '[':
1500 level++;
1501 break;
1503 case ']':
1504 if (--level == 0) {
1505 pc->tend = pc->p - 1;
1506 pc->p++;
1507 pc->len--;
1508 return;
1510 break;
1512 case '"':
1513 if (startofword) {
1514 JimParseSubQuote(pc);
1515 continue;
1517 break;
1519 case '{':
1520 JimParseSubBrace(pc);
1521 startofword = 0;
1522 continue;
1524 case '\n':
1525 pc->linenr++;
1526 break;
1528 startofword = isspace(UCHAR(*pc->p));
1529 pc->p++;
1530 pc->len--;
1532 pc->missing.ch = '[';
1533 pc->missing.line = line;
1534 pc->tend = pc->p - 1;
1537 static int JimParseBrace(struct JimParserCtx *pc)
1539 pc->tstart = pc->p + 1;
1540 pc->tline = pc->linenr;
1541 pc->tt = JIM_TT_STR;
1542 JimParseSubBrace(pc);
1543 return JIM_OK;
1546 static int JimParseCmd(struct JimParserCtx *pc)
1548 pc->tstart = pc->p + 1;
1549 pc->tline = pc->linenr;
1550 pc->tt = JIM_TT_CMD;
1551 JimParseSubCmd(pc);
1552 return JIM_OK;
1555 static int JimParseQuote(struct JimParserCtx *pc)
1557 pc->tstart = pc->p + 1;
1558 pc->tline = pc->linenr;
1559 pc->tt = JimParseSubQuote(pc);
1560 return JIM_OK;
1563 static int JimParseVar(struct JimParserCtx *pc)
1565 /* skip the $ */
1566 pc->p++;
1567 pc->len--;
1569 #ifdef EXPRSUGAR_BRACKET
1570 if (*pc->p == '[') {
1571 /* Parse $[...] expr shorthand syntax */
1572 JimParseCmd(pc);
1573 pc->tt = JIM_TT_EXPRSUGAR;
1574 return JIM_OK;
1576 #endif
1578 pc->tstart = pc->p;
1579 pc->tt = JIM_TT_VAR;
1580 pc->tline = pc->linenr;
1582 if (*pc->p == '{') {
1583 pc->tstart = ++pc->p;
1584 pc->len--;
1586 while (pc->len && *pc->p != '}') {
1587 if (*pc->p == '\n') {
1588 pc->linenr++;
1590 pc->p++;
1591 pc->len--;
1593 pc->tend = pc->p - 1;
1594 if (pc->len) {
1595 pc->p++;
1596 pc->len--;
1599 else {
1600 while (1) {
1601 /* Skip double colon, but not single colon! */
1602 if (pc->p[0] == ':' && pc->p[1] == ':') {
1603 while (*pc->p == ':') {
1604 pc->p++;
1605 pc->len--;
1607 continue;
1609 /* Note that any char >= 0x80 must be part of a utf-8 char.
1610 * We consider all unicode points outside of ASCII as letters
1612 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1613 pc->p++;
1614 pc->len--;
1615 continue;
1617 break;
1619 /* Parse [dict get] syntax sugar. */
1620 if (*pc->p == '(') {
1621 int count = 1;
1622 const char *paren = NULL;
1624 pc->tt = JIM_TT_DICTSUGAR;
1626 while (count && pc->len) {
1627 pc->p++;
1628 pc->len--;
1629 if (*pc->p == '\\' && pc->len >= 1) {
1630 pc->p++;
1631 pc->len--;
1633 else if (*pc->p == '(') {
1634 count++;
1636 else if (*pc->p == ')') {
1637 paren = pc->p;
1638 count--;
1641 if (count == 0) {
1642 pc->p++;
1643 pc->len--;
1645 else if (paren) {
1646 /* Did not find a matching paren. Back up */
1647 paren++;
1648 pc->len += (pc->p - paren);
1649 pc->p = paren;
1651 #ifndef EXPRSUGAR_BRACKET
1652 if (*pc->tstart == '(') {
1653 pc->tt = JIM_TT_EXPRSUGAR;
1655 #endif
1657 pc->tend = pc->p - 1;
1659 /* Check if we parsed just the '$' character.
1660 * That's not a variable so an error is returned
1661 * to tell the state machine to consider this '$' just
1662 * a string. */
1663 if (pc->tstart == pc->p) {
1664 pc->p--;
1665 pc->len++;
1666 return JIM_ERR;
1668 return JIM_OK;
1671 static int JimParseStr(struct JimParserCtx *pc)
1673 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1674 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1675 /* Starting a new word */
1676 if (*pc->p == '{') {
1677 return JimParseBrace(pc);
1679 if (*pc->p == '"') {
1680 pc->inquote = 1;
1681 pc->p++;
1682 pc->len--;
1683 /* In case the end quote is missing */
1684 pc->missing.line = pc->tline;
1687 pc->tstart = pc->p;
1688 pc->tline = pc->linenr;
1689 while (1) {
1690 if (pc->len == 0) {
1691 if (pc->inquote) {
1692 pc->missing.ch = '"';
1694 pc->tend = pc->p - 1;
1695 pc->tt = JIM_TT_ESC;
1696 return JIM_OK;
1698 switch (*pc->p) {
1699 case '\\':
1700 if (!pc->inquote && *(pc->p + 1) == '\n') {
1701 pc->tend = pc->p - 1;
1702 pc->tt = JIM_TT_ESC;
1703 return JIM_OK;
1705 if (pc->len >= 2) {
1706 if (*(pc->p + 1) == '\n') {
1707 pc->linenr++;
1709 pc->p++;
1710 pc->len--;
1712 else if (pc->len == 1) {
1713 /* End of script with trailing backslash */
1714 pc->missing.ch = '\\';
1716 break;
1717 case '(':
1718 /* If the following token is not '$' just keep going */
1719 if (pc->len > 1 && pc->p[1] != '$') {
1720 break;
1722 /* fall through */
1723 case ')':
1724 /* Only need a separate ')' token if the previous was a var */
1725 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1726 if (pc->p == pc->tstart) {
1727 /* At the start of the token, so just return this char */
1728 pc->p++;
1729 pc->len--;
1731 pc->tend = pc->p - 1;
1732 pc->tt = JIM_TT_ESC;
1733 return JIM_OK;
1735 break;
1737 case '$':
1738 case '[':
1739 pc->tend = pc->p - 1;
1740 pc->tt = JIM_TT_ESC;
1741 return JIM_OK;
1742 case ' ':
1743 case '\t':
1744 case '\n':
1745 case '\r':
1746 case '\f':
1747 case ';':
1748 if (!pc->inquote) {
1749 pc->tend = pc->p - 1;
1750 pc->tt = JIM_TT_ESC;
1751 return JIM_OK;
1753 else if (*pc->p == '\n') {
1754 pc->linenr++;
1756 break;
1757 case '"':
1758 if (pc->inquote) {
1759 pc->tend = pc->p - 1;
1760 pc->tt = JIM_TT_ESC;
1761 pc->p++;
1762 pc->len--;
1763 pc->inquote = 0;
1764 return JIM_OK;
1766 break;
1768 pc->p++;
1769 pc->len--;
1771 return JIM_OK; /* unreached */
1774 static int JimParseComment(struct JimParserCtx *pc)
1776 while (*pc->p) {
1777 if (*pc->p == '\\') {
1778 pc->p++;
1779 pc->len--;
1780 if (pc->len == 0) {
1781 pc->missing.ch = '\\';
1782 return JIM_OK;
1784 if (*pc->p == '\n') {
1785 pc->linenr++;
1788 else if (*pc->p == '\n') {
1789 pc->p++;
1790 pc->len--;
1791 pc->linenr++;
1792 break;
1794 pc->p++;
1795 pc->len--;
1797 return JIM_OK;
1800 /* xdigitval and odigitval are helper functions for JimEscape() */
1801 static int xdigitval(int c)
1803 if (c >= '0' && c <= '9')
1804 return c - '0';
1805 if (c >= 'a' && c <= 'f')
1806 return c - 'a' + 10;
1807 if (c >= 'A' && c <= 'F')
1808 return c - 'A' + 10;
1809 return -1;
1812 static int odigitval(int c)
1814 if (c >= '0' && c <= '7')
1815 return c - '0';
1816 return -1;
1819 /* Perform Tcl escape substitution of 's', storing the result
1820 * string into 'dest'. The escaped string is guaranteed to
1821 * be the same length or shorter than the source string.
1822 * slen is the length of the string at 's'.
1824 * The function returns the length of the resulting string. */
1825 static int JimEscape(char *dest, const char *s, int slen)
1827 char *p = dest;
1828 int i, len;
1830 for (i = 0; i < slen; i++) {
1831 switch (s[i]) {
1832 case '\\':
1833 switch (s[i + 1]) {
1834 case 'a':
1835 *p++ = 0x7;
1836 i++;
1837 break;
1838 case 'b':
1839 *p++ = 0x8;
1840 i++;
1841 break;
1842 case 'f':
1843 *p++ = 0xc;
1844 i++;
1845 break;
1846 case 'n':
1847 *p++ = 0xa;
1848 i++;
1849 break;
1850 case 'r':
1851 *p++ = 0xd;
1852 i++;
1853 break;
1854 case 't':
1855 *p++ = 0x9;
1856 i++;
1857 break;
1858 case 'u':
1859 case 'U':
1860 case 'x':
1861 /* A unicode or hex sequence.
1862 * \x Expect 1-2 hex chars and convert to hex.
1863 * \u Expect 1-4 hex chars and convert to utf-8.
1864 * \U Expect 1-8 hex chars and convert to utf-8.
1865 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1866 * An invalid sequence means simply the escaped char.
1869 unsigned val = 0;
1870 int k;
1871 int maxchars = 2;
1873 i++;
1875 if (s[i] == 'U') {
1876 maxchars = 8;
1878 else if (s[i] == 'u') {
1879 if (s[i + 1] == '{') {
1880 maxchars = 6;
1881 i++;
1883 else {
1884 maxchars = 4;
1888 for (k = 0; k < maxchars; k++) {
1889 int c = xdigitval(s[i + k + 1]);
1890 if (c == -1) {
1891 break;
1893 val = (val << 4) | c;
1895 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1896 if (s[i] == '{') {
1897 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1898 /* Back up */
1899 i--;
1900 k = 0;
1902 else {
1903 /* Skip the closing brace */
1904 k++;
1907 if (k) {
1908 /* Got a valid sequence, so convert */
1909 if (s[i] == 'x') {
1910 *p++ = val;
1912 else {
1913 p += utf8_fromunicode(p, val);
1915 i += k;
1916 break;
1918 /* Not a valid codepoint, just an escaped char */
1919 *p++ = s[i];
1921 break;
1922 case 'v':
1923 *p++ = 0xb;
1924 i++;
1925 break;
1926 case '\0':
1927 *p++ = '\\';
1928 i++;
1929 break;
1930 case '\n':
1931 /* Replace all spaces and tabs after backslash newline with a single space*/
1932 *p++ = ' ';
1933 do {
1934 i++;
1935 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1936 break;
1937 case '0':
1938 case '1':
1939 case '2':
1940 case '3':
1941 case '4':
1942 case '5':
1943 case '6':
1944 case '7':
1945 /* octal escape */
1947 int val = 0;
1948 int c = odigitval(s[i + 1]);
1950 val = c;
1951 c = odigitval(s[i + 2]);
1952 if (c == -1) {
1953 *p++ = val;
1954 i++;
1955 break;
1957 val = (val * 8) + c;
1958 c = odigitval(s[i + 3]);
1959 if (c == -1) {
1960 *p++ = val;
1961 i += 2;
1962 break;
1964 val = (val * 8) + c;
1965 *p++ = val;
1966 i += 3;
1968 break;
1969 default:
1970 *p++ = s[i + 1];
1971 i++;
1972 break;
1974 break;
1975 default:
1976 *p++ = s[i];
1977 break;
1980 len = p - dest;
1981 *p = '\0';
1982 return len;
1985 /* Returns a dynamically allocated copy of the current token in the
1986 * parser context. The function performs conversion of escapes if
1987 * the token is of type JIM_TT_ESC.
1989 * Note that after the conversion, tokens that are grouped with
1990 * braces in the source code, are always recognizable from the
1991 * identical string obtained in a different way from the type.
1993 * For example the string:
1995 * {*}$a
1997 * will return as first token "*", of type JIM_TT_STR
1999 * While the string:
2001 * *$a
2003 * will return as first token "*", of type JIM_TT_ESC
2005 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
2007 const char *start, *end;
2008 char *token;
2009 int len;
2011 start = pc->tstart;
2012 end = pc->tend;
2013 len = (end - start) + 1;
2014 if (len < 0) {
2015 len = 0;
2017 token = Jim_Alloc(len + 1);
2018 if (pc->tt != JIM_TT_ESC) {
2019 /* No escape conversion needed? Just copy it. */
2020 memcpy(token, start, len);
2021 token[len] = '\0';
2023 else {
2024 /* Else convert the escape chars. */
2025 len = JimEscape(token, start, len);
2028 return Jim_NewStringObjNoAlloc(interp, token, len);
2031 /* -----------------------------------------------------------------------------
2032 * Tcl Lists parsing
2033 * ---------------------------------------------------------------------------*/
2034 static int JimParseListSep(struct JimParserCtx *pc);
2035 static int JimParseListStr(struct JimParserCtx *pc);
2036 static int JimParseListQuote(struct JimParserCtx *pc);
2038 static int JimParseList(struct JimParserCtx *pc)
2040 if (isspace(UCHAR(*pc->p))) {
2041 return JimParseListSep(pc);
2043 switch (*pc->p) {
2044 case '"':
2045 return JimParseListQuote(pc);
2047 case '{':
2048 return JimParseBrace(pc);
2050 default:
2051 if (pc->len) {
2052 return JimParseListStr(pc);
2054 break;
2057 pc->tstart = pc->tend = pc->p;
2058 pc->tline = pc->linenr;
2059 pc->tt = JIM_TT_EOL;
2060 pc->eof = 1;
2061 return JIM_OK;
2064 static int JimParseListSep(struct JimParserCtx *pc)
2066 pc->tstart = pc->p;
2067 pc->tline = pc->linenr;
2068 while (isspace(UCHAR(*pc->p))) {
2069 if (*pc->p == '\n') {
2070 pc->linenr++;
2072 pc->p++;
2073 pc->len--;
2075 pc->tend = pc->p - 1;
2076 pc->tt = JIM_TT_SEP;
2077 return JIM_OK;
2080 static int JimParseListQuote(struct JimParserCtx *pc)
2082 pc->p++;
2083 pc->len--;
2085 pc->tstart = pc->p;
2086 pc->tline = pc->linenr;
2087 pc->tt = JIM_TT_STR;
2089 while (pc->len) {
2090 switch (*pc->p) {
2091 case '\\':
2092 pc->tt = JIM_TT_ESC;
2093 if (--pc->len == 0) {
2094 /* Trailing backslash */
2095 pc->tend = pc->p;
2096 return JIM_OK;
2098 pc->p++;
2099 break;
2100 case '\n':
2101 pc->linenr++;
2102 break;
2103 case '"':
2104 pc->tend = pc->p - 1;
2105 pc->p++;
2106 pc->len--;
2107 return JIM_OK;
2109 pc->p++;
2110 pc->len--;
2113 pc->tend = pc->p - 1;
2114 return JIM_OK;
2117 static int JimParseListStr(struct JimParserCtx *pc)
2119 pc->tstart = pc->p;
2120 pc->tline = pc->linenr;
2121 pc->tt = JIM_TT_STR;
2123 while (pc->len) {
2124 if (isspace(UCHAR(*pc->p))) {
2125 pc->tend = pc->p - 1;
2126 return JIM_OK;
2128 if (*pc->p == '\\') {
2129 if (--pc->len == 0) {
2130 /* Trailing backslash */
2131 pc->tend = pc->p;
2132 return JIM_OK;
2134 pc->tt = JIM_TT_ESC;
2135 pc->p++;
2137 pc->p++;
2138 pc->len--;
2140 pc->tend = pc->p - 1;
2141 return JIM_OK;
2144 /* -----------------------------------------------------------------------------
2145 * Jim_Obj related functions
2146 * ---------------------------------------------------------------------------*/
2148 /* Return a new initialized object. */
2149 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2151 Jim_Obj *objPtr;
2153 /* -- Check if there are objects in the free list -- */
2154 if (interp->freeList != NULL) {
2155 /* -- Unlink the object from the free list -- */
2156 objPtr = interp->freeList;
2157 interp->freeList = objPtr->nextObjPtr;
2159 else {
2160 /* -- No ready to use objects: allocate a new one -- */
2161 objPtr = Jim_Alloc(sizeof(*objPtr));
2164 /* Object is returned with refCount of 0. Every
2165 * kind of GC implemented should take care to avoid
2166 * scanning objects with refCount == 0. */
2167 objPtr->refCount = 0;
2168 /* All the other fields are left uninitialized to save time.
2169 * The caller will probably want to set them to the right
2170 * value anyway. */
2172 /* -- Put the object into the live list -- */
2173 objPtr->prevObjPtr = NULL;
2174 objPtr->nextObjPtr = interp->liveList;
2175 if (interp->liveList)
2176 interp->liveList->prevObjPtr = objPtr;
2177 interp->liveList = objPtr;
2179 return objPtr;
2182 /* Free an object. Actually objects are never freed, but
2183 * just moved to the free objects list, where they will be
2184 * reused by Jim_NewObj(). */
2185 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2187 /* Check if the object was already freed, panic. */
2188 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2189 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2191 /* Free the internal representation */
2192 Jim_FreeIntRep(interp, objPtr);
2193 /* Free the string representation */
2194 if (objPtr->bytes != NULL) {
2195 if (objPtr->bytes != JimEmptyStringRep)
2196 Jim_Free(objPtr->bytes);
2198 /* Unlink the object from the live objects list */
2199 if (objPtr->prevObjPtr)
2200 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2201 if (objPtr->nextObjPtr)
2202 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2203 if (interp->liveList == objPtr)
2204 interp->liveList = objPtr->nextObjPtr;
2205 #ifdef JIM_DISABLE_OBJECT_POOL
2206 Jim_Free(objPtr);
2207 #else
2208 /* Link the object into the free objects list */
2209 objPtr->prevObjPtr = NULL;
2210 objPtr->nextObjPtr = interp->freeList;
2211 if (interp->freeList)
2212 interp->freeList->prevObjPtr = objPtr;
2213 interp->freeList = objPtr;
2214 objPtr->refCount = -1;
2215 #endif
2218 /* Invalidate the string representation of an object. */
2219 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2221 if (objPtr->bytes != NULL) {
2222 if (objPtr->bytes != JimEmptyStringRep)
2223 Jim_Free(objPtr->bytes);
2225 objPtr->bytes = NULL;
2228 /* Duplicate an object. The returned object has refcount = 0. */
2229 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2231 Jim_Obj *dupPtr;
2233 dupPtr = Jim_NewObj(interp);
2234 if (objPtr->bytes == NULL) {
2235 /* Object does not have a valid string representation. */
2236 dupPtr->bytes = NULL;
2238 else if (objPtr->length == 0) {
2239 /* Zero length, so don't even bother with the type-specific dup,
2240 * since all zero length objects look the same
2242 dupPtr->bytes = JimEmptyStringRep;
2243 dupPtr->length = 0;
2244 dupPtr->typePtr = NULL;
2245 return dupPtr;
2247 else {
2248 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2249 dupPtr->length = objPtr->length;
2250 /* Copy the null byte too */
2251 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2254 /* By default, the new object has the same type as the old object */
2255 dupPtr->typePtr = objPtr->typePtr;
2256 if (objPtr->typePtr != NULL) {
2257 if (objPtr->typePtr->dupIntRepProc == NULL) {
2258 dupPtr->internalRep = objPtr->internalRep;
2260 else {
2261 /* The dup proc may set a different type, e.g. NULL */
2262 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2265 return dupPtr;
2268 /* Return the string representation for objPtr. If the object's
2269 * string representation is invalid, calls the updateStringProc method to create
2270 * a new one from the internal representation of the object.
2272 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2274 if (objPtr->bytes == NULL) {
2275 /* Invalid string repr. Generate it. */
2276 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2277 objPtr->typePtr->updateStringProc(objPtr);
2279 if (lenPtr)
2280 *lenPtr = objPtr->length;
2281 return objPtr->bytes;
2284 /* Just returns the length (in bytes) of the object's string rep */
2285 int Jim_Length(Jim_Obj *objPtr)
2287 if (objPtr->bytes == NULL) {
2288 /* Invalid string repr. Generate it. */
2289 Jim_GetString(objPtr, NULL);
2291 return objPtr->length;
2294 /* Just returns object's string rep */
2295 const char *Jim_String(Jim_Obj *objPtr)
2297 if (objPtr->bytes == NULL) {
2298 /* Invalid string repr. Generate it. */
2299 Jim_GetString(objPtr, NULL);
2301 return objPtr->bytes;
2304 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2306 objPtr->bytes = Jim_StrDup(str);
2307 objPtr->length = strlen(str);
2310 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2311 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2313 static const Jim_ObjType dictSubstObjType = {
2314 "dict-substitution",
2315 FreeDictSubstInternalRep,
2316 DupDictSubstInternalRep,
2317 NULL,
2318 JIM_TYPE_NONE,
2321 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2322 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2324 static const Jim_ObjType interpolatedObjType = {
2325 "interpolated",
2326 FreeInterpolatedInternalRep,
2327 DupInterpolatedInternalRep,
2328 NULL,
2329 JIM_TYPE_NONE,
2332 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2334 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2337 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2339 /* Copy the interal rep */
2340 dupPtr->internalRep = srcPtr->internalRep;
2341 /* Need to increment the key ref count */
2342 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2345 /* -----------------------------------------------------------------------------
2346 * String Object
2347 * ---------------------------------------------------------------------------*/
2348 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2349 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2351 static const Jim_ObjType stringObjType = {
2352 "string",
2353 NULL,
2354 DupStringInternalRep,
2355 NULL,
2356 JIM_TYPE_REFERENCES,
2359 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2361 JIM_NOTUSED(interp);
2363 /* This is a bit subtle: the only caller of this function
2364 * should be Jim_DuplicateObj(), that will copy the
2365 * string representaion. After the copy, the duplicated
2366 * object will not have more room in the buffer than
2367 * srcPtr->length bytes. So we just set it to length. */
2368 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2369 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2372 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2374 if (objPtr->typePtr != &stringObjType) {
2375 /* Get a fresh string representation. */
2376 if (objPtr->bytes == NULL) {
2377 /* Invalid string repr. Generate it. */
2378 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2379 objPtr->typePtr->updateStringProc(objPtr);
2381 /* Free any other internal representation. */
2382 Jim_FreeIntRep(interp, objPtr);
2383 /* Set it as string, i.e. just set the maxLength field. */
2384 objPtr->typePtr = &stringObjType;
2385 objPtr->internalRep.strValue.maxLength = objPtr->length;
2386 /* Don't know the utf-8 length yet */
2387 objPtr->internalRep.strValue.charLength = -1;
2389 return JIM_OK;
2393 * Returns the length of the object string in chars, not bytes.
2395 * These may be different for a utf-8 string.
2397 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2399 #ifdef JIM_UTF8
2400 SetStringFromAny(interp, objPtr);
2402 if (objPtr->internalRep.strValue.charLength < 0) {
2403 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2405 return objPtr->internalRep.strValue.charLength;
2406 #else
2407 return Jim_Length(objPtr);
2408 #endif
2411 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2412 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2414 Jim_Obj *objPtr = Jim_NewObj(interp);
2416 /* Need to find out how many bytes the string requires */
2417 if (len == -1)
2418 len = strlen(s);
2419 /* Alloc/Set the string rep. */
2420 if (len == 0) {
2421 objPtr->bytes = JimEmptyStringRep;
2423 else {
2424 objPtr->bytes = Jim_StrDupLen(s, len);
2426 objPtr->length = len;
2428 /* No typePtr field for the vanilla string object. */
2429 objPtr->typePtr = NULL;
2430 return objPtr;
2433 /* charlen is in characters -- see also Jim_NewStringObj() */
2434 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2436 #ifdef JIM_UTF8
2437 /* Need to find out how many bytes the string requires */
2438 int bytelen = utf8_index(s, charlen);
2440 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2442 /* Remember the utf8 length, so set the type */
2443 objPtr->typePtr = &stringObjType;
2444 objPtr->internalRep.strValue.maxLength = bytelen;
2445 objPtr->internalRep.strValue.charLength = charlen;
2447 return objPtr;
2448 #else
2449 return Jim_NewStringObj(interp, s, charlen);
2450 #endif
2453 /* This version does not try to duplicate the 's' pointer, but
2454 * use it directly. */
2455 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2457 Jim_Obj *objPtr = Jim_NewObj(interp);
2459 objPtr->bytes = s;
2460 objPtr->length = (len == -1) ? strlen(s) : len;
2461 objPtr->typePtr = NULL;
2462 return objPtr;
2465 /* Low-level string append. Use it only against unshared objects
2466 * of type "string". */
2467 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2469 int needlen;
2471 if (len == -1)
2472 len = strlen(str);
2473 needlen = objPtr->length + len;
2474 if (objPtr->internalRep.strValue.maxLength < needlen ||
2475 objPtr->internalRep.strValue.maxLength == 0) {
2476 needlen *= 2;
2477 /* Inefficient to malloc() for less than 8 bytes */
2478 if (needlen < 7) {
2479 needlen = 7;
2481 if (objPtr->bytes == JimEmptyStringRep) {
2482 objPtr->bytes = Jim_Alloc(needlen + 1);
2484 else {
2485 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2487 objPtr->internalRep.strValue.maxLength = needlen;
2489 memcpy(objPtr->bytes + objPtr->length, str, len);
2490 objPtr->bytes[objPtr->length + len] = '\0';
2492 if (objPtr->internalRep.strValue.charLength >= 0) {
2493 /* Update the utf-8 char length */
2494 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2496 objPtr->length += len;
2499 /* Higher level API to append strings to objects.
2500 * Object must not be unshared for each of these.
2502 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2504 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2505 SetStringFromAny(interp, objPtr);
2506 StringAppendString(objPtr, str, len);
2509 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2511 int len;
2512 const char *str = Jim_GetString(appendObjPtr, &len);
2513 Jim_AppendString(interp, objPtr, str, len);
2516 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2518 va_list ap;
2520 SetStringFromAny(interp, objPtr);
2521 va_start(ap, objPtr);
2522 while (1) {
2523 const char *s = va_arg(ap, const char *);
2525 if (s == NULL)
2526 break;
2527 Jim_AppendString(interp, objPtr, s, -1);
2529 va_end(ap);
2532 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2534 if (aObjPtr == bObjPtr) {
2535 return 1;
2537 else {
2538 int Alen, Blen;
2539 const char *sA = Jim_GetString(aObjPtr, &Alen);
2540 const char *sB = Jim_GetString(bObjPtr, &Blen);
2542 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2547 * Note. Does not support embedded nulls in either the pattern or the object.
2549 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2551 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2555 * Note: does not support embedded nulls for the nocase option.
2557 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2559 int l1, l2;
2560 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2561 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2563 if (nocase) {
2564 /* Do a character compare for nocase */
2565 return JimStringCompareLen(s1, s2, -1, nocase);
2567 return JimStringCompare(s1, l1, s2, l2);
2571 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2573 * Note: does not support embedded nulls
2575 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2577 const char *s1 = Jim_String(firstObjPtr);
2578 const char *s2 = Jim_String(secondObjPtr);
2580 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2583 /* Convert a range, as returned by Jim_GetRange(), into
2584 * an absolute index into an object of the specified length.
2585 * This function may return negative values, or values
2586 * greater than or equal to the length of the list if the index
2587 * is out of range. */
2588 static int JimRelToAbsIndex(int len, int idx)
2590 if (idx < 0)
2591 return len + idx;
2592 return idx;
2595 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2596 * into a form suitable for implementation of commands like [string range] and [lrange].
2598 * The resulting range is guaranteed to address valid elements of
2599 * the structure.
2601 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2603 int rangeLen;
2605 if (*firstPtr > *lastPtr) {
2606 rangeLen = 0;
2608 else {
2609 rangeLen = *lastPtr - *firstPtr + 1;
2610 if (rangeLen) {
2611 if (*firstPtr < 0) {
2612 rangeLen += *firstPtr;
2613 *firstPtr = 0;
2615 if (*lastPtr >= len) {
2616 rangeLen -= (*lastPtr - (len - 1));
2617 *lastPtr = len - 1;
2621 if (rangeLen < 0)
2622 rangeLen = 0;
2624 *rangeLenPtr = rangeLen;
2627 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2628 int len, int *first, int *last, int *range)
2630 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2631 return JIM_ERR;
2633 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2634 return JIM_ERR;
2636 *first = JimRelToAbsIndex(len, *first);
2637 *last = JimRelToAbsIndex(len, *last);
2638 JimRelToAbsRange(len, first, last, range);
2639 return JIM_OK;
2642 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2643 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2645 int first, last;
2646 const char *str;
2647 int rangeLen;
2648 int bytelen;
2650 str = Jim_GetString(strObjPtr, &bytelen);
2652 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2653 return NULL;
2656 if (first == 0 && rangeLen == bytelen) {
2657 return strObjPtr;
2659 return Jim_NewStringObj(interp, str + first, rangeLen);
2662 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2663 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2665 #ifdef JIM_UTF8
2666 int first, last;
2667 const char *str;
2668 int len, rangeLen;
2669 int bytelen;
2671 str = Jim_GetString(strObjPtr, &bytelen);
2672 len = Jim_Utf8Length(interp, strObjPtr);
2674 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2675 return NULL;
2678 if (first == 0 && rangeLen == len) {
2679 return strObjPtr;
2681 if (len == bytelen) {
2682 /* ASCII optimisation */
2683 return Jim_NewStringObj(interp, str + first, rangeLen);
2685 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2686 #else
2687 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2688 #endif
2691 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2692 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2694 int first, last;
2695 const char *str;
2696 int len, rangeLen;
2697 Jim_Obj *objPtr;
2699 len = Jim_Utf8Length(interp, strObjPtr);
2701 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2702 return NULL;
2705 if (last < first) {
2706 return strObjPtr;
2709 str = Jim_String(strObjPtr);
2711 /* Before part */
2712 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2714 /* Replacement */
2715 if (newStrObj) {
2716 Jim_AppendObj(interp, objPtr, newStrObj);
2719 /* After part */
2720 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2722 return objPtr;
2726 * Note: does not support embedded nulls.
2728 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2730 while (*str) {
2731 int c;
2732 str += utf8_tounicode(str, &c);
2733 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2735 *dest = 0;
2739 * Note: does not support embedded nulls.
2741 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2743 char *buf;
2744 int len;
2745 const char *str;
2747 str = Jim_GetString(strObjPtr, &len);
2749 #ifdef JIM_UTF8
2750 /* Case mapping can change the utf-8 length of the string.
2751 * But at worst it will be by one extra byte per char
2753 len *= 2;
2754 #endif
2755 buf = Jim_Alloc(len + 1);
2756 JimStrCopyUpperLower(buf, str, 0);
2757 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2761 * Note: does not support embedded nulls.
2763 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2765 char *buf;
2766 const char *str;
2767 int len;
2769 str = Jim_GetString(strObjPtr, &len);
2771 #ifdef JIM_UTF8
2772 /* Case mapping can change the utf-8 length of the string.
2773 * But at worst it will be by one extra byte per char
2775 len *= 2;
2776 #endif
2777 buf = Jim_Alloc(len + 1);
2778 JimStrCopyUpperLower(buf, str, 1);
2779 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2783 * Note: does not support embedded nulls.
2785 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2787 char *buf, *p;
2788 int len;
2789 int c;
2790 const char *str;
2792 str = Jim_GetString(strObjPtr, &len);
2794 #ifdef JIM_UTF8
2795 /* Case mapping can change the utf-8 length of the string.
2796 * But at worst it will be by one extra byte per char
2798 len *= 2;
2799 #endif
2800 buf = p = Jim_Alloc(len + 1);
2802 str += utf8_tounicode(str, &c);
2803 p += utf8_getchars(p, utf8_title(c));
2805 JimStrCopyUpperLower(p, str, 0);
2807 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2810 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2811 * for unicode character 'c'.
2812 * Returns the position if found or NULL if not
2814 static const char *utf8_memchr(const char *str, int len, int c)
2816 #ifdef JIM_UTF8
2817 while (len) {
2818 int sc;
2819 int n = utf8_tounicode(str, &sc);
2820 if (sc == c) {
2821 return str;
2823 str += n;
2824 len -= n;
2826 return NULL;
2827 #else
2828 return memchr(str, c, len);
2829 #endif
2833 * Searches for the first non-trim char in string (str, len)
2835 * If none is found, returns just past the last char.
2837 * Lengths are in bytes.
2839 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2841 while (len) {
2842 int c;
2843 int n = utf8_tounicode(str, &c);
2845 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2846 /* Not a trim char, so stop */
2847 break;
2849 str += n;
2850 len -= n;
2852 return str;
2856 * Searches backwards for a non-trim char in string (str, len).
2858 * Returns a pointer to just after the non-trim char, or NULL if not found.
2860 * Lengths are in bytes.
2862 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2864 str += len;
2866 while (len) {
2867 int c;
2868 int n = utf8_prev_len(str, len);
2870 len -= n;
2871 str -= n;
2873 n = utf8_tounicode(str, &c);
2875 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2876 return str + n;
2880 return NULL;
2883 static const char default_trim_chars[] = " \t\n\r";
2884 /* sizeof() here includes the null byte */
2885 static int default_trim_chars_len = sizeof(default_trim_chars);
2887 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2889 int len;
2890 const char *str = Jim_GetString(strObjPtr, &len);
2891 const char *trimchars = default_trim_chars;
2892 int trimcharslen = default_trim_chars_len;
2893 const char *newstr;
2895 if (trimcharsObjPtr) {
2896 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2899 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2900 if (newstr == str) {
2901 return strObjPtr;
2904 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2907 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2909 int len;
2910 const char *trimchars = default_trim_chars;
2911 int trimcharslen = default_trim_chars_len;
2912 const char *nontrim;
2914 if (trimcharsObjPtr) {
2915 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2918 SetStringFromAny(interp, strObjPtr);
2920 len = Jim_Length(strObjPtr);
2921 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2923 if (nontrim == NULL) {
2924 /* All trim, so return a zero-length string */
2925 return Jim_NewEmptyStringObj(interp);
2927 if (nontrim == strObjPtr->bytes + len) {
2928 /* All non-trim, so return the original object */
2929 return strObjPtr;
2932 if (Jim_IsShared(strObjPtr)) {
2933 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2935 else {
2936 /* Can modify this string in place */
2937 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2938 strObjPtr->length = (nontrim - strObjPtr->bytes);
2941 return strObjPtr;
2944 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2946 /* First trim left. */
2947 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2949 /* Now trim right */
2950 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2952 /* Note: refCount check is needed since objPtr may be emptyObj */
2953 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2954 /* We don't want this object to be leaked */
2955 Jim_FreeNewObj(interp, objPtr);
2958 return strObjPtr;
2961 /* Some platforms don't have isascii - need a non-macro version */
2962 #ifdef HAVE_ISASCII
2963 #define jim_isascii isascii
2964 #else
2965 static int jim_isascii(int c)
2967 return !(c & ~0x7f);
2969 #endif
2971 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2973 static const char * const strclassnames[] = {
2974 "integer", "alpha", "alnum", "ascii", "digit",
2975 "double", "lower", "upper", "space", "xdigit",
2976 "control", "print", "graph", "punct", "boolean",
2977 NULL
2979 enum {
2980 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2981 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2982 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2984 int strclass;
2985 int len;
2986 int i;
2987 const char *str;
2988 int (*isclassfunc)(int c) = NULL;
2990 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2991 return JIM_ERR;
2994 str = Jim_GetString(strObjPtr, &len);
2995 if (len == 0) {
2996 Jim_SetResultBool(interp, !strict);
2997 return JIM_OK;
3000 switch (strclass) {
3001 case STR_IS_INTEGER:
3003 jim_wide w;
3004 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3005 return JIM_OK;
3008 case STR_IS_DOUBLE:
3010 double d;
3011 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3012 return JIM_OK;
3015 case STR_IS_BOOLEAN:
3017 int b;
3018 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3019 return JIM_OK;
3022 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3023 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3024 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3025 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3026 case STR_IS_LOWER: isclassfunc = islower; break;
3027 case STR_IS_UPPER: isclassfunc = isupper; break;
3028 case STR_IS_SPACE: isclassfunc = isspace; break;
3029 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3030 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3031 case STR_IS_PRINT: isclassfunc = isprint; break;
3032 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3033 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3034 default:
3035 return JIM_ERR;
3038 for (i = 0; i < len; i++) {
3039 if (!isclassfunc(UCHAR(str[i]))) {
3040 Jim_SetResultBool(interp, 0);
3041 return JIM_OK;
3044 Jim_SetResultBool(interp, 1);
3045 return JIM_OK;
3048 /* -----------------------------------------------------------------------------
3049 * Compared String Object
3050 * ---------------------------------------------------------------------------*/
3052 /* This is strange object that allows comparison of a C literal string
3053 * with a Jim object in a very short time if the same comparison is done
3054 * multiple times. For example every time the [if] command is executed,
3055 * Jim has to check if a given argument is "else".
3056 * If the code has no errors, this comparison is true most of the time,
3057 * so we can cache the pointer of the string of the last matching
3058 * comparison inside the object. Because most C compilers perform literal sharing,
3059 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3060 * this works pretty well even if comparisons are at different places
3061 * inside the C code. */
3063 static const Jim_ObjType comparedStringObjType = {
3064 "compared-string",
3065 NULL,
3066 NULL,
3067 NULL,
3068 JIM_TYPE_REFERENCES,
3071 /* The only way this object is exposed to the API is via the following
3072 * function. Returns true if the string and the object string repr.
3073 * are the same, otherwise zero is returned.
3075 * Note: this isn't binary safe, but it hardly needs to be.*/
3076 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3078 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3079 return 1;
3081 else {
3082 if (strcmp(str, Jim_String(objPtr)) != 0)
3083 return 0;
3085 if (objPtr->typePtr != &comparedStringObjType) {
3086 Jim_FreeIntRep(interp, objPtr);
3087 objPtr->typePtr = &comparedStringObjType;
3089 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3090 return 1;
3094 static int qsortCompareStringPointers(const void *a, const void *b)
3096 char *const *sa = (char *const *)a;
3097 char *const *sb = (char *const *)b;
3099 return strcmp(*sa, *sb);
3103 /* -----------------------------------------------------------------------------
3104 * Source Object
3106 * This object is just a string from the language point of view, but
3107 * the internal representation contains the filename and line number
3108 * where this token was read. This information is used by
3109 * Jim_EvalObj() if the object passed happens to be of type "source".
3111 * This allows propagation of the information about line numbers and file
3112 * names and gives error messages with absolute line numbers.
3114 * Note that this object uses the internal representation of the Jim_Object,
3115 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3117 * Also the object will be converted to something else if the given
3118 * token it represents in the source file is not something to be
3119 * evaluated (not a script), and will be specialized in some other way,
3120 * so the time overhead is also almost zero.
3121 * ---------------------------------------------------------------------------*/
3123 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3124 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3126 static const Jim_ObjType sourceObjType = {
3127 "source",
3128 FreeSourceInternalRep,
3129 DupSourceInternalRep,
3130 NULL,
3131 JIM_TYPE_REFERENCES,
3134 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3136 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3139 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3141 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3142 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3145 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3146 Jim_Obj *fileNameObj, int lineNumber)
3148 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3149 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3150 Jim_IncrRefCount(fileNameObj);
3151 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3152 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3153 objPtr->typePtr = &sourceObjType;
3156 /* -----------------------------------------------------------------------------
3157 * ScriptLine Object
3159 * This object is used only in the Script internal represenation.
3160 * For each line of the script, it holds the number of tokens on the line
3161 * and the source line number.
3163 static const Jim_ObjType scriptLineObjType = {
3164 "scriptline",
3165 NULL,
3166 NULL,
3167 NULL,
3168 JIM_NONE,
3171 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3173 Jim_Obj *objPtr;
3175 #ifdef DEBUG_SHOW_SCRIPT
3176 char buf[100];
3177 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3178 objPtr = Jim_NewStringObj(interp, buf, -1);
3179 #else
3180 objPtr = Jim_NewEmptyStringObj(interp);
3181 #endif
3182 objPtr->typePtr = &scriptLineObjType;
3183 objPtr->internalRep.scriptLineValue.argc = argc;
3184 objPtr->internalRep.scriptLineValue.line = line;
3186 return objPtr;
3189 /* -----------------------------------------------------------------------------
3190 * Script Object
3192 * This object holds the parsed internal representation of a script.
3193 * This representation is help within an allocated ScriptObj (see below)
3195 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3196 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3198 static const Jim_ObjType scriptObjType = {
3199 "script",
3200 FreeScriptInternalRep,
3201 DupScriptInternalRep,
3202 NULL,
3203 JIM_TYPE_REFERENCES,
3206 /* Each token of a script is represented by a ScriptToken.
3207 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3208 * can be specialized by commands operating on it.
3210 typedef struct ScriptToken
3212 Jim_Obj *objPtr;
3213 int type;
3214 } ScriptToken;
3216 /* This is the script object internal representation. An array of
3217 * ScriptToken structures, including a pre-computed representation of the
3218 * command length and arguments.
3220 * For example the script:
3222 * puts hello
3223 * set $i $x$y [foo]BAR
3225 * will produce a ScriptObj with the following ScriptToken's:
3227 * LIN 2
3228 * ESC puts
3229 * ESC hello
3230 * LIN 4
3231 * ESC set
3232 * VAR i
3233 * WRD 2
3234 * VAR x
3235 * VAR y
3236 * WRD 2
3237 * CMD foo
3238 * ESC BAR
3240 * "puts hello" has two args (LIN 2), composed of single tokens.
3241 * (Note that the WRD token is omitted for the common case of a single token.)
3243 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3244 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3246 * The precomputation of the command structure makes Jim_Eval() faster,
3247 * and simpler because there aren't dynamic lengths / allocations.
3249 * -- {expand}/{*} handling --
3251 * Expand is handled in a special way.
3253 * If a "word" begins with {*}, the word token count is -ve.
3255 * For example the command:
3257 * list {*}{a b}
3259 * Will produce the following cmdstruct array:
3261 * LIN 2
3262 * ESC list
3263 * WRD -1
3264 * STR a b
3266 * Note that the 'LIN' token also contains the source information for the
3267 * first word of the line for error reporting purposes
3269 * -- the substFlags field of the structure --
3271 * The scriptObj structure is used to represent both "script" objects
3272 * and "subst" objects. In the second case, there are no LIN and WRD
3273 * tokens. Instead SEP and EOL tokens are added as-is.
3274 * In addition, the field 'substFlags' is used to represent the flags used to turn
3275 * the string into the internal representation.
3276 * If these flags do not match what the application requires,
3277 * the scriptObj is created again. For example the script:
3279 * subst -nocommands $string
3280 * subst -novariables $string
3282 * Will (re)create the internal representation of the $string object
3283 * two times.
3285 typedef struct ScriptObj
3287 ScriptToken *token; /* Tokens array. */
3288 Jim_Obj *fileNameObj; /* Filename */
3289 int len; /* Length of token[] */
3290 int substFlags; /* flags used for the compilation of "subst" objects */
3291 int inUse; /* Used to share a ScriptObj. Currently
3292 only used by Jim_EvalObj() as protection against
3293 shimmering of the currently evaluated object. */
3294 int firstline; /* Line number of the first line */
3295 int linenr; /* Error line number, if any */
3296 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3297 } ScriptObj;
3299 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3300 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3301 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3303 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3305 int i;
3306 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3308 if (--script->inUse != 0)
3309 return;
3310 for (i = 0; i < script->len; i++) {
3311 Jim_DecrRefCount(interp, script->token[i].objPtr);
3313 Jim_Free(script->token);
3314 Jim_DecrRefCount(interp, script->fileNameObj);
3315 Jim_Free(script);
3318 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3320 JIM_NOTUSED(interp);
3321 JIM_NOTUSED(srcPtr);
3323 /* Just return a simple string. We don't try to preserve the source info
3324 * since in practice scripts are never duplicated
3326 dupPtr->typePtr = NULL;
3329 /* A simple parse token.
3330 * As the script is parsed, the created tokens point into the script string rep.
3332 typedef struct
3334 const char *token; /* Pointer to the start of the token */
3335 int len; /* Length of this token */
3336 int type; /* Token type */
3337 int line; /* Line number */
3338 } ParseToken;
3340 /* A list of parsed tokens representing a script.
3341 * Tokens are added to this list as the script is parsed.
3342 * It grows as needed.
3344 typedef struct
3346 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3347 ParseToken *list; /* Array of tokens */
3348 int size; /* Current size of the list */
3349 int count; /* Number of entries used */
3350 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3351 } ParseTokenList;
3353 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3355 tokenlist->list = tokenlist->static_list;
3356 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3357 tokenlist->count = 0;
3360 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3362 if (tokenlist->list != tokenlist->static_list) {
3363 Jim_Free(tokenlist->list);
3368 * Adds the new token to the tokenlist.
3369 * The token has the given length, type and line number.
3370 * The token list is resized as necessary.
3372 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3373 int line)
3375 ParseToken *t;
3377 if (tokenlist->count == tokenlist->size) {
3378 /* Resize the list */
3379 tokenlist->size *= 2;
3380 if (tokenlist->list != tokenlist->static_list) {
3381 tokenlist->list =
3382 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3384 else {
3385 /* The list needs to become allocated */
3386 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3387 memcpy(tokenlist->list, tokenlist->static_list,
3388 tokenlist->count * sizeof(*tokenlist->list));
3391 t = &tokenlist->list[tokenlist->count++];
3392 t->token = token;
3393 t->len = len;
3394 t->type = type;
3395 t->line = line;
3398 /* Counts the number of adjoining non-separator tokens.
3400 * Returns -ve if the first token is the expansion
3401 * operator (in which case the count doesn't include
3402 * that token).
3404 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3406 int expand = 1;
3407 int count = 0;
3409 /* Is the first word {*} or {expand}? */
3410 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3411 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3412 /* Create an expand token */
3413 expand = -1;
3414 t++;
3416 else {
3417 if (script->missing == ' ') {
3418 /* This is a "extra characters after close-brace" error. Report the first error */
3419 script->missing = '}';
3420 script->linenr = t[1].line;
3425 /* Now count non-separator words */
3426 while (!TOKEN_IS_SEP(t->type)) {
3427 t++;
3428 count++;
3431 return count * expand;
3435 * Create a script/subst object from the given token.
3437 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3439 Jim_Obj *objPtr;
3441 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3442 /* Convert backlash escapes. The result will never be longer than the original */
3443 int len = t->len;
3444 char *str = Jim_Alloc(len + 1);
3445 len = JimEscape(str, t->token, len);
3446 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3448 else {
3449 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3450 * with a single space.
3452 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3454 return objPtr;
3458 * Takes a tokenlist and creates the allocated list of script tokens
3459 * in script->token, of length script->len.
3461 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3462 * as required.
3464 * Also sets script->line to the line number of the first token
3466 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3467 ParseTokenList *tokenlist)
3469 int i;
3470 struct ScriptToken *token;
3471 /* Number of tokens so far for the current command */
3472 int lineargs = 0;
3473 /* This is the first token for the current command */
3474 ScriptToken *linefirst;
3475 int count;
3476 int linenr;
3478 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3479 printf("==== Tokens ====\n");
3480 for (i = 0; i < tokenlist->count; i++) {
3481 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3482 tokenlist->list[i].len, tokenlist->list[i].token);
3484 #endif
3486 /* May need up to one extra script token for each EOL in the worst case */
3487 count = tokenlist->count;
3488 for (i = 0; i < tokenlist->count; i++) {
3489 if (tokenlist->list[i].type == JIM_TT_EOL) {
3490 count++;
3493 linenr = script->firstline = tokenlist->list[0].line;
3495 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3497 /* This is the first token for the current command */
3498 linefirst = token++;
3500 for (i = 0; i < tokenlist->count; ) {
3501 /* Look ahead to find out how many tokens make up the next word */
3502 int wordtokens;
3504 /* Skip any leading separators */
3505 while (tokenlist->list[i].type == JIM_TT_SEP) {
3506 i++;
3509 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3511 if (wordtokens == 0) {
3512 /* None, so at end of line */
3513 if (lineargs) {
3514 linefirst->type = JIM_TT_LINE;
3515 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3516 Jim_IncrRefCount(linefirst->objPtr);
3518 /* Reset for new line */
3519 lineargs = 0;
3520 linefirst = token++;
3522 i++;
3523 continue;
3525 else if (wordtokens != 1) {
3526 /* More than 1, or {*}, so insert a WORD token */
3527 token->type = JIM_TT_WORD;
3528 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3529 Jim_IncrRefCount(token->objPtr);
3530 token++;
3531 if (wordtokens < 0) {
3532 /* Skip the expand token */
3533 i++;
3534 wordtokens = -wordtokens - 1;
3535 lineargs--;
3539 if (lineargs == 0) {
3540 /* First real token on the line, so record the line number */
3541 linenr = tokenlist->list[i].line;
3543 lineargs++;
3545 /* Add each non-separator word token to the line */
3546 while (wordtokens--) {
3547 const ParseToken *t = &tokenlist->list[i++];
3549 token->type = t->type;
3550 token->objPtr = JimMakeScriptObj(interp, t);
3551 Jim_IncrRefCount(token->objPtr);
3553 /* Every object is initially a string of type 'source', but the
3554 * internal type may be specialized during execution of the
3555 * script. */
3556 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3557 token++;
3561 if (lineargs == 0) {
3562 token--;
3565 script->len = token - script->token;
3567 JimPanic((script->len >= count, "allocated script array is too short"));
3569 #ifdef DEBUG_SHOW_SCRIPT
3570 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3571 for (i = 0; i < script->len; i++) {
3572 const ScriptToken *t = &script->token[i];
3573 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3575 #endif
3579 /* Parses the given string object to determine if it represents a complete script.
3581 * This is useful for interactive shells implementation, for [info complete].
3583 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3584 * '{' on scripts incomplete missing one or more '}' to be balanced.
3585 * '[' on scripts incomplete missing one or more ']' to be balanced.
3586 * '"' on scripts incomplete missing a '"' char.
3587 * '\\' on scripts with a trailing backslash.
3589 * If the script is complete, 1 is returned, otherwise 0.
3591 * If the script has extra characters after a close brace, this still returns 1,
3592 * but sets *stateCharPtr to '}'
3593 * Evaluating the script will give the error "extra characters after close-brace".
3595 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3597 ScriptObj *script = JimGetScript(interp, scriptObj);
3598 if (stateCharPtr) {
3599 *stateCharPtr = script->missing;
3601 return script->missing == ' ' || script->missing == '}';
3605 * Sets an appropriate error message for a missing script/expression terminator.
3607 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3609 * Note that a trailing backslash is not considered to be an error.
3611 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3613 const char *msg;
3615 switch (ch) {
3616 case '\\':
3617 case ' ':
3618 return JIM_OK;
3620 case '[':
3621 msg = "unmatched \"[\"";
3622 break;
3623 case '{':
3624 msg = "missing close-brace";
3625 break;
3626 case '}':
3627 msg = "extra characters after close-brace";
3628 break;
3629 case '"':
3630 default:
3631 msg = "missing quote";
3632 break;
3635 Jim_SetResultString(interp, msg, -1);
3636 return JIM_ERR;
3640 * Similar to ScriptObjAddTokens(), but for subst objects.
3642 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3643 ParseTokenList *tokenlist)
3645 int i;
3646 struct ScriptToken *token;
3648 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3650 for (i = 0; i < tokenlist->count; i++) {
3651 const ParseToken *t = &tokenlist->list[i];
3653 /* Create a token for 't' */
3654 token->type = t->type;
3655 token->objPtr = JimMakeScriptObj(interp, t);
3656 Jim_IncrRefCount(token->objPtr);
3657 token++;
3660 script->len = i;
3663 /* This method takes the string representation of an object
3664 * as a Tcl script, and generates the pre-parsed internal representation
3665 * of the script.
3667 * On parse error, sets an error message and returns JIM_ERR
3668 * (Note: the object is still converted to a script, even if an error occurs)
3670 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3672 int scriptTextLen;
3673 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3674 struct JimParserCtx parser;
3675 struct ScriptObj *script;
3676 ParseTokenList tokenlist;
3677 int line = 1;
3679 /* Try to get information about filename / line number */
3680 if (objPtr->typePtr == &sourceObjType) {
3681 line = objPtr->internalRep.sourceValue.lineNumber;
3684 /* Initially parse the script into tokens (in tokenlist) */
3685 ScriptTokenListInit(&tokenlist);
3687 JimParserInit(&parser, scriptText, scriptTextLen, line);
3688 while (!parser.eof) {
3689 JimParseScript(&parser);
3690 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3691 parser.tline);
3694 /* Add a final EOF token */
3695 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3697 /* Create the "real" script tokens from the parsed tokens */
3698 script = Jim_Alloc(sizeof(*script));
3699 memset(script, 0, sizeof(*script));
3700 script->inUse = 1;
3701 if (objPtr->typePtr == &sourceObjType) {
3702 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3704 else {
3705 script->fileNameObj = interp->emptyObj;
3707 Jim_IncrRefCount(script->fileNameObj);
3708 script->missing = parser.missing.ch;
3709 script->linenr = parser.missing.line;
3711 ScriptObjAddTokens(interp, script, &tokenlist);
3713 /* No longer need the token list */
3714 ScriptTokenListFree(&tokenlist);
3716 /* Free the old internal rep and set the new one. */
3717 Jim_FreeIntRep(interp, objPtr);
3718 Jim_SetIntRepPtr(objPtr, script);
3719 objPtr->typePtr = &scriptObjType;
3722 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3725 * Returns the parsed script.
3726 * Note that if there is any possibility that the script is not valid,
3727 * call JimScriptValid() to check
3729 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3731 if (objPtr == interp->emptyObj) {
3732 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3733 objPtr = interp->nullScriptObj;
3736 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3737 JimSetScriptFromAny(interp, objPtr);
3740 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3744 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3745 * and leaves an error message in the interp result.
3748 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3750 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3751 JimAddErrorToStack(interp, script);
3752 return 0;
3754 return 1;
3758 /* -----------------------------------------------------------------------------
3759 * Commands
3760 * ---------------------------------------------------------------------------*/
3761 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3763 cmdPtr->inUse++;
3766 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3768 if (--cmdPtr->inUse == 0) {
3769 if (cmdPtr->isproc) {
3770 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3771 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3772 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3773 if (cmdPtr->u.proc.staticVars) {
3774 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3775 Jim_Free(cmdPtr->u.proc.staticVars);
3778 else {
3779 /* native (C) */
3780 if (cmdPtr->u.native.delProc) {
3781 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3784 if (cmdPtr->prevCmd) {
3785 /* Delete any pushed command too */
3786 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3788 Jim_Free(cmdPtr);
3792 /* Variables HashTable Type.
3794 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3796 static void JimVariablesHTValDestructor(void *interp, void *val)
3798 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3799 Jim_Free(val);
3802 static const Jim_HashTableType JimVariablesHashTableType = {
3803 JimStringCopyHTHashFunction, /* hash function */
3804 JimStringCopyHTDup, /* key dup */
3805 NULL, /* val dup */
3806 JimStringCopyHTKeyCompare, /* key compare */
3807 JimStringCopyHTKeyDestructor, /* key destructor */
3808 JimVariablesHTValDestructor /* val destructor */
3811 /* Commands HashTable Type.
3813 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3815 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3817 JimDecrCmdRefCount(interp, val);
3820 static const Jim_HashTableType JimCommandsHashTableType = {
3821 JimStringCopyHTHashFunction, /* hash function */
3822 JimStringCopyHTDup, /* key dup */
3823 NULL, /* val dup */
3824 JimStringCopyHTKeyCompare, /* key compare */
3825 JimStringCopyHTKeyDestructor, /* key destructor */
3826 JimCommandsHT_ValDestructor /* val destructor */
3829 /* ------------------------- Commands related functions --------------------- */
3831 #ifdef jim_ext_namespace
3833 * Returns the "unscoped" version of the given namespace.
3834 * That is, the fully qualified name without the leading ::
3835 * The returned value is either nsObj, or an object with a zero ref count.
3837 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3839 const char *name = Jim_String(nsObj);
3840 if (name[0] == ':' && name[1] == ':') {
3841 /* This command is being defined in the global namespace */
3842 while (*++name == ':') {
3844 nsObj = Jim_NewStringObj(interp, name, -1);
3846 else if (Jim_Length(interp->framePtr->nsObj)) {
3847 /* This command is being defined in a non-global namespace */
3848 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3849 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3851 return nsObj;
3855 * If nameObjPtr starts with "::", returns it.
3856 * Otherwise returns a new object with nameObjPtr prefixed with "::".
3857 * In this case, decrements the ref count of nameObjPtr.
3859 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3861 Jim_Obj *resultObj;
3863 const char *name = Jim_String(nameObjPtr);
3864 if (name[0] == ':' && name[1] == ':') {
3865 return nameObjPtr;
3867 Jim_IncrRefCount(nameObjPtr);
3868 resultObj = Jim_NewStringObj(interp, "::", -1);
3869 Jim_AppendObj(interp, resultObj, nameObjPtr);
3870 Jim_DecrRefCount(interp, nameObjPtr);
3872 return resultObj;
3876 * An efficient version of JimQualifyNameObj() where the name is
3877 * available (and needed) as a 'const char *'.
3878 * Avoids creating an object if not necessary.
3879 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3881 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3883 Jim_Obj *objPtr = interp->emptyObj;
3885 if (name[0] == ':' && name[1] == ':') {
3886 /* This command is being defined in the global namespace */
3887 while (*++name == ':') {
3890 else if (Jim_Length(interp->framePtr->nsObj)) {
3891 /* This command is being defined in a non-global namespace */
3892 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3893 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3894 name = Jim_String(objPtr);
3896 Jim_IncrRefCount(objPtr);
3897 *objPtrPtr = objPtr;
3898 return name;
3901 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3903 #else
3904 /* We can be more efficient in the no-namespace case */
3905 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3906 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3908 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3910 return nameObjPtr;
3912 #endif
3914 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3916 /* It may already exist, so we try to delete the old one.
3917 * Note that reference count means that it won't be deleted yet if
3918 * it exists in the call stack.
3920 * BUT, if 'local' is in force, instead of deleting the existing
3921 * proc, we stash a reference to the old proc here.
3923 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3924 if (he) {
3925 /* There was an old cmd with the same name,
3926 * so this requires a 'proc epoch' update. */
3928 /* If a procedure with the same name didn't exist there is no need
3929 * to increment the 'proc epoch' because creation of a new procedure
3930 * can never affect existing cached commands. We don't do
3931 * negative caching. */
3932 Jim_InterpIncrProcEpoch(interp);
3935 if (he && interp->local) {
3936 /* Push this command over the top of the previous one */
3937 cmd->prevCmd = Jim_GetHashEntryVal(he);
3938 Jim_SetHashVal(&interp->commands, he, cmd);
3940 else {
3941 if (he) {
3942 /* Replace the existing command */
3943 Jim_DeleteHashEntry(&interp->commands, name);
3946 Jim_AddHashEntry(&interp->commands, name, cmd);
3948 return JIM_OK;
3952 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3953 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3955 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3957 /* Store the new details for this command */
3958 memset(cmdPtr, 0, sizeof(*cmdPtr));
3959 cmdPtr->inUse = 1;
3960 cmdPtr->u.native.delProc = delProc;
3961 cmdPtr->u.native.cmdProc = cmdProc;
3962 cmdPtr->u.native.privData = privData;
3964 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3966 return JIM_OK;
3969 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3971 int len, i;
3973 len = Jim_ListLength(interp, staticsListObjPtr);
3974 if (len == 0) {
3975 return JIM_OK;
3978 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3979 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3980 for (i = 0; i < len; i++) {
3981 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3982 Jim_Var *varPtr;
3983 int subLen;
3985 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3986 /* Check if it's composed of two elements. */
3987 subLen = Jim_ListLength(interp, objPtr);
3988 if (subLen == 1 || subLen == 2) {
3989 /* Try to get the variable value from the current
3990 * environment. */
3991 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3992 if (subLen == 1) {
3993 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3994 if (initObjPtr == NULL) {
3995 Jim_SetResultFormatted(interp,
3996 "variable for initialization of static \"%#s\" not found in the local context",
3997 nameObjPtr);
3998 return JIM_ERR;
4001 else {
4002 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
4004 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
4005 return JIM_ERR;
4008 varPtr = Jim_Alloc(sizeof(*varPtr));
4009 varPtr->objPtr = initObjPtr;
4010 Jim_IncrRefCount(initObjPtr);
4011 varPtr->linkFramePtr = NULL;
4012 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
4013 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
4014 Jim_SetResultFormatted(interp,
4015 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4016 Jim_DecrRefCount(interp, initObjPtr);
4017 Jim_Free(varPtr);
4018 return JIM_ERR;
4021 else {
4022 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4023 objPtr);
4024 return JIM_ERR;
4027 return JIM_OK;
4031 * If the command is a proc, sets/updates the cached namespace (nsObj)
4032 * based on the command name.
4034 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4036 #ifdef jim_ext_namespace
4037 if (cmdPtr->isproc) {
4038 /* XXX: Really need JimNamespaceSplit() */
4039 const char *pt = strrchr(cmdname, ':');
4040 if (pt && pt != cmdname && pt[-1] == ':') {
4041 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4042 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4043 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4045 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4046 /* This command shadows a global command, so a proc epoch update is required */
4047 Jim_InterpIncrProcEpoch(interp);
4051 #endif
4054 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4055 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4057 Jim_Cmd *cmdPtr;
4058 int argListLen;
4059 int i;
4061 argListLen = Jim_ListLength(interp, argListObjPtr);
4063 /* Allocate space for both the command pointer and the arg list */
4064 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4065 memset(cmdPtr, 0, sizeof(*cmdPtr));
4066 cmdPtr->inUse = 1;
4067 cmdPtr->isproc = 1;
4068 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4069 cmdPtr->u.proc.argListLen = argListLen;
4070 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4071 cmdPtr->u.proc.argsPos = -1;
4072 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4073 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4074 Jim_IncrRefCount(argListObjPtr);
4075 Jim_IncrRefCount(bodyObjPtr);
4076 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4078 /* Create the statics hash table. */
4079 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4080 goto err;
4083 /* Parse the args out into arglist, validating as we go */
4084 /* Examine the argument list for default parameters and 'args' */
4085 for (i = 0; i < argListLen; i++) {
4086 Jim_Obj *argPtr;
4087 Jim_Obj *nameObjPtr;
4088 Jim_Obj *defaultObjPtr;
4089 int len;
4091 /* Examine a parameter */
4092 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4093 len = Jim_ListLength(interp, argPtr);
4094 if (len == 0) {
4095 Jim_SetResultString(interp, "argument with no name", -1);
4096 err:
4097 JimDecrCmdRefCount(interp, cmdPtr);
4098 return NULL;
4100 if (len > 2) {
4101 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4102 goto err;
4105 if (len == 2) {
4106 /* Optional parameter */
4107 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4108 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4110 else {
4111 /* Required parameter */
4112 nameObjPtr = argPtr;
4113 defaultObjPtr = NULL;
4117 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4118 if (cmdPtr->u.proc.argsPos >= 0) {
4119 Jim_SetResultString(interp, "'args' specified more than once", -1);
4120 goto err;
4122 cmdPtr->u.proc.argsPos = i;
4124 else {
4125 if (len == 2) {
4126 cmdPtr->u.proc.optArity++;
4128 else {
4129 cmdPtr->u.proc.reqArity++;
4133 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4134 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4137 return cmdPtr;
4140 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4142 int ret = JIM_OK;
4143 Jim_Obj *qualifiedNameObj;
4144 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4146 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4147 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4148 ret = JIM_ERR;
4150 else {
4151 Jim_InterpIncrProcEpoch(interp);
4154 JimFreeQualifiedName(interp, qualifiedNameObj);
4156 return ret;
4159 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4161 int ret = JIM_ERR;
4162 Jim_HashEntry *he;
4163 Jim_Cmd *cmdPtr;
4164 Jim_Obj *qualifiedOldNameObj;
4165 Jim_Obj *qualifiedNewNameObj;
4166 const char *fqold;
4167 const char *fqnew;
4169 if (newName[0] == 0) {
4170 return Jim_DeleteCommand(interp, oldName);
4173 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4174 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4176 /* Does it exist? */
4177 he = Jim_FindHashEntry(&interp->commands, fqold);
4178 if (he == NULL) {
4179 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4181 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4182 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4184 else {
4185 /* Add the new name first */
4186 cmdPtr = Jim_GetHashEntryVal(he);
4187 JimIncrCmdRefCount(cmdPtr);
4188 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4189 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4191 /* Now remove the old name */
4192 Jim_DeleteHashEntry(&interp->commands, fqold);
4194 /* Increment the epoch */
4195 Jim_InterpIncrProcEpoch(interp);
4197 ret = JIM_OK;
4200 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4201 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4203 return ret;
4206 /* -----------------------------------------------------------------------------
4207 * Command object
4208 * ---------------------------------------------------------------------------*/
4210 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4212 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4215 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4217 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4218 dupPtr->typePtr = srcPtr->typePtr;
4219 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4222 static const Jim_ObjType commandObjType = {
4223 "command",
4224 FreeCommandInternalRep,
4225 DupCommandInternalRep,
4226 NULL,
4227 JIM_TYPE_REFERENCES,
4230 /* This function returns the command structure for the command name
4231 * stored in objPtr. It specializes the objPtr to contain
4232 * cached info instead of performing the lookup into the hash table
4233 * every time. The information cached may not be up-to-date, in this
4234 * case the lookup is performed and the cache updated.
4236 * Respects the 'upcall' setting.
4238 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4240 Jim_Cmd *cmd;
4242 /* In order to be valid, the proc epoch must match and
4243 * the lookup must have occurred in the same namespace
4245 if (objPtr->typePtr != &commandObjType ||
4246 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4247 #ifdef jim_ext_namespace
4248 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4249 #endif
4251 /* Not cached or out of date, so lookup */
4253 /* Do we need to try the local namespace? */
4254 const char *name = Jim_String(objPtr);
4255 Jim_HashEntry *he;
4257 if (name[0] == ':' && name[1] == ':') {
4258 while (*++name == ':') {
4261 #ifdef jim_ext_namespace
4262 else if (Jim_Length(interp->framePtr->nsObj)) {
4263 /* This command is being defined in a non-global namespace */
4264 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4265 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4266 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4267 Jim_FreeNewObj(interp, nameObj);
4268 if (he) {
4269 goto found;
4272 #endif
4274 /* Lookup in the global namespace */
4275 he = Jim_FindHashEntry(&interp->commands, name);
4276 if (he == NULL) {
4277 if (flags & JIM_ERRMSG) {
4278 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4280 return NULL;
4282 #ifdef jim_ext_namespace
4283 found:
4284 #endif
4285 cmd = Jim_GetHashEntryVal(he);
4287 /* Free the old internal rep and set the new one. */
4288 Jim_FreeIntRep(interp, objPtr);
4289 objPtr->typePtr = &commandObjType;
4290 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4291 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4292 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4293 Jim_IncrRefCount(interp->framePtr->nsObj);
4295 else {
4296 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4298 while (cmd->u.proc.upcall) {
4299 cmd = cmd->prevCmd;
4301 return cmd;
4304 /* -----------------------------------------------------------------------------
4305 * Variables
4306 * ---------------------------------------------------------------------------*/
4308 /* -----------------------------------------------------------------------------
4309 * Variable object
4310 * ---------------------------------------------------------------------------*/
4312 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4314 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4316 static const Jim_ObjType variableObjType = {
4317 "variable",
4318 NULL,
4319 NULL,
4320 NULL,
4321 JIM_TYPE_REFERENCES,
4325 * Check that the name does not contain embedded nulls.
4327 * Variable and procedure names are manipulated as null terminated strings, so
4328 * don't allow names with embedded nulls.
4330 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4332 /* Variable names and proc names can't contain embedded nulls */
4333 if (nameObjPtr->typePtr != &variableObjType) {
4334 int len;
4335 const char *str = Jim_GetString(nameObjPtr, &len);
4336 if (memchr(str, '\0', len)) {
4337 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4338 return JIM_ERR;
4341 return JIM_OK;
4344 /* This method should be called only by the variable API.
4345 * It returns JIM_OK on success (variable already exists),
4346 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4347 * a variable name, but syntax glue for [dict] i.e. the last
4348 * character is ')' */
4349 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4351 const char *varName;
4352 Jim_CallFrame *framePtr;
4353 Jim_HashEntry *he;
4354 int global;
4355 int len;
4357 /* Check if the object is already an uptodate variable */
4358 if (objPtr->typePtr == &variableObjType) {
4359 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4360 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4361 /* nothing to do */
4362 return JIM_OK;
4364 /* Need to re-resolve the variable in the updated callframe */
4366 else if (objPtr->typePtr == &dictSubstObjType) {
4367 return JIM_DICT_SUGAR;
4369 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4370 return JIM_ERR;
4374 varName = Jim_GetString(objPtr, &len);
4376 /* Make sure it's not syntax glue to get/set dict. */
4377 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4378 return JIM_DICT_SUGAR;
4381 if (varName[0] == ':' && varName[1] == ':') {
4382 while (*++varName == ':') {
4384 global = 1;
4385 framePtr = interp->topFramePtr;
4387 else {
4388 global = 0;
4389 framePtr = interp->framePtr;
4392 /* Resolve this name in the variables hash table */
4393 he = Jim_FindHashEntry(&framePtr->vars, varName);
4394 if (he == NULL) {
4395 if (!global && framePtr->staticVars) {
4396 /* Try with static vars. */
4397 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4399 if (he == NULL) {
4400 return JIM_ERR;
4404 /* Free the old internal repr and set the new one. */
4405 Jim_FreeIntRep(interp, objPtr);
4406 objPtr->typePtr = &variableObjType;
4407 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4408 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4409 objPtr->internalRep.varValue.global = global;
4410 return JIM_OK;
4413 /* -------------------- Variables related functions ------------------------- */
4414 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4415 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4417 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4419 const char *name;
4420 Jim_CallFrame *framePtr;
4421 int global;
4423 /* New variable to create */
4424 Jim_Var *var = Jim_Alloc(sizeof(*var));
4426 var->objPtr = valObjPtr;
4427 Jim_IncrRefCount(valObjPtr);
4428 var->linkFramePtr = NULL;
4430 name = Jim_String(nameObjPtr);
4431 if (name[0] == ':' && name[1] == ':') {
4432 while (*++name == ':') {
4434 framePtr = interp->topFramePtr;
4435 global = 1;
4437 else {
4438 framePtr = interp->framePtr;
4439 global = 0;
4442 /* Insert the new variable */
4443 Jim_AddHashEntry(&framePtr->vars, name, var);
4445 /* Make the object int rep a variable */
4446 Jim_FreeIntRep(interp, nameObjPtr);
4447 nameObjPtr->typePtr = &variableObjType;
4448 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4449 nameObjPtr->internalRep.varValue.varPtr = var;
4450 nameObjPtr->internalRep.varValue.global = global;
4452 return var;
4455 /* For now that's dummy. Variables lookup should be optimized
4456 * in many ways, with caching of lookups, and possibly with
4457 * a table of pre-allocated vars in every CallFrame for local vars.
4458 * All the caching should also have an 'epoch' mechanism similar
4459 * to the one used by Tcl for procedures lookup caching. */
4462 * Set the variable nameObjPtr to value valObjptr.
4464 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4466 int err;
4467 Jim_Var *var;
4469 switch (SetVariableFromAny(interp, nameObjPtr)) {
4470 case JIM_DICT_SUGAR:
4471 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4473 case JIM_ERR:
4474 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4475 return JIM_ERR;
4477 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4478 break;
4480 case JIM_OK:
4481 var = nameObjPtr->internalRep.varValue.varPtr;
4482 if (var->linkFramePtr == NULL) {
4483 Jim_IncrRefCount(valObjPtr);
4484 Jim_DecrRefCount(interp, var->objPtr);
4485 var->objPtr = valObjPtr;
4487 else { /* Else handle the link */
4488 Jim_CallFrame *savedCallFrame;
4490 savedCallFrame = interp->framePtr;
4491 interp->framePtr = var->linkFramePtr;
4492 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4493 interp->framePtr = savedCallFrame;
4494 if (err != JIM_OK)
4495 return err;
4498 return JIM_OK;
4501 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4503 Jim_Obj *nameObjPtr;
4504 int result;
4506 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4507 Jim_IncrRefCount(nameObjPtr);
4508 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4509 Jim_DecrRefCount(interp, nameObjPtr);
4510 return result;
4513 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4515 Jim_CallFrame *savedFramePtr;
4516 int result;
4518 savedFramePtr = interp->framePtr;
4519 interp->framePtr = interp->topFramePtr;
4520 result = Jim_SetVariableStr(interp, name, objPtr);
4521 interp->framePtr = savedFramePtr;
4522 return result;
4525 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4527 Jim_Obj *valObjPtr;
4528 int result;
4530 valObjPtr = Jim_NewStringObj(interp, val, -1);
4531 Jim_IncrRefCount(valObjPtr);
4532 result = Jim_SetVariableStr(interp, name, valObjPtr);
4533 Jim_DecrRefCount(interp, valObjPtr);
4534 return result;
4537 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4538 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4540 const char *varName;
4541 const char *targetName;
4542 Jim_CallFrame *framePtr;
4543 Jim_Var *varPtr;
4545 /* Check for an existing variable or link */
4546 switch (SetVariableFromAny(interp, nameObjPtr)) {
4547 case JIM_DICT_SUGAR:
4548 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4549 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4550 return JIM_ERR;
4552 case JIM_OK:
4553 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4555 if (varPtr->linkFramePtr == NULL) {
4556 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4557 return JIM_ERR;
4560 /* It exists, but is a link, so first delete the link */
4561 varPtr->linkFramePtr = NULL;
4562 break;
4565 /* Resolve the call frames for both variables */
4566 /* XXX: SetVariableFromAny() already did this! */
4567 varName = Jim_String(nameObjPtr);
4569 if (varName[0] == ':' && varName[1] == ':') {
4570 while (*++varName == ':') {
4572 /* Linking a global var does nothing */
4573 framePtr = interp->topFramePtr;
4575 else {
4576 framePtr = interp->framePtr;
4579 targetName = Jim_String(targetNameObjPtr);
4580 if (targetName[0] == ':' && targetName[1] == ':') {
4581 while (*++targetName == ':') {
4583 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4584 targetCallFrame = interp->topFramePtr;
4586 Jim_IncrRefCount(targetNameObjPtr);
4588 if (framePtr->level < targetCallFrame->level) {
4589 Jim_SetResultFormatted(interp,
4590 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4591 nameObjPtr);
4592 Jim_DecrRefCount(interp, targetNameObjPtr);
4593 return JIM_ERR;
4596 /* Check for cycles. */
4597 if (framePtr == targetCallFrame) {
4598 Jim_Obj *objPtr = targetNameObjPtr;
4600 /* Cycles are only possible with 'uplevel 0' */
4601 while (1) {
4602 if (strcmp(Jim_String(objPtr), varName) == 0) {
4603 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4604 Jim_DecrRefCount(interp, targetNameObjPtr);
4605 return JIM_ERR;
4607 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4608 break;
4609 varPtr = objPtr->internalRep.varValue.varPtr;
4610 if (varPtr->linkFramePtr != targetCallFrame)
4611 break;
4612 objPtr = varPtr->objPtr;
4616 /* Perform the binding */
4617 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4618 /* We are now sure 'nameObjPtr' type is variableObjType */
4619 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4620 Jim_DecrRefCount(interp, targetNameObjPtr);
4621 return JIM_OK;
4624 /* Return the Jim_Obj pointer associated with a variable name,
4625 * or NULL if the variable was not found in the current context.
4626 * The same optimization discussed in the comment to the
4627 * 'SetVariable' function should apply here.
4629 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4630 * in a dictionary which is shared, the array variable value is duplicated first.
4631 * This allows the array element to be updated (e.g. append, lappend) without
4632 * affecting other references to the dictionary.
4634 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4636 switch (SetVariableFromAny(interp, nameObjPtr)) {
4637 case JIM_OK:{
4638 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4640 if (varPtr->linkFramePtr == NULL) {
4641 return varPtr->objPtr;
4643 else {
4644 Jim_Obj *objPtr;
4646 /* The variable is a link? Resolve it. */
4647 Jim_CallFrame *savedCallFrame = interp->framePtr;
4649 interp->framePtr = varPtr->linkFramePtr;
4650 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4651 interp->framePtr = savedCallFrame;
4652 if (objPtr) {
4653 return objPtr;
4655 /* Error, so fall through to the error message */
4658 break;
4660 case JIM_DICT_SUGAR:
4661 /* [dict] syntax sugar. */
4662 return JimDictSugarGet(interp, nameObjPtr, flags);
4664 if (flags & JIM_ERRMSG) {
4665 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4667 return NULL;
4670 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4672 Jim_CallFrame *savedFramePtr;
4673 Jim_Obj *objPtr;
4675 savedFramePtr = interp->framePtr;
4676 interp->framePtr = interp->topFramePtr;
4677 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4678 interp->framePtr = savedFramePtr;
4680 return objPtr;
4683 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4685 Jim_Obj *nameObjPtr, *varObjPtr;
4687 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4688 Jim_IncrRefCount(nameObjPtr);
4689 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4690 Jim_DecrRefCount(interp, nameObjPtr);
4691 return varObjPtr;
4694 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4696 Jim_CallFrame *savedFramePtr;
4697 Jim_Obj *objPtr;
4699 savedFramePtr = interp->framePtr;
4700 interp->framePtr = interp->topFramePtr;
4701 objPtr = Jim_GetVariableStr(interp, name, flags);
4702 interp->framePtr = savedFramePtr;
4704 return objPtr;
4707 /* Unset a variable.
4708 * Note: On success unset invalidates all the (cached) variable objects
4709 * by incrementing callFrameEpoch
4711 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4713 Jim_Var *varPtr;
4714 int retval;
4715 Jim_CallFrame *framePtr;
4717 retval = SetVariableFromAny(interp, nameObjPtr);
4718 if (retval == JIM_DICT_SUGAR) {
4719 /* [dict] syntax sugar. */
4720 return JimDictSugarSet(interp, nameObjPtr, NULL);
4722 else if (retval == JIM_OK) {
4723 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4725 /* If it's a link call UnsetVariable recursively */
4726 if (varPtr->linkFramePtr) {
4727 framePtr = interp->framePtr;
4728 interp->framePtr = varPtr->linkFramePtr;
4729 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4730 interp->framePtr = framePtr;
4732 else {
4733 const char *name = Jim_String(nameObjPtr);
4734 if (nameObjPtr->internalRep.varValue.global) {
4735 name += 2;
4736 framePtr = interp->topFramePtr;
4738 else {
4739 framePtr = interp->framePtr;
4742 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4743 if (retval == JIM_OK) {
4744 /* Change the callframe id, invalidating var lookup caching */
4745 framePtr->id = interp->callFrameEpoch++;
4749 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4750 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4752 return retval;
4755 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4757 /* Given a variable name for [dict] operation syntax sugar,
4758 * this function returns two objects, the first with the name
4759 * of the variable to set, and the second with the respective key.
4760 * For example "foo(bar)" will return objects with string repr. of
4761 * "foo" and "bar".
4763 * The returned objects have refcount = 1. The function can't fail. */
4764 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4765 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4767 const char *str, *p;
4768 int len, keyLen;
4769 Jim_Obj *varObjPtr, *keyObjPtr;
4771 str = Jim_GetString(objPtr, &len);
4773 p = strchr(str, '(');
4774 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4776 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4778 p++;
4779 keyLen = (str + len) - p;
4780 if (str[len - 1] == ')') {
4781 keyLen--;
4784 /* Create the objects with the variable name and key. */
4785 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4787 Jim_IncrRefCount(varObjPtr);
4788 Jim_IncrRefCount(keyObjPtr);
4789 *varPtrPtr = varObjPtr;
4790 *keyPtrPtr = keyObjPtr;
4793 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4794 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4795 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4797 int err;
4799 SetDictSubstFromAny(interp, objPtr);
4801 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4802 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4804 if (err == JIM_OK) {
4805 /* Don't keep an extra ref to the result */
4806 Jim_SetEmptyResult(interp);
4808 else {
4809 if (!valObjPtr) {
4810 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4811 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4812 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4813 objPtr);
4814 return err;
4817 /* Make the error more informative and Tcl-compatible */
4818 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4819 (valObjPtr ? "set" : "unset"), objPtr);
4821 return err;
4825 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4827 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4828 * and stored back to the variable before expansion.
4830 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4831 Jim_Obj *keyObjPtr, int flags)
4833 Jim_Obj *dictObjPtr;
4834 Jim_Obj *resObjPtr = NULL;
4835 int ret;
4837 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4838 if (!dictObjPtr) {
4839 return NULL;
4842 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4843 if (ret != JIM_OK) {
4844 Jim_SetResultFormatted(interp,
4845 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4846 ret < 0 ? "variable isn't" : "no such element in");
4848 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4849 /* Update the variable to have an unshared copy */
4850 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4853 return resObjPtr;
4856 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4857 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4859 SetDictSubstFromAny(interp, objPtr);
4861 return JimDictExpandArrayVariable(interp,
4862 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4863 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4866 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4868 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4870 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4871 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4874 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4876 /* Copy the internal rep */
4877 dupPtr->internalRep = srcPtr->internalRep;
4878 /* Need to increment the ref counts */
4879 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4880 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4883 /* Note: The object *must* be in dict-sugar format */
4884 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4886 if (objPtr->typePtr != &dictSubstObjType) {
4887 Jim_Obj *varObjPtr, *keyObjPtr;
4889 if (objPtr->typePtr == &interpolatedObjType) {
4890 /* An interpolated object in dict-sugar form */
4892 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4893 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4895 Jim_IncrRefCount(varObjPtr);
4896 Jim_IncrRefCount(keyObjPtr);
4898 else {
4899 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4902 Jim_FreeIntRep(interp, objPtr);
4903 objPtr->typePtr = &dictSubstObjType;
4904 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4905 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4909 /* This function is used to expand [dict get] sugar in the form
4910 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4911 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4912 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4913 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4914 * the [dict]ionary contained in variable VARNAME. */
4915 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4917 Jim_Obj *resObjPtr = NULL;
4918 Jim_Obj *substKeyObjPtr = NULL;
4920 SetDictSubstFromAny(interp, objPtr);
4922 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4923 &substKeyObjPtr, JIM_NONE)
4924 != JIM_OK) {
4925 return NULL;
4927 Jim_IncrRefCount(substKeyObjPtr);
4928 resObjPtr =
4929 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4930 substKeyObjPtr, 0);
4931 Jim_DecrRefCount(interp, substKeyObjPtr);
4933 return resObjPtr;
4936 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4938 if (Jim_EvalExpression(interp, objPtr) == JIM_OK) {
4939 return Jim_GetResult(interp);
4941 return NULL;
4944 /* -----------------------------------------------------------------------------
4945 * CallFrame
4946 * ---------------------------------------------------------------------------*/
4948 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4950 Jim_CallFrame *cf;
4952 if (interp->freeFramesList) {
4953 cf = interp->freeFramesList;
4954 interp->freeFramesList = cf->next;
4956 cf->argv = NULL;
4957 cf->argc = 0;
4958 cf->procArgsObjPtr = NULL;
4959 cf->procBodyObjPtr = NULL;
4960 cf->next = NULL;
4961 cf->staticVars = NULL;
4962 cf->localCommands = NULL;
4963 cf->tailcallObj = NULL;
4964 cf->tailcallCmd = NULL;
4966 else {
4967 cf = Jim_Alloc(sizeof(*cf));
4968 memset(cf, 0, sizeof(*cf));
4970 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4973 cf->id = interp->callFrameEpoch++;
4974 cf->parent = parent;
4975 cf->level = parent ? parent->level + 1 : 0;
4976 cf->nsObj = nsObj;
4977 Jim_IncrRefCount(nsObj);
4979 return cf;
4982 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4984 /* Delete any local procs */
4985 if (localCommands) {
4986 Jim_Obj *cmdNameObj;
4988 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4989 Jim_HashEntry *he;
4990 Jim_Obj *fqObjName;
4991 Jim_HashTable *ht = &interp->commands;
4993 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4995 he = Jim_FindHashEntry(ht, fqname);
4997 if (he) {
4998 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4999 if (cmd->prevCmd) {
5000 Jim_Cmd *prevCmd = cmd->prevCmd;
5001 cmd->prevCmd = NULL;
5003 /* Delete the old command */
5004 JimDecrCmdRefCount(interp, cmd);
5006 /* And restore the original */
5007 Jim_SetHashVal(ht, he, prevCmd);
5009 else {
5010 Jim_DeleteHashEntry(ht, fqname);
5012 Jim_InterpIncrProcEpoch(interp);
5014 Jim_DecrRefCount(interp, cmdNameObj);
5015 JimFreeQualifiedName(interp, fqObjName);
5017 Jim_FreeStack(localCommands);
5018 Jim_Free(localCommands);
5020 return JIM_OK;
5024 * Run any $jim::defer scripts for the current call frame.
5026 * retcode is the return code from the current proc.
5028 * Returns the new return code.
5030 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
5032 Jim_Obj *objPtr;
5034 /* Fast check for the likely case that the variable doesn't exist */
5035 if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
5036 return retcode;
5039 objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
5041 if (objPtr) {
5042 int ret = JIM_OK;
5043 int i;
5044 int listLen = Jim_ListLength(interp, objPtr);
5045 Jim_Obj *resultObjPtr;
5047 Jim_IncrRefCount(objPtr);
5049 /* Need to save away the current interp result and
5050 * restore it if appropriate
5052 resultObjPtr = Jim_GetResult(interp);
5053 Jim_IncrRefCount(resultObjPtr);
5054 Jim_SetEmptyResult(interp);
5056 /* Invoke in reverse order */
5057 for (i = listLen; i > 0; i--) {
5058 /* If a defer script returns an error, don't evaluate remaining scripts */
5059 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5060 ret = Jim_EvalObj(interp, scriptObjPtr);
5061 if (ret != JIM_OK) {
5062 break;
5066 if (ret == JIM_OK || retcode == JIM_ERR) {
5067 /* defer script had no error, or proc had an error so restore proc result */
5068 Jim_SetResult(interp, resultObjPtr);
5070 else {
5071 retcode = ret;
5074 Jim_DecrRefCount(interp, resultObjPtr);
5075 Jim_DecrRefCount(interp, objPtr);
5077 return retcode;
5080 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5081 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5082 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5084 JimDeleteLocalProcs(interp, cf->localCommands);
5086 if (cf->procArgsObjPtr)
5087 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5088 if (cf->procBodyObjPtr)
5089 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5090 Jim_DecrRefCount(interp, cf->nsObj);
5091 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5092 Jim_FreeHashTable(&cf->vars);
5093 else {
5094 int i;
5095 Jim_HashEntry **table = cf->vars.table, *he;
5097 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5098 he = table[i];
5099 while (he != NULL) {
5100 Jim_HashEntry *nextEntry = he->next;
5101 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5103 Jim_DecrRefCount(interp, varPtr->objPtr);
5104 Jim_Free(Jim_GetHashEntryKey(he));
5105 Jim_Free(varPtr);
5106 Jim_Free(he);
5107 table[i] = NULL;
5108 he = nextEntry;
5111 cf->vars.used = 0;
5113 cf->next = interp->freeFramesList;
5114 interp->freeFramesList = cf;
5118 /* -----------------------------------------------------------------------------
5119 * References
5120 * ---------------------------------------------------------------------------*/
5121 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5123 /* References HashTable Type.
5125 * Keys are unsigned long integers, dynamically allocated for now but in the
5126 * future it's worth to cache this 4 bytes objects. Values are pointers
5127 * to Jim_References. */
5128 static void JimReferencesHTValDestructor(void *interp, void *val)
5130 Jim_Reference *refPtr = (void *)val;
5132 Jim_DecrRefCount(interp, refPtr->objPtr);
5133 if (refPtr->finalizerCmdNamePtr != NULL) {
5134 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5136 Jim_Free(val);
5139 static unsigned int JimReferencesHTHashFunction(const void *key)
5141 /* Only the least significant bits are used. */
5142 const unsigned long *widePtr = key;
5143 unsigned int intValue = (unsigned int)*widePtr;
5145 return Jim_IntHashFunction(intValue);
5148 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5150 void *copy = Jim_Alloc(sizeof(unsigned long));
5152 JIM_NOTUSED(privdata);
5154 memcpy(copy, key, sizeof(unsigned long));
5155 return copy;
5158 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5160 JIM_NOTUSED(privdata);
5162 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5165 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5167 JIM_NOTUSED(privdata);
5169 Jim_Free(key);
5172 static const Jim_HashTableType JimReferencesHashTableType = {
5173 JimReferencesHTHashFunction, /* hash function */
5174 JimReferencesHTKeyDup, /* key dup */
5175 NULL, /* val dup */
5176 JimReferencesHTKeyCompare, /* key compare */
5177 JimReferencesHTKeyDestructor, /* key destructor */
5178 JimReferencesHTValDestructor /* val destructor */
5181 /* -----------------------------------------------------------------------------
5182 * Reference object type and References API
5183 * ---------------------------------------------------------------------------*/
5185 /* The string representation of references has two features in order
5186 * to make the GC faster. The first is that every reference starts
5187 * with a non common character '<', in order to make the string matching
5188 * faster. The second is that the reference string rep is 42 characters
5189 * in length, this means that it is not necessary to check any object with a string
5190 * repr < 42, and usually there aren't many of these objects. */
5192 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5194 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5196 const char *fmt = "<reference.<%s>.%020lu>";
5198 sprintf(buf, fmt, refPtr->tag, id);
5199 return JIM_REFERENCE_SPACE;
5202 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5204 static const Jim_ObjType referenceObjType = {
5205 "reference",
5206 NULL,
5207 NULL,
5208 UpdateStringOfReference,
5209 JIM_TYPE_REFERENCES,
5212 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5214 char buf[JIM_REFERENCE_SPACE + 1];
5216 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5217 JimSetStringBytes(objPtr, buf);
5220 /* returns true if 'c' is a valid reference tag character.
5221 * i.e. inside the range [_a-zA-Z0-9] */
5222 static int isrefchar(int c)
5224 return (c == '_' || isalnum(c));
5227 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5229 unsigned long value;
5230 int i, len;
5231 const char *str, *start, *end;
5232 char refId[21];
5233 Jim_Reference *refPtr;
5234 Jim_HashEntry *he;
5235 char *endptr;
5237 /* Get the string representation */
5238 str = Jim_GetString(objPtr, &len);
5239 /* Check if it looks like a reference */
5240 if (len < JIM_REFERENCE_SPACE)
5241 goto badformat;
5242 /* Trim spaces */
5243 start = str;
5244 end = str + len - 1;
5245 while (*start == ' ')
5246 start++;
5247 while (*end == ' ' && end > start)
5248 end--;
5249 if (end - start + 1 != JIM_REFERENCE_SPACE)
5250 goto badformat;
5251 /* <reference.<1234567>.%020> */
5252 if (memcmp(start, "<reference.<", 12) != 0)
5253 goto badformat;
5254 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5255 goto badformat;
5256 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5257 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5258 if (!isrefchar(start[12 + i]))
5259 goto badformat;
5261 /* Extract info from the reference. */
5262 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5263 refId[20] = '\0';
5264 /* Try to convert the ID into an unsigned long */
5265 value = strtoul(refId, &endptr, 10);
5266 if (JimCheckConversion(refId, endptr) != JIM_OK)
5267 goto badformat;
5268 /* Check if the reference really exists! */
5269 he = Jim_FindHashEntry(&interp->references, &value);
5270 if (he == NULL) {
5271 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5272 return JIM_ERR;
5274 refPtr = Jim_GetHashEntryVal(he);
5275 /* Free the old internal repr and set the new one. */
5276 Jim_FreeIntRep(interp, objPtr);
5277 objPtr->typePtr = &referenceObjType;
5278 objPtr->internalRep.refValue.id = value;
5279 objPtr->internalRep.refValue.refPtr = refPtr;
5280 return JIM_OK;
5282 badformat:
5283 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5284 return JIM_ERR;
5287 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5288 * as finalizer command (or NULL if there is no finalizer).
5289 * The returned reference object has refcount = 0. */
5290 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5292 struct Jim_Reference *refPtr;
5293 unsigned long id;
5294 Jim_Obj *refObjPtr;
5295 const char *tag;
5296 int tagLen, i;
5298 /* Perform the Garbage Collection if needed. */
5299 Jim_CollectIfNeeded(interp);
5301 refPtr = Jim_Alloc(sizeof(*refPtr));
5302 refPtr->objPtr = objPtr;
5303 Jim_IncrRefCount(objPtr);
5304 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5305 if (cmdNamePtr)
5306 Jim_IncrRefCount(cmdNamePtr);
5307 id = interp->referenceNextId++;
5308 Jim_AddHashEntry(&interp->references, &id, refPtr);
5309 refObjPtr = Jim_NewObj(interp);
5310 refObjPtr->typePtr = &referenceObjType;
5311 refObjPtr->bytes = NULL;
5312 refObjPtr->internalRep.refValue.id = id;
5313 refObjPtr->internalRep.refValue.refPtr = refPtr;
5314 interp->referenceNextId++;
5315 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5316 * that does not pass the 'isrefchar' test is replaced with '_' */
5317 tag = Jim_GetString(tagPtr, &tagLen);
5318 if (tagLen > JIM_REFERENCE_TAGLEN)
5319 tagLen = JIM_REFERENCE_TAGLEN;
5320 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5321 if (i < tagLen && isrefchar(tag[i]))
5322 refPtr->tag[i] = tag[i];
5323 else
5324 refPtr->tag[i] = '_';
5326 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5327 return refObjPtr;
5330 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5332 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5333 return NULL;
5334 return objPtr->internalRep.refValue.refPtr;
5337 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5339 Jim_Reference *refPtr;
5341 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5342 return JIM_ERR;
5343 Jim_IncrRefCount(cmdNamePtr);
5344 if (refPtr->finalizerCmdNamePtr)
5345 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5346 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5347 return JIM_OK;
5350 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5352 Jim_Reference *refPtr;
5354 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5355 return JIM_ERR;
5356 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5357 return JIM_OK;
5360 /* -----------------------------------------------------------------------------
5361 * References Garbage Collection
5362 * ---------------------------------------------------------------------------*/
5364 /* This the hash table type for the "MARK" phase of the GC */
5365 static const Jim_HashTableType JimRefMarkHashTableType = {
5366 JimReferencesHTHashFunction, /* hash function */
5367 JimReferencesHTKeyDup, /* key dup */
5368 NULL, /* val dup */
5369 JimReferencesHTKeyCompare, /* key compare */
5370 JimReferencesHTKeyDestructor, /* key destructor */
5371 NULL /* val destructor */
5374 /* Performs the garbage collection. */
5375 int Jim_Collect(Jim_Interp *interp)
5377 int collected = 0;
5378 Jim_HashTable marks;
5379 Jim_HashTableIterator htiter;
5380 Jim_HashEntry *he;
5381 Jim_Obj *objPtr;
5383 /* Avoid recursive calls */
5384 if (interp->lastCollectId == (unsigned long)~0) {
5385 /* Jim_Collect() already running. Return just now. */
5386 return 0;
5388 interp->lastCollectId = ~0;
5390 /* Mark all the references found into the 'mark' hash table.
5391 * The references are searched in every live object that
5392 * is of a type that can contain references. */
5393 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5394 objPtr = interp->liveList;
5395 while (objPtr) {
5396 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5397 const char *str, *p;
5398 int len;
5400 /* If the object is of type reference, to get the
5401 * Id is simple... */
5402 if (objPtr->typePtr == &referenceObjType) {
5403 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5404 #ifdef JIM_DEBUG_GC
5405 printf("MARK (reference): %d refcount: %d\n",
5406 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5407 #endif
5408 objPtr = objPtr->nextObjPtr;
5409 continue;
5411 /* Get the string repr of the object we want
5412 * to scan for references. */
5413 p = str = Jim_GetString(objPtr, &len);
5414 /* Skip objects too little to contain references. */
5415 if (len < JIM_REFERENCE_SPACE) {
5416 objPtr = objPtr->nextObjPtr;
5417 continue;
5419 /* Extract references from the object string repr. */
5420 while (1) {
5421 int i;
5422 unsigned long id;
5424 if ((p = strstr(p, "<reference.<")) == NULL)
5425 break;
5426 /* Check if it's a valid reference. */
5427 if (len - (p - str) < JIM_REFERENCE_SPACE)
5428 break;
5429 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5430 break;
5431 for (i = 21; i <= 40; i++)
5432 if (!isdigit(UCHAR(p[i])))
5433 break;
5434 /* Get the ID */
5435 id = strtoul(p + 21, NULL, 10);
5437 /* Ok, a reference for the given ID
5438 * was found. Mark it. */
5439 Jim_AddHashEntry(&marks, &id, NULL);
5440 #ifdef JIM_DEBUG_GC
5441 printf("MARK: %d\n", (int)id);
5442 #endif
5443 p += JIM_REFERENCE_SPACE;
5446 objPtr = objPtr->nextObjPtr;
5449 /* Run the references hash table to destroy every reference that
5450 * is not referenced outside (not present in the mark HT). */
5451 JimInitHashTableIterator(&interp->references, &htiter);
5452 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5453 const unsigned long *refId;
5454 Jim_Reference *refPtr;
5456 refId = he->key;
5457 /* Check if in the mark phase we encountered
5458 * this reference. */
5459 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5460 #ifdef JIM_DEBUG_GC
5461 printf("COLLECTING %d\n", (int)*refId);
5462 #endif
5463 collected++;
5464 /* Drop the reference, but call the
5465 * finalizer first if registered. */
5466 refPtr = Jim_GetHashEntryVal(he);
5467 if (refPtr->finalizerCmdNamePtr) {
5468 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5469 Jim_Obj *objv[3], *oldResult;
5471 JimFormatReference(refstr, refPtr, *refId);
5473 objv[0] = refPtr->finalizerCmdNamePtr;
5474 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5475 objv[2] = refPtr->objPtr;
5477 /* Drop the reference itself */
5478 /* Avoid the finaliser being freed here */
5479 Jim_IncrRefCount(objv[0]);
5480 /* Don't remove the reference from the hash table just yet
5481 * since that will free refPtr, and hence refPtr->objPtr
5484 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5485 oldResult = interp->result;
5486 Jim_IncrRefCount(oldResult);
5487 Jim_EvalObjVector(interp, 3, objv);
5488 Jim_SetResult(interp, oldResult);
5489 Jim_DecrRefCount(interp, oldResult);
5491 Jim_DecrRefCount(interp, objv[0]);
5493 Jim_DeleteHashEntry(&interp->references, refId);
5496 Jim_FreeHashTable(&marks);
5497 interp->lastCollectId = interp->referenceNextId;
5498 interp->lastCollectTime = time(NULL);
5499 return collected;
5502 #define JIM_COLLECT_ID_PERIOD 5000
5503 #define JIM_COLLECT_TIME_PERIOD 300
5505 void Jim_CollectIfNeeded(Jim_Interp *interp)
5507 unsigned long elapsedId;
5508 int elapsedTime;
5510 elapsedId = interp->referenceNextId - interp->lastCollectId;
5511 elapsedTime = time(NULL) - interp->lastCollectTime;
5514 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5515 Jim_Collect(interp);
5518 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5520 int Jim_IsBigEndian(void)
5522 union {
5523 unsigned short s;
5524 unsigned char c[2];
5525 } uval = {0x0102};
5527 return uval.c[0] == 1;
5530 /* -----------------------------------------------------------------------------
5531 * Interpreter related functions
5532 * ---------------------------------------------------------------------------*/
5534 Jim_Interp *Jim_CreateInterp(void)
5536 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5538 memset(i, 0, sizeof(*i));
5540 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5541 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5542 i->lastCollectTime = time(NULL);
5544 /* Note that we can create objects only after the
5545 * interpreter liveList and freeList pointers are
5546 * initialized to NULL. */
5547 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5548 #ifdef JIM_REFERENCES
5549 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5550 #endif
5551 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5552 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5553 i->emptyObj = Jim_NewEmptyStringObj(i);
5554 i->trueObj = Jim_NewIntObj(i, 1);
5555 i->falseObj = Jim_NewIntObj(i, 0);
5556 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5557 i->errorFileNameObj = i->emptyObj;
5558 i->result = i->emptyObj;
5559 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5560 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5561 i->errorProc = i->emptyObj;
5562 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5563 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5564 Jim_IncrRefCount(i->emptyObj);
5565 Jim_IncrRefCount(i->errorFileNameObj);
5566 Jim_IncrRefCount(i->result);
5567 Jim_IncrRefCount(i->stackTrace);
5568 Jim_IncrRefCount(i->unknown);
5569 Jim_IncrRefCount(i->currentScriptObj);
5570 Jim_IncrRefCount(i->nullScriptObj);
5571 Jim_IncrRefCount(i->errorProc);
5572 Jim_IncrRefCount(i->trueObj);
5573 Jim_IncrRefCount(i->falseObj);
5575 /* Initialize key variables every interpreter should contain */
5576 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5577 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5579 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5580 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5581 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5582 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5583 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5584 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5585 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5586 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5588 return i;
5591 void Jim_FreeInterp(Jim_Interp *i)
5593 Jim_CallFrame *cf, *cfx;
5595 Jim_Obj *objPtr, *nextObjPtr;
5597 /* Free the active call frames list - must be done before i->commands is destroyed */
5598 for (cf = i->framePtr; cf; cf = cfx) {
5599 /* Note that we ignore any errors */
5600 JimInvokeDefer(i, JIM_OK);
5601 cfx = cf->parent;
5602 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5605 Jim_DecrRefCount(i, i->emptyObj);
5606 Jim_DecrRefCount(i, i->trueObj);
5607 Jim_DecrRefCount(i, i->falseObj);
5608 Jim_DecrRefCount(i, i->result);
5609 Jim_DecrRefCount(i, i->stackTrace);
5610 Jim_DecrRefCount(i, i->errorProc);
5611 Jim_DecrRefCount(i, i->unknown);
5612 Jim_DecrRefCount(i, i->errorFileNameObj);
5613 Jim_DecrRefCount(i, i->currentScriptObj);
5614 Jim_DecrRefCount(i, i->nullScriptObj);
5615 Jim_FreeHashTable(&i->commands);
5616 #ifdef JIM_REFERENCES
5617 Jim_FreeHashTable(&i->references);
5618 #endif
5619 Jim_FreeHashTable(&i->packages);
5620 Jim_Free(i->prngState);
5621 Jim_FreeHashTable(&i->assocData);
5623 /* Check that the live object list is empty, otherwise
5624 * there is a memory leak. */
5625 #ifdef JIM_MAINTAINER
5626 if (i->liveList != NULL) {
5627 objPtr = i->liveList;
5629 printf("\n-------------------------------------\n");
5630 printf("Objects still in the free list:\n");
5631 while (objPtr) {
5632 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5633 Jim_String(objPtr);
5635 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5636 printf("%p (%d) %-10s: '%.20s...'\n",
5637 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5639 else {
5640 printf("%p (%d) %-10s: '%s'\n",
5641 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5643 if (objPtr->typePtr == &sourceObjType) {
5644 printf("FILE %s LINE %d\n",
5645 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5646 objPtr->internalRep.sourceValue.lineNumber);
5648 objPtr = objPtr->nextObjPtr;
5650 printf("-------------------------------------\n\n");
5651 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5653 #endif
5655 /* Free all the freed objects. */
5656 objPtr = i->freeList;
5657 while (objPtr) {
5658 nextObjPtr = objPtr->nextObjPtr;
5659 Jim_Free(objPtr);
5660 objPtr = nextObjPtr;
5663 /* Free the free call frames list */
5664 for (cf = i->freeFramesList; cf; cf = cfx) {
5665 cfx = cf->next;
5666 if (cf->vars.table)
5667 Jim_FreeHashTable(&cf->vars);
5668 Jim_Free(cf);
5671 /* Free the interpreter structure. */
5672 Jim_Free(i);
5675 /* Returns the call frame relative to the level represented by
5676 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5678 * This function accepts the 'level' argument in the form
5679 * of the commands [uplevel] and [upvar].
5681 * Returns NULL on error.
5683 * Note: for a function accepting a relative integer as level suitable
5684 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5686 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5688 long level;
5689 const char *str;
5690 Jim_CallFrame *framePtr;
5692 if (levelObjPtr) {
5693 str = Jim_String(levelObjPtr);
5694 if (str[0] == '#') {
5695 char *endptr;
5697 level = jim_strtol(str + 1, &endptr);
5698 if (str[1] == '\0' || endptr[0] != '\0') {
5699 level = -1;
5702 else {
5703 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5704 level = -1;
5706 else {
5707 /* Convert from a relative to an absolute level */
5708 level = interp->framePtr->level - level;
5712 else {
5713 str = "1"; /* Needed to format the error message. */
5714 level = interp->framePtr->level - 1;
5717 if (level == 0) {
5718 return interp->topFramePtr;
5720 if (level > 0) {
5721 /* Lookup */
5722 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5723 if (framePtr->level == level) {
5724 return framePtr;
5729 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5730 return NULL;
5733 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5734 * as a relative integer like in the [info level ?level?] command.
5736 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5738 long level;
5739 Jim_CallFrame *framePtr;
5741 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5742 if (level <= 0) {
5743 /* Convert from a relative to an absolute level */
5744 level = interp->framePtr->level + level;
5747 if (level == 0) {
5748 return interp->topFramePtr;
5751 /* Lookup */
5752 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5753 if (framePtr->level == level) {
5754 return framePtr;
5759 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5760 return NULL;
5763 static void JimResetStackTrace(Jim_Interp *interp)
5765 Jim_DecrRefCount(interp, interp->stackTrace);
5766 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5767 Jim_IncrRefCount(interp->stackTrace);
5770 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5772 int len;
5774 /* Increment reference first in case these are the same object */
5775 Jim_IncrRefCount(stackTraceObj);
5776 Jim_DecrRefCount(interp, interp->stackTrace);
5777 interp->stackTrace = stackTraceObj;
5778 interp->errorFlag = 1;
5780 /* This is a bit ugly.
5781 * If the filename of the last entry of the stack trace is empty,
5782 * the next stack level should be added.
5784 len = Jim_ListLength(interp, interp->stackTrace);
5785 if (len >= 3) {
5786 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5787 interp->addStackTrace = 1;
5792 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5793 Jim_Obj *fileNameObj, int linenr)
5795 if (strcmp(procname, "unknown") == 0) {
5796 procname = "";
5798 if (!*procname && !Jim_Length(fileNameObj)) {
5799 /* No useful info here */
5800 return;
5803 if (Jim_IsShared(interp->stackTrace)) {
5804 Jim_DecrRefCount(interp, interp->stackTrace);
5805 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5806 Jim_IncrRefCount(interp->stackTrace);
5809 /* If we have no procname but the previous element did, merge with that frame */
5810 if (!*procname && Jim_Length(fileNameObj)) {
5811 /* Just a filename. Check the previous entry */
5812 int len = Jim_ListLength(interp, interp->stackTrace);
5814 if (len >= 3) {
5815 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5816 if (Jim_Length(objPtr)) {
5817 /* Yes, the previous level had procname */
5818 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5819 if (Jim_Length(objPtr) == 0) {
5820 /* But no filename, so merge the new info with that frame */
5821 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5822 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5823 return;
5829 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5830 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5831 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5834 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5835 void *data)
5837 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5839 assocEntryPtr->delProc = delProc;
5840 assocEntryPtr->data = data;
5841 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5844 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5846 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5848 if (entryPtr != NULL) {
5849 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5850 return assocEntryPtr->data;
5852 return NULL;
5855 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5857 return Jim_DeleteHashEntry(&interp->assocData, key);
5860 int Jim_GetExitCode(Jim_Interp *interp)
5862 return interp->exitCode;
5865 /* -----------------------------------------------------------------------------
5866 * Integer object
5867 * ---------------------------------------------------------------------------*/
5868 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5869 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5871 static const Jim_ObjType intObjType = {
5872 "int",
5873 NULL,
5874 NULL,
5875 UpdateStringOfInt,
5876 JIM_TYPE_NONE,
5879 /* A coerced double is closer to an int than a double.
5880 * It is an int value temporarily masquerading as a double value.
5881 * i.e. it has the same string value as an int and Jim_GetWide()
5882 * succeeds, but also Jim_GetDouble() returns the value directly.
5884 static const Jim_ObjType coercedDoubleObjType = {
5885 "coerced-double",
5886 NULL,
5887 NULL,
5888 UpdateStringOfInt,
5889 JIM_TYPE_NONE,
5893 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5895 char buf[JIM_INTEGER_SPACE + 1];
5896 jim_wide wideValue = JimWideValue(objPtr);
5897 int pos = 0;
5899 if (wideValue == 0) {
5900 buf[pos++] = '0';
5902 else {
5903 char tmp[JIM_INTEGER_SPACE];
5904 int num = 0;
5905 int i;
5907 if (wideValue < 0) {
5908 buf[pos++] = '-';
5909 i = wideValue % 10;
5910 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5911 * whereas C99 is always -6
5912 * coverity[dead_error_line]
5914 tmp[num++] = (i > 0) ? (10 - i) : -i;
5915 wideValue /= -10;
5918 while (wideValue) {
5919 tmp[num++] = wideValue % 10;
5920 wideValue /= 10;
5923 for (i = 0; i < num; i++) {
5924 buf[pos++] = '0' + tmp[num - i - 1];
5927 buf[pos] = 0;
5929 JimSetStringBytes(objPtr, buf);
5932 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5934 jim_wide wideValue;
5935 const char *str;
5937 if (objPtr->typePtr == &coercedDoubleObjType) {
5938 /* Simple switch */
5939 objPtr->typePtr = &intObjType;
5940 return JIM_OK;
5943 /* Get the string representation */
5944 str = Jim_String(objPtr);
5945 /* Try to convert into a jim_wide */
5946 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5947 if (flags & JIM_ERRMSG) {
5948 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5950 return JIM_ERR;
5952 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5953 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5954 return JIM_ERR;
5956 /* Free the old internal repr and set the new one. */
5957 Jim_FreeIntRep(interp, objPtr);
5958 objPtr->typePtr = &intObjType;
5959 objPtr->internalRep.wideValue = wideValue;
5960 return JIM_OK;
5963 #ifdef JIM_OPTIMIZATION
5964 static int JimIsWide(Jim_Obj *objPtr)
5966 return objPtr->typePtr == &intObjType;
5968 #endif
5970 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5972 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5973 return JIM_ERR;
5974 *widePtr = JimWideValue(objPtr);
5975 return JIM_OK;
5978 /* Get a wide but does not set an error if the format is bad. */
5979 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5981 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5982 return JIM_ERR;
5983 *widePtr = JimWideValue(objPtr);
5984 return JIM_OK;
5987 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5989 jim_wide wideValue;
5990 int retval;
5992 retval = Jim_GetWide(interp, objPtr, &wideValue);
5993 if (retval == JIM_OK) {
5994 *longPtr = (long)wideValue;
5995 return JIM_OK;
5997 return JIM_ERR;
6000 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
6002 Jim_Obj *objPtr;
6004 objPtr = Jim_NewObj(interp);
6005 objPtr->typePtr = &intObjType;
6006 objPtr->bytes = NULL;
6007 objPtr->internalRep.wideValue = wideValue;
6008 return objPtr;
6011 /* -----------------------------------------------------------------------------
6012 * Double object
6013 * ---------------------------------------------------------------------------*/
6014 #define JIM_DOUBLE_SPACE 30
6016 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
6017 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6019 static const Jim_ObjType doubleObjType = {
6020 "double",
6021 NULL,
6022 NULL,
6023 UpdateStringOfDouble,
6024 JIM_TYPE_NONE,
6027 #ifndef HAVE_ISNAN
6028 #undef isnan
6029 #define isnan(X) ((X) != (X))
6030 #endif
6031 #ifndef HAVE_ISINF
6032 #undef isinf
6033 #define isinf(X) (1.0 / (X) == 0.0)
6034 #endif
6036 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
6038 double value = objPtr->internalRep.doubleValue;
6040 if (isnan(value)) {
6041 JimSetStringBytes(objPtr, "NaN");
6042 return;
6044 if (isinf(value)) {
6045 if (value < 0) {
6046 JimSetStringBytes(objPtr, "-Inf");
6048 else {
6049 JimSetStringBytes(objPtr, "Inf");
6051 return;
6054 char buf[JIM_DOUBLE_SPACE + 1];
6055 int i;
6056 int len = sprintf(buf, "%.12g", value);
6058 /* Add a final ".0" if necessary */
6059 for (i = 0; i < len; i++) {
6060 if (buf[i] == '.' || buf[i] == 'e') {
6061 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6062 /* If 'buf' ends in e-0nn or e+0nn, remove
6063 * the 0 after the + or - and reduce the length by 1
6065 char *e = strchr(buf, 'e');
6066 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6067 /* Move it up */
6068 e += 2;
6069 memmove(e, e + 1, len - (e - buf));
6071 #endif
6072 break;
6075 if (buf[i] == '\0') {
6076 buf[i++] = '.';
6077 buf[i++] = '0';
6078 buf[i] = '\0';
6080 JimSetStringBytes(objPtr, buf);
6084 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6086 double doubleValue;
6087 jim_wide wideValue;
6088 const char *str;
6090 #ifdef HAVE_LONG_LONG
6091 /* Assume a 53 bit mantissa */
6092 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6093 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6095 if (objPtr->typePtr == &intObjType
6096 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6097 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6099 /* Direct conversion to coerced double */
6100 objPtr->typePtr = &coercedDoubleObjType;
6101 return JIM_OK;
6103 #endif
6104 /* Preserve the string representation.
6105 * Needed so we can convert back to int without loss
6107 str = Jim_String(objPtr);
6109 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6110 /* Managed to convert to an int, so we can use this as a cooerced double */
6111 Jim_FreeIntRep(interp, objPtr);
6112 objPtr->typePtr = &coercedDoubleObjType;
6113 objPtr->internalRep.wideValue = wideValue;
6114 return JIM_OK;
6116 else {
6117 /* Try to convert into a double */
6118 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6119 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6120 return JIM_ERR;
6122 /* Free the old internal repr and set the new one. */
6123 Jim_FreeIntRep(interp, objPtr);
6125 objPtr->typePtr = &doubleObjType;
6126 objPtr->internalRep.doubleValue = doubleValue;
6127 return JIM_OK;
6130 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6132 if (objPtr->typePtr == &coercedDoubleObjType) {
6133 *doublePtr = JimWideValue(objPtr);
6134 return JIM_OK;
6136 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6137 return JIM_ERR;
6139 if (objPtr->typePtr == &coercedDoubleObjType) {
6140 *doublePtr = JimWideValue(objPtr);
6142 else {
6143 *doublePtr = objPtr->internalRep.doubleValue;
6145 return JIM_OK;
6148 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6150 Jim_Obj *objPtr;
6152 objPtr = Jim_NewObj(interp);
6153 objPtr->typePtr = &doubleObjType;
6154 objPtr->bytes = NULL;
6155 objPtr->internalRep.doubleValue = doubleValue;
6156 return objPtr;
6159 /* -----------------------------------------------------------------------------
6160 * Boolean conversion
6161 * ---------------------------------------------------------------------------*/
6162 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6164 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6166 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6167 return JIM_ERR;
6168 *booleanPtr = (int) JimWideValue(objPtr);
6169 return JIM_OK;
6172 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6174 static const char * const falses[] = {
6175 "0", "false", "no", "off", NULL
6177 static const char * const trues[] = {
6178 "1", "true", "yes", "on", NULL
6181 int boolean;
6183 int index;
6184 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6185 boolean = 0;
6186 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6187 boolean = 1;
6188 } else {
6189 if (flags & JIM_ERRMSG) {
6190 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6192 return JIM_ERR;
6195 /* Free the old internal repr and set the new one. */
6196 Jim_FreeIntRep(interp, objPtr);
6197 objPtr->typePtr = &intObjType;
6198 objPtr->internalRep.wideValue = boolean;
6199 return JIM_OK;
6202 /* -----------------------------------------------------------------------------
6203 * List object
6204 * ---------------------------------------------------------------------------*/
6205 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6206 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6207 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6208 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6209 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6210 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6212 /* Note that while the elements of the list may contain references,
6213 * the list object itself can't. This basically means that the
6214 * list object string representation as a whole can't contain references
6215 * that are not presents in the single elements. */
6216 static const Jim_ObjType listObjType = {
6217 "list",
6218 FreeListInternalRep,
6219 DupListInternalRep,
6220 UpdateStringOfList,
6221 JIM_TYPE_NONE,
6224 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6226 int i;
6228 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6229 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6231 Jim_Free(objPtr->internalRep.listValue.ele);
6234 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6236 int i;
6238 JIM_NOTUSED(interp);
6240 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6241 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6242 dupPtr->internalRep.listValue.ele =
6243 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6244 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6245 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6246 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6247 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6249 dupPtr->typePtr = &listObjType;
6252 /* The following function checks if a given string can be encoded
6253 * into a list element without any kind of quoting, surrounded by braces,
6254 * or using escapes to quote. */
6255 #define JIM_ELESTR_SIMPLE 0
6256 #define JIM_ELESTR_BRACE 1
6257 #define JIM_ELESTR_QUOTE 2
6258 static unsigned char ListElementQuotingType(const char *s, int len)
6260 int i, level, blevel, trySimple = 1;
6262 /* Try with the SIMPLE case */
6263 if (len == 0)
6264 return JIM_ELESTR_BRACE;
6265 if (s[0] == '"' || s[0] == '{') {
6266 trySimple = 0;
6267 goto testbrace;
6269 for (i = 0; i < len; i++) {
6270 switch (s[i]) {
6271 case ' ':
6272 case '$':
6273 case '"':
6274 case '[':
6275 case ']':
6276 case ';':
6277 case '\\':
6278 case '\r':
6279 case '\n':
6280 case '\t':
6281 case '\f':
6282 case '\v':
6283 trySimple = 0;
6284 /* fall through */
6285 case '{':
6286 case '}':
6287 goto testbrace;
6290 return JIM_ELESTR_SIMPLE;
6292 testbrace:
6293 /* Test if it's possible to do with braces */
6294 if (s[len - 1] == '\\')
6295 return JIM_ELESTR_QUOTE;
6296 level = 0;
6297 blevel = 0;
6298 for (i = 0; i < len; i++) {
6299 switch (s[i]) {
6300 case '{':
6301 level++;
6302 break;
6303 case '}':
6304 level--;
6305 if (level < 0)
6306 return JIM_ELESTR_QUOTE;
6307 break;
6308 case '[':
6309 blevel++;
6310 break;
6311 case ']':
6312 blevel--;
6313 break;
6314 case '\\':
6315 if (s[i + 1] == '\n')
6316 return JIM_ELESTR_QUOTE;
6317 else if (s[i + 1] != '\0')
6318 i++;
6319 break;
6322 if (blevel < 0) {
6323 return JIM_ELESTR_QUOTE;
6326 if (level == 0) {
6327 if (!trySimple)
6328 return JIM_ELESTR_BRACE;
6329 for (i = 0; i < len; i++) {
6330 switch (s[i]) {
6331 case ' ':
6332 case '$':
6333 case '"':
6334 case '[':
6335 case ']':
6336 case ';':
6337 case '\\':
6338 case '\r':
6339 case '\n':
6340 case '\t':
6341 case '\f':
6342 case '\v':
6343 return JIM_ELESTR_BRACE;
6344 break;
6347 return JIM_ELESTR_SIMPLE;
6349 return JIM_ELESTR_QUOTE;
6352 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6353 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6354 * scenario.
6355 * Returns the length of the result.
6357 static int BackslashQuoteString(const char *s, int len, char *q)
6359 char *p = q;
6361 while (len--) {
6362 switch (*s) {
6363 case ' ':
6364 case '$':
6365 case '"':
6366 case '[':
6367 case ']':
6368 case '{':
6369 case '}':
6370 case ';':
6371 case '\\':
6372 *p++ = '\\';
6373 *p++ = *s++;
6374 break;
6375 case '\n':
6376 *p++ = '\\';
6377 *p++ = 'n';
6378 s++;
6379 break;
6380 case '\r':
6381 *p++ = '\\';
6382 *p++ = 'r';
6383 s++;
6384 break;
6385 case '\t':
6386 *p++ = '\\';
6387 *p++ = 't';
6388 s++;
6389 break;
6390 case '\f':
6391 *p++ = '\\';
6392 *p++ = 'f';
6393 s++;
6394 break;
6395 case '\v':
6396 *p++ = '\\';
6397 *p++ = 'v';
6398 s++;
6399 break;
6400 default:
6401 *p++ = *s++;
6402 break;
6405 *p = '\0';
6407 return p - q;
6410 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6412 #define STATIC_QUOTING_LEN 32
6413 int i, bufLen, realLength;
6414 const char *strRep;
6415 char *p;
6416 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6418 /* Estimate the space needed. */
6419 if (objc > STATIC_QUOTING_LEN) {
6420 quotingType = Jim_Alloc(objc);
6422 else {
6423 quotingType = staticQuoting;
6425 bufLen = 0;
6426 for (i = 0; i < objc; i++) {
6427 int len;
6429 strRep = Jim_GetString(objv[i], &len);
6430 quotingType[i] = ListElementQuotingType(strRep, len);
6431 switch (quotingType[i]) {
6432 case JIM_ELESTR_SIMPLE:
6433 if (i != 0 || strRep[0] != '#') {
6434 bufLen += len;
6435 break;
6437 /* Special case '#' on first element needs braces */
6438 quotingType[i] = JIM_ELESTR_BRACE;
6439 /* fall through */
6440 case JIM_ELESTR_BRACE:
6441 bufLen += len + 2;
6442 break;
6443 case JIM_ELESTR_QUOTE:
6444 bufLen += len * 2;
6445 break;
6447 bufLen++; /* elements separator. */
6449 bufLen++;
6451 /* Generate the string rep. */
6452 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6453 realLength = 0;
6454 for (i = 0; i < objc; i++) {
6455 int len, qlen;
6457 strRep = Jim_GetString(objv[i], &len);
6459 switch (quotingType[i]) {
6460 case JIM_ELESTR_SIMPLE:
6461 memcpy(p, strRep, len);
6462 p += len;
6463 realLength += len;
6464 break;
6465 case JIM_ELESTR_BRACE:
6466 *p++ = '{';
6467 memcpy(p, strRep, len);
6468 p += len;
6469 *p++ = '}';
6470 realLength += len + 2;
6471 break;
6472 case JIM_ELESTR_QUOTE:
6473 if (i == 0 && strRep[0] == '#') {
6474 *p++ = '\\';
6475 realLength++;
6477 qlen = BackslashQuoteString(strRep, len, p);
6478 p += qlen;
6479 realLength += qlen;
6480 break;
6482 /* Add a separating space */
6483 if (i + 1 != objc) {
6484 *p++ = ' ';
6485 realLength++;
6488 *p = '\0'; /* nul term. */
6489 objPtr->length = realLength;
6491 if (quotingType != staticQuoting) {
6492 Jim_Free(quotingType);
6496 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6498 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6501 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6503 struct JimParserCtx parser;
6504 const char *str;
6505 int strLen;
6506 Jim_Obj *fileNameObj;
6507 int linenr;
6509 if (objPtr->typePtr == &listObjType) {
6510 return JIM_OK;
6513 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6514 * it also preserves any source location of the dict elements
6515 * which can be very useful
6517 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6518 Jim_Obj **listObjPtrPtr;
6519 int len;
6520 int i;
6522 listObjPtrPtr = JimDictPairs(objPtr, &len);
6523 for (i = 0; i < len; i++) {
6524 Jim_IncrRefCount(listObjPtrPtr[i]);
6527 /* Now just switch the internal rep */
6528 Jim_FreeIntRep(interp, objPtr);
6529 objPtr->typePtr = &listObjType;
6530 objPtr->internalRep.listValue.len = len;
6531 objPtr->internalRep.listValue.maxLen = len;
6532 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6534 return JIM_OK;
6537 /* Try to preserve information about filename / line number */
6538 if (objPtr->typePtr == &sourceObjType) {
6539 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6540 linenr = objPtr->internalRep.sourceValue.lineNumber;
6542 else {
6543 fileNameObj = interp->emptyObj;
6544 linenr = 1;
6546 Jim_IncrRefCount(fileNameObj);
6548 /* Get the string representation */
6549 str = Jim_GetString(objPtr, &strLen);
6551 /* Free the old internal repr just now and initialize the
6552 * new one just now. The string->list conversion can't fail. */
6553 Jim_FreeIntRep(interp, objPtr);
6554 objPtr->typePtr = &listObjType;
6555 objPtr->internalRep.listValue.len = 0;
6556 objPtr->internalRep.listValue.maxLen = 0;
6557 objPtr->internalRep.listValue.ele = NULL;
6559 /* Convert into a list */
6560 if (strLen) {
6561 JimParserInit(&parser, str, strLen, linenr);
6562 while (!parser.eof) {
6563 Jim_Obj *elementPtr;
6565 JimParseList(&parser);
6566 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6567 continue;
6568 elementPtr = JimParserGetTokenObj(interp, &parser);
6569 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6570 ListAppendElement(objPtr, elementPtr);
6573 Jim_DecrRefCount(interp, fileNameObj);
6574 return JIM_OK;
6577 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6579 Jim_Obj *objPtr;
6581 objPtr = Jim_NewObj(interp);
6582 objPtr->typePtr = &listObjType;
6583 objPtr->bytes = NULL;
6584 objPtr->internalRep.listValue.ele = NULL;
6585 objPtr->internalRep.listValue.len = 0;
6586 objPtr->internalRep.listValue.maxLen = 0;
6588 if (len) {
6589 ListInsertElements(objPtr, 0, len, elements);
6592 return objPtr;
6595 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6596 * length of the vector. Note that the user of this function should make
6597 * sure that the list object can't shimmer while the vector returned
6598 * is in use, this vector is the one stored inside the internal representation
6599 * of the list object. This function is not exported, extensions should
6600 * always access to the List object elements using Jim_ListIndex(). */
6601 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6602 Jim_Obj ***listVec)
6604 *listLen = Jim_ListLength(interp, listObj);
6605 *listVec = listObj->internalRep.listValue.ele;
6608 /* Sorting uses ints, but commands may return wide */
6609 static int JimSign(jim_wide w)
6611 if (w == 0) {
6612 return 0;
6614 else if (w < 0) {
6615 return -1;
6617 return 1;
6620 /* ListSortElements type values */
6621 struct lsort_info {
6622 jmp_buf jmpbuf;
6623 Jim_Obj *command;
6624 Jim_Interp *interp;
6625 enum {
6626 JIM_LSORT_ASCII,
6627 JIM_LSORT_NOCASE,
6628 JIM_LSORT_INTEGER,
6629 JIM_LSORT_REAL,
6630 JIM_LSORT_COMMAND
6631 } type;
6632 int order;
6633 int index;
6634 int indexed;
6635 int unique;
6636 int (*subfn)(Jim_Obj **, Jim_Obj **);
6639 static struct lsort_info *sort_info;
6641 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6643 Jim_Obj *lObj, *rObj;
6645 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6646 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6647 longjmp(sort_info->jmpbuf, JIM_ERR);
6649 return sort_info->subfn(&lObj, &rObj);
6652 /* Sort the internal rep of a list. */
6653 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6655 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6658 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6660 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6663 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6665 jim_wide lhs = 0, rhs = 0;
6667 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6668 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6669 longjmp(sort_info->jmpbuf, JIM_ERR);
6672 return JimSign(lhs - rhs) * sort_info->order;
6675 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6677 double lhs = 0, rhs = 0;
6679 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6680 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6681 longjmp(sort_info->jmpbuf, JIM_ERR);
6683 if (lhs == rhs) {
6684 return 0;
6686 if (lhs > rhs) {
6687 return sort_info->order;
6689 return -sort_info->order;
6692 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6694 Jim_Obj *compare_script;
6695 int rc;
6697 jim_wide ret = 0;
6699 /* This must be a valid list */
6700 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6701 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6702 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6704 rc = Jim_EvalObj(sort_info->interp, compare_script);
6706 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6707 longjmp(sort_info->jmpbuf, rc);
6710 return JimSign(ret) * sort_info->order;
6713 /* Remove duplicate elements from the (sorted) list in-place, according to the
6714 * comparison function, comp.
6716 * Note that the last unique value is kept, not the first
6718 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6720 int src;
6721 int dst = 0;
6722 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6724 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6725 if (comp(&ele[dst], &ele[src]) == 0) {
6726 /* Match, so replace the dest with the current source */
6727 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6729 else {
6730 /* No match, so keep the current source and move to the next destination */
6731 dst++;
6733 ele[dst] = ele[src];
6736 /* At end of list, keep the final element unless all elements were kept */
6737 dst++;
6738 if (dst < listObjPtr->internalRep.listValue.len) {
6739 ele[dst] = ele[src];
6742 /* Set the new length */
6743 listObjPtr->internalRep.listValue.len = dst;
6746 /* Sort a list *in place*. MUST be called with a non-shared list. */
6747 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6749 struct lsort_info *prev_info;
6751 typedef int (qsort_comparator) (const void *, const void *);
6752 int (*fn) (Jim_Obj **, Jim_Obj **);
6753 Jim_Obj **vector;
6754 int len;
6755 int rc;
6757 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6758 SetListFromAny(interp, listObjPtr);
6760 /* Allow lsort to be called reentrantly */
6761 prev_info = sort_info;
6762 sort_info = info;
6764 vector = listObjPtr->internalRep.listValue.ele;
6765 len = listObjPtr->internalRep.listValue.len;
6766 switch (info->type) {
6767 case JIM_LSORT_ASCII:
6768 fn = ListSortString;
6769 break;
6770 case JIM_LSORT_NOCASE:
6771 fn = ListSortStringNoCase;
6772 break;
6773 case JIM_LSORT_INTEGER:
6774 fn = ListSortInteger;
6775 break;
6776 case JIM_LSORT_REAL:
6777 fn = ListSortReal;
6778 break;
6779 case JIM_LSORT_COMMAND:
6780 fn = ListSortCommand;
6781 break;
6782 default:
6783 fn = NULL; /* avoid warning */
6784 JimPanic((1, "ListSort called with invalid sort type"));
6785 return -1; /* Should not be run but keeps static analysers happy */
6788 if (info->indexed) {
6789 /* Need to interpose a "list index" function */
6790 info->subfn = fn;
6791 fn = ListSortIndexHelper;
6794 if ((rc = setjmp(info->jmpbuf)) == 0) {
6795 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6797 if (info->unique && len > 1) {
6798 ListRemoveDuplicates(listObjPtr, fn);
6801 Jim_InvalidateStringRep(listObjPtr);
6803 sort_info = prev_info;
6805 return rc;
6808 /* This is the low-level function to insert elements into a list.
6809 * The higher-level Jim_ListInsertElements() performs shared object
6810 * check and invalidates the string repr. This version is used
6811 * in the internals of the List Object and is not exported.
6813 * NOTE: this function can be called only against objects
6814 * with internal type of List.
6816 * An insertion point (idx) of -1 means end-of-list.
6818 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6820 int currentLen = listPtr->internalRep.listValue.len;
6821 int requiredLen = currentLen + elemc;
6822 int i;
6823 Jim_Obj **point;
6825 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6826 if (requiredLen < 2) {
6827 /* Don't do allocations of under 4 pointers. */
6828 requiredLen = 4;
6830 else {
6831 requiredLen *= 2;
6834 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6835 sizeof(Jim_Obj *) * requiredLen);
6837 listPtr->internalRep.listValue.maxLen = requiredLen;
6839 if (idx < 0) {
6840 idx = currentLen;
6842 point = listPtr->internalRep.listValue.ele + idx;
6843 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6844 for (i = 0; i < elemc; ++i) {
6845 point[i] = elemVec[i];
6846 Jim_IncrRefCount(point[i]);
6848 listPtr->internalRep.listValue.len += elemc;
6851 /* Convenience call to ListInsertElements() to append a single element.
6853 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6855 ListInsertElements(listPtr, -1, 1, &objPtr);
6858 /* Appends every element of appendListPtr into listPtr.
6859 * Both have to be of the list type.
6860 * Convenience call to ListInsertElements()
6862 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6864 ListInsertElements(listPtr, -1,
6865 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6868 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6870 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6871 SetListFromAny(interp, listPtr);
6872 Jim_InvalidateStringRep(listPtr);
6873 ListAppendElement(listPtr, objPtr);
6876 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6878 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6879 SetListFromAny(interp, listPtr);
6880 SetListFromAny(interp, appendListPtr);
6881 Jim_InvalidateStringRep(listPtr);
6882 ListAppendList(listPtr, appendListPtr);
6885 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6887 SetListFromAny(interp, objPtr);
6888 return objPtr->internalRep.listValue.len;
6891 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6892 int objc, Jim_Obj *const *objVec)
6894 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6895 SetListFromAny(interp, listPtr);
6896 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6897 idx = listPtr->internalRep.listValue.len;
6898 else if (idx < 0)
6899 idx = 0;
6900 Jim_InvalidateStringRep(listPtr);
6901 ListInsertElements(listPtr, idx, objc, objVec);
6904 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6906 SetListFromAny(interp, listPtr);
6907 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6908 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6909 return NULL;
6911 if (idx < 0)
6912 idx = listPtr->internalRep.listValue.len + idx;
6913 return listPtr->internalRep.listValue.ele[idx];
6916 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6918 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6919 if (*objPtrPtr == NULL) {
6920 if (flags & JIM_ERRMSG) {
6921 Jim_SetResultString(interp, "list index out of range", -1);
6923 return JIM_ERR;
6925 return JIM_OK;
6928 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6929 Jim_Obj *newObjPtr, int flags)
6931 SetListFromAny(interp, listPtr);
6932 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6933 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6934 if (flags & JIM_ERRMSG) {
6935 Jim_SetResultString(interp, "list index out of range", -1);
6937 return JIM_ERR;
6939 if (idx < 0)
6940 idx = listPtr->internalRep.listValue.len + idx;
6941 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6942 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6943 Jim_IncrRefCount(newObjPtr);
6944 return JIM_OK;
6947 /* Modify the list stored in the variable named 'varNamePtr'
6948 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6949 * with the new element 'newObjptr'. (implements the [lset] command) */
6950 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6951 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6953 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6954 int shared, i, idx;
6956 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6957 if (objPtr == NULL)
6958 return JIM_ERR;
6959 if ((shared = Jim_IsShared(objPtr)))
6960 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6961 for (i = 0; i < indexc - 1; i++) {
6962 listObjPtr = objPtr;
6963 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6964 goto err;
6965 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6966 goto err;
6968 if (Jim_IsShared(objPtr)) {
6969 objPtr = Jim_DuplicateObj(interp, objPtr);
6970 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6972 Jim_InvalidateStringRep(listObjPtr);
6974 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6975 goto err;
6976 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6977 goto err;
6978 Jim_InvalidateStringRep(objPtr);
6979 Jim_InvalidateStringRep(varObjPtr);
6980 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6981 goto err;
6982 Jim_SetResult(interp, varObjPtr);
6983 return JIM_OK;
6984 err:
6985 if (shared) {
6986 Jim_FreeNewObj(interp, varObjPtr);
6988 return JIM_ERR;
6991 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6993 int i;
6994 int listLen = Jim_ListLength(interp, listObjPtr);
6995 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6997 for (i = 0; i < listLen; ) {
6998 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6999 if (++i != listLen) {
7000 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
7003 return resObjPtr;
7006 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
7008 int i;
7010 /* If all the objects in objv are lists,
7011 * it's possible to return a list as result, that's the
7012 * concatenation of all the lists. */
7013 for (i = 0; i < objc; i++) {
7014 if (!Jim_IsList(objv[i]))
7015 break;
7017 if (i == objc) {
7018 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
7020 for (i = 0; i < objc; i++)
7021 ListAppendList(objPtr, objv[i]);
7022 return objPtr;
7024 else {
7025 /* Else... we have to glue strings together */
7026 int len = 0, objLen;
7027 char *bytes, *p;
7029 /* Compute the length */
7030 for (i = 0; i < objc; i++) {
7031 len += Jim_Length(objv[i]);
7033 if (objc)
7034 len += objc - 1;
7035 /* Create the string rep, and a string object holding it. */
7036 p = bytes = Jim_Alloc(len + 1);
7037 for (i = 0; i < objc; i++) {
7038 const char *s = Jim_GetString(objv[i], &objLen);
7040 /* Remove leading space */
7041 while (objLen && isspace(UCHAR(*s))) {
7042 s++;
7043 objLen--;
7044 len--;
7046 /* And trailing space */
7047 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
7048 /* Handle trailing backslash-space case */
7049 if (objLen > 1 && s[objLen - 2] == '\\') {
7050 break;
7052 objLen--;
7053 len--;
7055 memcpy(p, s, objLen);
7056 p += objLen;
7057 if (i + 1 != objc) {
7058 if (objLen)
7059 *p++ = ' ';
7060 else {
7061 /* Drop the space calculated for this
7062 * element that is instead null. */
7063 len--;
7067 *p = '\0';
7068 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7072 /* Returns a list composed of the elements in the specified range.
7073 * first and start are directly accepted as Jim_Objects and
7074 * processed for the end?-index? case. */
7075 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7076 Jim_Obj *lastObjPtr)
7078 int first, last;
7079 int len, rangeLen;
7081 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7082 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7083 return NULL;
7084 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7085 first = JimRelToAbsIndex(len, first);
7086 last = JimRelToAbsIndex(len, last);
7087 JimRelToAbsRange(len, &first, &last, &rangeLen);
7088 if (first == 0 && last == len) {
7089 return listObjPtr;
7091 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7094 /* -----------------------------------------------------------------------------
7095 * Dict object
7096 * ---------------------------------------------------------------------------*/
7097 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7098 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7099 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7100 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7102 /* Dict HashTable Type.
7104 * Keys and Values are Jim objects. */
7106 static unsigned int JimObjectHTHashFunction(const void *key)
7108 int len;
7109 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7110 return Jim_GenHashFunction((const unsigned char *)str, len);
7113 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7115 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7118 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7120 Jim_IncrRefCount((Jim_Obj *)val);
7121 return (void *)val;
7124 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7126 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7129 static const Jim_HashTableType JimDictHashTableType = {
7130 JimObjectHTHashFunction, /* hash function */
7131 JimObjectHTKeyValDup, /* key dup */
7132 JimObjectHTKeyValDup, /* val dup */
7133 JimObjectHTKeyCompare, /* key compare */
7134 JimObjectHTKeyValDestructor, /* key destructor */
7135 JimObjectHTKeyValDestructor /* val destructor */
7138 /* Note that while the elements of the dict may contain references,
7139 * the list object itself can't. This basically means that the
7140 * dict object string representation as a whole can't contain references
7141 * that are not presents in the single elements. */
7142 static const Jim_ObjType dictObjType = {
7143 "dict",
7144 FreeDictInternalRep,
7145 DupDictInternalRep,
7146 UpdateStringOfDict,
7147 JIM_TYPE_NONE,
7150 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7152 JIM_NOTUSED(interp);
7154 Jim_FreeHashTable(objPtr->internalRep.ptr);
7155 Jim_Free(objPtr->internalRep.ptr);
7158 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7160 Jim_HashTable *ht, *dupHt;
7161 Jim_HashTableIterator htiter;
7162 Jim_HashEntry *he;
7164 /* Create a new hash table */
7165 ht = srcPtr->internalRep.ptr;
7166 dupHt = Jim_Alloc(sizeof(*dupHt));
7167 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7168 if (ht->size != 0)
7169 Jim_ExpandHashTable(dupHt, ht->size);
7170 /* Copy every element from the source to the dup hash table */
7171 JimInitHashTableIterator(ht, &htiter);
7172 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7173 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7176 dupPtr->internalRep.ptr = dupHt;
7177 dupPtr->typePtr = &dictObjType;
7180 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7182 Jim_HashTable *ht;
7183 Jim_HashTableIterator htiter;
7184 Jim_HashEntry *he;
7185 Jim_Obj **objv;
7186 int i;
7188 ht = dictPtr->internalRep.ptr;
7190 /* Turn the hash table into a flat vector of Jim_Objects. */
7191 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7192 JimInitHashTableIterator(ht, &htiter);
7193 i = 0;
7194 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7195 objv[i++] = Jim_GetHashEntryKey(he);
7196 objv[i++] = Jim_GetHashEntryVal(he);
7198 *len = i;
7199 return objv;
7202 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7204 /* Turn the hash table into a flat vector of Jim_Objects. */
7205 int len;
7206 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7208 /* And now generate the string rep as a list */
7209 JimMakeListStringRep(objPtr, objv, len);
7211 Jim_Free(objv);
7214 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7216 int listlen;
7218 if (objPtr->typePtr == &dictObjType) {
7219 return JIM_OK;
7222 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7223 /* A shared list, so get the string representation now to avoid
7224 * changing the order in case of fast conversion to dict.
7226 Jim_String(objPtr);
7229 /* For simplicity, convert a non-list object to a list and then to a dict */
7230 listlen = Jim_ListLength(interp, objPtr);
7231 if (listlen % 2) {
7232 Jim_SetResultString(interp, "missing value to go with key", -1);
7233 return JIM_ERR;
7235 else {
7236 /* Converting from a list to a dict can't fail */
7237 Jim_HashTable *ht;
7238 int i;
7240 ht = Jim_Alloc(sizeof(*ht));
7241 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7243 for (i = 0; i < listlen; i += 2) {
7244 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7245 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7247 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7250 Jim_FreeIntRep(interp, objPtr);
7251 objPtr->typePtr = &dictObjType;
7252 objPtr->internalRep.ptr = ht;
7254 return JIM_OK;
7258 /* Dict object API */
7260 /* Add an element to a dict. objPtr must be of the "dict" type.
7261 * The higher-level exported function is Jim_DictAddElement().
7262 * If an element with the specified key already exists, the value
7263 * associated is replaced with the new one.
7265 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7266 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7267 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7269 Jim_HashTable *ht = objPtr->internalRep.ptr;
7271 if (valueObjPtr == NULL) { /* unset */
7272 return Jim_DeleteHashEntry(ht, keyObjPtr);
7274 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7275 return JIM_OK;
7278 /* Add an element, higher-level interface for DictAddElement().
7279 * If valueObjPtr == NULL, the key is removed if it exists. */
7280 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7281 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7283 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7284 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7285 return JIM_ERR;
7287 Jim_InvalidateStringRep(objPtr);
7288 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7291 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7293 Jim_Obj *objPtr;
7294 int i;
7296 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7298 objPtr = Jim_NewObj(interp);
7299 objPtr->typePtr = &dictObjType;
7300 objPtr->bytes = NULL;
7301 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7302 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7303 for (i = 0; i < len; i += 2)
7304 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7305 return objPtr;
7308 /* Return the value associated to the specified dict key
7309 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7311 * Sets *objPtrPtr to non-NULL only upon success.
7313 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7314 Jim_Obj **objPtrPtr, int flags)
7316 Jim_HashEntry *he;
7317 Jim_HashTable *ht;
7319 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7320 return -1;
7322 ht = dictPtr->internalRep.ptr;
7323 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7324 if (flags & JIM_ERRMSG) {
7325 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7327 return JIM_ERR;
7329 else {
7330 *objPtrPtr = Jim_GetHashEntryVal(he);
7331 return JIM_OK;
7335 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7336 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7338 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7339 return JIM_ERR;
7341 *objPtrPtr = JimDictPairs(dictPtr, len);
7343 return JIM_OK;
7347 /* Return the value associated to the specified dict keys */
7348 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7349 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7351 int i;
7353 if (keyc == 0) {
7354 *objPtrPtr = dictPtr;
7355 return JIM_OK;
7358 for (i = 0; i < keyc; i++) {
7359 Jim_Obj *objPtr;
7361 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7362 if (rc != JIM_OK) {
7363 return rc;
7365 dictPtr = objPtr;
7367 *objPtrPtr = dictPtr;
7368 return JIM_OK;
7371 /* Modify the dict stored into the variable named 'varNamePtr'
7372 * setting the element specified by the 'keyc' keys objects in 'keyv',
7373 * with the new value of the element 'newObjPtr'.
7375 * If newObjPtr == NULL the operation is to remove the given key
7376 * from the dictionary.
7378 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7379 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7381 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7382 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7384 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7385 int shared, i;
7387 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7388 if (objPtr == NULL) {
7389 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7390 /* Cannot remove a key from non existing var */
7391 return JIM_ERR;
7393 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7394 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7395 Jim_FreeNewObj(interp, varObjPtr);
7396 return JIM_ERR;
7399 if ((shared = Jim_IsShared(objPtr)))
7400 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7401 for (i = 0; i < keyc; i++) {
7402 dictObjPtr = objPtr;
7404 /* Check if it's a valid dictionary */
7405 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7406 goto err;
7409 if (i == keyc - 1) {
7410 /* Last key: Note that error on unset with missing last key is OK */
7411 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7412 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7413 goto err;
7416 break;
7419 /* Check if the given key exists. */
7420 Jim_InvalidateStringRep(dictObjPtr);
7421 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7422 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7423 /* This key exists at the current level.
7424 * Make sure it's not shared!. */
7425 if (Jim_IsShared(objPtr)) {
7426 objPtr = Jim_DuplicateObj(interp, objPtr);
7427 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7430 else {
7431 /* Key not found. If it's an [unset] operation
7432 * this is an error. Only the last key may not
7433 * exist. */
7434 if (newObjPtr == NULL) {
7435 goto err;
7437 /* Otherwise set an empty dictionary
7438 * as key's value. */
7439 objPtr = Jim_NewDictObj(interp, NULL, 0);
7440 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7443 /* XXX: Is this necessary? */
7444 Jim_InvalidateStringRep(objPtr);
7445 Jim_InvalidateStringRep(varObjPtr);
7446 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7447 goto err;
7449 Jim_SetResult(interp, varObjPtr);
7450 return JIM_OK;
7451 err:
7452 if (shared) {
7453 Jim_FreeNewObj(interp, varObjPtr);
7455 return JIM_ERR;
7458 /* -----------------------------------------------------------------------------
7459 * Index object
7460 * ---------------------------------------------------------------------------*/
7461 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7462 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7464 static const Jim_ObjType indexObjType = {
7465 "index",
7466 NULL,
7467 NULL,
7468 UpdateStringOfIndex,
7469 JIM_TYPE_NONE,
7472 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7474 if (objPtr->internalRep.intValue == -1) {
7475 JimSetStringBytes(objPtr, "end");
7477 else {
7478 char buf[JIM_INTEGER_SPACE + 1];
7479 if (objPtr->internalRep.intValue >= 0) {
7480 sprintf(buf, "%d", objPtr->internalRep.intValue);
7482 else {
7483 /* Must be <= -2 */
7484 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7486 JimSetStringBytes(objPtr, buf);
7490 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7492 int idx, end = 0;
7493 const char *str;
7494 char *endptr;
7496 /* Get the string representation */
7497 str = Jim_String(objPtr);
7499 /* Try to convert into an index */
7500 if (strncmp(str, "end", 3) == 0) {
7501 end = 1;
7502 str += 3;
7503 idx = 0;
7505 else {
7506 idx = jim_strtol(str, &endptr);
7508 if (endptr == str) {
7509 goto badindex;
7511 str = endptr;
7514 /* Now str may include or +<num> or -<num> */
7515 if (*str == '+' || *str == '-') {
7516 int sign = (*str == '+' ? 1 : -1);
7518 idx += sign * jim_strtol(++str, &endptr);
7519 if (str == endptr || *endptr) {
7520 goto badindex;
7522 str = endptr;
7524 /* The only thing left should be spaces */
7525 while (isspace(UCHAR(*str))) {
7526 str++;
7528 if (*str) {
7529 goto badindex;
7531 if (end) {
7532 if (idx > 0) {
7533 idx = INT_MAX;
7535 else {
7536 /* end-1 is repesented as -2 */
7537 idx--;
7540 else if (idx < 0) {
7541 idx = -INT_MAX;
7544 /* Free the old internal repr and set the new one. */
7545 Jim_FreeIntRep(interp, objPtr);
7546 objPtr->typePtr = &indexObjType;
7547 objPtr->internalRep.intValue = idx;
7548 return JIM_OK;
7550 badindex:
7551 Jim_SetResultFormatted(interp,
7552 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7553 return JIM_ERR;
7556 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7558 /* Avoid shimmering if the object is an integer. */
7559 if (objPtr->typePtr == &intObjType) {
7560 jim_wide val = JimWideValue(objPtr);
7562 if (val < 0)
7563 *indexPtr = -INT_MAX;
7564 else if (val > INT_MAX)
7565 *indexPtr = INT_MAX;
7566 else
7567 *indexPtr = (int)val;
7568 return JIM_OK;
7570 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7571 return JIM_ERR;
7572 *indexPtr = objPtr->internalRep.intValue;
7573 return JIM_OK;
7576 /* -----------------------------------------------------------------------------
7577 * Return Code Object.
7578 * ---------------------------------------------------------------------------*/
7580 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7581 static const char * const jimReturnCodes[] = {
7582 "ok",
7583 "error",
7584 "return",
7585 "break",
7586 "continue",
7587 "signal",
7588 "exit",
7589 "eval",
7590 NULL
7593 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7595 static const Jim_ObjType returnCodeObjType = {
7596 "return-code",
7597 NULL,
7598 NULL,
7599 NULL,
7600 JIM_TYPE_NONE,
7603 /* Converts a (standard) return code to a string. Returns "?" for
7604 * non-standard return codes.
7606 const char *Jim_ReturnCode(int code)
7608 if (code < 0 || code >= (int)jimReturnCodesSize) {
7609 return "?";
7611 else {
7612 return jimReturnCodes[code];
7616 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7618 int returnCode;
7619 jim_wide wideValue;
7621 /* Try to convert into an integer */
7622 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7623 returnCode = (int)wideValue;
7624 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7625 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7626 return JIM_ERR;
7628 /* Free the old internal repr and set the new one. */
7629 Jim_FreeIntRep(interp, objPtr);
7630 objPtr->typePtr = &returnCodeObjType;
7631 objPtr->internalRep.intValue = returnCode;
7632 return JIM_OK;
7635 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7637 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7638 return JIM_ERR;
7639 *intPtr = objPtr->internalRep.intValue;
7640 return JIM_OK;
7643 /* -----------------------------------------------------------------------------
7644 * Expression Parsing
7645 * ---------------------------------------------------------------------------*/
7646 static int JimParseExprOperator(struct JimParserCtx *pc);
7647 static int JimParseExprNumber(struct JimParserCtx *pc);
7648 static int JimParseExprIrrational(struct JimParserCtx *pc);
7649 static int JimParseExprBoolean(struct JimParserCtx *pc);
7651 /* expr operator opcodes. */
7652 enum
7654 /* Continues on from the JIM_TT_ space */
7656 /* Binary operators (numbers) */
7657 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7658 JIM_EXPROP_DIV,
7659 JIM_EXPROP_MOD,
7660 JIM_EXPROP_SUB,
7661 JIM_EXPROP_ADD,
7662 JIM_EXPROP_LSHIFT,
7663 JIM_EXPROP_RSHIFT,
7664 JIM_EXPROP_ROTL,
7665 JIM_EXPROP_ROTR,
7666 JIM_EXPROP_LT,
7667 JIM_EXPROP_GT,
7668 JIM_EXPROP_LTE,
7669 JIM_EXPROP_GTE,
7670 JIM_EXPROP_NUMEQ,
7671 JIM_EXPROP_NUMNE,
7672 JIM_EXPROP_BITAND, /* 35 */
7673 JIM_EXPROP_BITXOR,
7674 JIM_EXPROP_BITOR,
7675 JIM_EXPROP_LOGICAND, /* 38 */
7676 JIM_EXPROP_LOGICOR, /* 39 */
7677 JIM_EXPROP_TERNARY, /* 40 */
7678 JIM_EXPROP_COLON, /* 41 */
7679 JIM_EXPROP_POW, /* 42 */
7681 /* Binary operators (strings) */
7682 JIM_EXPROP_STREQ, /* 43 */
7683 JIM_EXPROP_STRNE,
7684 JIM_EXPROP_STRIN,
7685 JIM_EXPROP_STRNI,
7687 /* Unary operators (numbers) */
7688 JIM_EXPROP_NOT, /* 47 */
7689 JIM_EXPROP_BITNOT,
7690 JIM_EXPROP_UNARYMINUS,
7691 JIM_EXPROP_UNARYPLUS,
7693 /* Functions */
7694 JIM_EXPROP_FUNC_INT, /* 51 */
7695 JIM_EXPROP_FUNC_WIDE,
7696 JIM_EXPROP_FUNC_ABS,
7697 JIM_EXPROP_FUNC_DOUBLE,
7698 JIM_EXPROP_FUNC_ROUND,
7699 JIM_EXPROP_FUNC_RAND,
7700 JIM_EXPROP_FUNC_SRAND,
7702 /* math functions from libm */
7703 JIM_EXPROP_FUNC_SIN, /* 65 */
7704 JIM_EXPROP_FUNC_COS,
7705 JIM_EXPROP_FUNC_TAN,
7706 JIM_EXPROP_FUNC_ASIN,
7707 JIM_EXPROP_FUNC_ACOS,
7708 JIM_EXPROP_FUNC_ATAN,
7709 JIM_EXPROP_FUNC_ATAN2,
7710 JIM_EXPROP_FUNC_SINH,
7711 JIM_EXPROP_FUNC_COSH,
7712 JIM_EXPROP_FUNC_TANH,
7713 JIM_EXPROP_FUNC_CEIL,
7714 JIM_EXPROP_FUNC_FLOOR,
7715 JIM_EXPROP_FUNC_EXP,
7716 JIM_EXPROP_FUNC_LOG,
7717 JIM_EXPROP_FUNC_LOG10,
7718 JIM_EXPROP_FUNC_SQRT,
7719 JIM_EXPROP_FUNC_POW,
7720 JIM_EXPROP_FUNC_HYPOT,
7721 JIM_EXPROP_FUNC_FMOD,
7724 /* A expression node is either a term or an operator
7725 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7727 struct JimExprNode {
7728 int type; /* JIM_TT_xxx */
7729 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7731 struct JimExprNode *left; /* For all operators */
7732 struct JimExprNode *right; /* For binary operators */
7733 struct JimExprNode *ternary; /* For ternary operator only */
7736 /* Operators table */
7737 typedef struct Jim_ExprOperator
7739 const char *name;
7740 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7741 unsigned char precedence;
7742 unsigned char arity;
7743 unsigned char attr;
7744 unsigned char namelen;
7745 } Jim_ExprOperator;
7747 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7748 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7749 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7751 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7753 int intresult = 1;
7754 int rc;
7755 double dA, dC = 0;
7756 jim_wide wA, wC = 0;
7757 Jim_Obj *A;
7759 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7760 return rc;
7763 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7764 switch (node->type) {
7765 case JIM_EXPROP_FUNC_INT:
7766 case JIM_EXPROP_FUNC_WIDE:
7767 case JIM_EXPROP_FUNC_ROUND:
7768 case JIM_EXPROP_UNARYPLUS:
7769 wC = wA;
7770 break;
7771 case JIM_EXPROP_FUNC_DOUBLE:
7772 dC = wA;
7773 intresult = 0;
7774 break;
7775 case JIM_EXPROP_FUNC_ABS:
7776 wC = wA >= 0 ? wA : -wA;
7777 break;
7778 case JIM_EXPROP_UNARYMINUS:
7779 wC = -wA;
7780 break;
7781 case JIM_EXPROP_NOT:
7782 wC = !wA;
7783 break;
7784 default:
7785 abort();
7788 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7789 switch (node->type) {
7790 case JIM_EXPROP_FUNC_INT:
7791 case JIM_EXPROP_FUNC_WIDE:
7792 wC = dA;
7793 break;
7794 case JIM_EXPROP_FUNC_ROUND:
7795 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7796 break;
7797 case JIM_EXPROP_FUNC_DOUBLE:
7798 case JIM_EXPROP_UNARYPLUS:
7799 dC = dA;
7800 intresult = 0;
7801 break;
7802 case JIM_EXPROP_FUNC_ABS:
7803 #ifdef JIM_MATH_FUNCTIONS
7804 dC = fabs(dA);
7805 #else
7806 dC = dA >= 0 ? dA : -dA;
7807 #endif
7808 intresult = 0;
7809 break;
7810 case JIM_EXPROP_UNARYMINUS:
7811 dC = -dA;
7812 intresult = 0;
7813 break;
7814 case JIM_EXPROP_NOT:
7815 wC = !dA;
7816 break;
7817 default:
7818 abort();
7822 if (rc == JIM_OK) {
7823 if (intresult) {
7824 Jim_SetResultInt(interp, wC);
7826 else {
7827 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7831 Jim_DecrRefCount(interp, A);
7833 return rc;
7836 static double JimRandDouble(Jim_Interp *interp)
7838 unsigned long x;
7839 JimRandomBytes(interp, &x, sizeof(x));
7841 return (double)x / (unsigned long)~0;
7844 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7846 jim_wide wA;
7847 Jim_Obj *A;
7848 int rc;
7850 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7851 return rc;
7854 rc = Jim_GetWide(interp, A, &wA);
7855 if (rc == JIM_OK) {
7856 switch (node->type) {
7857 case JIM_EXPROP_BITNOT:
7858 Jim_SetResultInt(interp, ~wA);
7859 break;
7860 case JIM_EXPROP_FUNC_SRAND:
7861 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7862 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7863 break;
7864 default:
7865 abort();
7869 Jim_DecrRefCount(interp, A);
7871 return rc;
7874 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7876 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7878 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7880 return JIM_OK;
7883 #ifdef JIM_MATH_FUNCTIONS
7884 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7886 int rc;
7887 double dA, dC;
7888 Jim_Obj *A;
7890 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7891 return rc;
7894 rc = Jim_GetDouble(interp, A, &dA);
7895 if (rc == JIM_OK) {
7896 switch (node->type) {
7897 case JIM_EXPROP_FUNC_SIN:
7898 dC = sin(dA);
7899 break;
7900 case JIM_EXPROP_FUNC_COS:
7901 dC = cos(dA);
7902 break;
7903 case JIM_EXPROP_FUNC_TAN:
7904 dC = tan(dA);
7905 break;
7906 case JIM_EXPROP_FUNC_ASIN:
7907 dC = asin(dA);
7908 break;
7909 case JIM_EXPROP_FUNC_ACOS:
7910 dC = acos(dA);
7911 break;
7912 case JIM_EXPROP_FUNC_ATAN:
7913 dC = atan(dA);
7914 break;
7915 case JIM_EXPROP_FUNC_SINH:
7916 dC = sinh(dA);
7917 break;
7918 case JIM_EXPROP_FUNC_COSH:
7919 dC = cosh(dA);
7920 break;
7921 case JIM_EXPROP_FUNC_TANH:
7922 dC = tanh(dA);
7923 break;
7924 case JIM_EXPROP_FUNC_CEIL:
7925 dC = ceil(dA);
7926 break;
7927 case JIM_EXPROP_FUNC_FLOOR:
7928 dC = floor(dA);
7929 break;
7930 case JIM_EXPROP_FUNC_EXP:
7931 dC = exp(dA);
7932 break;
7933 case JIM_EXPROP_FUNC_LOG:
7934 dC = log(dA);
7935 break;
7936 case JIM_EXPROP_FUNC_LOG10:
7937 dC = log10(dA);
7938 break;
7939 case JIM_EXPROP_FUNC_SQRT:
7940 dC = sqrt(dA);
7941 break;
7942 default:
7943 abort();
7945 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7948 Jim_DecrRefCount(interp, A);
7950 return rc;
7952 #endif
7954 /* A binary operation on two ints */
7955 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7957 jim_wide wA, wB;
7958 int rc;
7959 Jim_Obj *A, *B;
7961 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7962 return rc;
7964 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7965 Jim_DecrRefCount(interp, A);
7966 return rc;
7969 rc = JIM_ERR;
7971 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7972 jim_wide wC;
7974 rc = JIM_OK;
7976 switch (node->type) {
7977 case JIM_EXPROP_LSHIFT:
7978 wC = wA << wB;
7979 break;
7980 case JIM_EXPROP_RSHIFT:
7981 wC = wA >> wB;
7982 break;
7983 case JIM_EXPROP_BITAND:
7984 wC = wA & wB;
7985 break;
7986 case JIM_EXPROP_BITXOR:
7987 wC = wA ^ wB;
7988 break;
7989 case JIM_EXPROP_BITOR:
7990 wC = wA | wB;
7991 break;
7992 case JIM_EXPROP_MOD:
7993 if (wB == 0) {
7994 wC = 0;
7995 Jim_SetResultString(interp, "Division by zero", -1);
7996 rc = JIM_ERR;
7998 else {
8000 * From Tcl 8.x
8002 * This code is tricky: C doesn't guarantee much
8003 * about the quotient or remainder, but Tcl does.
8004 * The remainder always has the same sign as the
8005 * divisor and a smaller absolute value.
8007 int negative = 0;
8009 if (wB < 0) {
8010 wB = -wB;
8011 wA = -wA;
8012 negative = 1;
8014 wC = wA % wB;
8015 if (wC < 0) {
8016 wC += wB;
8018 if (negative) {
8019 wC = -wC;
8022 break;
8023 case JIM_EXPROP_ROTL:
8024 case JIM_EXPROP_ROTR:{
8025 /* uint32_t would be better. But not everyone has inttypes.h? */
8026 unsigned long uA = (unsigned long)wA;
8027 unsigned long uB = (unsigned long)wB;
8028 const unsigned int S = sizeof(unsigned long) * 8;
8030 /* Shift left by the word size or more is undefined. */
8031 uB %= S;
8033 if (node->type == JIM_EXPROP_ROTR) {
8034 uB = S - uB;
8036 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
8037 break;
8039 default:
8040 abort();
8042 Jim_SetResultInt(interp, wC);
8045 Jim_DecrRefCount(interp, A);
8046 Jim_DecrRefCount(interp, B);
8048 return rc;
8052 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8053 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8055 int rc = JIM_OK;
8056 double dA, dB, dC = 0;
8057 jim_wide wA, wB, wC = 0;
8058 Jim_Obj *A, *B;
8060 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8061 return rc;
8063 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8064 Jim_DecrRefCount(interp, A);
8065 return rc;
8068 if ((A->typePtr != &doubleObjType || A->bytes) &&
8069 (B->typePtr != &doubleObjType || B->bytes) &&
8070 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8072 /* Both are ints */
8074 switch (node->type) {
8075 case JIM_EXPROP_POW:
8076 case JIM_EXPROP_FUNC_POW:
8077 if (wA == 0 && wB < 0) {
8078 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8079 rc = JIM_ERR;
8080 goto done;
8082 wC = JimPowWide(wA, wB);
8083 goto intresult;
8084 case JIM_EXPROP_ADD:
8085 wC = wA + wB;
8086 goto intresult;
8087 case JIM_EXPROP_SUB:
8088 wC = wA - wB;
8089 goto intresult;
8090 case JIM_EXPROP_MUL:
8091 wC = wA * wB;
8092 goto intresult;
8093 case JIM_EXPROP_DIV:
8094 if (wB == 0) {
8095 Jim_SetResultString(interp, "Division by zero", -1);
8096 rc = JIM_ERR;
8097 goto done;
8099 else {
8101 * From Tcl 8.x
8103 * This code is tricky: C doesn't guarantee much
8104 * about the quotient or remainder, but Tcl does.
8105 * The remainder always has the same sign as the
8106 * divisor and a smaller absolute value.
8108 if (wB < 0) {
8109 wB = -wB;
8110 wA = -wA;
8112 wC = wA / wB;
8113 if (wA % wB < 0) {
8114 wC--;
8116 goto intresult;
8118 case JIM_EXPROP_LT:
8119 wC = wA < wB;
8120 goto intresult;
8121 case JIM_EXPROP_GT:
8122 wC = wA > wB;
8123 goto intresult;
8124 case JIM_EXPROP_LTE:
8125 wC = wA <= wB;
8126 goto intresult;
8127 case JIM_EXPROP_GTE:
8128 wC = wA >= wB;
8129 goto intresult;
8130 case JIM_EXPROP_NUMEQ:
8131 wC = wA == wB;
8132 goto intresult;
8133 case JIM_EXPROP_NUMNE:
8134 wC = wA != wB;
8135 goto intresult;
8138 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8139 switch (node->type) {
8140 #ifndef JIM_MATH_FUNCTIONS
8141 case JIM_EXPROP_POW:
8142 case JIM_EXPROP_FUNC_POW:
8143 case JIM_EXPROP_FUNC_ATAN2:
8144 case JIM_EXPROP_FUNC_HYPOT:
8145 case JIM_EXPROP_FUNC_FMOD:
8146 Jim_SetResultString(interp, "unsupported", -1);
8147 rc = JIM_ERR;
8148 goto done;
8149 #else
8150 case JIM_EXPROP_POW:
8151 case JIM_EXPROP_FUNC_POW:
8152 dC = pow(dA, dB);
8153 goto doubleresult;
8154 case JIM_EXPROP_FUNC_ATAN2:
8155 dC = atan2(dA, dB);
8156 goto doubleresult;
8157 case JIM_EXPROP_FUNC_HYPOT:
8158 dC = hypot(dA, dB);
8159 goto doubleresult;
8160 case JIM_EXPROP_FUNC_FMOD:
8161 dC = fmod(dA, dB);
8162 goto doubleresult;
8163 #endif
8164 case JIM_EXPROP_ADD:
8165 dC = dA + dB;
8166 goto doubleresult;
8167 case JIM_EXPROP_SUB:
8168 dC = dA - dB;
8169 goto doubleresult;
8170 case JIM_EXPROP_MUL:
8171 dC = dA * dB;
8172 goto doubleresult;
8173 case JIM_EXPROP_DIV:
8174 if (dB == 0) {
8175 #ifdef INFINITY
8176 dC = dA < 0 ? -INFINITY : INFINITY;
8177 #else
8178 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8179 #endif
8181 else {
8182 dC = dA / dB;
8184 goto doubleresult;
8185 case JIM_EXPROP_LT:
8186 wC = dA < dB;
8187 goto intresult;
8188 case JIM_EXPROP_GT:
8189 wC = dA > dB;
8190 goto intresult;
8191 case JIM_EXPROP_LTE:
8192 wC = dA <= dB;
8193 goto intresult;
8194 case JIM_EXPROP_GTE:
8195 wC = dA >= dB;
8196 goto intresult;
8197 case JIM_EXPROP_NUMEQ:
8198 wC = dA == dB;
8199 goto intresult;
8200 case JIM_EXPROP_NUMNE:
8201 wC = dA != dB;
8202 goto intresult;
8205 else {
8206 /* Handle the string case */
8208 /* XXX: Could optimise the eq/ne case by checking lengths */
8209 int i = Jim_StringCompareObj(interp, A, B, 0);
8211 switch (node->type) {
8212 case JIM_EXPROP_LT:
8213 wC = i < 0;
8214 goto intresult;
8215 case JIM_EXPROP_GT:
8216 wC = i > 0;
8217 goto intresult;
8218 case JIM_EXPROP_LTE:
8219 wC = i <= 0;
8220 goto intresult;
8221 case JIM_EXPROP_GTE:
8222 wC = i >= 0;
8223 goto intresult;
8224 case JIM_EXPROP_NUMEQ:
8225 wC = i == 0;
8226 goto intresult;
8227 case JIM_EXPROP_NUMNE:
8228 wC = i != 0;
8229 goto intresult;
8232 /* If we get here, it is an error */
8233 rc = JIM_ERR;
8234 done:
8235 Jim_DecrRefCount(interp, A);
8236 Jim_DecrRefCount(interp, B);
8237 return rc;
8238 intresult:
8239 Jim_SetResultInt(interp, wC);
8240 goto done;
8241 doubleresult:
8242 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8243 goto done;
8246 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8248 int listlen;
8249 int i;
8251 listlen = Jim_ListLength(interp, listObjPtr);
8252 for (i = 0; i < listlen; i++) {
8253 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8254 return 1;
8257 return 0;
8262 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8264 Jim_Obj *A, *B;
8265 jim_wide wC;
8266 int rc;
8268 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8269 return rc;
8271 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8272 Jim_DecrRefCount(interp, A);
8273 return rc;
8276 switch (node->type) {
8277 case JIM_EXPROP_STREQ:
8278 case JIM_EXPROP_STRNE:
8279 wC = Jim_StringEqObj(A, B);
8280 if (node->type == JIM_EXPROP_STRNE) {
8281 wC = !wC;
8283 break;
8284 case JIM_EXPROP_STRIN:
8285 wC = JimSearchList(interp, B, A);
8286 break;
8287 case JIM_EXPROP_STRNI:
8288 wC = !JimSearchList(interp, B, A);
8289 break;
8290 default:
8291 abort();
8293 Jim_SetResultInt(interp, wC);
8295 Jim_DecrRefCount(interp, A);
8296 Jim_DecrRefCount(interp, B);
8298 return rc;
8301 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8303 long l;
8304 double d;
8305 int b;
8306 int ret = -1;
8308 /* In case the object is interp->result with refcount 1*/
8309 Jim_IncrRefCount(obj);
8311 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8312 ret = (l != 0);
8314 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8315 ret = (d != 0);
8317 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8318 ret = (b != 0);
8321 Jim_DecrRefCount(interp, obj);
8322 return ret;
8325 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8327 /* evaluate left */
8328 int result = JimExprGetTermBoolean(interp, node->left);
8330 if (result == 1) {
8331 /* true so evaluate right */
8332 result = JimExprGetTermBoolean(interp, node->right);
8334 if (result == -1) {
8335 return JIM_ERR;
8337 Jim_SetResultInt(interp, result);
8338 return JIM_OK;
8341 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8343 /* evaluate left */
8344 int result = JimExprGetTermBoolean(interp, node->left);
8346 if (result == 0) {
8347 /* false so evaluate right */
8348 result = JimExprGetTermBoolean(interp, node->right);
8350 if (result == -1) {
8351 return JIM_ERR;
8353 Jim_SetResultInt(interp, result);
8354 return JIM_OK;
8357 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8359 /* evaluate left */
8360 int result = JimExprGetTermBoolean(interp, node->left);
8362 if (result == 1) {
8363 /* true so select right */
8364 return JimExprEvalTermNode(interp, node->right);
8366 else if (result == 0) {
8367 /* false so select ternary */
8368 return JimExprEvalTermNode(interp, node->ternary);
8370 /* error */
8371 return JIM_ERR;
8374 enum
8376 OP_FUNC = 0x0001, /* function syntax */
8377 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8380 /* name - precedence - arity - opcode
8382 * This array *must* be kept in sync with the JIM_EXPROP enum.
8384 * The following macros pre-compute the string length at compile time.
8386 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8387 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8389 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8390 OPRINIT("*", 110, 2, JimExprOpBin),
8391 OPRINIT("/", 110, 2, JimExprOpBin),
8392 OPRINIT("%", 110, 2, JimExprOpIntBin),
8394 OPRINIT("-", 100, 2, JimExprOpBin),
8395 OPRINIT("+", 100, 2, JimExprOpBin),
8397 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8398 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8400 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8401 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8403 OPRINIT("<", 80, 2, JimExprOpBin),
8404 OPRINIT(">", 80, 2, JimExprOpBin),
8405 OPRINIT("<=", 80, 2, JimExprOpBin),
8406 OPRINIT(">=", 80, 2, JimExprOpBin),
8408 OPRINIT("==", 70, 2, JimExprOpBin),
8409 OPRINIT("!=", 70, 2, JimExprOpBin),
8411 OPRINIT("&", 50, 2, JimExprOpIntBin),
8412 OPRINIT("^", 49, 2, JimExprOpIntBin),
8413 OPRINIT("|", 48, 2, JimExprOpIntBin),
8415 OPRINIT("&&", 10, 2, JimExprOpAnd),
8416 OPRINIT("||", 9, 2, JimExprOpOr),
8417 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8418 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8420 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8421 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8423 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8424 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8426 OPRINIT("in", 55, 2, JimExprOpStrBin),
8427 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8429 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8430 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8431 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8432 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8436 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8437 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8438 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8439 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8440 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8441 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8442 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8444 #ifdef JIM_MATH_FUNCTIONS
8445 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8446 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8447 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8448 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8449 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8450 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8451 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8452 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8453 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8454 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8455 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8456 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8457 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8458 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8459 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8460 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8461 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8462 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8463 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8464 #endif
8466 #undef OPRINIT
8467 #undef OPRINIT_ATTR
8469 #define JIM_EXPR_OPERATORS_NUM \
8470 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8472 static int JimParseExpression(struct JimParserCtx *pc)
8474 /* Discard spaces and quoted newline */
8475 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8476 if (*pc->p == '\n') {
8477 pc->linenr++;
8479 pc->p++;
8480 pc->len--;
8483 /* Common case */
8484 pc->tline = pc->linenr;
8485 pc->tstart = pc->p;
8487 if (pc->len == 0) {
8488 pc->tend = pc->p;
8489 pc->tt = JIM_TT_EOL;
8490 pc->eof = 1;
8491 return JIM_OK;
8493 switch (*(pc->p)) {
8494 case '(':
8495 pc->tt = JIM_TT_SUBEXPR_START;
8496 goto singlechar;
8497 case ')':
8498 pc->tt = JIM_TT_SUBEXPR_END;
8499 goto singlechar;
8500 case ',':
8501 pc->tt = JIM_TT_SUBEXPR_COMMA;
8502 singlechar:
8503 pc->tend = pc->p;
8504 pc->p++;
8505 pc->len--;
8506 break;
8507 case '[':
8508 return JimParseCmd(pc);
8509 case '$':
8510 if (JimParseVar(pc) == JIM_ERR)
8511 return JimParseExprOperator(pc);
8512 else {
8513 /* Don't allow expr sugar in expressions */
8514 if (pc->tt == JIM_TT_EXPRSUGAR) {
8515 return JIM_ERR;
8517 return JIM_OK;
8519 break;
8520 case '0':
8521 case '1':
8522 case '2':
8523 case '3':
8524 case '4':
8525 case '5':
8526 case '6':
8527 case '7':
8528 case '8':
8529 case '9':
8530 case '.':
8531 return JimParseExprNumber(pc);
8532 case '"':
8533 return JimParseQuote(pc);
8534 case '{':
8535 return JimParseBrace(pc);
8537 case 'N':
8538 case 'I':
8539 case 'n':
8540 case 'i':
8541 if (JimParseExprIrrational(pc) == JIM_ERR)
8542 if (JimParseExprBoolean(pc) == JIM_ERR)
8543 return JimParseExprOperator(pc);
8544 break;
8545 case 't':
8546 case 'f':
8547 case 'o':
8548 case 'y':
8549 if (JimParseExprBoolean(pc) == JIM_ERR)
8550 return JimParseExprOperator(pc);
8551 break;
8552 default:
8553 return JimParseExprOperator(pc);
8554 break;
8556 return JIM_OK;
8559 static int JimParseExprNumber(struct JimParserCtx *pc)
8561 char *end;
8563 /* Assume an integer for now */
8564 pc->tt = JIM_TT_EXPR_INT;
8566 jim_strtoull(pc->p, (char **)&pc->p);
8567 /* Tried as an integer, but perhaps it parses as a double */
8568 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8569 /* Some stupid compilers insist they are cleverer that
8570 * we are. Even a (void) cast doesn't prevent this warning!
8572 if (strtod(pc->tstart, &end)) { /* nothing */ }
8573 if (end == pc->tstart)
8574 return JIM_ERR;
8575 if (end > pc->p) {
8576 /* Yes, double captured more chars */
8577 pc->tt = JIM_TT_EXPR_DOUBLE;
8578 pc->p = end;
8581 pc->tend = pc->p - 1;
8582 pc->len -= (pc->p - pc->tstart);
8583 return JIM_OK;
8586 static int JimParseExprIrrational(struct JimParserCtx *pc)
8588 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8589 int i;
8591 for (i = 0; irrationals[i]; i++) {
8592 const char *irr = irrationals[i];
8594 if (strncmp(irr, pc->p, 3) == 0) {
8595 pc->p += 3;
8596 pc->len -= 3;
8597 pc->tend = pc->p - 1;
8598 pc->tt = JIM_TT_EXPR_DOUBLE;
8599 return JIM_OK;
8602 return JIM_ERR;
8605 static int JimParseExprBoolean(struct JimParserCtx *pc)
8607 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8608 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8609 int i;
8611 for (i = 0; booleans[i]; i++) {
8612 const char *boolean = booleans[i];
8613 int length = lengths[i];
8615 if (strncmp(boolean, pc->p, length) == 0) {
8616 pc->p += length;
8617 pc->len -= length;
8618 pc->tend = pc->p - 1;
8619 pc->tt = JIM_TT_EXPR_BOOLEAN;
8620 return JIM_OK;
8623 return JIM_ERR;
8626 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8628 static Jim_ExprOperator dummy_op;
8629 if (opcode < JIM_TT_EXPR_OP) {
8630 return &dummy_op;
8632 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8635 static int JimParseExprOperator(struct JimParserCtx *pc)
8637 int i;
8638 const struct Jim_ExprOperator *bestOp = NULL;
8639 int bestLen = 0;
8641 /* Try to get the longest match. */
8642 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8643 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8645 if (op->name[0] != pc->p[0]) {
8646 continue;
8649 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8650 bestOp = op;
8651 bestLen = op->namelen;
8654 if (bestOp == NULL) {
8655 return JIM_ERR;
8658 /* Validate paretheses around function arguments */
8659 if (bestOp->attr & OP_FUNC) {
8660 const char *p = pc->p + bestLen;
8661 int len = pc->len - bestLen;
8663 while (len && isspace(UCHAR(*p))) {
8664 len--;
8665 p++;
8667 if (*p != '(') {
8668 return JIM_ERR;
8671 pc->tend = pc->p + bestLen - 1;
8672 pc->p += bestLen;
8673 pc->len -= bestLen;
8675 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8676 return JIM_OK;
8679 const char *jim_tt_name(int type)
8681 static const char * const tt_names[JIM_TT_EXPR_OP] =
8682 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8683 "DBL", "BOO", "$()" };
8684 if (type < JIM_TT_EXPR_OP) {
8685 return tt_names[type];
8687 else if (type == JIM_EXPROP_UNARYMINUS) {
8688 return "-VE";
8690 else if (type == JIM_EXPROP_UNARYPLUS) {
8691 return "+VE";
8693 else {
8694 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8695 static char buf[20];
8697 if (op->name) {
8698 return op->name;
8700 sprintf(buf, "(%d)", type);
8701 return buf;
8705 /* -----------------------------------------------------------------------------
8706 * Expression Object
8707 * ---------------------------------------------------------------------------*/
8708 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8709 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8710 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8712 static const Jim_ObjType exprObjType = {
8713 "expression",
8714 FreeExprInternalRep,
8715 DupExprInternalRep,
8716 NULL,
8717 JIM_TYPE_REFERENCES,
8720 /* expr tree structure */
8721 struct ExprTree
8723 struct JimExprNode *expr; /* The first operator or term */
8724 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8725 int len; /* Number of nodes in use */
8726 int inUse; /* Used for sharing. */
8729 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8731 int i;
8732 for (i = 0; i < num; i++) {
8733 if (nodes[i].objPtr) {
8734 Jim_DecrRefCount(interp, nodes[i].objPtr);
8737 Jim_Free(nodes);
8740 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8742 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8743 Jim_Free(expr);
8746 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8748 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8750 if (expr) {
8751 if (--expr->inUse != 0) {
8752 return;
8755 ExprTreeFree(interp, expr);
8759 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8761 JIM_NOTUSED(interp);
8762 JIM_NOTUSED(srcPtr);
8764 /* Just returns an simple string. */
8765 dupPtr->typePtr = NULL;
8768 struct ExprBuilder {
8769 int parencount; /* count of outstanding parentheses */
8770 int level; /* recursion depth */
8771 ParseToken *token; /* The current token */
8772 ParseToken *first_token; /* The first token */
8773 Jim_Stack stack; /* stack of pending terms */
8774 Jim_Obj *exprObjPtr; /* the original expression */
8775 Jim_Obj *fileNameObj; /* filename of the original expression */
8776 struct JimExprNode *nodes; /* storage for all nodes */
8777 struct JimExprNode *next; /* storage for the next node */
8780 #ifdef DEBUG_SHOW_EXPR
8781 static void JimShowExprNode(struct JimExprNode *node, int level)
8783 int i;
8784 for (i = 0; i < level; i++) {
8785 printf(" ");
8787 if (TOKEN_IS_EXPR_OP(node->type)) {
8788 printf("%s\n", jim_tt_name(node->type));
8789 if (node->left) {
8790 JimShowExprNode(node->left, level + 1);
8792 if (node->right) {
8793 JimShowExprNode(node->right, level + 1);
8795 if (node->ternary) {
8796 JimShowExprNode(node->ternary, level + 1);
8799 else {
8800 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8803 #endif
8805 #define EXPR_UNTIL_CLOSE 0x0001
8806 #define EXPR_FUNC_ARGS 0x0002
8807 #define EXPR_TERNARY 0x0004
8810 * Parse the subexpression at builder->token and return with the node on the stack.
8811 * builder->token is advanced to the next unconsumed token.
8812 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8814 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8815 * with an equal or lower precedence is reached (or strictly lower if right associative).
8817 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8818 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8819 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8821 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8823 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8825 int rc;
8826 struct JimExprNode *node;
8827 /* Calculate the stack length expected after pushing the number of expected terms */
8828 int exp_stacklen = builder->stack.len + exp_numterms;
8830 if (builder->level++ > 200) {
8831 Jim_SetResultString(interp, "Expression too complex", -1);
8832 return JIM_ERR;
8835 while (builder->token->type != JIM_TT_EOL) {
8836 ParseToken *t = builder->token++;
8837 int prevtt;
8839 if (t == builder->first_token) {
8840 prevtt = JIM_TT_NONE;
8842 else {
8843 prevtt = t[-1].type;
8846 if (t->type == JIM_TT_SUBEXPR_START) {
8847 if (builder->stack.len == exp_stacklen) {
8848 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8849 return JIM_ERR;
8851 builder->parencount++;
8852 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8853 if (rc != JIM_OK) {
8854 return rc;
8856 /* A complete subexpression is on the stack */
8858 else if (t->type == JIM_TT_SUBEXPR_END) {
8859 if (!(flags & EXPR_UNTIL_CLOSE)) {
8860 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8861 builder->token--;
8862 builder->level--;
8863 return JIM_OK;
8865 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8866 return JIM_ERR;
8868 builder->parencount--;
8869 if (builder->stack.len == exp_stacklen) {
8870 /* Return with the expected number of subexpressions on the stack */
8871 break;
8874 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8875 if (!(flags & EXPR_FUNC_ARGS)) {
8876 if (builder->stack.len == exp_stacklen) {
8877 /* handle the comma back at the parent level */
8878 builder->token--;
8879 builder->level--;
8880 return JIM_OK;
8882 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8883 return JIM_ERR;
8885 else {
8886 /* If we see more terms than expected, it is an error */
8887 if (builder->stack.len > exp_stacklen) {
8888 Jim_SetResultFormatted(interp, "too many arguments to math function");
8889 return JIM_ERR;
8892 /* just go onto the next arg */
8894 else if (t->type == JIM_EXPROP_COLON) {
8895 if (!(flags & EXPR_TERNARY)) {
8896 if (builder->level != 1) {
8897 /* handle the comma back at the parent level */
8898 builder->token--;
8899 builder->level--;
8900 return JIM_OK;
8902 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8903 return JIM_ERR;
8905 if (builder->stack.len == exp_stacklen) {
8906 /* handle the comma back at the parent level */
8907 builder->token--;
8908 builder->level--;
8909 return JIM_OK;
8911 /* just go onto the next term */
8913 else if (TOKEN_IS_EXPR_OP(t->type)) {
8914 const struct Jim_ExprOperator *op;
8916 /* Convert -/+ to unary minus or unary plus if necessary */
8917 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8918 if (t->type == JIM_EXPROP_SUB) {
8919 t->type = JIM_EXPROP_UNARYMINUS;
8921 else if (t->type == JIM_EXPROP_ADD) {
8922 t->type = JIM_EXPROP_UNARYPLUS;
8926 op = JimExprOperatorInfoByOpcode(t->type);
8928 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8929 /* next op is lower precedence, or equal and left associative, so done here */
8930 builder->token--;
8931 break;
8934 if (op->attr & OP_FUNC) {
8935 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8936 Jim_SetResultString(interp, "missing arguments for math function", -1);
8937 return JIM_ERR;
8939 builder->token++;
8940 if (op->arity == 0) {
8941 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8942 Jim_SetResultString(interp, "too many arguments for math function", -1);
8943 return JIM_ERR;
8945 builder->token++;
8946 goto noargs;
8948 builder->parencount++;
8950 /* This will push left and return right */
8951 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8953 else if (t->type == JIM_EXPROP_TERNARY) {
8954 /* Collect the two arguments to the ternary operator */
8955 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8957 else {
8958 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8959 * and push that on the term stack
8961 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8964 if (rc != JIM_OK) {
8965 return rc;
8968 noargs:
8969 node = builder->next++;
8970 node->type = t->type;
8972 if (op->arity >= 3) {
8973 node->ternary = Jim_StackPop(&builder->stack);
8974 if (node->ternary == NULL) {
8975 goto missingoperand;
8978 if (op->arity >= 2) {
8979 node->right = Jim_StackPop(&builder->stack);
8980 if (node->right == NULL) {
8981 goto missingoperand;
8984 if (op->arity >= 1) {
8985 node->left = Jim_StackPop(&builder->stack);
8986 if (node->left == NULL) {
8987 missingoperand:
8988 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8989 builder->next--;
8990 return JIM_ERR;
8995 /* Now push the node */
8996 Jim_StackPush(&builder->stack, node);
8998 else {
8999 Jim_Obj *objPtr = NULL;
9001 /* This is a simple non-operator term, so create and push the appropriate object */
9003 /* Two consecutive terms without an operator is invalid */
9004 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9005 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
9006 return JIM_ERR;
9009 /* Immediately create a double or int object? */
9010 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9011 char *endptr;
9012 if (t->type == JIM_TT_EXPR_INT) {
9013 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9015 else {
9016 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9018 if (endptr != t->token + t->len) {
9019 /* Conversion failed, so just store it as a string */
9020 Jim_FreeNewObj(interp, objPtr);
9021 objPtr = NULL;
9025 if (!objPtr) {
9026 /* Everything else is stored a simple string term */
9027 objPtr = Jim_NewStringObj(interp, t->token, t->len);
9028 if (t->type == JIM_TT_CMD) {
9029 /* Only commands need source info */
9030 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
9034 /* Now push a term node */
9035 node = builder->next++;
9036 node->objPtr = objPtr;
9037 Jim_IncrRefCount(node->objPtr);
9038 node->type = t->type;
9039 Jim_StackPush(&builder->stack, node);
9043 if (builder->stack.len == exp_stacklen) {
9044 builder->level--;
9045 return JIM_OK;
9048 if ((flags & EXPR_FUNC_ARGS)) {
9049 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9051 else {
9052 if (builder->stack.len < exp_stacklen) {
9053 if (builder->level == 0) {
9054 Jim_SetResultFormatted(interp, "empty expression");
9056 else {
9057 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9060 else {
9061 Jim_SetResultFormatted(interp, "extra terms after expression");
9065 return JIM_ERR;
9068 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9070 struct ExprTree *expr;
9071 struct ExprBuilder builder;
9072 int rc;
9073 struct JimExprNode *top = NULL;
9075 builder.parencount = 0;
9076 builder.level = 0;
9077 builder.token = builder.first_token = tokenlist->list;
9078 builder.exprObjPtr = exprObjPtr;
9079 builder.fileNameObj = fileNameObj;
9080 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9081 builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9082 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9083 builder.next = builder.nodes;
9084 Jim_InitStack(&builder.stack);
9086 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9088 if (rc == JIM_OK) {
9089 top = Jim_StackPop(&builder.stack);
9091 if (builder.parencount) {
9092 Jim_SetResultString(interp, "missing close parenthesis", -1);
9093 rc = JIM_ERR;
9097 /* Free the stack used for the compilation. */
9098 Jim_FreeStack(&builder.stack);
9100 if (rc != JIM_OK) {
9101 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9102 return NULL;
9105 expr = Jim_Alloc(sizeof(*expr));
9106 expr->inUse = 1;
9107 expr->expr = top;
9108 expr->nodes = builder.nodes;
9109 expr->len = builder.next - builder.nodes;
9111 assert(expr->len <= tokenlist->count - 1);
9113 return expr;
9116 /* This method takes the string representation of an expression
9117 * and generates a program for the expr engine */
9118 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9120 int exprTextLen;
9121 const char *exprText;
9122 struct JimParserCtx parser;
9123 struct ExprTree *expr;
9124 ParseTokenList tokenlist;
9125 int line;
9126 Jim_Obj *fileNameObj;
9127 int rc = JIM_ERR;
9129 /* Try to get information about filename / line number */
9130 if (objPtr->typePtr == &sourceObjType) {
9131 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9132 line = objPtr->internalRep.sourceValue.lineNumber;
9134 else {
9135 fileNameObj = interp->emptyObj;
9136 line = 1;
9138 Jim_IncrRefCount(fileNameObj);
9140 exprText = Jim_GetString(objPtr, &exprTextLen);
9142 /* Initially tokenise the expression into tokenlist */
9143 ScriptTokenListInit(&tokenlist);
9145 JimParserInit(&parser, exprText, exprTextLen, line);
9146 while (!parser.eof) {
9147 if (JimParseExpression(&parser) != JIM_OK) {
9148 ScriptTokenListFree(&tokenlist);
9149 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9150 expr = NULL;
9151 goto err;
9154 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9155 parser.tline);
9158 #ifdef DEBUG_SHOW_EXPR_TOKENS
9160 int i;
9161 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9162 for (i = 0; i < tokenlist.count; i++) {
9163 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9164 tokenlist.list[i].len, tokenlist.list[i].token);
9167 #endif
9169 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9170 ScriptTokenListFree(&tokenlist);
9171 Jim_DecrRefCount(interp, fileNameObj);
9172 return JIM_ERR;
9175 /* Now create the expression bytecode from the tokenlist */
9176 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9178 /* No longer need the token list */
9179 ScriptTokenListFree(&tokenlist);
9181 if (!expr) {
9182 goto err;
9185 #ifdef DEBUG_SHOW_EXPR
9186 printf("==== Expr ====\n");
9187 JimShowExprNode(expr->expr, 0);
9188 #endif
9190 rc = JIM_OK;
9192 err:
9193 /* Free the old internal rep and set the new one. */
9194 Jim_DecrRefCount(interp, fileNameObj);
9195 Jim_FreeIntRep(interp, objPtr);
9196 Jim_SetIntRepPtr(objPtr, expr);
9197 objPtr->typePtr = &exprObjType;
9198 return rc;
9201 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9203 if (objPtr->typePtr != &exprObjType) {
9204 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9205 return NULL;
9208 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9211 #ifdef JIM_OPTIMIZATION
9212 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9214 if (node->type == JIM_TT_EXPR_INT)
9215 return node->objPtr;
9216 else if (node->type == JIM_TT_VAR)
9217 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9218 else if (node->type == JIM_TT_DICTSUGAR)
9219 return JimExpandDictSugar(interp, node->objPtr);
9220 else
9221 return NULL;
9223 #endif
9225 /* -----------------------------------------------------------------------------
9226 * Expressions evaluation.
9227 * Jim uses a recursive evaluation engine for expressions,
9228 * that takes advantage of the fact that expr's operators
9229 * can't be redefined.
9231 * Jim_EvalExpression() uses the expression tree compiled by
9232 * SetExprFromAny() method of the "expression" object.
9234 * On success a Tcl Object containing the result of the evaluation
9235 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9236 * returned.
9237 * On error the function returns a retcode != to JIM_OK and set a suitable
9238 * error on the interp.
9239 * ---------------------------------------------------------------------------*/
9241 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9243 if (TOKEN_IS_EXPR_OP(node->type)) {
9244 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9245 return op->funcop(interp, node);
9247 else {
9248 Jim_Obj *objPtr;
9250 /* A term */
9251 switch (node->type) {
9252 case JIM_TT_EXPR_INT:
9253 case JIM_TT_EXPR_DOUBLE:
9254 case JIM_TT_EXPR_BOOLEAN:
9255 case JIM_TT_STR:
9256 Jim_SetResult(interp, node->objPtr);
9257 return JIM_OK;
9259 case JIM_TT_VAR:
9260 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9261 if (objPtr) {
9262 Jim_SetResult(interp, objPtr);
9263 return JIM_OK;
9265 return JIM_ERR;
9267 case JIM_TT_DICTSUGAR:
9268 objPtr = JimExpandDictSugar(interp, node->objPtr);
9269 if (objPtr) {
9270 Jim_SetResult(interp, objPtr);
9271 return JIM_OK;
9273 return JIM_ERR;
9275 case JIM_TT_ESC:
9276 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9277 Jim_SetResult(interp, objPtr);
9278 return JIM_OK;
9280 return JIM_ERR;
9282 case JIM_TT_CMD:
9283 return Jim_EvalObj(interp, node->objPtr);
9285 default:
9286 /* Should never get here */
9287 return JIM_ERR;
9292 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9294 int rc = JimExprEvalTermNode(interp, node);
9295 if (rc == JIM_OK) {
9296 *objPtrPtr = Jim_GetResult(interp);
9297 Jim_IncrRefCount(*objPtrPtr);
9299 return rc;
9302 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9304 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9305 return ExprBool(interp, Jim_GetResult(interp));
9307 return -1;
9310 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9312 struct ExprTree *expr;
9313 int retcode = JIM_OK;
9315 expr = JimGetExpression(interp, exprObjPtr);
9316 if (!expr) {
9317 return JIM_ERR; /* error in expression. */
9320 #ifdef JIM_OPTIMIZATION
9321 /* Check for one of the following common expressions used by while/for
9323 * CONST
9324 * $a
9325 * !$a
9326 * $a < CONST, $a < $b
9327 * $a <= CONST, $a <= $b
9328 * $a > CONST, $a > $b
9329 * $a >= CONST, $a >= $b
9330 * $a != CONST, $a != $b
9331 * $a == CONST, $a == $b
9334 Jim_Obj *objPtr;
9336 /* STEP 1 -- Check if there are the conditions to run the specialized
9337 * version of while */
9339 switch (expr->len) {
9340 case 1:
9341 objPtr = JimExprIntValOrVar(interp, expr->expr);
9342 if (objPtr) {
9343 Jim_SetResult(interp, objPtr);
9344 return JIM_OK;
9346 break;
9348 case 2:
9349 if (expr->expr->type == JIM_EXPROP_NOT) {
9350 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9352 if (objPtr && JimIsWide(objPtr)) {
9353 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9354 return JIM_OK;
9357 break;
9359 case 3:
9360 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9361 if (objPtr && JimIsWide(objPtr)) {
9362 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9363 if (objPtr2 && JimIsWide(objPtr2)) {
9364 jim_wide wideValueA = JimWideValue(objPtr);
9365 jim_wide wideValueB = JimWideValue(objPtr2);
9366 int cmpRes;
9367 switch (expr->expr->type) {
9368 case JIM_EXPROP_LT:
9369 cmpRes = wideValueA < wideValueB;
9370 break;
9371 case JIM_EXPROP_LTE:
9372 cmpRes = wideValueA <= wideValueB;
9373 break;
9374 case JIM_EXPROP_GT:
9375 cmpRes = wideValueA > wideValueB;
9376 break;
9377 case JIM_EXPROP_GTE:
9378 cmpRes = wideValueA >= wideValueB;
9379 break;
9380 case JIM_EXPROP_NUMEQ:
9381 cmpRes = wideValueA == wideValueB;
9382 break;
9383 case JIM_EXPROP_NUMNE:
9384 cmpRes = wideValueA != wideValueB;
9385 break;
9386 default:
9387 goto noopt;
9389 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9390 return JIM_OK;
9393 break;
9396 noopt:
9397 #endif
9399 /* In order to avoid the internal repr being freed due to
9400 * shimmering of the exprObjPtr's object, we make the internal rep
9401 * shared. */
9402 expr->inUse++;
9404 /* Evaluate with the recursive expr engine */
9405 retcode = JimExprEvalTermNode(interp, expr->expr);
9407 expr->inUse--;
9409 return retcode;
9412 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9414 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9416 if (retcode == JIM_OK) {
9417 switch (ExprBool(interp, Jim_GetResult(interp))) {
9418 case 0:
9419 *boolPtr = 0;
9420 break;
9422 case 1:
9423 *boolPtr = 1;
9424 break;
9426 case -1:
9427 retcode = JIM_ERR;
9428 break;
9431 return retcode;
9434 /* -----------------------------------------------------------------------------
9435 * ScanFormat String Object
9436 * ---------------------------------------------------------------------------*/
9438 /* This Jim_Obj will held a parsed representation of a format string passed to
9439 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9440 * to be parsed in its entirely first and then, if correct, can be used for
9441 * scanning. To avoid endless re-parsing, the parsed representation will be
9442 * stored in an internal representation and re-used for performance reason. */
9444 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9445 * scanformat string. This part will later be used to extract information
9446 * out from the string to be parsed by Jim_ScanString */
9448 typedef struct ScanFmtPartDescr
9450 const char *arg; /* Specification of a CHARSET conversion */
9451 const char *prefix; /* Prefix to be scanned literally before conversion */
9452 size_t width; /* Maximal width of input to be converted */
9453 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9454 char type; /* Type of conversion (e.g. c, d, f) */
9455 char modifier; /* Modify type (e.g. l - long, h - short */
9456 } ScanFmtPartDescr;
9458 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9459 * string parsed and separated in part descriptions. Furthermore it contains
9460 * the original string representation of the scanformat string to allow for
9461 * fast update of the Jim_Obj's string representation part.
9463 * As an add-on the internal object representation adds some scratch pad area
9464 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9465 * memory for purpose of string scanning.
9467 * The error member points to a static allocated string in case of a mal-
9468 * formed scanformat string or it contains '0' (NULL) in case of a valid
9469 * parse representation.
9471 * The whole memory of the internal representation is allocated as a single
9472 * area of memory that will be internally separated. So freeing and duplicating
9473 * of such an object is cheap */
9475 typedef struct ScanFmtStringObj
9477 jim_wide size; /* Size of internal repr in bytes */
9478 char *stringRep; /* Original string representation */
9479 size_t count; /* Number of ScanFmtPartDescr contained */
9480 size_t convCount; /* Number of conversions that will assign */
9481 size_t maxPos; /* Max position index if XPG3 is used */
9482 const char *error; /* Ptr to error text (NULL if no error */
9483 char *scratch; /* Some scratch pad used by Jim_ScanString */
9484 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9485 } ScanFmtStringObj;
9488 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9489 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9490 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9492 static const Jim_ObjType scanFmtStringObjType = {
9493 "scanformatstring",
9494 FreeScanFmtInternalRep,
9495 DupScanFmtInternalRep,
9496 UpdateStringOfScanFmt,
9497 JIM_TYPE_NONE,
9500 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9502 JIM_NOTUSED(interp);
9503 Jim_Free((char *)objPtr->internalRep.ptr);
9504 objPtr->internalRep.ptr = 0;
9507 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9509 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9510 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9512 JIM_NOTUSED(interp);
9513 memcpy(newVec, srcPtr->internalRep.ptr, size);
9514 dupPtr->internalRep.ptr = newVec;
9515 dupPtr->typePtr = &scanFmtStringObjType;
9518 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9520 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9523 /* SetScanFmtFromAny will parse a given string and create the internal
9524 * representation of the format specification. In case of an error
9525 * the error data member of the internal representation will be set
9526 * to an descriptive error text and the function will be left with
9527 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9528 * specification */
9530 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9532 ScanFmtStringObj *fmtObj;
9533 char *buffer;
9534 int maxCount, i, approxSize, lastPos = -1;
9535 const char *fmt = Jim_String(objPtr);
9536 int maxFmtLen = Jim_Length(objPtr);
9537 const char *fmtEnd = fmt + maxFmtLen;
9538 int curr;
9540 Jim_FreeIntRep(interp, objPtr);
9541 /* Count how many conversions could take place maximally */
9542 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9543 if (fmt[i] == '%')
9544 ++maxCount;
9545 /* Calculate an approximation of the memory necessary */
9546 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9547 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9548 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9549 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9550 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9551 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9552 +1; /* safety byte */
9553 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9554 memset(fmtObj, 0, approxSize);
9555 fmtObj->size = approxSize;
9556 fmtObj->maxPos = 0;
9557 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9558 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9559 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9560 buffer = fmtObj->stringRep + maxFmtLen + 1;
9561 objPtr->internalRep.ptr = fmtObj;
9562 objPtr->typePtr = &scanFmtStringObjType;
9563 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9564 int width = 0, skip;
9565 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9567 fmtObj->count++;
9568 descr->width = 0; /* Assume width unspecified */
9569 /* Overread and store any "literal" prefix */
9570 if (*fmt != '%' || fmt[1] == '%') {
9571 descr->type = 0;
9572 descr->prefix = &buffer[i];
9573 for (; fmt < fmtEnd; ++fmt) {
9574 if (*fmt == '%') {
9575 if (fmt[1] != '%')
9576 break;
9577 ++fmt;
9579 buffer[i++] = *fmt;
9581 buffer[i++] = 0;
9583 /* Skip the conversion introducing '%' sign */
9584 ++fmt;
9585 /* End reached due to non-conversion literal only? */
9586 if (fmt >= fmtEnd)
9587 goto done;
9588 descr->pos = 0; /* Assume "natural" positioning */
9589 if (*fmt == '*') {
9590 descr->pos = -1; /* Okay, conversion will not be assigned */
9591 ++fmt;
9593 else
9594 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9595 /* Check if next token is a number (could be width or pos */
9596 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9597 fmt += skip;
9598 /* Was the number a XPG3 position specifier? */
9599 if (descr->pos != -1 && *fmt == '$') {
9600 int prev;
9602 ++fmt;
9603 descr->pos = width;
9604 width = 0;
9605 /* Look if "natural" postioning and XPG3 one was mixed */
9606 if ((lastPos == 0 && descr->pos > 0)
9607 || (lastPos > 0 && descr->pos == 0)) {
9608 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9609 return JIM_ERR;
9611 /* Look if this position was already used */
9612 for (prev = 0; prev < curr; ++prev) {
9613 if (fmtObj->descr[prev].pos == -1)
9614 continue;
9615 if (fmtObj->descr[prev].pos == descr->pos) {
9616 fmtObj->error =
9617 "variable is assigned by multiple \"%n$\" conversion specifiers";
9618 return JIM_ERR;
9621 if (descr->pos < 0) {
9622 fmtObj->error =
9623 "\"%n$\" conversion specifier is negative";
9624 return JIM_ERR;
9626 /* Try to find a width after the XPG3 specifier */
9627 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9628 descr->width = width;
9629 fmt += skip;
9631 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9632 fmtObj->maxPos = descr->pos;
9634 else {
9635 /* Number was not a XPG3, so it has to be a width */
9636 descr->width = width;
9639 /* If positioning mode was undetermined yet, fix this */
9640 if (lastPos == -1)
9641 lastPos = descr->pos;
9642 /* Handle CHARSET conversion type ... */
9643 if (*fmt == '[') {
9644 int swapped = 1, beg = i, end, j;
9646 descr->type = '[';
9647 descr->arg = &buffer[i];
9648 ++fmt;
9649 if (*fmt == '^')
9650 buffer[i++] = *fmt++;
9651 if (*fmt == ']')
9652 buffer[i++] = *fmt++;
9653 while (*fmt && *fmt != ']')
9654 buffer[i++] = *fmt++;
9655 if (*fmt != ']') {
9656 fmtObj->error = "unmatched [ in format string";
9657 return JIM_ERR;
9659 end = i;
9660 buffer[i++] = 0;
9661 /* In case a range fence was given "backwards", swap it */
9662 while (swapped) {
9663 swapped = 0;
9664 for (j = beg + 1; j < end - 1; ++j) {
9665 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9666 char tmp = buffer[j - 1];
9668 buffer[j - 1] = buffer[j + 1];
9669 buffer[j + 1] = tmp;
9670 swapped = 1;
9675 else {
9676 /* Remember any valid modifier if given */
9677 if (fmt < fmtEnd && strchr("hlL", *fmt))
9678 descr->modifier = tolower((int)*fmt++);
9680 if (fmt >= fmtEnd) {
9681 fmtObj->error = "missing scan conversion character";
9682 return JIM_ERR;
9685 descr->type = *fmt;
9686 if (strchr("efgcsndoxui", *fmt) == 0) {
9687 fmtObj->error = "bad scan conversion character";
9688 return JIM_ERR;
9690 else if (*fmt == 'c' && descr->width != 0) {
9691 fmtObj->error = "field width may not be specified in %c " "conversion";
9692 return JIM_ERR;
9694 else if (*fmt == 'u' && descr->modifier == 'l') {
9695 fmtObj->error = "unsigned wide not supported";
9696 return JIM_ERR;
9699 curr++;
9701 done:
9702 return JIM_OK;
9705 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9707 #define FormatGetCnvCount(_fo_) \
9708 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9709 #define FormatGetMaxPos(_fo_) \
9710 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9711 #define FormatGetError(_fo_) \
9712 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9714 /* JimScanAString is used to scan an unspecified string that ends with
9715 * next WS, or a string that is specified via a charset.
9718 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9720 char *buffer = Jim_StrDup(str);
9721 char *p = buffer;
9723 while (*str) {
9724 int c;
9725 int n;
9727 if (!sdescr && isspace(UCHAR(*str)))
9728 break; /* EOS via WS if unspecified */
9730 n = utf8_tounicode(str, &c);
9731 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9732 break;
9733 while (n--)
9734 *p++ = *str++;
9736 *p = 0;
9737 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9740 /* ScanOneEntry will scan one entry out of the string passed as argument.
9741 * It use the sscanf() function for this task. After extracting and
9742 * converting of the value, the count of scanned characters will be
9743 * returned of -1 in case of no conversion tool place and string was
9744 * already scanned thru */
9746 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9747 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9749 const char *tok;
9750 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9751 size_t scanned = 0;
9752 size_t anchor = pos;
9753 int i;
9754 Jim_Obj *tmpObj = NULL;
9756 /* First pessimistically assume, we will not scan anything :-) */
9757 *valObjPtr = 0;
9758 if (descr->prefix) {
9759 /* There was a prefix given before the conversion, skip it and adjust
9760 * the string-to-be-parsed accordingly */
9761 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9762 /* If prefix require, skip WS */
9763 if (isspace(UCHAR(descr->prefix[i])))
9764 while (pos < strLen && isspace(UCHAR(str[pos])))
9765 ++pos;
9766 else if (descr->prefix[i] != str[pos])
9767 break; /* Prefix do not match here, leave the loop */
9768 else
9769 ++pos; /* Prefix matched so far, next round */
9771 if (pos >= strLen) {
9772 return -1; /* All of str consumed: EOF condition */
9774 else if (descr->prefix[i] != 0)
9775 return 0; /* Not whole prefix consumed, no conversion possible */
9777 /* For all but following conversion, skip leading WS */
9778 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9779 while (isspace(UCHAR(str[pos])))
9780 ++pos;
9781 /* Determine how much skipped/scanned so far */
9782 scanned = pos - anchor;
9784 /* %c is a special, simple case. no width */
9785 if (descr->type == 'n') {
9786 /* Return pseudo conversion means: how much scanned so far? */
9787 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9789 else if (pos >= strLen) {
9790 /* Cannot scan anything, as str is totally consumed */
9791 return -1;
9793 else if (descr->type == 'c') {
9794 int c;
9795 scanned += utf8_tounicode(&str[pos], &c);
9796 *valObjPtr = Jim_NewIntObj(interp, c);
9797 return scanned;
9799 else {
9800 /* Processing of conversions follows ... */
9801 if (descr->width > 0) {
9802 /* Do not try to scan as fas as possible but only the given width.
9803 * To ensure this, we copy the part that should be scanned. */
9804 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9805 size_t tLen = descr->width > sLen ? sLen : descr->width;
9807 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9808 tok = tmpObj->bytes;
9810 else {
9811 /* As no width was given, simply refer to the original string */
9812 tok = &str[pos];
9814 switch (descr->type) {
9815 case 'd':
9816 case 'o':
9817 case 'x':
9818 case 'u':
9819 case 'i':{
9820 char *endp; /* Position where the number finished */
9821 jim_wide w;
9823 int base = descr->type == 'o' ? 8
9824 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9826 /* Try to scan a number with the given base */
9827 if (base == 0) {
9828 w = jim_strtoull(tok, &endp);
9830 else {
9831 w = strtoull(tok, &endp, base);
9834 if (endp != tok) {
9835 /* There was some number sucessfully scanned! */
9836 *valObjPtr = Jim_NewIntObj(interp, w);
9838 /* Adjust the number-of-chars scanned so far */
9839 scanned += endp - tok;
9841 else {
9842 /* Nothing was scanned. We have to determine if this
9843 * happened due to e.g. prefix mismatch or input str
9844 * exhausted */
9845 scanned = *tok ? 0 : -1;
9847 break;
9849 case 's':
9850 case '[':{
9851 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9852 scanned += Jim_Length(*valObjPtr);
9853 break;
9855 case 'e':
9856 case 'f':
9857 case 'g':{
9858 char *endp;
9859 double value = strtod(tok, &endp);
9861 if (endp != tok) {
9862 /* There was some number sucessfully scanned! */
9863 *valObjPtr = Jim_NewDoubleObj(interp, value);
9864 /* Adjust the number-of-chars scanned so far */
9865 scanned += endp - tok;
9867 else {
9868 /* Nothing was scanned. We have to determine if this
9869 * happened due to e.g. prefix mismatch or input str
9870 * exhausted */
9871 scanned = *tok ? 0 : -1;
9873 break;
9876 /* If a substring was allocated (due to pre-defined width) do not
9877 * forget to free it */
9878 if (tmpObj) {
9879 Jim_FreeNewObj(interp, tmpObj);
9882 return scanned;
9885 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9886 * string and returns all converted (and not ignored) values in a list back
9887 * to the caller. If an error occured, a NULL pointer will be returned */
9889 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9891 size_t i, pos;
9892 int scanned = 1;
9893 const char *str = Jim_String(strObjPtr);
9894 int strLen = Jim_Utf8Length(interp, strObjPtr);
9895 Jim_Obj *resultList = 0;
9896 Jim_Obj **resultVec = 0;
9897 int resultc;
9898 Jim_Obj *emptyStr = 0;
9899 ScanFmtStringObj *fmtObj;
9901 /* This should never happen. The format object should already be of the correct type */
9902 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9904 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9905 /* Check if format specification was valid */
9906 if (fmtObj->error != 0) {
9907 if (flags & JIM_ERRMSG)
9908 Jim_SetResultString(interp, fmtObj->error, -1);
9909 return 0;
9911 /* Allocate a new "shared" empty string for all unassigned conversions */
9912 emptyStr = Jim_NewEmptyStringObj(interp);
9913 Jim_IncrRefCount(emptyStr);
9914 /* Create a list and fill it with empty strings up to max specified XPG3 */
9915 resultList = Jim_NewListObj(interp, NULL, 0);
9916 if (fmtObj->maxPos > 0) {
9917 for (i = 0; i < fmtObj->maxPos; ++i)
9918 Jim_ListAppendElement(interp, resultList, emptyStr);
9919 JimListGetElements(interp, resultList, &resultc, &resultVec);
9921 /* Now handle every partial format description */
9922 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9923 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9924 Jim_Obj *value = 0;
9926 /* Only last type may be "literal" w/o conversion - skip it! */
9927 if (descr->type == 0)
9928 continue;
9929 /* As long as any conversion could be done, we will proceed */
9930 if (scanned > 0)
9931 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9932 /* In case our first try results in EOF, we will leave */
9933 if (scanned == -1 && i == 0)
9934 goto eof;
9935 /* Advance next pos-to-be-scanned for the amount scanned already */
9936 pos += scanned;
9938 /* value == 0 means no conversion took place so take empty string */
9939 if (value == 0)
9940 value = Jim_NewEmptyStringObj(interp);
9941 /* If value is a non-assignable one, skip it */
9942 if (descr->pos == -1) {
9943 Jim_FreeNewObj(interp, value);
9945 else if (descr->pos == 0)
9946 /* Otherwise append it to the result list if no XPG3 was given */
9947 Jim_ListAppendElement(interp, resultList, value);
9948 else if (resultVec[descr->pos - 1] == emptyStr) {
9949 /* But due to given XPG3, put the value into the corr. slot */
9950 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9951 Jim_IncrRefCount(value);
9952 resultVec[descr->pos - 1] = value;
9954 else {
9955 /* Otherwise, the slot was already used - free obj and ERROR */
9956 Jim_FreeNewObj(interp, value);
9957 goto err;
9960 Jim_DecrRefCount(interp, emptyStr);
9961 return resultList;
9962 eof:
9963 Jim_DecrRefCount(interp, emptyStr);
9964 Jim_FreeNewObj(interp, resultList);
9965 return (Jim_Obj *)EOF;
9966 err:
9967 Jim_DecrRefCount(interp, emptyStr);
9968 Jim_FreeNewObj(interp, resultList);
9969 return 0;
9972 /* -----------------------------------------------------------------------------
9973 * Pseudo Random Number Generation
9974 * ---------------------------------------------------------------------------*/
9975 /* Initialize the sbox with the numbers from 0 to 255 */
9976 static void JimPrngInit(Jim_Interp *interp)
9978 #define PRNG_SEED_SIZE 256
9979 int i;
9980 unsigned int *seed;
9981 time_t t = time(NULL);
9983 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9985 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9986 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9987 seed[i] = (rand() ^ t ^ clock());
9989 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9990 Jim_Free(seed);
9993 /* Generates N bytes of random data */
9994 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9996 Jim_PrngState *prng;
9997 unsigned char *destByte = (unsigned char *)dest;
9998 unsigned int si, sj, x;
10000 /* initialization, only needed the first time */
10001 if (interp->prngState == NULL)
10002 JimPrngInit(interp);
10003 prng = interp->prngState;
10004 /* generates 'len' bytes of pseudo-random numbers */
10005 for (x = 0; x < len; x++) {
10006 prng->i = (prng->i + 1) & 0xff;
10007 si = prng->sbox[prng->i];
10008 prng->j = (prng->j + si) & 0xff;
10009 sj = prng->sbox[prng->j];
10010 prng->sbox[prng->i] = sj;
10011 prng->sbox[prng->j] = si;
10012 *destByte++ = prng->sbox[(si + sj) & 0xff];
10016 /* Re-seed the generator with user-provided bytes */
10017 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10019 int i;
10020 Jim_PrngState *prng;
10022 /* initialization, only needed the first time */
10023 if (interp->prngState == NULL)
10024 JimPrngInit(interp);
10025 prng = interp->prngState;
10027 /* Set the sbox[i] with i */
10028 for (i = 0; i < 256; i++)
10029 prng->sbox[i] = i;
10030 /* Now use the seed to perform a random permutation of the sbox */
10031 for (i = 0; i < seedLen; i++) {
10032 unsigned char t;
10034 t = prng->sbox[i & 0xFF];
10035 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10036 prng->sbox[seed[i]] = t;
10038 prng->i = prng->j = 0;
10040 /* discard at least the first 256 bytes of stream.
10041 * borrow the seed buffer for this
10043 for (i = 0; i < 256; i += seedLen) {
10044 JimRandomBytes(interp, seed, seedLen);
10048 /* [incr] */
10049 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10051 jim_wide wideValue, increment = 1;
10052 Jim_Obj *intObjPtr;
10054 if (argc != 2 && argc != 3) {
10055 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10056 return JIM_ERR;
10058 if (argc == 3) {
10059 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10060 return JIM_ERR;
10062 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10063 if (!intObjPtr) {
10064 /* Set missing variable to 0 */
10065 wideValue = 0;
10067 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10068 return JIM_ERR;
10070 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10071 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10072 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10073 Jim_FreeNewObj(interp, intObjPtr);
10074 return JIM_ERR;
10077 else {
10078 /* Can do it the quick way */
10079 Jim_InvalidateStringRep(intObjPtr);
10080 JimWideValue(intObjPtr) = wideValue + increment;
10082 /* The following step is required in order to invalidate the
10083 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10084 if (argv[1]->typePtr != &variableObjType) {
10085 /* Note that this can't fail since GetVariable already succeeded */
10086 Jim_SetVariable(interp, argv[1], intObjPtr);
10089 Jim_SetResult(interp, intObjPtr);
10090 return JIM_OK;
10094 /* -----------------------------------------------------------------------------
10095 * Eval
10096 * ---------------------------------------------------------------------------*/
10097 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10098 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10100 /* Handle calls to the [unknown] command */
10101 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10103 int retcode;
10105 /* If JimUnknown() is recursively called too many times...
10106 * done here
10108 if (interp->unknown_called > 50) {
10109 return JIM_ERR;
10112 /* The object interp->unknown just contains
10113 * the "unknown" string, it is used in order to
10114 * avoid to lookup the unknown command every time
10115 * but instead to cache the result. */
10117 /* If the [unknown] command does not exist ... */
10118 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10119 return JIM_ERR;
10121 interp->unknown_called++;
10122 /* XXX: Are we losing fileNameObj and linenr? */
10123 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10124 interp->unknown_called--;
10126 return retcode;
10129 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10131 int retcode;
10132 Jim_Cmd *cmdPtr;
10133 void *prevPrivData;
10135 #if 0
10136 printf("invoke");
10137 int j;
10138 for (j = 0; j < objc; j++) {
10139 printf(" '%s'", Jim_String(objv[j]));
10141 printf("\n");
10142 #endif
10144 if (interp->framePtr->tailcallCmd) {
10145 /* Special tailcall command was pre-resolved */
10146 cmdPtr = interp->framePtr->tailcallCmd;
10147 interp->framePtr->tailcallCmd = NULL;
10149 else {
10150 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10151 if (cmdPtr == NULL) {
10152 return JimUnknown(interp, objc, objv);
10154 JimIncrCmdRefCount(cmdPtr);
10157 if (interp->evalDepth == interp->maxEvalDepth) {
10158 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10159 retcode = JIM_ERR;
10160 goto out;
10162 interp->evalDepth++;
10163 prevPrivData = interp->cmdPrivData;
10165 /* Call it -- Make sure result is an empty object. */
10166 Jim_SetEmptyResult(interp);
10167 if (cmdPtr->isproc) {
10168 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10170 else {
10171 interp->cmdPrivData = cmdPtr->u.native.privData;
10172 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10174 interp->cmdPrivData = prevPrivData;
10175 interp->evalDepth--;
10177 out:
10178 JimDecrCmdRefCount(interp, cmdPtr);
10180 return retcode;
10183 /* Eval the object vector 'objv' composed of 'objc' elements.
10184 * Every element is used as single argument.
10185 * Jim_EvalObj() will call this function every time its object
10186 * argument is of "list" type, with no string representation.
10188 * This is possible because the string representation of a
10189 * list object generated by the UpdateStringOfList is made
10190 * in a way that ensures that every list element is a different
10191 * command argument. */
10192 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10194 int i, retcode;
10196 /* Incr refcount of arguments. */
10197 for (i = 0; i < objc; i++)
10198 Jim_IncrRefCount(objv[i]);
10200 retcode = JimInvokeCommand(interp, objc, objv);
10202 /* Decr refcount of arguments and return the retcode */
10203 for (i = 0; i < objc; i++)
10204 Jim_DecrRefCount(interp, objv[i]);
10206 return retcode;
10210 * Invokes 'prefix' as a command with the objv array as arguments.
10212 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10214 int ret;
10215 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10217 nargv[0] = prefix;
10218 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10219 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10220 Jim_Free(nargv);
10221 return ret;
10224 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10226 if (!interp->errorFlag) {
10227 /* This is the first error, so save the file/line information and reset the stack */
10228 interp->errorFlag = 1;
10229 Jim_IncrRefCount(script->fileNameObj);
10230 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10231 interp->errorFileNameObj = script->fileNameObj;
10232 interp->errorLine = script->linenr;
10234 JimResetStackTrace(interp);
10235 /* Always add a level where the error first occurs */
10236 interp->addStackTrace++;
10239 /* Now if this is an "interesting" level, add it to the stack trace */
10240 if (interp->addStackTrace > 0) {
10241 /* Add the stack info for the current level */
10243 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10245 /* Note: if we didn't have a filename for this level,
10246 * don't clear the addStackTrace flag
10247 * so we can pick it up at the next level
10249 if (Jim_Length(script->fileNameObj)) {
10250 interp->addStackTrace = 0;
10253 Jim_DecrRefCount(interp, interp->errorProc);
10254 interp->errorProc = interp->emptyObj;
10255 Jim_IncrRefCount(interp->errorProc);
10259 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10261 Jim_Obj *objPtr;
10263 switch (token->type) {
10264 case JIM_TT_STR:
10265 case JIM_TT_ESC:
10266 objPtr = token->objPtr;
10267 break;
10268 case JIM_TT_VAR:
10269 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10270 break;
10271 case JIM_TT_DICTSUGAR:
10272 objPtr = JimExpandDictSugar(interp, token->objPtr);
10273 break;
10274 case JIM_TT_EXPRSUGAR:
10275 objPtr = JimExpandExprSugar(interp, token->objPtr);
10276 break;
10277 case JIM_TT_CMD:
10278 switch (Jim_EvalObj(interp, token->objPtr)) {
10279 case JIM_OK:
10280 case JIM_RETURN:
10281 objPtr = interp->result;
10282 break;
10283 case JIM_BREAK:
10284 /* Stop substituting */
10285 return JIM_BREAK;
10286 case JIM_CONTINUE:
10287 /* just skip this one */
10288 return JIM_CONTINUE;
10289 default:
10290 return JIM_ERR;
10292 break;
10293 default:
10294 JimPanic((1,
10295 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10296 objPtr = NULL;
10297 break;
10299 if (objPtr) {
10300 *objPtrPtr = objPtr;
10301 return JIM_OK;
10303 return JIM_ERR;
10306 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10307 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10308 * The returned object has refcount = 0.
10310 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10312 int totlen = 0, i;
10313 Jim_Obj **intv;
10314 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10315 Jim_Obj *objPtr;
10316 char *s;
10318 if (tokens <= JIM_EVAL_SINTV_LEN)
10319 intv = sintv;
10320 else
10321 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10323 /* Compute every token forming the argument
10324 * in the intv objects vector. */
10325 for (i = 0; i < tokens; i++) {
10326 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10327 case JIM_OK:
10328 case JIM_RETURN:
10329 break;
10330 case JIM_BREAK:
10331 if (flags & JIM_SUBST_FLAG) {
10332 /* Stop here */
10333 tokens = i;
10334 continue;
10336 /* XXX: Should probably set an error about break outside loop */
10337 /* fall through to error */
10338 case JIM_CONTINUE:
10339 if (flags & JIM_SUBST_FLAG) {
10340 intv[i] = NULL;
10341 continue;
10343 /* XXX: Ditto continue outside loop */
10344 /* fall through to error */
10345 default:
10346 while (i--) {
10347 Jim_DecrRefCount(interp, intv[i]);
10349 if (intv != sintv) {
10350 Jim_Free(intv);
10352 return NULL;
10354 Jim_IncrRefCount(intv[i]);
10355 Jim_String(intv[i]);
10356 totlen += intv[i]->length;
10359 /* Fast path return for a single token */
10360 if (tokens == 1 && intv[0] && intv == sintv) {
10361 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10362 intv[0]->refCount--;
10363 return intv[0];
10366 /* Concatenate every token in an unique
10367 * object. */
10368 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10370 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10371 && token[2].type == JIM_TT_VAR) {
10372 /* May be able to do fast interpolated object -> dictSubst */
10373 objPtr->typePtr = &interpolatedObjType;
10374 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10375 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10376 Jim_IncrRefCount(intv[2]);
10378 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10379 /* The first interpolated token is source, so preserve the source info */
10380 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10384 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10385 objPtr->length = totlen;
10386 for (i = 0; i < tokens; i++) {
10387 if (intv[i]) {
10388 memcpy(s, intv[i]->bytes, intv[i]->length);
10389 s += intv[i]->length;
10390 Jim_DecrRefCount(interp, intv[i]);
10393 objPtr->bytes[totlen] = '\0';
10394 /* Free the intv vector if not static. */
10395 if (intv != sintv) {
10396 Jim_Free(intv);
10399 return objPtr;
10403 /* listPtr *must* be a list.
10404 * The contents of the list is evaluated with the first element as the command and
10405 * the remaining elements as the arguments.
10407 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10409 int retcode = JIM_OK;
10411 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10413 if (listPtr->internalRep.listValue.len) {
10414 Jim_IncrRefCount(listPtr);
10415 retcode = JimInvokeCommand(interp,
10416 listPtr->internalRep.listValue.len,
10417 listPtr->internalRep.listValue.ele);
10418 Jim_DecrRefCount(interp, listPtr);
10420 return retcode;
10423 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10425 SetListFromAny(interp, listPtr);
10426 return JimEvalObjList(interp, listPtr);
10429 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10431 int i;
10432 ScriptObj *script;
10433 ScriptToken *token;
10434 int retcode = JIM_OK;
10435 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10436 Jim_Obj *prevScriptObj;
10438 /* If the object is of type "list", with no string rep we can call
10439 * a specialized version of Jim_EvalObj() */
10440 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10441 return JimEvalObjList(interp, scriptObjPtr);
10444 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10445 script = JimGetScript(interp, scriptObjPtr);
10446 if (!JimScriptValid(interp, script)) {
10447 Jim_DecrRefCount(interp, scriptObjPtr);
10448 return JIM_ERR;
10451 /* Reset the interpreter result. This is useful to
10452 * return the empty result in the case of empty program. */
10453 Jim_SetEmptyResult(interp);
10455 token = script->token;
10457 #ifdef JIM_OPTIMIZATION
10458 /* Check for one of the following common scripts used by for, while
10460 * {}
10461 * incr a
10463 if (script->len == 0) {
10464 Jim_DecrRefCount(interp, scriptObjPtr);
10465 return JIM_OK;
10467 if (script->len == 3
10468 && token[1].objPtr->typePtr == &commandObjType
10469 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10470 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10471 && token[2].objPtr->typePtr == &variableObjType) {
10473 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10475 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10476 JimWideValue(objPtr)++;
10477 Jim_InvalidateStringRep(objPtr);
10478 Jim_DecrRefCount(interp, scriptObjPtr);
10479 Jim_SetResult(interp, objPtr);
10480 return JIM_OK;
10483 #endif
10485 /* Now we have to make sure the internal repr will not be
10486 * freed on shimmering.
10488 * Think for example to this:
10490 * set x {llength $x; ... some more code ...}; eval $x
10492 * In order to preserve the internal rep, we increment the
10493 * inUse field of the script internal rep structure. */
10494 script->inUse++;
10496 /* Stash the current script */
10497 prevScriptObj = interp->currentScriptObj;
10498 interp->currentScriptObj = scriptObjPtr;
10500 interp->errorFlag = 0;
10501 argv = sargv;
10503 /* Execute every command sequentially until the end of the script
10504 * or an error occurs.
10506 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10507 int argc;
10508 int j;
10510 /* First token of the line is always JIM_TT_LINE */
10511 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10512 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10514 /* Allocate the arguments vector if required */
10515 if (argc > JIM_EVAL_SARGV_LEN)
10516 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10518 /* Skip the JIM_TT_LINE token */
10519 i++;
10521 /* Populate the arguments objects.
10522 * If an error occurs, retcode will be set and
10523 * 'j' will be set to the number of args expanded
10525 for (j = 0; j < argc; j++) {
10526 long wordtokens = 1;
10527 int expand = 0;
10528 Jim_Obj *wordObjPtr = NULL;
10530 if (token[i].type == JIM_TT_WORD) {
10531 wordtokens = JimWideValue(token[i++].objPtr);
10532 if (wordtokens < 0) {
10533 expand = 1;
10534 wordtokens = -wordtokens;
10538 if (wordtokens == 1) {
10539 /* Fast path if the token does not
10540 * need interpolation */
10542 switch (token[i].type) {
10543 case JIM_TT_ESC:
10544 case JIM_TT_STR:
10545 wordObjPtr = token[i].objPtr;
10546 break;
10547 case JIM_TT_VAR:
10548 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10549 break;
10550 case JIM_TT_EXPRSUGAR:
10551 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
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 /* Now chain any tailcalls in the parent frame */
10878 if (interp->framePtr->tailcallObj) {
10879 do {
10880 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10882 interp->framePtr->tailcallObj = NULL;
10884 if (retcode == JIM_EVAL) {
10885 retcode = Jim_EvalObjList(interp, tailcallObj);
10886 if (retcode == JIM_RETURN) {
10887 /* If the result of the tailcall is 'return', push
10888 * it up to the caller
10890 interp->returnLevel++;
10893 Jim_DecrRefCount(interp, tailcallObj);
10894 } while (interp->framePtr->tailcallObj);
10896 /* If the tailcall chain finished early, may need to manually discard the command */
10897 if (interp->framePtr->tailcallCmd) {
10898 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10899 interp->framePtr->tailcallCmd = NULL;
10903 /* Handle the JIM_RETURN return code */
10904 if (retcode == JIM_RETURN) {
10905 if (--interp->returnLevel <= 0) {
10906 retcode = interp->returnCode;
10907 interp->returnCode = JIM_OK;
10908 interp->returnLevel = 0;
10911 else if (retcode == JIM_ERR) {
10912 interp->addStackTrace++;
10913 Jim_DecrRefCount(interp, interp->errorProc);
10914 interp->errorProc = argv[0];
10915 Jim_IncrRefCount(interp->errorProc);
10918 return retcode;
10921 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10923 int retval;
10924 Jim_Obj *scriptObjPtr;
10926 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10927 Jim_IncrRefCount(scriptObjPtr);
10929 if (filename) {
10930 Jim_Obj *prevScriptObj;
10932 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10934 prevScriptObj = interp->currentScriptObj;
10935 interp->currentScriptObj = scriptObjPtr;
10937 retval = Jim_EvalObj(interp, scriptObjPtr);
10939 interp->currentScriptObj = prevScriptObj;
10941 else {
10942 retval = Jim_EvalObj(interp, scriptObjPtr);
10944 Jim_DecrRefCount(interp, scriptObjPtr);
10945 return retval;
10948 int Jim_Eval(Jim_Interp *interp, const char *script)
10950 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10953 /* Execute script in the scope of the global level */
10954 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10956 int retval;
10957 Jim_CallFrame *savedFramePtr = interp->framePtr;
10959 interp->framePtr = interp->topFramePtr;
10960 retval = Jim_Eval(interp, script);
10961 interp->framePtr = savedFramePtr;
10963 return retval;
10966 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10968 int retval;
10969 Jim_CallFrame *savedFramePtr = interp->framePtr;
10971 interp->framePtr = interp->topFramePtr;
10972 retval = Jim_EvalFile(interp, filename);
10973 interp->framePtr = savedFramePtr;
10975 return retval;
10978 #include <sys/stat.h>
10980 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10982 FILE *fp;
10983 char *buf;
10984 Jim_Obj *scriptObjPtr;
10985 Jim_Obj *prevScriptObj;
10986 struct stat sb;
10987 int retcode;
10988 int readlen;
10990 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10991 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10992 return JIM_ERR;
10994 if (sb.st_size == 0) {
10995 fclose(fp);
10996 return JIM_OK;
10999 buf = Jim_Alloc(sb.st_size + 1);
11000 readlen = fread(buf, 1, sb.st_size, fp);
11001 if (ferror(fp)) {
11002 fclose(fp);
11003 Jim_Free(buf);
11004 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11005 return JIM_ERR;
11007 fclose(fp);
11008 buf[readlen] = 0;
11010 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11011 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11012 Jim_IncrRefCount(scriptObjPtr);
11014 prevScriptObj = interp->currentScriptObj;
11015 interp->currentScriptObj = scriptObjPtr;
11017 retcode = Jim_EvalObj(interp, scriptObjPtr);
11019 /* Handle the JIM_RETURN return code */
11020 if (retcode == JIM_RETURN) {
11021 if (--interp->returnLevel <= 0) {
11022 retcode = interp->returnCode;
11023 interp->returnCode = JIM_OK;
11024 interp->returnLevel = 0;
11027 if (retcode == JIM_ERR) {
11028 /* EvalFile changes context, so add a stack frame here */
11029 interp->addStackTrace++;
11032 interp->currentScriptObj = prevScriptObj;
11034 Jim_DecrRefCount(interp, scriptObjPtr);
11036 return retcode;
11039 /* -----------------------------------------------------------------------------
11040 * Subst
11041 * ---------------------------------------------------------------------------*/
11042 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11044 pc->tstart = pc->p;
11045 pc->tline = pc->linenr;
11047 if (pc->len == 0) {
11048 pc->tend = pc->p;
11049 pc->tt = JIM_TT_EOL;
11050 pc->eof = 1;
11051 return;
11053 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11054 JimParseCmd(pc);
11055 return;
11057 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11058 if (JimParseVar(pc) == JIM_OK) {
11059 return;
11061 /* Not a var, so treat as a string */
11062 pc->tstart = pc->p;
11063 flags |= JIM_SUBST_NOVAR;
11065 while (pc->len) {
11066 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11067 break;
11069 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11070 break;
11072 if (*pc->p == '\\' && pc->len > 1) {
11073 pc->p++;
11074 pc->len--;
11076 pc->p++;
11077 pc->len--;
11079 pc->tend = pc->p - 1;
11080 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11083 /* The subst object type reuses most of the data structures and functions
11084 * of the script object. Script's data structures are a bit more complex
11085 * for what is needed for [subst]itution tasks, but the reuse helps to
11086 * deal with a single data structure at the cost of some more memory
11087 * usage for substitutions. */
11089 /* This method takes the string representation of an object
11090 * as a Tcl string where to perform [subst]itution, and generates
11091 * the pre-parsed internal representation. */
11092 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11094 int scriptTextLen;
11095 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11096 struct JimParserCtx parser;
11097 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11098 ParseTokenList tokenlist;
11100 /* Initially parse the subst into tokens (in tokenlist) */
11101 ScriptTokenListInit(&tokenlist);
11103 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11104 while (1) {
11105 JimParseSubst(&parser, flags);
11106 if (parser.eof) {
11107 /* Note that subst doesn't need the EOL token */
11108 break;
11110 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11111 parser.tline);
11114 /* Create the "real" subst/script tokens from the initial token list */
11115 script->inUse = 1;
11116 script->substFlags = flags;
11117 script->fileNameObj = interp->emptyObj;
11118 Jim_IncrRefCount(script->fileNameObj);
11119 SubstObjAddTokens(interp, script, &tokenlist);
11121 /* No longer need the token list */
11122 ScriptTokenListFree(&tokenlist);
11124 #ifdef DEBUG_SHOW_SUBST
11126 int i;
11128 printf("==== Subst ====\n");
11129 for (i = 0; i < script->len; i++) {
11130 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11131 Jim_String(script->token[i].objPtr));
11134 #endif
11136 /* Free the old internal rep and set the new one. */
11137 Jim_FreeIntRep(interp, objPtr);
11138 Jim_SetIntRepPtr(objPtr, script);
11139 objPtr->typePtr = &scriptObjType;
11140 return JIM_OK;
11143 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11145 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11146 SetSubstFromAny(interp, objPtr, flags);
11147 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11150 /* Performs commands,variables,blackslashes substitution,
11151 * storing the result object (with refcount 0) into
11152 * resObjPtrPtr. */
11153 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11155 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11157 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11158 /* In order to preserve the internal rep, we increment the
11159 * inUse field of the script internal rep structure. */
11160 script->inUse++;
11162 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11164 script->inUse--;
11165 Jim_DecrRefCount(interp, substObjPtr);
11166 if (*resObjPtrPtr == NULL) {
11167 return JIM_ERR;
11169 return JIM_OK;
11172 /* -----------------------------------------------------------------------------
11173 * Core commands utility functions
11174 * ---------------------------------------------------------------------------*/
11175 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11177 Jim_Obj *objPtr;
11178 Jim_Obj *listObjPtr;
11180 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11182 listObjPtr = Jim_NewListObj(interp, argv, argc);
11184 if (msg && *msg) {
11185 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11187 Jim_IncrRefCount(listObjPtr);
11188 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11189 Jim_DecrRefCount(interp, listObjPtr);
11191 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11195 * May add the key and/or value to the list.
11197 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11198 Jim_HashEntry *he, int type);
11200 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11203 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11204 * invoke the callback to add entries to a list.
11205 * Returns the list.
11207 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11208 JimHashtableIteratorCallbackType *callback, int type)
11210 Jim_HashEntry *he;
11211 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11213 /* Check for the non-pattern case. We can do this much more efficiently. */
11214 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11215 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11216 if (he) {
11217 callback(interp, listObjPtr, he, type);
11220 else {
11221 Jim_HashTableIterator htiter;
11222 JimInitHashTableIterator(ht, &htiter);
11223 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11224 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11225 callback(interp, listObjPtr, he, type);
11229 return listObjPtr;
11232 /* Keep these in order */
11233 #define JIM_CMDLIST_COMMANDS 0
11234 #define JIM_CMDLIST_PROCS 1
11235 #define JIM_CMDLIST_CHANNELS 2
11238 * Adds matching command names (procs, channels) to the list.
11240 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11241 Jim_HashEntry *he, int type)
11243 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11244 Jim_Obj *objPtr;
11246 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11247 /* not a proc */
11248 return;
11251 objPtr = Jim_NewStringObj(interp, he->key, -1);
11252 Jim_IncrRefCount(objPtr);
11254 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11255 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11257 Jim_DecrRefCount(interp, objPtr);
11260 /* type is JIM_CMDLIST_xxx */
11261 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11263 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11266 /* Keep these in order */
11267 #define JIM_VARLIST_GLOBALS 0
11268 #define JIM_VARLIST_LOCALS 1
11269 #define JIM_VARLIST_VARS 2
11271 #define JIM_VARLIST_VALUES 0x1000
11274 * Adds matching variable names to the list.
11276 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11277 Jim_HashEntry *he, int type)
11279 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11281 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11282 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11283 if (type & JIM_VARLIST_VALUES) {
11284 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11289 /* mode is JIM_VARLIST_xxx */
11290 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11292 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11293 /* For [info locals], if we are at top level an emtpy list
11294 * is returned. I don't agree, but we aim at compatibility (SS) */
11295 return interp->emptyObj;
11297 else {
11298 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11299 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11303 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11304 Jim_Obj **objPtrPtr, int info_level_cmd)
11306 Jim_CallFrame *targetCallFrame;
11308 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11309 if (targetCallFrame == NULL) {
11310 return JIM_ERR;
11312 /* No proc call at toplevel callframe */
11313 if (targetCallFrame == interp->topFramePtr) {
11314 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11315 return JIM_ERR;
11317 if (info_level_cmd) {
11318 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11320 else {
11321 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11323 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11324 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11325 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11326 *objPtrPtr = listObj;
11328 return JIM_OK;
11331 /* -----------------------------------------------------------------------------
11332 * Core commands
11333 * ---------------------------------------------------------------------------*/
11335 /* fake [puts] -- not the real puts, just for debugging. */
11336 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11338 if (argc != 2 && argc != 3) {
11339 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11340 return JIM_ERR;
11342 if (argc == 3) {
11343 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11344 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11345 return JIM_ERR;
11347 else {
11348 fputs(Jim_String(argv[2]), stdout);
11351 else {
11352 puts(Jim_String(argv[1]));
11354 return JIM_OK;
11357 /* Helper for [+] and [*] */
11358 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11360 jim_wide wideValue, res;
11361 double doubleValue, doubleRes;
11362 int i;
11364 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11366 for (i = 1; i < argc; i++) {
11367 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11368 goto trydouble;
11369 if (op == JIM_EXPROP_ADD)
11370 res += wideValue;
11371 else
11372 res *= wideValue;
11374 Jim_SetResultInt(interp, res);
11375 return JIM_OK;
11376 trydouble:
11377 doubleRes = (double)res;
11378 for (; i < argc; i++) {
11379 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11380 return JIM_ERR;
11381 if (op == JIM_EXPROP_ADD)
11382 doubleRes += doubleValue;
11383 else
11384 doubleRes *= doubleValue;
11386 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11387 return JIM_OK;
11390 /* Helper for [-] and [/] */
11391 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11393 jim_wide wideValue, res = 0;
11394 double doubleValue, doubleRes = 0;
11395 int i = 2;
11397 if (argc < 2) {
11398 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11399 return JIM_ERR;
11401 else if (argc == 2) {
11402 /* The arity = 2 case is different. For [- x] returns -x,
11403 * while [/ x] returns 1/x. */
11404 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11405 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11406 return JIM_ERR;
11408 else {
11409 if (op == JIM_EXPROP_SUB)
11410 doubleRes = -doubleValue;
11411 else
11412 doubleRes = 1.0 / doubleValue;
11413 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11414 return JIM_OK;
11417 if (op == JIM_EXPROP_SUB) {
11418 res = -wideValue;
11419 Jim_SetResultInt(interp, res);
11421 else {
11422 doubleRes = 1.0 / wideValue;
11423 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11425 return JIM_OK;
11427 else {
11428 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11429 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11430 != JIM_OK) {
11431 return JIM_ERR;
11433 else {
11434 goto trydouble;
11438 for (i = 2; i < argc; i++) {
11439 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11440 doubleRes = (double)res;
11441 goto trydouble;
11443 if (op == JIM_EXPROP_SUB)
11444 res -= wideValue;
11445 else {
11446 if (wideValue == 0) {
11447 Jim_SetResultString(interp, "Division by zero", -1);
11448 return JIM_ERR;
11450 res /= wideValue;
11453 Jim_SetResultInt(interp, res);
11454 return JIM_OK;
11455 trydouble:
11456 for (; i < argc; i++) {
11457 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11458 return JIM_ERR;
11459 if (op == JIM_EXPROP_SUB)
11460 doubleRes -= doubleValue;
11461 else
11462 doubleRes /= doubleValue;
11464 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11465 return JIM_OK;
11469 /* [+] */
11470 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11472 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11475 /* [*] */
11476 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11478 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11481 /* [-] */
11482 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11484 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11487 /* [/] */
11488 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11490 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11493 /* [set] */
11494 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11496 if (argc != 2 && argc != 3) {
11497 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11498 return JIM_ERR;
11500 if (argc == 2) {
11501 Jim_Obj *objPtr;
11503 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11504 if (!objPtr)
11505 return JIM_ERR;
11506 Jim_SetResult(interp, objPtr);
11507 return JIM_OK;
11509 /* argc == 3 case. */
11510 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11511 return JIM_ERR;
11512 Jim_SetResult(interp, argv[2]);
11513 return JIM_OK;
11516 /* [unset]
11518 * unset ?-nocomplain? ?--? ?varName ...?
11520 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11522 int i = 1;
11523 int complain = 1;
11525 while (i < argc) {
11526 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11527 i++;
11528 break;
11530 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11531 complain = 0;
11532 i++;
11533 continue;
11535 break;
11538 while (i < argc) {
11539 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11540 && complain) {
11541 return JIM_ERR;
11543 i++;
11545 return JIM_OK;
11548 /* [while] */
11549 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11551 if (argc != 3) {
11552 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11553 return JIM_ERR;
11556 /* The general purpose implementation of while starts here */
11557 while (1) {
11558 int boolean, retval;
11560 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11561 return retval;
11562 if (!boolean)
11563 break;
11565 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11566 switch (retval) {
11567 case JIM_BREAK:
11568 goto out;
11569 break;
11570 case JIM_CONTINUE:
11571 continue;
11572 break;
11573 default:
11574 return retval;
11578 out:
11579 Jim_SetEmptyResult(interp);
11580 return JIM_OK;
11583 /* [for] */
11584 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11586 int retval;
11587 int boolean = 1;
11588 Jim_Obj *varNamePtr = NULL;
11589 Jim_Obj *stopVarNamePtr = NULL;
11591 if (argc != 5) {
11592 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11593 return JIM_ERR;
11596 /* Do the initialisation */
11597 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11598 return retval;
11601 /* And do the first test now. Better for optimisation
11602 * if we can do next/test at the bottom of the loop
11604 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11606 /* Ready to do the body as follows:
11607 * while (1) {
11608 * body // check retcode
11609 * next // check retcode
11610 * test // check retcode/test bool
11614 #ifdef JIM_OPTIMIZATION
11615 /* Check if the for is on the form:
11616 * for ... {$i < CONST} {incr i}
11617 * for ... {$i < $j} {incr i}
11619 if (retval == JIM_OK && boolean) {
11620 ScriptObj *incrScript;
11621 struct ExprTree *expr;
11622 jim_wide stop, currentVal;
11623 Jim_Obj *objPtr;
11624 int cmpOffset;
11626 /* Do it only if there aren't shared arguments */
11627 expr = JimGetExpression(interp, argv[2]);
11628 incrScript = JimGetScript(interp, argv[3]);
11630 /* Ensure proper lengths to start */
11631 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11632 goto evalstart;
11634 /* Ensure proper token types. */
11635 if (incrScript->token[1].type != JIM_TT_ESC) {
11636 goto evalstart;
11639 if (expr->expr->type == JIM_EXPROP_LT) {
11640 cmpOffset = 0;
11642 else if (expr->expr->type == JIM_EXPROP_LTE) {
11643 cmpOffset = 1;
11645 else {
11646 goto evalstart;
11649 if (expr->expr->left->type != JIM_TT_VAR) {
11650 goto evalstart;
11653 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11654 goto evalstart;
11657 /* Update command must be incr */
11658 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11659 goto evalstart;
11662 /* incr, expression must be about the same variable */
11663 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11664 goto evalstart;
11667 /* Get the stop condition (must be a variable or integer) */
11668 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11669 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11670 goto evalstart;
11673 else {
11674 stopVarNamePtr = expr->expr->right->objPtr;
11675 Jim_IncrRefCount(stopVarNamePtr);
11676 /* Keep the compiler happy */
11677 stop = 0;
11680 /* Initialization */
11681 varNamePtr = expr->expr->left->objPtr;
11682 Jim_IncrRefCount(varNamePtr);
11684 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11685 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11686 goto testcond;
11689 /* --- OPTIMIZED FOR --- */
11690 while (retval == JIM_OK) {
11691 /* === Check condition === */
11692 /* Note that currentVal is already set here */
11694 /* Immediate or Variable? get the 'stop' value if the latter. */
11695 if (stopVarNamePtr) {
11696 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11697 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11698 goto testcond;
11702 if (currentVal >= stop + cmpOffset) {
11703 break;
11706 /* Eval body */
11707 retval = Jim_EvalObj(interp, argv[4]);
11708 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11709 retval = JIM_OK;
11711 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11713 /* Increment */
11714 if (objPtr == NULL) {
11715 retval = JIM_ERR;
11716 goto out;
11718 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11719 currentVal = ++JimWideValue(objPtr);
11720 Jim_InvalidateStringRep(objPtr);
11722 else {
11723 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11724 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11725 ++currentVal)) != JIM_OK) {
11726 goto evalnext;
11731 goto out;
11733 evalstart:
11734 #endif
11736 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11737 /* Body */
11738 retval = Jim_EvalObj(interp, argv[4]);
11740 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11741 /* increment */
11742 JIM_IF_OPTIM(evalnext:)
11743 retval = Jim_EvalObj(interp, argv[3]);
11744 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11745 /* test */
11746 JIM_IF_OPTIM(testcond:)
11747 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11751 JIM_IF_OPTIM(out:)
11752 if (stopVarNamePtr) {
11753 Jim_DecrRefCount(interp, stopVarNamePtr);
11755 if (varNamePtr) {
11756 Jim_DecrRefCount(interp, varNamePtr);
11759 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11760 Jim_SetEmptyResult(interp);
11761 return JIM_OK;
11764 return retval;
11767 /* [loop] */
11768 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11770 int retval;
11771 jim_wide i;
11772 jim_wide limit;
11773 jim_wide incr = 1;
11774 Jim_Obj *bodyObjPtr;
11776 if (argc != 5 && argc != 6) {
11777 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11778 return JIM_ERR;
11781 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11782 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11783 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11784 return JIM_ERR;
11786 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11788 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11790 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11791 retval = Jim_EvalObj(interp, bodyObjPtr);
11792 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11793 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11795 retval = JIM_OK;
11797 /* Increment */
11798 i += incr;
11800 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11801 if (argv[1]->typePtr != &variableObjType) {
11802 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11803 return JIM_ERR;
11806 JimWideValue(objPtr) = i;
11807 Jim_InvalidateStringRep(objPtr);
11809 /* The following step is required in order to invalidate the
11810 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11811 if (argv[1]->typePtr != &variableObjType) {
11812 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11813 retval = JIM_ERR;
11814 break;
11818 else {
11819 objPtr = Jim_NewIntObj(interp, i);
11820 retval = Jim_SetVariable(interp, argv[1], objPtr);
11821 if (retval != JIM_OK) {
11822 Jim_FreeNewObj(interp, objPtr);
11828 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11829 Jim_SetEmptyResult(interp);
11830 return JIM_OK;
11832 return retval;
11835 /* List iterators make it easy to iterate over a list.
11836 * At some point iterators will be expanded to support generators.
11838 typedef struct {
11839 Jim_Obj *objPtr;
11840 int idx;
11841 } Jim_ListIter;
11844 * Initialise the iterator at the start of the list.
11846 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11848 iter->objPtr = objPtr;
11849 iter->idx = 0;
11853 * Returns the next object from the list, or NULL on end-of-list.
11855 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11857 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11858 return NULL;
11860 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11864 * Returns 1 if end-of-list has been reached.
11866 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11868 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11871 /* foreach + lmap implementation. */
11872 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11874 int result = JIM_OK;
11875 int i, numargs;
11876 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11877 Jim_ListIter *iters;
11878 Jim_Obj *script;
11879 Jim_Obj *resultObj;
11881 if (argc < 4 || argc % 2 != 0) {
11882 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11883 return JIM_ERR;
11885 script = argv[argc - 1]; /* Last argument is a script */
11886 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11888 if (numargs == 2) {
11889 iters = twoiters;
11891 else {
11892 iters = Jim_Alloc(numargs * sizeof(*iters));
11894 for (i = 0; i < numargs; i++) {
11895 JimListIterInit(&iters[i], argv[i + 1]);
11896 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11897 result = JIM_ERR;
11900 if (result != JIM_OK) {
11901 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11902 goto empty_varlist;
11905 if (doMap) {
11906 resultObj = Jim_NewListObj(interp, NULL, 0);
11908 else {
11909 resultObj = interp->emptyObj;
11911 Jim_IncrRefCount(resultObj);
11913 while (1) {
11914 /* Have we expired all lists? */
11915 for (i = 0; i < numargs; i += 2) {
11916 if (!JimListIterDone(interp, &iters[i + 1])) {
11917 break;
11920 if (i == numargs) {
11921 /* All done */
11922 break;
11925 /* For each list */
11926 for (i = 0; i < numargs; i += 2) {
11927 Jim_Obj *varName;
11929 /* foreach var */
11930 JimListIterInit(&iters[i], argv[i + 1]);
11931 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11932 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11933 if (!valObj) {
11934 /* Ran out, so store the empty string */
11935 valObj = interp->emptyObj;
11937 /* Avoid shimmering */
11938 Jim_IncrRefCount(valObj);
11939 result = Jim_SetVariable(interp, varName, valObj);
11940 Jim_DecrRefCount(interp, valObj);
11941 if (result != JIM_OK) {
11942 goto err;
11946 switch (result = Jim_EvalObj(interp, script)) {
11947 case JIM_OK:
11948 if (doMap) {
11949 Jim_ListAppendElement(interp, resultObj, interp->result);
11951 break;
11952 case JIM_CONTINUE:
11953 break;
11954 case JIM_BREAK:
11955 goto out;
11956 default:
11957 goto err;
11960 out:
11961 result = JIM_OK;
11962 Jim_SetResult(interp, resultObj);
11963 err:
11964 Jim_DecrRefCount(interp, resultObj);
11965 empty_varlist:
11966 if (numargs > 2) {
11967 Jim_Free(iters);
11969 return result;
11972 /* [foreach] */
11973 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11975 return JimForeachMapHelper(interp, argc, argv, 0);
11978 /* [lmap] */
11979 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11981 return JimForeachMapHelper(interp, argc, argv, 1);
11984 /* [lassign] */
11985 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11987 int result = JIM_ERR;
11988 int i;
11989 Jim_ListIter iter;
11990 Jim_Obj *resultObj;
11992 if (argc < 2) {
11993 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11994 return JIM_ERR;
11997 JimListIterInit(&iter, argv[1]);
11999 for (i = 2; i < argc; i++) {
12000 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12001 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12002 if (result != JIM_OK) {
12003 return result;
12007 resultObj = Jim_NewListObj(interp, NULL, 0);
12008 while (!JimListIterDone(interp, &iter)) {
12009 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12012 Jim_SetResult(interp, resultObj);
12014 return JIM_OK;
12017 /* [if] */
12018 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12020 int boolean, retval, current = 1, falsebody = 0;
12022 if (argc >= 3) {
12023 while (1) {
12024 /* Far not enough arguments given! */
12025 if (current >= argc)
12026 goto err;
12027 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12028 != JIM_OK)
12029 return retval;
12030 /* There lacks something, isn't it? */
12031 if (current >= argc)
12032 goto err;
12033 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12034 current++;
12035 /* Tsk tsk, no then-clause? */
12036 if (current >= argc)
12037 goto err;
12038 if (boolean)
12039 return Jim_EvalObj(interp, argv[current]);
12040 /* Ok: no else-clause follows */
12041 if (++current >= argc) {
12042 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12043 return JIM_OK;
12045 falsebody = current++;
12046 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12047 /* IIICKS - else-clause isn't last cmd? */
12048 if (current != argc - 1)
12049 goto err;
12050 return Jim_EvalObj(interp, argv[current]);
12052 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12053 /* Ok: elseif follows meaning all the stuff
12054 * again (how boring...) */
12055 continue;
12056 /* OOPS - else-clause is not last cmd? */
12057 else if (falsebody != argc - 1)
12058 goto err;
12059 return Jim_EvalObj(interp, argv[falsebody]);
12061 return JIM_OK;
12063 err:
12064 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12065 return JIM_ERR;
12069 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12070 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12071 Jim_Obj *stringObj, int nocase)
12073 Jim_Obj *parms[4];
12074 int argc = 0;
12075 long eq;
12076 int rc;
12078 parms[argc++] = commandObj;
12079 if (nocase) {
12080 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12082 parms[argc++] = patternObj;
12083 parms[argc++] = stringObj;
12085 rc = Jim_EvalObjVector(interp, argc, parms);
12087 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12088 eq = -rc;
12091 return eq;
12094 /* [switch] */
12095 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12097 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12098 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12099 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12100 Jim_Obj **caseList;
12102 if (argc < 3) {
12103 wrongnumargs:
12104 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12105 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12106 return JIM_ERR;
12108 for (opt = 1; opt < argc; ++opt) {
12109 const char *option = Jim_String(argv[opt]);
12111 if (*option != '-')
12112 break;
12113 else if (strncmp(option, "--", 2) == 0) {
12114 ++opt;
12115 break;
12117 else if (strncmp(option, "-exact", 2) == 0)
12118 matchOpt = SWITCH_EXACT;
12119 else if (strncmp(option, "-glob", 2) == 0)
12120 matchOpt = SWITCH_GLOB;
12121 else if (strncmp(option, "-regexp", 2) == 0)
12122 matchOpt = SWITCH_RE;
12123 else if (strncmp(option, "-command", 2) == 0) {
12124 matchOpt = SWITCH_CMD;
12125 if ((argc - opt) < 2)
12126 goto wrongnumargs;
12127 command = argv[++opt];
12129 else {
12130 Jim_SetResultFormatted(interp,
12131 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12132 argv[opt]);
12133 return JIM_ERR;
12135 if ((argc - opt) < 2)
12136 goto wrongnumargs;
12138 strObj = argv[opt++];
12139 patCount = argc - opt;
12140 if (patCount == 1) {
12141 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12143 else
12144 caseList = (Jim_Obj **)&argv[opt];
12145 if (patCount == 0 || patCount % 2 != 0)
12146 goto wrongnumargs;
12147 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12148 Jim_Obj *patObj = caseList[i];
12150 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12151 || i < (patCount - 2)) {
12152 switch (matchOpt) {
12153 case SWITCH_EXACT:
12154 if (Jim_StringEqObj(strObj, patObj))
12155 scriptObj = caseList[i + 1];
12156 break;
12157 case SWITCH_GLOB:
12158 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12159 scriptObj = caseList[i + 1];
12160 break;
12161 case SWITCH_RE:
12162 command = Jim_NewStringObj(interp, "regexp", -1);
12163 /* Fall thru intentionally */
12164 case SWITCH_CMD:{
12165 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12167 /* After the execution of a command we need to
12168 * make sure to reconvert the object into a list
12169 * again. Only for the single-list style [switch]. */
12170 if (argc - opt == 1) {
12171 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12173 /* command is here already decref'd */
12174 if (rc < 0) {
12175 return -rc;
12177 if (rc)
12178 scriptObj = caseList[i + 1];
12179 break;
12183 else {
12184 scriptObj = caseList[i + 1];
12187 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12188 scriptObj = caseList[i + 1];
12189 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12190 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12191 return JIM_ERR;
12193 Jim_SetEmptyResult(interp);
12194 if (scriptObj) {
12195 return Jim_EvalObj(interp, scriptObj);
12197 return JIM_OK;
12200 /* [list] */
12201 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12203 Jim_Obj *listObjPtr;
12205 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12206 Jim_SetResult(interp, listObjPtr);
12207 return JIM_OK;
12210 /* [lindex] */
12211 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12213 Jim_Obj *objPtr, *listObjPtr;
12214 int i;
12215 int idx;
12217 if (argc < 2) {
12218 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12219 return JIM_ERR;
12221 objPtr = argv[1];
12222 Jim_IncrRefCount(objPtr);
12223 for (i = 2; i < argc; i++) {
12224 listObjPtr = objPtr;
12225 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12226 Jim_DecrRefCount(interp, listObjPtr);
12227 return JIM_ERR;
12229 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12230 /* Returns an empty object if the index
12231 * is out of range. */
12232 Jim_DecrRefCount(interp, listObjPtr);
12233 Jim_SetEmptyResult(interp);
12234 return JIM_OK;
12236 Jim_IncrRefCount(objPtr);
12237 Jim_DecrRefCount(interp, listObjPtr);
12239 Jim_SetResult(interp, objPtr);
12240 Jim_DecrRefCount(interp, objPtr);
12241 return JIM_OK;
12244 /* [llength] */
12245 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12247 if (argc != 2) {
12248 Jim_WrongNumArgs(interp, 1, argv, "list");
12249 return JIM_ERR;
12251 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12252 return JIM_OK;
12255 /* [lsearch] */
12256 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12258 static const char * const options[] = {
12259 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12260 NULL
12262 enum
12263 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12264 OPT_COMMAND };
12265 int i;
12266 int opt_bool = 0;
12267 int opt_not = 0;
12268 int opt_nocase = 0;
12269 int opt_all = 0;
12270 int opt_inline = 0;
12271 int opt_match = OPT_EXACT;
12272 int listlen;
12273 int rc = JIM_OK;
12274 Jim_Obj *listObjPtr = NULL;
12275 Jim_Obj *commandObj = NULL;
12277 if (argc < 3) {
12278 wrongargs:
12279 Jim_WrongNumArgs(interp, 1, argv,
12280 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12281 return JIM_ERR;
12284 for (i = 1; i < argc - 2; i++) {
12285 int option;
12287 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12288 return JIM_ERR;
12290 switch (option) {
12291 case OPT_BOOL:
12292 opt_bool = 1;
12293 opt_inline = 0;
12294 break;
12295 case OPT_NOT:
12296 opt_not = 1;
12297 break;
12298 case OPT_NOCASE:
12299 opt_nocase = 1;
12300 break;
12301 case OPT_INLINE:
12302 opt_inline = 1;
12303 opt_bool = 0;
12304 break;
12305 case OPT_ALL:
12306 opt_all = 1;
12307 break;
12308 case OPT_COMMAND:
12309 if (i >= argc - 2) {
12310 goto wrongargs;
12312 commandObj = argv[++i];
12313 /* fallthru */
12314 case OPT_EXACT:
12315 case OPT_GLOB:
12316 case OPT_REGEXP:
12317 opt_match = option;
12318 break;
12322 argv += i;
12324 if (opt_all) {
12325 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12327 if (opt_match == OPT_REGEXP) {
12328 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12330 if (commandObj) {
12331 Jim_IncrRefCount(commandObj);
12334 listlen = Jim_ListLength(interp, argv[0]);
12335 for (i = 0; i < listlen; i++) {
12336 int eq = 0;
12337 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12339 switch (opt_match) {
12340 case OPT_EXACT:
12341 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12342 break;
12344 case OPT_GLOB:
12345 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12346 break;
12348 case OPT_REGEXP:
12349 case OPT_COMMAND:
12350 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12351 if (eq < 0) {
12352 if (listObjPtr) {
12353 Jim_FreeNewObj(interp, listObjPtr);
12355 rc = JIM_ERR;
12356 goto done;
12358 break;
12361 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12362 if (!eq && opt_bool && opt_not && !opt_all) {
12363 continue;
12366 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12367 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12368 Jim_Obj *resultObj;
12370 if (opt_bool) {
12371 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12373 else if (!opt_inline) {
12374 resultObj = Jim_NewIntObj(interp, i);
12376 else {
12377 resultObj = objPtr;
12380 if (opt_all) {
12381 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12383 else {
12384 Jim_SetResult(interp, resultObj);
12385 goto done;
12390 if (opt_all) {
12391 Jim_SetResult(interp, listObjPtr);
12393 else {
12394 /* No match */
12395 if (opt_bool) {
12396 Jim_SetResultBool(interp, opt_not);
12398 else if (!opt_inline) {
12399 Jim_SetResultInt(interp, -1);
12403 done:
12404 if (commandObj) {
12405 Jim_DecrRefCount(interp, commandObj);
12407 return rc;
12410 /* [lappend] */
12411 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12413 Jim_Obj *listObjPtr;
12414 int new_obj = 0;
12415 int i;
12417 if (argc < 2) {
12418 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12419 return JIM_ERR;
12421 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12422 if (!listObjPtr) {
12423 /* Create the list if it does not exist */
12424 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12425 new_obj = 1;
12427 else if (Jim_IsShared(listObjPtr)) {
12428 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12429 new_obj = 1;
12431 for (i = 2; i < argc; i++)
12432 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12433 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12434 if (new_obj)
12435 Jim_FreeNewObj(interp, listObjPtr);
12436 return JIM_ERR;
12438 Jim_SetResult(interp, listObjPtr);
12439 return JIM_OK;
12442 /* [linsert] */
12443 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12445 int idx, len;
12446 Jim_Obj *listPtr;
12448 if (argc < 3) {
12449 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12450 return JIM_ERR;
12452 listPtr = argv[1];
12453 if (Jim_IsShared(listPtr))
12454 listPtr = Jim_DuplicateObj(interp, listPtr);
12455 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12456 goto err;
12457 len = Jim_ListLength(interp, listPtr);
12458 if (idx >= len)
12459 idx = len;
12460 else if (idx < 0)
12461 idx = len + idx + 1;
12462 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12463 Jim_SetResult(interp, listPtr);
12464 return JIM_OK;
12465 err:
12466 if (listPtr != argv[1]) {
12467 Jim_FreeNewObj(interp, listPtr);
12469 return JIM_ERR;
12472 /* [lreplace] */
12473 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12475 int first, last, len, rangeLen;
12476 Jim_Obj *listObj;
12477 Jim_Obj *newListObj;
12479 if (argc < 4) {
12480 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12481 return JIM_ERR;
12483 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12484 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12485 return JIM_ERR;
12488 listObj = argv[1];
12489 len = Jim_ListLength(interp, listObj);
12491 first = JimRelToAbsIndex(len, first);
12492 last = JimRelToAbsIndex(len, last);
12493 JimRelToAbsRange(len, &first, &last, &rangeLen);
12495 /* Now construct a new list which consists of:
12496 * <elements before first> <supplied elements> <elements after last>
12499 /* Trying to replace past the end of the list means end of list
12500 * See TIP #505
12502 if (first > len) {
12503 first = len;
12506 /* Add the first set of elements */
12507 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12509 /* Add supplied elements */
12510 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12512 /* Add the remaining elements */
12513 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12515 Jim_SetResult(interp, newListObj);
12516 return JIM_OK;
12519 /* [lset] */
12520 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12522 if (argc < 3) {
12523 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12524 return JIM_ERR;
12526 else if (argc == 3) {
12527 /* With no indexes, simply implements [set] */
12528 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12529 return JIM_ERR;
12530 Jim_SetResult(interp, argv[2]);
12531 return JIM_OK;
12533 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12536 /* [lsort] */
12537 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12539 static const char * const options[] = {
12540 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12542 enum
12543 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12544 Jim_Obj *resObj;
12545 int i;
12546 int retCode;
12547 int shared;
12549 struct lsort_info info;
12551 if (argc < 2) {
12552 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12553 return JIM_ERR;
12556 info.type = JIM_LSORT_ASCII;
12557 info.order = 1;
12558 info.indexed = 0;
12559 info.unique = 0;
12560 info.command = NULL;
12561 info.interp = interp;
12563 for (i = 1; i < (argc - 1); i++) {
12564 int option;
12566 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12567 != JIM_OK)
12568 return JIM_ERR;
12569 switch (option) {
12570 case OPT_ASCII:
12571 info.type = JIM_LSORT_ASCII;
12572 break;
12573 case OPT_NOCASE:
12574 info.type = JIM_LSORT_NOCASE;
12575 break;
12576 case OPT_INTEGER:
12577 info.type = JIM_LSORT_INTEGER;
12578 break;
12579 case OPT_REAL:
12580 info.type = JIM_LSORT_REAL;
12581 break;
12582 case OPT_INCREASING:
12583 info.order = 1;
12584 break;
12585 case OPT_DECREASING:
12586 info.order = -1;
12587 break;
12588 case OPT_UNIQUE:
12589 info.unique = 1;
12590 break;
12591 case OPT_COMMAND:
12592 if (i >= (argc - 2)) {
12593 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12594 return JIM_ERR;
12596 info.type = JIM_LSORT_COMMAND;
12597 info.command = argv[i + 1];
12598 i++;
12599 break;
12600 case OPT_INDEX:
12601 if (i >= (argc - 2)) {
12602 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12603 return JIM_ERR;
12605 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12606 return JIM_ERR;
12608 info.indexed = 1;
12609 i++;
12610 break;
12613 resObj = argv[argc - 1];
12614 if ((shared = Jim_IsShared(resObj)))
12615 resObj = Jim_DuplicateObj(interp, resObj);
12616 retCode = ListSortElements(interp, resObj, &info);
12617 if (retCode == JIM_OK) {
12618 Jim_SetResult(interp, resObj);
12620 else if (shared) {
12621 Jim_FreeNewObj(interp, resObj);
12623 return retCode;
12626 /* [append] */
12627 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12629 Jim_Obj *stringObjPtr;
12630 int i;
12632 if (argc < 2) {
12633 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12634 return JIM_ERR;
12636 if (argc == 2) {
12637 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12638 if (!stringObjPtr)
12639 return JIM_ERR;
12641 else {
12642 int new_obj = 0;
12643 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12644 if (!stringObjPtr) {
12645 /* Create the string if it doesn't exist */
12646 stringObjPtr = Jim_NewEmptyStringObj(interp);
12647 new_obj = 1;
12649 else if (Jim_IsShared(stringObjPtr)) {
12650 new_obj = 1;
12651 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12653 for (i = 2; i < argc; i++) {
12654 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12656 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12657 if (new_obj) {
12658 Jim_FreeNewObj(interp, stringObjPtr);
12660 return JIM_ERR;
12663 Jim_SetResult(interp, stringObjPtr);
12664 return JIM_OK;
12667 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12669 * Returns a zero-refcount list describing the expression at 'node'
12671 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12673 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12675 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12676 if (TOKEN_IS_EXPR_OP(node->type)) {
12677 if (node->left) {
12678 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12680 if (node->right) {
12681 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12683 if (node->ternary) {
12684 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12687 else {
12688 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12690 return listObjPtr;
12692 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12694 /* [debug] */
12695 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12697 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12698 static const char * const options[] = {
12699 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12700 "exprbc", "show",
12701 NULL
12703 enum
12705 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12706 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12708 int option;
12710 if (argc < 2) {
12711 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12712 return JIM_ERR;
12714 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12715 return Jim_CheckShowCommands(interp, argv[1], options);
12716 if (option == OPT_REFCOUNT) {
12717 if (argc != 3) {
12718 Jim_WrongNumArgs(interp, 2, argv, "object");
12719 return JIM_ERR;
12721 Jim_SetResultInt(interp, argv[2]->refCount);
12722 return JIM_OK;
12724 else if (option == OPT_OBJCOUNT) {
12725 int freeobj = 0, liveobj = 0;
12726 char buf[256];
12727 Jim_Obj *objPtr;
12729 if (argc != 2) {
12730 Jim_WrongNumArgs(interp, 2, argv, "");
12731 return JIM_ERR;
12733 /* Count the number of free objects. */
12734 objPtr = interp->freeList;
12735 while (objPtr) {
12736 freeobj++;
12737 objPtr = objPtr->nextObjPtr;
12739 /* Count the number of live objects. */
12740 objPtr = interp->liveList;
12741 while (objPtr) {
12742 liveobj++;
12743 objPtr = objPtr->nextObjPtr;
12745 /* Set the result string and return. */
12746 sprintf(buf, "free %d used %d", freeobj, liveobj);
12747 Jim_SetResultString(interp, buf, -1);
12748 return JIM_OK;
12750 else if (option == OPT_OBJECTS) {
12751 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12753 /* Count the number of live objects. */
12754 objPtr = interp->liveList;
12755 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12756 while (objPtr) {
12757 char buf[128];
12758 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12760 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12761 sprintf(buf, "%p", objPtr);
12762 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12763 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12764 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12765 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12766 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12767 objPtr = objPtr->nextObjPtr;
12769 Jim_SetResult(interp, listObjPtr);
12770 return JIM_OK;
12772 else if (option == OPT_INVSTR) {
12773 Jim_Obj *objPtr;
12775 if (argc != 3) {
12776 Jim_WrongNumArgs(interp, 2, argv, "object");
12777 return JIM_ERR;
12779 objPtr = argv[2];
12780 if (objPtr->typePtr != NULL)
12781 Jim_InvalidateStringRep(objPtr);
12782 Jim_SetEmptyResult(interp);
12783 return JIM_OK;
12785 else if (option == OPT_SHOW) {
12786 const char *s;
12787 int len, charlen;
12789 if (argc != 3) {
12790 Jim_WrongNumArgs(interp, 2, argv, "object");
12791 return JIM_ERR;
12793 s = Jim_GetString(argv[2], &len);
12794 #ifdef JIM_UTF8
12795 charlen = utf8_strlen(s, len);
12796 #else
12797 charlen = len;
12798 #endif
12799 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12800 printf("chars (%d): <<%s>>\n", charlen, s);
12801 printf("bytes (%d):", len);
12802 while (len--) {
12803 printf(" %02x", (unsigned char)*s++);
12805 printf("\n");
12806 return JIM_OK;
12808 else if (option == OPT_SCRIPTLEN) {
12809 ScriptObj *script;
12811 if (argc != 3) {
12812 Jim_WrongNumArgs(interp, 2, argv, "script");
12813 return JIM_ERR;
12815 script = JimGetScript(interp, argv[2]);
12816 if (script == NULL)
12817 return JIM_ERR;
12818 Jim_SetResultInt(interp, script->len);
12819 return JIM_OK;
12821 else if (option == OPT_EXPRLEN) {
12822 struct ExprTree *expr;
12824 if (argc != 3) {
12825 Jim_WrongNumArgs(interp, 2, argv, "expression");
12826 return JIM_ERR;
12828 expr = JimGetExpression(interp, argv[2]);
12829 if (expr == NULL)
12830 return JIM_ERR;
12831 Jim_SetResultInt(interp, expr->len);
12832 return JIM_OK;
12834 else if (option == OPT_EXPRBC) {
12835 struct ExprTree *expr;
12837 if (argc != 3) {
12838 Jim_WrongNumArgs(interp, 2, argv, "expression");
12839 return JIM_ERR;
12841 expr = JimGetExpression(interp, argv[2]);
12842 if (expr == NULL)
12843 return JIM_ERR;
12844 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12845 return JIM_OK;
12847 else {
12848 Jim_SetResultString(interp,
12849 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12850 return JIM_ERR;
12852 /* unreached */
12853 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12854 #if !defined(JIM_DEBUG_COMMAND)
12855 Jim_SetResultString(interp, "unsupported", -1);
12856 return JIM_ERR;
12857 #endif
12860 /* [eval] */
12861 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12863 int rc;
12865 if (argc < 2) {
12866 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12867 return JIM_ERR;
12870 if (argc == 2) {
12871 rc = Jim_EvalObj(interp, argv[1]);
12873 else {
12874 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12877 if (rc == JIM_ERR) {
12878 /* eval is "interesting", so add a stack frame here */
12879 interp->addStackTrace++;
12881 return rc;
12884 /* [uplevel] */
12885 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12887 if (argc >= 2) {
12888 int retcode;
12889 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12890 const char *str;
12892 /* Save the old callframe pointer */
12893 savedCallFrame = interp->framePtr;
12895 /* Lookup the target frame pointer */
12896 str = Jim_String(argv[1]);
12897 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12898 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12899 argc--;
12900 argv++;
12902 else {
12903 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12905 if (targetCallFrame == NULL) {
12906 return JIM_ERR;
12908 if (argc < 2) {
12909 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12910 return JIM_ERR;
12912 /* Eval the code in the target callframe. */
12913 interp->framePtr = targetCallFrame;
12914 if (argc == 2) {
12915 retcode = Jim_EvalObj(interp, argv[1]);
12917 else {
12918 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12920 interp->framePtr = savedCallFrame;
12921 return retcode;
12923 else {
12924 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12925 return JIM_ERR;
12929 /* [expr] */
12930 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12932 int retcode;
12934 if (argc == 2) {
12935 retcode = Jim_EvalExpression(interp, argv[1]);
12937 else if (argc > 2) {
12938 Jim_Obj *objPtr;
12940 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12941 Jim_IncrRefCount(objPtr);
12942 retcode = Jim_EvalExpression(interp, objPtr);
12943 Jim_DecrRefCount(interp, objPtr);
12945 else {
12946 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12947 return JIM_ERR;
12949 if (retcode != JIM_OK)
12950 return retcode;
12951 return JIM_OK;
12954 /* [break] */
12955 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12957 if (argc != 1) {
12958 Jim_WrongNumArgs(interp, 1, argv, "");
12959 return JIM_ERR;
12961 return JIM_BREAK;
12964 /* [continue] */
12965 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12967 if (argc != 1) {
12968 Jim_WrongNumArgs(interp, 1, argv, "");
12969 return JIM_ERR;
12971 return JIM_CONTINUE;
12974 /* [return] */
12975 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12977 int i;
12978 Jim_Obj *stackTraceObj = NULL;
12979 Jim_Obj *errorCodeObj = NULL;
12980 int returnCode = JIM_OK;
12981 long level = 1;
12983 for (i = 1; i < argc - 1; i += 2) {
12984 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12985 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12986 return JIM_ERR;
12989 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12990 stackTraceObj = argv[i + 1];
12992 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12993 errorCodeObj = argv[i + 1];
12995 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12996 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12997 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12998 return JIM_ERR;
13001 else {
13002 break;
13006 if (i != argc - 1 && i != argc) {
13007 Jim_WrongNumArgs(interp, 1, argv,
13008 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13011 /* If a stack trace is supplied and code is error, set the stack trace */
13012 if (stackTraceObj && returnCode == JIM_ERR) {
13013 JimSetStackTrace(interp, stackTraceObj);
13015 /* If an error code list is supplied, set the global $errorCode */
13016 if (errorCodeObj && returnCode == JIM_ERR) {
13017 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13019 interp->returnCode = returnCode;
13020 interp->returnLevel = level;
13022 if (i == argc - 1) {
13023 Jim_SetResult(interp, argv[i]);
13025 return JIM_RETURN;
13028 /* [tailcall] */
13029 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13031 if (interp->framePtr->level == 0) {
13032 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13033 return JIM_ERR;
13035 else if (argc >= 2) {
13036 /* Need to resolve the tailcall command in the current context */
13037 Jim_CallFrame *cf = interp->framePtr->parent;
13039 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13040 if (cmdPtr == NULL) {
13041 return JIM_ERR;
13044 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13046 /* And stash this pre-resolved command */
13047 JimIncrCmdRefCount(cmdPtr);
13048 cf->tailcallCmd = cmdPtr;
13050 /* And stash the command list */
13051 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13053 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13054 Jim_IncrRefCount(cf->tailcallObj);
13056 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13057 return JIM_EVAL;
13059 return JIM_OK;
13062 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13064 Jim_Obj *cmdList;
13065 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13067 /* prefixListObj is a list to which the args need to be appended */
13068 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13069 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13071 return JimEvalObjList(interp, cmdList);
13074 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13076 Jim_Obj *prefixListObj = privData;
13077 Jim_DecrRefCount(interp, prefixListObj);
13080 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13082 Jim_Obj *prefixListObj;
13083 const char *newname;
13085 if (argc < 3) {
13086 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13087 return JIM_ERR;
13090 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13091 Jim_IncrRefCount(prefixListObj);
13092 newname = Jim_String(argv[1]);
13093 if (newname[0] == ':' && newname[1] == ':') {
13094 while (*++newname == ':') {
13098 Jim_SetResult(interp, argv[1]);
13100 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13103 /* [proc] */
13104 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13106 Jim_Cmd *cmd;
13108 if (argc != 4 && argc != 5) {
13109 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13110 return JIM_ERR;
13113 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13114 return JIM_ERR;
13117 if (argc == 4) {
13118 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13120 else {
13121 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13124 if (cmd) {
13125 /* Add the new command */
13126 Jim_Obj *qualifiedCmdNameObj;
13127 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13129 JimCreateCommand(interp, cmdname, cmd);
13131 /* Calculate and set the namespace for this proc */
13132 JimUpdateProcNamespace(interp, cmd, cmdname);
13134 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13136 /* Unlike Tcl, set the name of the proc as the result */
13137 Jim_SetResult(interp, argv[1]);
13138 return JIM_OK;
13140 return JIM_ERR;
13143 /* [local] */
13144 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13146 int retcode;
13148 if (argc < 2) {
13149 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13150 return JIM_ERR;
13153 /* Evaluate the arguments with 'local' in force */
13154 interp->local++;
13155 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13156 interp->local--;
13159 /* If OK, and the result is a proc, add it to the list of local procs */
13160 if (retcode == 0) {
13161 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13163 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13164 return JIM_ERR;
13166 if (interp->framePtr->localCommands == NULL) {
13167 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13168 Jim_InitStack(interp->framePtr->localCommands);
13170 Jim_IncrRefCount(cmdNameObj);
13171 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13174 return retcode;
13177 /* [upcall] */
13178 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13180 if (argc < 2) {
13181 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13182 return JIM_ERR;
13184 else {
13185 int retcode;
13187 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13188 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13189 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13190 return JIM_ERR;
13192 /* OK. Mark this command as being in an upcall */
13193 cmdPtr->u.proc.upcall++;
13194 JimIncrCmdRefCount(cmdPtr);
13196 /* Invoke the command as normal */
13197 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13199 /* No longer in an upcall */
13200 cmdPtr->u.proc.upcall--;
13201 JimDecrCmdRefCount(interp, cmdPtr);
13203 return retcode;
13207 /* [apply] */
13208 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13210 if (argc < 2) {
13211 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13212 return JIM_ERR;
13214 else {
13215 int ret;
13216 Jim_Cmd *cmd;
13217 Jim_Obj *argListObjPtr;
13218 Jim_Obj *bodyObjPtr;
13219 Jim_Obj *nsObj = NULL;
13220 Jim_Obj **nargv;
13222 int len = Jim_ListLength(interp, argv[1]);
13223 if (len != 2 && len != 3) {
13224 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13225 return JIM_ERR;
13228 if (len == 3) {
13229 #ifdef jim_ext_namespace
13230 /* Need to canonicalise the given namespace. */
13231 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13232 #else
13233 Jim_SetResultString(interp, "namespaces not enabled", -1);
13234 return JIM_ERR;
13235 #endif
13237 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13238 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13240 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13242 if (cmd) {
13243 /* Create a new argv array with a dummy argv[0], for error messages */
13244 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13245 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13246 Jim_IncrRefCount(nargv[0]);
13247 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13248 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13249 Jim_DecrRefCount(interp, nargv[0]);
13250 Jim_Free(nargv);
13252 JimDecrCmdRefCount(interp, cmd);
13253 return ret;
13255 return JIM_ERR;
13260 /* [concat] */
13261 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13263 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13264 return JIM_OK;
13267 /* [upvar] */
13268 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13270 int i;
13271 Jim_CallFrame *targetCallFrame;
13273 /* Lookup the target frame pointer */
13274 if (argc > 3 && (argc % 2 == 0)) {
13275 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13276 argc--;
13277 argv++;
13279 else {
13280 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13282 if (targetCallFrame == NULL) {
13283 return JIM_ERR;
13286 /* Check for arity */
13287 if (argc < 3) {
13288 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13289 return JIM_ERR;
13292 /* Now... for every other/local couple: */
13293 for (i = 1; i < argc; i += 2) {
13294 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13295 return JIM_ERR;
13297 return JIM_OK;
13300 /* [global] */
13301 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13303 int i;
13305 if (argc < 2) {
13306 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13307 return JIM_ERR;
13309 /* Link every var to the toplevel having the same name */
13310 if (interp->framePtr->level == 0)
13311 return JIM_OK; /* global at toplevel... */
13312 for (i = 1; i < argc; i++) {
13313 /* global ::blah does nothing */
13314 const char *name = Jim_String(argv[i]);
13315 if (name[0] != ':' || name[1] != ':') {
13316 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13317 return JIM_ERR;
13320 return JIM_OK;
13323 /* does the [string map] operation. On error NULL is returned,
13324 * otherwise a new string object with the result, having refcount = 0,
13325 * is returned. */
13326 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13327 Jim_Obj *objPtr, int nocase)
13329 int numMaps;
13330 const char *str, *noMatchStart = NULL;
13331 int strLen, i;
13332 Jim_Obj *resultObjPtr;
13334 numMaps = Jim_ListLength(interp, mapListObjPtr);
13335 if (numMaps % 2) {
13336 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13337 return NULL;
13340 str = Jim_String(objPtr);
13341 strLen = Jim_Utf8Length(interp, objPtr);
13343 /* Map it */
13344 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13345 while (strLen) {
13346 for (i = 0; i < numMaps; i += 2) {
13347 Jim_Obj *eachObjPtr;
13348 const char *k;
13349 int kl;
13351 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13352 k = Jim_String(eachObjPtr);
13353 kl = Jim_Utf8Length(interp, eachObjPtr);
13355 if (strLen >= kl && kl) {
13356 int rc;
13357 rc = JimStringCompareLen(str, k, kl, nocase);
13358 if (rc == 0) {
13359 if (noMatchStart) {
13360 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13361 noMatchStart = NULL;
13363 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13364 str += utf8_index(str, kl);
13365 strLen -= kl;
13366 break;
13370 if (i == numMaps) { /* no match */
13371 int c;
13372 if (noMatchStart == NULL)
13373 noMatchStart = str;
13374 str += utf8_tounicode(str, &c);
13375 strLen--;
13378 if (noMatchStart) {
13379 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13381 return resultObjPtr;
13384 /* [string] */
13385 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13387 int len;
13388 int opt_case = 1;
13389 int option;
13390 static const char * const options[] = {
13391 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13392 "map", "repeat", "reverse", "index", "first", "last", "cat",
13393 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13395 enum
13397 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13398 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13399 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13401 static const char * const nocase_options[] = {
13402 "-nocase", NULL
13404 static const char * const nocase_length_options[] = {
13405 "-nocase", "-length", NULL
13408 if (argc < 2) {
13409 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13410 return JIM_ERR;
13412 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13413 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13414 return Jim_CheckShowCommands(interp, argv[1], options);
13416 switch (option) {
13417 case OPT_LENGTH:
13418 case OPT_BYTELENGTH:
13419 if (argc != 3) {
13420 Jim_WrongNumArgs(interp, 2, argv, "string");
13421 return JIM_ERR;
13423 if (option == OPT_LENGTH) {
13424 len = Jim_Utf8Length(interp, argv[2]);
13426 else {
13427 len = Jim_Length(argv[2]);
13429 Jim_SetResultInt(interp, len);
13430 return JIM_OK;
13432 case OPT_CAT:{
13433 Jim_Obj *objPtr;
13434 if (argc == 3) {
13435 /* optimise the one-arg case */
13436 objPtr = argv[2];
13438 else {
13439 int i;
13441 objPtr = Jim_NewStringObj(interp, "", 0);
13443 for (i = 2; i < argc; i++) {
13444 Jim_AppendObj(interp, objPtr, argv[i]);
13447 Jim_SetResult(interp, objPtr);
13448 return JIM_OK;
13451 case OPT_COMPARE:
13452 case OPT_EQUAL:
13454 /* n is the number of remaining option args */
13455 long opt_length = -1;
13456 int n = argc - 4;
13457 int i = 2;
13458 while (n > 0) {
13459 int subopt;
13460 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13461 JIM_ENUM_ABBREV) != JIM_OK) {
13462 badcompareargs:
13463 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13464 return JIM_ERR;
13466 if (subopt == 0) {
13467 /* -nocase */
13468 opt_case = 0;
13469 n--;
13471 else {
13472 /* -length */
13473 if (n < 2) {
13474 goto badcompareargs;
13476 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13477 return JIM_ERR;
13479 n -= 2;
13482 if (n) {
13483 goto badcompareargs;
13485 argv += argc - 2;
13486 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13487 /* Fast version - [string equal], case sensitive, no length */
13488 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13490 else {
13491 if (opt_length >= 0) {
13492 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13494 else {
13495 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13497 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13499 return JIM_OK;
13502 case OPT_MATCH:
13503 if (argc != 4 &&
13504 (argc != 5 ||
13505 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13506 JIM_ENUM_ABBREV) != JIM_OK)) {
13507 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13508 return JIM_ERR;
13510 if (opt_case == 0) {
13511 argv++;
13513 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13514 return JIM_OK;
13516 case OPT_MAP:{
13517 Jim_Obj *objPtr;
13519 if (argc != 4 &&
13520 (argc != 5 ||
13521 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13522 JIM_ENUM_ABBREV) != JIM_OK)) {
13523 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13524 return JIM_ERR;
13527 if (opt_case == 0) {
13528 argv++;
13530 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13531 if (objPtr == NULL) {
13532 return JIM_ERR;
13534 Jim_SetResult(interp, objPtr);
13535 return JIM_OK;
13538 case OPT_RANGE:
13539 case OPT_BYTERANGE:{
13540 Jim_Obj *objPtr;
13542 if (argc != 5) {
13543 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13544 return JIM_ERR;
13546 if (option == OPT_RANGE) {
13547 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13549 else
13551 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13554 if (objPtr == NULL) {
13555 return JIM_ERR;
13557 Jim_SetResult(interp, objPtr);
13558 return JIM_OK;
13561 case OPT_REPLACE:{
13562 Jim_Obj *objPtr;
13564 if (argc != 5 && argc != 6) {
13565 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13566 return JIM_ERR;
13568 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13569 if (objPtr == NULL) {
13570 return JIM_ERR;
13572 Jim_SetResult(interp, objPtr);
13573 return JIM_OK;
13577 case OPT_REPEAT:{
13578 Jim_Obj *objPtr;
13579 jim_wide count;
13581 if (argc != 4) {
13582 Jim_WrongNumArgs(interp, 2, argv, "string count");
13583 return JIM_ERR;
13585 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13586 return JIM_ERR;
13588 objPtr = Jim_NewStringObj(interp, "", 0);
13589 if (count > 0) {
13590 while (count--) {
13591 Jim_AppendObj(interp, objPtr, argv[2]);
13594 Jim_SetResult(interp, objPtr);
13595 return JIM_OK;
13598 case OPT_REVERSE:{
13599 char *buf, *p;
13600 const char *str;
13601 int i;
13603 if (argc != 3) {
13604 Jim_WrongNumArgs(interp, 2, argv, "string");
13605 return JIM_ERR;
13608 str = Jim_GetString(argv[2], &len);
13609 buf = Jim_Alloc(len + 1);
13610 p = buf + len;
13611 *p = 0;
13612 for (i = 0; i < len; ) {
13613 int c;
13614 int l = utf8_tounicode(str, &c);
13615 memcpy(p - l, str, l);
13616 p -= l;
13617 i += l;
13618 str += l;
13620 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13621 return JIM_OK;
13624 case OPT_INDEX:{
13625 int idx;
13626 const char *str;
13628 if (argc != 4) {
13629 Jim_WrongNumArgs(interp, 2, argv, "string index");
13630 return JIM_ERR;
13632 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13633 return JIM_ERR;
13635 str = Jim_String(argv[2]);
13636 len = Jim_Utf8Length(interp, argv[2]);
13637 if (idx != INT_MIN && idx != INT_MAX) {
13638 idx = JimRelToAbsIndex(len, idx);
13640 if (idx < 0 || idx >= len || str == NULL) {
13641 Jim_SetResultString(interp, "", 0);
13643 else if (len == Jim_Length(argv[2])) {
13644 /* ASCII optimisation */
13645 Jim_SetResultString(interp, str + idx, 1);
13647 else {
13648 int c;
13649 int i = utf8_index(str, idx);
13650 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13652 return JIM_OK;
13655 case OPT_FIRST:
13656 case OPT_LAST:{
13657 int idx = 0, l1, l2;
13658 const char *s1, *s2;
13660 if (argc != 4 && argc != 5) {
13661 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13662 return JIM_ERR;
13664 s1 = Jim_String(argv[2]);
13665 s2 = Jim_String(argv[3]);
13666 l1 = Jim_Utf8Length(interp, argv[2]);
13667 l2 = Jim_Utf8Length(interp, argv[3]);
13668 if (argc == 5) {
13669 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13670 return JIM_ERR;
13672 idx = JimRelToAbsIndex(l2, idx);
13674 else if (option == OPT_LAST) {
13675 idx = l2;
13677 if (option == OPT_FIRST) {
13678 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13680 else {
13681 #ifdef JIM_UTF8
13682 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13683 #else
13684 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13685 #endif
13687 return JIM_OK;
13690 case OPT_TRIM:
13691 case OPT_TRIMLEFT:
13692 case OPT_TRIMRIGHT:{
13693 Jim_Obj *trimchars;
13695 if (argc != 3 && argc != 4) {
13696 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13697 return JIM_ERR;
13699 trimchars = (argc == 4 ? argv[3] : NULL);
13700 if (option == OPT_TRIM) {
13701 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13703 else if (option == OPT_TRIMLEFT) {
13704 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13706 else if (option == OPT_TRIMRIGHT) {
13707 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13709 return JIM_OK;
13712 case OPT_TOLOWER:
13713 case OPT_TOUPPER:
13714 case OPT_TOTITLE:
13715 if (argc != 3) {
13716 Jim_WrongNumArgs(interp, 2, argv, "string");
13717 return JIM_ERR;
13719 if (option == OPT_TOLOWER) {
13720 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13722 else if (option == OPT_TOUPPER) {
13723 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13725 else {
13726 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13728 return JIM_OK;
13730 case OPT_IS:
13731 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13732 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13734 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13735 return JIM_ERR;
13737 return JIM_OK;
13740 /* [time] */
13741 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13743 long i, count = 1;
13744 jim_wide start, elapsed;
13745 char buf[60];
13746 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13748 if (argc < 2) {
13749 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13750 return JIM_ERR;
13752 if (argc == 3) {
13753 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13754 return JIM_ERR;
13756 if (count < 0)
13757 return JIM_OK;
13758 i = count;
13759 start = JimClock();
13760 while (i-- > 0) {
13761 int retval;
13763 retval = Jim_EvalObj(interp, argv[1]);
13764 if (retval != JIM_OK) {
13765 return retval;
13768 elapsed = JimClock() - start;
13769 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13770 Jim_SetResultString(interp, buf, -1);
13771 return JIM_OK;
13774 /* [exit] */
13775 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13777 long exitCode = 0;
13779 if (argc > 2) {
13780 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13781 return JIM_ERR;
13783 if (argc == 2) {
13784 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13785 return JIM_ERR;
13787 interp->exitCode = exitCode;
13788 return JIM_EXIT;
13791 /* [catch] */
13792 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13794 int exitCode = 0;
13795 int i;
13796 int sig = 0;
13798 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13799 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13800 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13802 /* Reset the error code before catch.
13803 * Note that this is not strictly correct.
13805 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13807 for (i = 1; i < argc - 1; i++) {
13808 const char *arg = Jim_String(argv[i]);
13809 jim_wide option;
13810 int ignore;
13812 /* It's a pity we can't use Jim_GetEnum here :-( */
13813 if (strcmp(arg, "--") == 0) {
13814 i++;
13815 break;
13817 if (*arg != '-') {
13818 break;
13821 if (strncmp(arg, "-no", 3) == 0) {
13822 arg += 3;
13823 ignore = 1;
13825 else {
13826 arg++;
13827 ignore = 0;
13830 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13831 option = -1;
13833 if (option < 0) {
13834 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13836 if (option < 0) {
13837 goto wrongargs;
13840 if (ignore) {
13841 ignore_mask |= ((jim_wide)1 << option);
13843 else {
13844 ignore_mask &= (~((jim_wide)1 << option));
13848 argc -= i;
13849 if (argc < 1 || argc > 3) {
13850 wrongargs:
13851 Jim_WrongNumArgs(interp, 1, argv,
13852 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13853 return JIM_ERR;
13855 argv += i;
13857 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13858 sig++;
13861 interp->signal_level += sig;
13862 if (Jim_CheckSignal(interp)) {
13863 /* If a signal is set, don't even try to execute the body */
13864 exitCode = JIM_SIGNAL;
13866 else {
13867 exitCode = Jim_EvalObj(interp, argv[0]);
13868 /* Don't want any caught error included in a later stack trace */
13869 interp->errorFlag = 0;
13871 interp->signal_level -= sig;
13873 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13874 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13875 /* Not caught, pass it up */
13876 return exitCode;
13879 if (sig && exitCode == JIM_SIGNAL) {
13880 /* Catch the signal at this level */
13881 if (interp->signal_set_result) {
13882 interp->signal_set_result(interp, interp->sigmask);
13884 else {
13885 Jim_SetResultInt(interp, interp->sigmask);
13887 interp->sigmask = 0;
13890 if (argc >= 2) {
13891 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13892 return JIM_ERR;
13894 if (argc == 3) {
13895 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13897 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13898 Jim_ListAppendElement(interp, optListObj,
13899 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13900 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13901 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13902 if (exitCode == JIM_ERR) {
13903 Jim_Obj *errorCode;
13904 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13905 -1));
13906 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13908 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13909 if (errorCode) {
13910 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13911 Jim_ListAppendElement(interp, optListObj, errorCode);
13914 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13915 return JIM_ERR;
13919 Jim_SetResultInt(interp, exitCode);
13920 return JIM_OK;
13923 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13925 /* [ref] */
13926 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13928 if (argc != 3 && argc != 4) {
13929 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13930 return JIM_ERR;
13932 if (argc == 3) {
13933 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13935 else {
13936 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13938 return JIM_OK;
13941 /* [getref] */
13942 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13944 Jim_Reference *refPtr;
13946 if (argc != 2) {
13947 Jim_WrongNumArgs(interp, 1, argv, "reference");
13948 return JIM_ERR;
13950 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13951 return JIM_ERR;
13952 Jim_SetResult(interp, refPtr->objPtr);
13953 return JIM_OK;
13956 /* [setref] */
13957 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13959 Jim_Reference *refPtr;
13961 if (argc != 3) {
13962 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13963 return JIM_ERR;
13965 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13966 return JIM_ERR;
13967 Jim_IncrRefCount(argv[2]);
13968 Jim_DecrRefCount(interp, refPtr->objPtr);
13969 refPtr->objPtr = argv[2];
13970 Jim_SetResult(interp, argv[2]);
13971 return JIM_OK;
13974 /* [collect] */
13975 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13977 if (argc != 1) {
13978 Jim_WrongNumArgs(interp, 1, argv, "");
13979 return JIM_ERR;
13981 Jim_SetResultInt(interp, Jim_Collect(interp));
13983 /* Free all the freed objects. */
13984 while (interp->freeList) {
13985 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13986 Jim_Free(interp->freeList);
13987 interp->freeList = nextObjPtr;
13990 return JIM_OK;
13993 /* [finalize] reference ?newValue? */
13994 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13996 if (argc != 2 && argc != 3) {
13997 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13998 return JIM_ERR;
14000 if (argc == 2) {
14001 Jim_Obj *cmdNamePtr;
14003 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14004 return JIM_ERR;
14005 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14006 Jim_SetResult(interp, cmdNamePtr);
14008 else {
14009 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14010 return JIM_ERR;
14011 Jim_SetResult(interp, argv[2]);
14013 return JIM_OK;
14016 /* [info references] */
14017 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14019 Jim_Obj *listObjPtr;
14020 Jim_HashTableIterator htiter;
14021 Jim_HashEntry *he;
14023 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14025 JimInitHashTableIterator(&interp->references, &htiter);
14026 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14027 char buf[JIM_REFERENCE_SPACE + 1];
14028 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14029 const unsigned long *refId = he->key;
14031 JimFormatReference(buf, refPtr, *refId);
14032 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14034 Jim_SetResult(interp, listObjPtr);
14035 return JIM_OK;
14037 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14039 /* [rename] */
14040 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14042 if (argc != 3) {
14043 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14044 return JIM_ERR;
14047 if (JimValidName(interp, "new procedure", argv[2])) {
14048 return JIM_ERR;
14051 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14054 #define JIM_DICTMATCH_KEYS 0x0001
14055 #define JIM_DICTMATCH_VALUES 0x002
14058 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14059 * return_types should be either or both
14061 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14063 Jim_HashEntry *he;
14064 Jim_Obj *listObjPtr;
14065 Jim_HashTableIterator htiter;
14067 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14068 return JIM_ERR;
14071 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14073 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14074 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14075 if (patternObj) {
14076 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14077 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14078 /* no match */
14079 continue;
14082 if (return_types & JIM_DICTMATCH_KEYS) {
14083 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14085 if (return_types & JIM_DICTMATCH_VALUES) {
14086 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14090 Jim_SetResult(interp, listObjPtr);
14091 return JIM_OK;
14094 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14096 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14097 return -1;
14099 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14103 * Must be called with at least one object.
14104 * Returns the new dictionary, or NULL on error.
14106 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14108 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14109 int i;
14111 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14113 /* Note that we don't optimise the trivial case of a single argument */
14115 for (i = 0; i < objc; i++) {
14116 Jim_HashTable *ht;
14117 Jim_HashTableIterator htiter;
14118 Jim_HashEntry *he;
14120 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14121 Jim_FreeNewObj(interp, objPtr);
14122 return NULL;
14124 ht = objv[i]->internalRep.ptr;
14125 JimInitHashTableIterator(ht, &htiter);
14126 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14127 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14130 return objPtr;
14133 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14135 Jim_HashTable *ht;
14136 unsigned int i;
14137 char buffer[100];
14138 int sum = 0;
14139 int nonzero_count = 0;
14140 Jim_Obj *output;
14141 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14143 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14144 return JIM_ERR;
14147 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14149 /* Note that this uses internal knowledge of the hash table */
14150 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14151 output = Jim_NewStringObj(interp, buffer, -1);
14153 for (i = 0; i < ht->size; i++) {
14154 Jim_HashEntry *he = ht->table[i];
14155 int entries = 0;
14156 while (he) {
14157 entries++;
14158 he = he->next;
14160 if (entries > 9) {
14161 bucket_counts[10]++;
14163 else {
14164 bucket_counts[entries]++;
14166 if (entries) {
14167 sum += entries;
14168 nonzero_count++;
14171 for (i = 0; i < 10; i++) {
14172 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14173 Jim_AppendString(interp, output, buffer, -1);
14175 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14176 Jim_AppendString(interp, output, buffer, -1);
14177 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14178 Jim_AppendString(interp, output, buffer, -1);
14179 Jim_SetResult(interp, output);
14180 return JIM_OK;
14183 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14185 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14187 Jim_AppendString(interp, prefixObj, " ", 1);
14188 Jim_AppendString(interp, prefixObj, subcmd, -1);
14190 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14194 * Implements the [dict with] command
14196 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14198 int i;
14199 Jim_Obj *objPtr;
14200 Jim_Obj *dictObj;
14201 Jim_Obj **dictValues;
14202 int len;
14203 int ret = JIM_OK;
14205 /* Open up the appropriate level of the dictionary */
14206 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14207 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14208 return JIM_ERR;
14210 /* Set the local variables */
14211 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14212 return JIM_ERR;
14214 for (i = 0; i < len; i += 2) {
14215 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14216 Jim_Free(dictValues);
14217 return JIM_ERR;
14221 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14222 if (Jim_Length(scriptObj)) {
14223 ret = Jim_EvalObj(interp, scriptObj);
14225 /* Now if the dictionary still exists, update it based on the local variables */
14226 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14227 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14228 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14229 for (i = 0; i < keyc; i++) {
14230 newkeyv[i] = keyv[i];
14233 for (i = 0; i < len; i += 2) {
14234 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14235 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14236 newkeyv[keyc] = dictValues[i];
14237 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14239 Jim_Free(newkeyv);
14243 Jim_Free(dictValues);
14245 return ret;
14248 /* [dict] */
14249 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14251 Jim_Obj *objPtr;
14252 int types = JIM_DICTMATCH_KEYS;
14253 int option;
14254 static const char * const options[] = {
14255 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14256 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14257 "replace", "update", NULL
14259 enum
14261 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14262 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14263 OPT_REPLACE, OPT_UPDATE,
14266 if (argc < 2) {
14267 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14268 return JIM_ERR;
14271 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14272 return Jim_CheckShowCommands(interp, argv[1], options);
14275 switch (option) {
14276 case OPT_GET:
14277 if (argc < 3) {
14278 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14279 return JIM_ERR;
14281 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14282 JIM_ERRMSG) != JIM_OK) {
14283 return JIM_ERR;
14285 Jim_SetResult(interp, objPtr);
14286 return JIM_OK;
14288 case OPT_SET:
14289 if (argc < 5) {
14290 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14291 return JIM_ERR;
14293 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14295 case OPT_EXISTS:
14296 if (argc < 4) {
14297 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14298 return JIM_ERR;
14300 else {
14301 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14302 if (rc < 0) {
14303 return JIM_ERR;
14305 Jim_SetResultBool(interp, rc == JIM_OK);
14306 return JIM_OK;
14309 case OPT_UNSET:
14310 if (argc < 4) {
14311 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14312 return JIM_ERR;
14314 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14315 return JIM_ERR;
14317 return JIM_OK;
14319 case OPT_VALUES:
14320 types = JIM_DICTMATCH_VALUES;
14321 /* fallthru */
14322 case OPT_KEYS:
14323 if (argc != 3 && argc != 4) {
14324 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14325 return JIM_ERR;
14327 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14329 case OPT_SIZE:
14330 if (argc != 3) {
14331 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14332 return JIM_ERR;
14334 else if (Jim_DictSize(interp, argv[2]) < 0) {
14335 return JIM_ERR;
14337 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14338 return JIM_OK;
14340 case OPT_MERGE:
14341 if (argc == 2) {
14342 return JIM_OK;
14344 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14345 if (objPtr == NULL) {
14346 return JIM_ERR;
14348 Jim_SetResult(interp, objPtr);
14349 return JIM_OK;
14351 case OPT_UPDATE:
14352 if (argc < 6 || argc % 2) {
14353 /* Better error message */
14354 argc = 2;
14356 break;
14358 case OPT_CREATE:
14359 if (argc % 2) {
14360 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14361 return JIM_ERR;
14363 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14364 Jim_SetResult(interp, objPtr);
14365 return JIM_OK;
14367 case OPT_INFO:
14368 if (argc != 3) {
14369 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14370 return JIM_ERR;
14372 return Jim_DictInfo(interp, argv[2]);
14374 case OPT_WITH:
14375 if (argc < 4) {
14376 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14377 return JIM_ERR;
14379 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14381 /* Handle command as an ensemble */
14382 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14385 /* [subst] */
14386 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14388 static const char * const options[] = {
14389 "-nobackslashes", "-nocommands", "-novariables", NULL
14391 enum
14392 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14393 int i;
14394 int flags = JIM_SUBST_FLAG;
14395 Jim_Obj *objPtr;
14397 if (argc < 2) {
14398 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14399 return JIM_ERR;
14401 for (i = 1; i < (argc - 1); i++) {
14402 int option;
14404 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14405 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14406 return JIM_ERR;
14408 switch (option) {
14409 case OPT_NOBACKSLASHES:
14410 flags |= JIM_SUBST_NOESC;
14411 break;
14412 case OPT_NOCOMMANDS:
14413 flags |= JIM_SUBST_NOCMD;
14414 break;
14415 case OPT_NOVARIABLES:
14416 flags |= JIM_SUBST_NOVAR;
14417 break;
14420 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14421 return JIM_ERR;
14423 Jim_SetResult(interp, objPtr);
14424 return JIM_OK;
14427 /* [info] */
14428 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14430 int cmd;
14431 Jim_Obj *objPtr;
14432 int mode = 0;
14434 static const char * const commands[] = {
14435 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14436 "vars", "version", "patchlevel", "complete", "args", "hostname",
14437 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14438 "references", "alias", NULL
14440 enum
14441 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14442 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14443 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14444 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14447 #ifdef jim_ext_namespace
14448 int nons = 0;
14450 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14451 /* This is for internal use only */
14452 argc--;
14453 argv++;
14454 nons = 1;
14456 #endif
14458 if (argc < 2) {
14459 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14460 return JIM_ERR;
14462 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14463 return Jim_CheckShowCommands(interp, argv[1], commands);
14466 /* Test for the most common commands first, just in case it makes a difference */
14467 switch (cmd) {
14468 case INFO_EXISTS:
14469 if (argc != 3) {
14470 Jim_WrongNumArgs(interp, 2, argv, "varName");
14471 return JIM_ERR;
14473 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14474 break;
14476 case INFO_ALIAS:{
14477 Jim_Cmd *cmdPtr;
14479 if (argc != 3) {
14480 Jim_WrongNumArgs(interp, 2, argv, "command");
14481 return JIM_ERR;
14483 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14484 return JIM_ERR;
14486 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14487 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14488 return JIM_ERR;
14490 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14491 return JIM_OK;
14494 case INFO_CHANNELS:
14495 mode++; /* JIM_CMDLIST_CHANNELS */
14496 #ifndef jim_ext_aio
14497 Jim_SetResultString(interp, "aio not enabled", -1);
14498 return JIM_ERR;
14499 #endif
14500 /* fall through */
14501 case INFO_PROCS:
14502 mode++; /* JIM_CMDLIST_PROCS */
14503 /* fall through */
14504 case INFO_COMMANDS:
14505 /* mode 0 => JIM_CMDLIST_COMMANDS */
14506 if (argc != 2 && argc != 3) {
14507 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14508 return JIM_ERR;
14510 #ifdef jim_ext_namespace
14511 if (!nons) {
14512 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14513 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14516 #endif
14517 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14518 break;
14520 case INFO_VARS:
14521 mode++; /* JIM_VARLIST_VARS */
14522 /* fall through */
14523 case INFO_LOCALS:
14524 mode++; /* JIM_VARLIST_LOCALS */
14525 /* fall through */
14526 case INFO_GLOBALS:
14527 /* mode 0 => JIM_VARLIST_GLOBALS */
14528 if (argc != 2 && argc != 3) {
14529 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14530 return JIM_ERR;
14532 #ifdef jim_ext_namespace
14533 if (!nons) {
14534 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14535 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14538 #endif
14539 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14540 break;
14542 case INFO_SCRIPT:
14543 if (argc != 2) {
14544 Jim_WrongNumArgs(interp, 2, argv, "");
14545 return JIM_ERR;
14547 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14548 break;
14550 case INFO_SOURCE:{
14551 jim_wide line;
14552 Jim_Obj *resObjPtr;
14553 Jim_Obj *fileNameObj;
14555 if (argc != 3 && argc != 5) {
14556 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14557 return JIM_ERR;
14559 if (argc == 5) {
14560 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14561 return JIM_ERR;
14563 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14564 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14566 else {
14567 if (argv[2]->typePtr == &sourceObjType) {
14568 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14569 line = argv[2]->internalRep.sourceValue.lineNumber;
14571 else if (argv[2]->typePtr == &scriptObjType) {
14572 ScriptObj *script = JimGetScript(interp, argv[2]);
14573 fileNameObj = script->fileNameObj;
14574 line = script->firstline;
14576 else {
14577 fileNameObj = interp->emptyObj;
14578 line = 1;
14580 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14581 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14582 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14584 Jim_SetResult(interp, resObjPtr);
14585 break;
14588 case INFO_STACKTRACE:
14589 Jim_SetResult(interp, interp->stackTrace);
14590 break;
14592 case INFO_LEVEL:
14593 case INFO_FRAME:
14594 switch (argc) {
14595 case 2:
14596 Jim_SetResultInt(interp, interp->framePtr->level);
14597 break;
14599 case 3:
14600 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14601 return JIM_ERR;
14603 Jim_SetResult(interp, objPtr);
14604 break;
14606 default:
14607 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14608 return JIM_ERR;
14610 break;
14612 case INFO_BODY:
14613 case INFO_STATICS:
14614 case INFO_ARGS:{
14615 Jim_Cmd *cmdPtr;
14617 if (argc != 3) {
14618 Jim_WrongNumArgs(interp, 2, argv, "procname");
14619 return JIM_ERR;
14621 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14622 return JIM_ERR;
14624 if (!cmdPtr->isproc) {
14625 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14626 return JIM_ERR;
14628 switch (cmd) {
14629 case INFO_BODY:
14630 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14631 break;
14632 case INFO_ARGS:
14633 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14634 break;
14635 case INFO_STATICS:
14636 if (cmdPtr->u.proc.staticVars) {
14637 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14638 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14640 break;
14642 break;
14645 case INFO_VERSION:
14646 case INFO_PATCHLEVEL:{
14647 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14649 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14650 Jim_SetResultString(interp, buf, -1);
14651 break;
14654 case INFO_COMPLETE:
14655 if (argc != 3 && argc != 4) {
14656 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14657 return JIM_ERR;
14659 else {
14660 char missing;
14662 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14663 if (missing != ' ' && argc == 4) {
14664 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14667 break;
14669 case INFO_HOSTNAME:
14670 /* Redirect to os.gethostname if it exists */
14671 return Jim_Eval(interp, "os.gethostname");
14673 case INFO_NAMEOFEXECUTABLE:
14674 /* Redirect to Tcl proc */
14675 return Jim_Eval(interp, "{info nameofexecutable}");
14677 case INFO_RETURNCODES:
14678 if (argc == 2) {
14679 int i;
14680 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14682 for (i = 0; jimReturnCodes[i]; i++) {
14683 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14684 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14685 jimReturnCodes[i], -1));
14688 Jim_SetResult(interp, listObjPtr);
14690 else if (argc == 3) {
14691 long code;
14692 const char *name;
14694 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14695 return JIM_ERR;
14697 name = Jim_ReturnCode(code);
14698 if (*name == '?') {
14699 Jim_SetResultInt(interp, code);
14701 else {
14702 Jim_SetResultString(interp, name, -1);
14705 else {
14706 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14707 return JIM_ERR;
14709 break;
14710 case INFO_REFERENCES:
14711 #ifdef JIM_REFERENCES
14712 return JimInfoReferences(interp, argc, argv);
14713 #else
14714 Jim_SetResultString(interp, "not supported", -1);
14715 return JIM_ERR;
14716 #endif
14718 return JIM_OK;
14721 /* [exists] */
14722 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14724 Jim_Obj *objPtr;
14725 int result = 0;
14727 static const char * const options[] = {
14728 "-command", "-proc", "-alias", "-var", NULL
14730 enum
14732 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14734 int option;
14736 if (argc == 2) {
14737 option = OPT_VAR;
14738 objPtr = argv[1];
14740 else if (argc == 3) {
14741 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14742 return JIM_ERR;
14744 objPtr = argv[2];
14746 else {
14747 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14748 return JIM_ERR;
14751 if (option == OPT_VAR) {
14752 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14754 else {
14755 /* Now different kinds of commands */
14756 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14758 if (cmd) {
14759 switch (option) {
14760 case OPT_COMMAND:
14761 result = 1;
14762 break;
14764 case OPT_ALIAS:
14765 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14766 break;
14768 case OPT_PROC:
14769 result = cmd->isproc;
14770 break;
14774 Jim_SetResultBool(interp, result);
14775 return JIM_OK;
14778 /* [split] */
14779 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14781 const char *str, *splitChars, *noMatchStart;
14782 int splitLen, strLen;
14783 Jim_Obj *resObjPtr;
14784 int c;
14785 int len;
14787 if (argc != 2 && argc != 3) {
14788 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14789 return JIM_ERR;
14792 str = Jim_GetString(argv[1], &len);
14793 if (len == 0) {
14794 return JIM_OK;
14796 strLen = Jim_Utf8Length(interp, argv[1]);
14798 /* Init */
14799 if (argc == 2) {
14800 splitChars = " \n\t\r";
14801 splitLen = 4;
14803 else {
14804 splitChars = Jim_String(argv[2]);
14805 splitLen = Jim_Utf8Length(interp, argv[2]);
14808 noMatchStart = str;
14809 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14811 /* Split */
14812 if (splitLen) {
14813 Jim_Obj *objPtr;
14814 while (strLen--) {
14815 const char *sc = splitChars;
14816 int scLen = splitLen;
14817 int sl = utf8_tounicode(str, &c);
14818 while (scLen--) {
14819 int pc;
14820 sc += utf8_tounicode(sc, &pc);
14821 if (c == pc) {
14822 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14823 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14824 noMatchStart = str + sl;
14825 break;
14828 str += sl;
14830 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14831 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14833 else {
14834 /* This handles the special case of splitchars eq {}
14835 * Optimise by sharing common (ASCII) characters
14837 Jim_Obj **commonObj = NULL;
14838 #define NUM_COMMON (128 - 9)
14839 while (strLen--) {
14840 int n = utf8_tounicode(str, &c);
14841 #ifdef JIM_OPTIMIZATION
14842 if (c >= 9 && c < 128) {
14843 /* Common ASCII char. Note that 9 is the tab character */
14844 c -= 9;
14845 if (!commonObj) {
14846 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14847 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14849 if (!commonObj[c]) {
14850 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14852 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14853 str++;
14854 continue;
14856 #endif
14857 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14858 str += n;
14860 Jim_Free(commonObj);
14863 Jim_SetResult(interp, resObjPtr);
14864 return JIM_OK;
14867 /* [join] */
14868 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14870 const char *joinStr;
14871 int joinStrLen;
14873 if (argc != 2 && argc != 3) {
14874 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14875 return JIM_ERR;
14877 /* Init */
14878 if (argc == 2) {
14879 joinStr = " ";
14880 joinStrLen = 1;
14882 else {
14883 joinStr = Jim_GetString(argv[2], &joinStrLen);
14885 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14886 return JIM_OK;
14889 /* [format] */
14890 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14892 Jim_Obj *objPtr;
14894 if (argc < 2) {
14895 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14896 return JIM_ERR;
14898 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14899 if (objPtr == NULL)
14900 return JIM_ERR;
14901 Jim_SetResult(interp, objPtr);
14902 return JIM_OK;
14905 /* [scan] */
14906 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14908 Jim_Obj *listPtr, **outVec;
14909 int outc, i;
14911 if (argc < 3) {
14912 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14913 return JIM_ERR;
14915 if (argv[2]->typePtr != &scanFmtStringObjType)
14916 SetScanFmtFromAny(interp, argv[2]);
14917 if (FormatGetError(argv[2]) != 0) {
14918 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14919 return JIM_ERR;
14921 if (argc > 3) {
14922 int maxPos = FormatGetMaxPos(argv[2]);
14923 int count = FormatGetCnvCount(argv[2]);
14925 if (maxPos > argc - 3) {
14926 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14927 return JIM_ERR;
14929 else if (count > argc - 3) {
14930 Jim_SetResultString(interp, "different numbers of variable names and "
14931 "field specifiers", -1);
14932 return JIM_ERR;
14934 else if (count < argc - 3) {
14935 Jim_SetResultString(interp, "variable is not assigned by any "
14936 "conversion specifiers", -1);
14937 return JIM_ERR;
14940 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14941 if (listPtr == 0)
14942 return JIM_ERR;
14943 if (argc > 3) {
14944 int rc = JIM_OK;
14945 int count = 0;
14947 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14948 int len = Jim_ListLength(interp, listPtr);
14950 if (len != 0) {
14951 JimListGetElements(interp, listPtr, &outc, &outVec);
14952 for (i = 0; i < outc; ++i) {
14953 if (Jim_Length(outVec[i]) > 0) {
14954 ++count;
14955 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14956 rc = JIM_ERR;
14961 Jim_FreeNewObj(interp, listPtr);
14963 else {
14964 count = -1;
14966 if (rc == JIM_OK) {
14967 Jim_SetResultInt(interp, count);
14969 return rc;
14971 else {
14972 if (listPtr == (Jim_Obj *)EOF) {
14973 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14974 return JIM_OK;
14976 Jim_SetResult(interp, listPtr);
14978 return JIM_OK;
14981 /* [error] */
14982 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14984 if (argc != 2 && argc != 3) {
14985 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14986 return JIM_ERR;
14988 Jim_SetResult(interp, argv[1]);
14989 if (argc == 3) {
14990 JimSetStackTrace(interp, argv[2]);
14991 return JIM_ERR;
14993 interp->addStackTrace++;
14994 return JIM_ERR;
14997 /* [lrange] */
14998 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15000 Jim_Obj *objPtr;
15002 if (argc != 4) {
15003 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15004 return JIM_ERR;
15006 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15007 return JIM_ERR;
15008 Jim_SetResult(interp, objPtr);
15009 return JIM_OK;
15012 /* [lrepeat] */
15013 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15015 Jim_Obj *objPtr;
15016 long count;
15018 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15019 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15020 return JIM_ERR;
15023 if (count == 0 || argc == 2) {
15024 return JIM_OK;
15027 argc -= 2;
15028 argv += 2;
15030 objPtr = Jim_NewListObj(interp, argv, argc);
15031 while (--count) {
15032 ListInsertElements(objPtr, -1, argc, argv);
15035 Jim_SetResult(interp, objPtr);
15036 return JIM_OK;
15039 char **Jim_GetEnviron(void)
15041 #if defined(HAVE__NSGETENVIRON)
15042 return *_NSGetEnviron();
15043 #else
15044 #if !defined(NO_ENVIRON_EXTERN)
15045 extern char **environ;
15046 #endif
15048 return environ;
15049 #endif
15052 void Jim_SetEnviron(char **env)
15054 #if defined(HAVE__NSGETENVIRON)
15055 *_NSGetEnviron() = env;
15056 #else
15057 #if !defined(NO_ENVIRON_EXTERN)
15058 extern char **environ;
15059 #endif
15061 environ = env;
15062 #endif
15065 /* [env] */
15066 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15068 const char *key;
15069 const char *val;
15071 if (argc == 1) {
15072 char **e = Jim_GetEnviron();
15074 int i;
15075 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15077 for (i = 0; e[i]; i++) {
15078 const char *equals = strchr(e[i], '=');
15080 if (equals) {
15081 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15082 equals - e[i]));
15083 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15087 Jim_SetResult(interp, listObjPtr);
15088 return JIM_OK;
15091 if (argc < 2) {
15092 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15093 return JIM_ERR;
15095 key = Jim_String(argv[1]);
15096 val = getenv(key);
15097 if (val == NULL) {
15098 if (argc < 3) {
15099 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15100 return JIM_ERR;
15102 val = Jim_String(argv[2]);
15104 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15105 return JIM_OK;
15108 /* [source] */
15109 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15111 int retval;
15113 if (argc != 2) {
15114 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15115 return JIM_ERR;
15117 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15118 if (retval == JIM_RETURN)
15119 return JIM_OK;
15120 return retval;
15123 /* [lreverse] */
15124 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15126 Jim_Obj *revObjPtr, **ele;
15127 int len;
15129 if (argc != 2) {
15130 Jim_WrongNumArgs(interp, 1, argv, "list");
15131 return JIM_ERR;
15133 JimListGetElements(interp, argv[1], &len, &ele);
15134 len--;
15135 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15136 while (len >= 0)
15137 ListAppendElement(revObjPtr, ele[len--]);
15138 Jim_SetResult(interp, revObjPtr);
15139 return JIM_OK;
15142 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15144 jim_wide len;
15146 if (step == 0)
15147 return -1;
15148 if (start == end)
15149 return 0;
15150 else if (step > 0 && start > end)
15151 return -1;
15152 else if (step < 0 && end > start)
15153 return -1;
15154 len = end - start;
15155 if (len < 0)
15156 len = -len; /* abs(len) */
15157 if (step < 0)
15158 step = -step; /* abs(step) */
15159 len = 1 + ((len - 1) / step);
15160 /* We can truncate safely to INT_MAX, the range command
15161 * will always return an error for a such long range
15162 * because Tcl lists can't be so long. */
15163 if (len > INT_MAX)
15164 len = INT_MAX;
15165 return (int)((len < 0) ? -1 : len);
15168 /* [range] */
15169 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15171 jim_wide start = 0, end, step = 1;
15172 int len, i;
15173 Jim_Obj *objPtr;
15175 if (argc < 2 || argc > 4) {
15176 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15177 return JIM_ERR;
15179 if (argc == 2) {
15180 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15181 return JIM_ERR;
15183 else {
15184 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15185 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15186 return JIM_ERR;
15187 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15188 return JIM_ERR;
15190 if ((len = JimRangeLen(start, end, step)) == -1) {
15191 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15192 return JIM_ERR;
15194 objPtr = Jim_NewListObj(interp, NULL, 0);
15195 for (i = 0; i < len; i++)
15196 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15197 Jim_SetResult(interp, objPtr);
15198 return JIM_OK;
15201 /* [rand] */
15202 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15204 jim_wide min = 0, max = 0, len, maxMul;
15206 if (argc < 1 || argc > 3) {
15207 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15208 return JIM_ERR;
15210 if (argc == 1) {
15211 max = JIM_WIDE_MAX;
15212 } else if (argc == 2) {
15213 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15214 return JIM_ERR;
15215 } else if (argc == 3) {
15216 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15217 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15218 return JIM_ERR;
15220 len = max-min;
15221 if (len < 0) {
15222 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15223 return JIM_ERR;
15225 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15226 while (1) {
15227 jim_wide r;
15229 JimRandomBytes(interp, &r, sizeof(jim_wide));
15230 if (r < 0 || r >= maxMul) continue;
15231 r = (len == 0) ? 0 : r%len;
15232 Jim_SetResultInt(interp, min+r);
15233 return JIM_OK;
15237 static const struct {
15238 const char *name;
15239 Jim_CmdProc *cmdProc;
15240 } Jim_CoreCommandsTable[] = {
15241 {"alias", Jim_AliasCoreCommand},
15242 {"set", Jim_SetCoreCommand},
15243 {"unset", Jim_UnsetCoreCommand},
15244 {"puts", Jim_PutsCoreCommand},
15245 {"+", Jim_AddCoreCommand},
15246 {"*", Jim_MulCoreCommand},
15247 {"-", Jim_SubCoreCommand},
15248 {"/", Jim_DivCoreCommand},
15249 {"incr", Jim_IncrCoreCommand},
15250 {"while", Jim_WhileCoreCommand},
15251 {"loop", Jim_LoopCoreCommand},
15252 {"for", Jim_ForCoreCommand},
15253 {"foreach", Jim_ForeachCoreCommand},
15254 {"lmap", Jim_LmapCoreCommand},
15255 {"lassign", Jim_LassignCoreCommand},
15256 {"if", Jim_IfCoreCommand},
15257 {"switch", Jim_SwitchCoreCommand},
15258 {"list", Jim_ListCoreCommand},
15259 {"lindex", Jim_LindexCoreCommand},
15260 {"lset", Jim_LsetCoreCommand},
15261 {"lsearch", Jim_LsearchCoreCommand},
15262 {"llength", Jim_LlengthCoreCommand},
15263 {"lappend", Jim_LappendCoreCommand},
15264 {"linsert", Jim_LinsertCoreCommand},
15265 {"lreplace", Jim_LreplaceCoreCommand},
15266 {"lsort", Jim_LsortCoreCommand},
15267 {"append", Jim_AppendCoreCommand},
15268 {"debug", Jim_DebugCoreCommand},
15269 {"eval", Jim_EvalCoreCommand},
15270 {"uplevel", Jim_UplevelCoreCommand},
15271 {"expr", Jim_ExprCoreCommand},
15272 {"break", Jim_BreakCoreCommand},
15273 {"continue", Jim_ContinueCoreCommand},
15274 {"proc", Jim_ProcCoreCommand},
15275 {"concat", Jim_ConcatCoreCommand},
15276 {"return", Jim_ReturnCoreCommand},
15277 {"upvar", Jim_UpvarCoreCommand},
15278 {"global", Jim_GlobalCoreCommand},
15279 {"string", Jim_StringCoreCommand},
15280 {"time", Jim_TimeCoreCommand},
15281 {"exit", Jim_ExitCoreCommand},
15282 {"catch", Jim_CatchCoreCommand},
15283 #ifdef JIM_REFERENCES
15284 {"ref", Jim_RefCoreCommand},
15285 {"getref", Jim_GetrefCoreCommand},
15286 {"setref", Jim_SetrefCoreCommand},
15287 {"finalize", Jim_FinalizeCoreCommand},
15288 {"collect", Jim_CollectCoreCommand},
15289 #endif
15290 {"rename", Jim_RenameCoreCommand},
15291 {"dict", Jim_DictCoreCommand},
15292 {"subst", Jim_SubstCoreCommand},
15293 {"info", Jim_InfoCoreCommand},
15294 {"exists", Jim_ExistsCoreCommand},
15295 {"split", Jim_SplitCoreCommand},
15296 {"join", Jim_JoinCoreCommand},
15297 {"format", Jim_FormatCoreCommand},
15298 {"scan", Jim_ScanCoreCommand},
15299 {"error", Jim_ErrorCoreCommand},
15300 {"lrange", Jim_LrangeCoreCommand},
15301 {"lrepeat", Jim_LrepeatCoreCommand},
15302 {"env", Jim_EnvCoreCommand},
15303 {"source", Jim_SourceCoreCommand},
15304 {"lreverse", Jim_LreverseCoreCommand},
15305 {"range", Jim_RangeCoreCommand},
15306 {"rand", Jim_RandCoreCommand},
15307 {"tailcall", Jim_TailcallCoreCommand},
15308 {"local", Jim_LocalCoreCommand},
15309 {"upcall", Jim_UpcallCoreCommand},
15310 {"apply", Jim_ApplyCoreCommand},
15311 {NULL, NULL},
15314 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15316 int i = 0;
15318 while (Jim_CoreCommandsTable[i].name != NULL) {
15319 Jim_CreateCommand(interp,
15320 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15321 i++;
15325 /* -----------------------------------------------------------------------------
15326 * Interactive prompt
15327 * ---------------------------------------------------------------------------*/
15328 void Jim_MakeErrorMessage(Jim_Interp *interp)
15330 Jim_Obj *argv[2];
15332 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15333 argv[1] = interp->result;
15335 Jim_EvalObjVector(interp, 2, argv);
15339 * Given a null terminated array of strings, returns an allocated, sorted
15340 * copy of the array.
15342 static char **JimSortStringTable(const char *const *tablePtr)
15344 int count;
15345 char **tablePtrSorted;
15347 /* Find the size of the table */
15348 for (count = 0; tablePtr[count]; count++) {
15351 /* Allocate one extra for the terminating NULL pointer */
15352 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15353 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15354 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15355 tablePtrSorted[count] = NULL;
15357 return tablePtrSorted;
15360 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15361 const char *prefix, const char *const *tablePtr, const char *name)
15363 char **tablePtrSorted;
15364 int i;
15366 if (name == NULL) {
15367 name = "option";
15370 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15371 tablePtrSorted = JimSortStringTable(tablePtr);
15372 for (i = 0; tablePtrSorted[i]; i++) {
15373 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15374 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15376 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15377 if (tablePtrSorted[i + 1]) {
15378 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15381 Jim_Free(tablePtrSorted);
15386 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15387 * and returns JIM_OK.
15389 * Otherwise returns JIM_ERR.
15391 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15393 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15394 int i;
15395 char **tablePtrSorted = JimSortStringTable(tablePtr);
15396 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15397 for (i = 0; tablePtrSorted[i]; i++) {
15398 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15400 Jim_Free(tablePtrSorted);
15401 return JIM_OK;
15403 return JIM_ERR;
15406 /* internal rep is stored in ptrIntvalue
15407 * ptr = tablePtr
15408 * int1 = flags
15409 * int2 = index
15411 static const Jim_ObjType getEnumObjType = {
15412 "get-enum",
15413 NULL,
15414 NULL,
15415 NULL,
15416 JIM_TYPE_REFERENCES
15419 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15420 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15422 const char *bad = "bad ";
15423 const char *const *entryPtr = NULL;
15424 int i;
15425 int match = -1;
15426 int arglen;
15427 const char *arg;
15429 if (objPtr->typePtr == &getEnumObjType) {
15430 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15431 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15432 return JIM_OK;
15436 arg = Jim_GetString(objPtr, &arglen);
15438 *indexPtr = -1;
15440 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15441 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15442 /* Found an exact match */
15443 match = i;
15444 goto found;
15446 if (flags & JIM_ENUM_ABBREV) {
15447 /* Accept an unambiguous abbreviation.
15448 * Note that '-' doesnt' consitute a valid abbreviation
15450 if (strncmp(arg, *entryPtr, arglen) == 0) {
15451 if (*arg == '-' && arglen == 1) {
15452 break;
15454 if (match >= 0) {
15455 bad = "ambiguous ";
15456 goto ambiguous;
15458 match = i;
15463 /* If we had an unambiguous partial match */
15464 if (match >= 0) {
15465 found:
15466 /* Record the match in the object */
15467 Jim_FreeIntRep(interp, objPtr);
15468 objPtr->typePtr = &getEnumObjType;
15469 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15470 objPtr->internalRep.ptrIntValue.int1 = flags;
15471 objPtr->internalRep.ptrIntValue.int2 = match;
15472 /* Return the result */
15473 *indexPtr = match;
15474 return JIM_OK;
15477 ambiguous:
15478 if (flags & JIM_ERRMSG) {
15479 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15481 return JIM_ERR;
15484 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15486 int i;
15488 for (i = 0; i < (int)len; i++) {
15489 if (array[i] && strcmp(array[i], name) == 0) {
15490 return i;
15493 return -1;
15496 int Jim_IsDict(Jim_Obj *objPtr)
15498 return objPtr->typePtr == &dictObjType;
15501 int Jim_IsList(Jim_Obj *objPtr)
15503 return objPtr->typePtr == &listObjType;
15507 * Very simple printf-like formatting, designed for error messages.
15509 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15510 * The resulting string is created and set as the result.
15512 * Each '%s' should correspond to a regular string parameter.
15513 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15514 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15516 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15518 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15520 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15522 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15524 /* Initial space needed */
15525 int len = strlen(format);
15526 int extra = 0;
15527 int n = 0;
15528 const char *params[5];
15529 int nobjparam = 0;
15530 Jim_Obj *objparam[5];
15531 char *buf;
15532 va_list args;
15533 int i;
15535 va_start(args, format);
15537 for (i = 0; i < len && n < 5; i++) {
15538 int l;
15540 if (strncmp(format + i, "%s", 2) == 0) {
15541 params[n] = va_arg(args, char *);
15543 l = strlen(params[n]);
15545 else if (strncmp(format + i, "%#s", 3) == 0) {
15546 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15548 params[n] = Jim_GetString(objPtr, &l);
15549 objparam[nobjparam++] = objPtr;
15550 Jim_IncrRefCount(objPtr);
15552 else {
15553 if (format[i] == '%') {
15554 i++;
15556 continue;
15558 n++;
15559 extra += l;
15562 len += extra;
15563 buf = Jim_Alloc(len + 1);
15564 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15566 va_end(args);
15568 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15570 for (i = 0; i < nobjparam; i++) {
15571 Jim_DecrRefCount(interp, objparam[i]);
15575 /* stubs */
15576 #ifndef jim_ext_package
15577 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15579 return JIM_OK;
15581 #endif
15582 #ifndef jim_ext_aio
15583 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15585 Jim_SetResultString(interp, "aio not enabled", -1);
15586 return NULL;
15588 #endif
15592 * Local Variables: ***
15593 * c-basic-offset: 4 ***
15594 * tab-width: 4 ***
15595 * End: ***