tests/exec.test: Add constraint "unix" for 12.1
[jimtcl.git] / jim.c
blob47f1bc72d8d19ca632ae2fcd6cc86673854d6e5b
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 #define _GNU_SOURCE /* Mostly just for environ */
46 #include <stdio.h>
47 #include <stdlib.h>
49 #include <string.h>
50 #include <stdarg.h>
51 #include <ctype.h>
52 #include <limits.h>
53 #include <assert.h>
54 #include <errno.h>
55 #include <time.h>
56 #include <setjmp.h>
58 #include "jim.h"
59 #include "jimautoconf.h"
60 #include "utf8.h"
62 #ifdef HAVE_SYS_TIME_H
63 #include <sys/time.h>
64 #endif
65 #ifdef HAVE_BACKTRACE
66 #include <execinfo.h>
67 #endif
68 #ifdef HAVE_CRT_EXTERNS_H
69 #include <crt_externs.h>
70 #endif
72 /* For INFINITY, even if math functions are not enabled */
73 #include <math.h>
75 /* We may decide to switch to using $[...] after all, so leave it as an option */
76 /*#define EXPRSUGAR_BRACKET*/
78 /* For the no-autoconf case */
79 #ifndef TCL_LIBRARY
80 #define TCL_LIBRARY "."
81 #endif
82 #ifndef TCL_PLATFORM_OS
83 #define TCL_PLATFORM_OS "unknown"
84 #endif
85 #ifndef TCL_PLATFORM_PLATFORM
86 #define TCL_PLATFORM_PLATFORM "unknown"
87 #endif
88 #ifndef TCL_PLATFORM_PATH_SEPARATOR
89 #define TCL_PLATFORM_PATH_SEPARATOR ":"
90 #endif
92 /*#define DEBUG_SHOW_SCRIPT*/
93 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
94 /*#define DEBUG_SHOW_SUBST*/
95 /*#define DEBUG_SHOW_EXPR*/
96 /*#define DEBUG_SHOW_EXPR_TOKENS*/
97 /*#define JIM_DEBUG_GC*/
98 #ifdef JIM_MAINTAINER
99 #define JIM_DEBUG_COMMAND
100 #define JIM_DEBUG_PANIC
101 #endif
102 /* Enable this (in conjunction with valgrind) to help debug
103 * reference counting issues
105 /*#define JIM_DISABLE_OBJECT_POOL*/
107 /* Maximum size of an integer */
108 #define JIM_INTEGER_SPACE 24
110 const char *jim_tt_name(int type);
112 #ifdef JIM_DEBUG_PANIC
113 static void JimPanicDump(int fail_condition, const char *fmt, ...);
114 #define JimPanic(X) JimPanicDump X
115 #else
116 #define JimPanic(X)
117 #endif
119 #ifdef JIM_OPTIMIZATION
120 #define JIM_IF_OPTIM(X) X
121 #else
122 #define JIM_IF_OPTIM(X)
123 #endif
125 /* -----------------------------------------------------------------------------
126 * Global variables
127 * ---------------------------------------------------------------------------*/
129 /* A shared empty string for the objects string representation.
130 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
131 static char JimEmptyStringRep[] = "";
133 /* -----------------------------------------------------------------------------
134 * Required prototypes of not exported functions
135 * ---------------------------------------------------------------------------*/
136 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
137 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
138 int flags);
139 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
140 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
141 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
142 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
143 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
144 const char *prefix, const char *const *tablePtr, const char *name);
145 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
146 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
147 static int JimSign(jim_wide w);
148 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
149 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
150 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
153 /* Fast access to the int (wide) value of an object which is known to be of int type */
154 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
156 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
158 static int utf8_tounicode_case(const char *s, int *uc, int upper)
160 int l = utf8_tounicode(s, uc);
161 if (upper) {
162 *uc = utf8_upper(*uc);
164 return l;
167 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
168 #define JIM_CHARSET_SCAN 2
169 #define JIM_CHARSET_GLOB 0
172 * pattern points to a string like "[^a-z\ub5]"
174 * The pattern may contain trailing chars, which are ignored.
176 * The pattern is matched against unicode char 'c'.
178 * If (flags & JIM_NOCASE), case is ignored when matching.
179 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
180 * of the charset, per scan, rather than glob/string match.
182 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
183 * or the null character if the ']' is missing.
185 * Returns NULL on no match.
187 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
189 int not = 0;
190 int pchar;
191 int match = 0;
192 int nocase = 0;
194 if (flags & JIM_NOCASE) {
195 nocase++;
196 c = utf8_upper(c);
199 if (flags & JIM_CHARSET_SCAN) {
200 if (*pattern == '^') {
201 not++;
202 pattern++;
205 /* Special case. If the first char is ']', it is part of the set */
206 if (*pattern == ']') {
207 goto first;
211 while (*pattern && *pattern != ']') {
212 /* Exact match */
213 if (pattern[0] == '\\') {
214 first:
215 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
217 else {
218 /* Is this a range? a-z */
219 int start;
220 int end;
222 pattern += utf8_tounicode_case(pattern, &start, nocase);
223 if (pattern[0] == '-' && pattern[1]) {
224 /* skip '-' */
225 pattern += utf8_tounicode(pattern, &pchar);
226 pattern += utf8_tounicode_case(pattern, &end, nocase);
228 /* Handle reversed range too */
229 if ((c >= start && c <= end) || (c >= end && c <= start)) {
230 match = 1;
232 continue;
234 pchar = start;
237 if (pchar == c) {
238 match = 1;
241 if (not) {
242 match = !match;
245 return match ? pattern : NULL;
248 /* Glob-style pattern matching. */
250 /* Note: string *must* be valid UTF-8 sequences
252 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
254 int c;
255 int pchar;
256 while (*pattern) {
257 switch (pattern[0]) {
258 case '*':
259 while (pattern[1] == '*') {
260 pattern++;
262 pattern++;
263 if (!pattern[0]) {
264 return 1; /* match */
266 while (*string) {
267 /* Recursive call - Does the remaining pattern match anywhere? */
268 if (JimGlobMatch(pattern, string, nocase))
269 return 1; /* match */
270 string += utf8_tounicode(string, &c);
272 return 0; /* no match */
274 case '?':
275 string += utf8_tounicode(string, &c);
276 break;
278 case '[': {
279 string += utf8_tounicode(string, &c);
280 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
281 if (!pattern) {
282 return 0;
284 if (!*pattern) {
285 /* Ran out of pattern (no ']') */
286 continue;
288 break;
290 case '\\':
291 if (pattern[1]) {
292 pattern++;
294 /* fall through */
295 default:
296 string += utf8_tounicode_case(string, &c, nocase);
297 utf8_tounicode_case(pattern, &pchar, nocase);
298 if (pchar != c) {
299 return 0;
301 break;
303 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
304 if (!*string) {
305 while (*pattern == '*') {
306 pattern++;
308 break;
311 if (!*pattern && !*string) {
312 return 1;
314 return 0;
318 * string comparison. Works on binary data.
320 * Returns -1, 0 or 1
322 * Note that the lengths are byte lengths, not char lengths.
324 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
326 if (l1 < l2) {
327 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
329 else if (l2 < l1) {
330 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
332 else {
333 return JimSign(memcmp(s1, s2, l1));
338 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
339 * (or end of string if 'maxchars' is -1).
341 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
343 * Note: does not support embedded nulls.
345 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
347 while (*s1 && *s2 && maxchars) {
348 int c1, c2;
349 s1 += utf8_tounicode_case(s1, &c1, nocase);
350 s2 += utf8_tounicode_case(s2, &c2, nocase);
351 if (c1 != c2) {
352 return JimSign(c1 - c2);
354 maxchars--;
356 if (!maxchars) {
357 return 0;
359 /* One string or both terminated */
360 if (*s1) {
361 return 1;
363 if (*s2) {
364 return -1;
366 return 0;
369 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
370 * The index of the first occurrence of s1 in s2 is returned.
371 * If s1 is not found inside s2, -1 is returned. */
372 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
374 int i;
375 int l1bytelen;
377 if (!l1 || !l2 || l1 > l2) {
378 return -1;
380 if (idx < 0)
381 idx = 0;
382 s2 += utf8_index(s2, idx);
384 l1bytelen = utf8_index(s1, l1);
386 for (i = idx; i <= l2 - l1; i++) {
387 int c;
388 if (memcmp(s2, s1, l1bytelen) == 0) {
389 return i;
391 s2 += utf8_tounicode(s2, &c);
393 return -1;
397 * Note: Lengths and return value are in bytes, not chars.
399 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
401 const char *p;
403 if (!l1 || !l2 || l1 > l2)
404 return -1;
406 /* Now search for the needle */
407 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
408 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
409 return p - s2;
412 return -1;
415 #ifdef JIM_UTF8
417 * Note: Lengths and return value are in chars.
419 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
421 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
422 if (n > 0) {
423 n = utf8_strlen(s2, n);
425 return n;
427 #endif
430 * After an strtol()/strtod()-like conversion,
431 * check whether something was converted and that
432 * the only thing left is white space.
434 * Returns JIM_OK or JIM_ERR.
436 static int JimCheckConversion(const char *str, const char *endptr)
438 if (str[0] == '\0' || str == endptr) {
439 return JIM_ERR;
442 if (endptr[0] != '\0') {
443 while (*endptr) {
444 if (!isspace(UCHAR(*endptr))) {
445 return JIM_ERR;
447 endptr++;
450 return JIM_OK;
453 /* Parses the front of a number to determine it's sign and base
454 * Returns the index to start parsing according to the given base
456 static int JimNumberBase(const char *str, int *base, int *sign)
458 int i = 0;
460 *base = 10;
462 while (isspace(UCHAR(str[i]))) {
463 i++;
466 if (str[i] == '-') {
467 *sign = -1;
468 i++;
470 else {
471 if (str[i] == '+') {
472 i++;
474 *sign = 1;
477 if (str[i] != '0') {
478 /* base 10 */
479 return 0;
482 /* We have 0<x>, so see if we can convert it */
483 switch (str[i + 1]) {
484 case 'x': case 'X': *base = 16; break;
485 case 'o': case 'O': *base = 8; break;
486 case 'b': case 'B': *base = 2; break;
487 default: return 0;
489 i += 2;
490 /* Ensure that (e.g.) 0x-5 fails to parse */
491 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
492 /* Parse according to this base */
493 return i;
495 /* Parse as base 10 */
496 *base = 10;
497 return 0;
500 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
501 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
503 static long jim_strtol(const char *str, char **endptr)
505 int sign;
506 int base;
507 int i = JimNumberBase(str, &base, &sign);
509 if (base != 10) {
510 long value = strtol(str + i, endptr, base);
511 if (endptr == NULL || *endptr != str + i) {
512 return value * sign;
516 /* Can just do a regular base-10 conversion */
517 return strtol(str, endptr, 10);
521 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
522 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
524 static jim_wide jim_strtoull(const char *str, char **endptr)
526 #ifdef HAVE_LONG_LONG
527 int sign;
528 int base;
529 int i = JimNumberBase(str, &base, &sign);
531 if (base != 10) {
532 jim_wide value = strtoull(str + i, endptr, base);
533 if (endptr == NULL || *endptr != str + i) {
534 return value * sign;
538 /* Can just do a regular base-10 conversion */
539 return strtoull(str, endptr, 10);
540 #else
541 return (unsigned long)jim_strtol(str, endptr);
542 #endif
545 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
547 char *endptr;
549 if (base) {
550 *widePtr = strtoull(str, &endptr, base);
552 else {
553 *widePtr = jim_strtoull(str, &endptr);
556 return JimCheckConversion(str, endptr);
559 int Jim_StringToDouble(const char *str, double *doublePtr)
561 char *endptr;
563 /* Callers can check for underflow via ERANGE */
564 errno = 0;
566 *doublePtr = strtod(str, &endptr);
568 return JimCheckConversion(str, endptr);
571 static jim_wide JimPowWide(jim_wide b, jim_wide e)
573 jim_wide res = 1;
575 /* Special cases */
576 if (b == 1) {
577 /* 1 ^ any = 1 */
578 return 1;
580 if (e < 0) {
581 if (b != -1) {
582 return 0;
584 /* Only special case is -1 ^ -n
585 * -1^-1 = -1
586 * -1^-2 = 1
587 * i.e. same as +ve n
589 e = -e;
591 while (e)
593 if (e & 1) {
594 res *= b;
596 e >>= 1;
597 b *= b;
599 return res;
602 /* -----------------------------------------------------------------------------
603 * Special functions
604 * ---------------------------------------------------------------------------*/
605 #ifdef JIM_DEBUG_PANIC
606 static void JimPanicDump(int condition, const char *fmt, ...)
608 va_list ap;
610 if (!condition) {
611 return;
614 va_start(ap, fmt);
616 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
617 vfprintf(stderr, fmt, ap);
618 fprintf(stderr, "\n\n");
619 va_end(ap);
621 #ifdef HAVE_BACKTRACE
623 void *array[40];
624 int size, i;
625 char **strings;
627 size = backtrace(array, 40);
628 strings = backtrace_symbols(array, size);
629 for (i = 0; i < size; i++)
630 fprintf(stderr, "[backtrace] %s\n", strings[i]);
631 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
632 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
634 #endif
636 exit(1);
638 #endif
640 /* -----------------------------------------------------------------------------
641 * Memory allocation
642 * ---------------------------------------------------------------------------*/
644 void *Jim_Alloc(int size)
646 return size ? malloc(size) : NULL;
649 void Jim_Free(void *ptr)
651 free(ptr);
654 void *Jim_Realloc(void *ptr, int size)
656 return realloc(ptr, size);
659 char *Jim_StrDup(const char *s)
661 return strdup(s);
664 char *Jim_StrDupLen(const char *s, int l)
666 char *copy = Jim_Alloc(l + 1);
668 memcpy(copy, s, l + 1);
669 copy[l] = 0; /* Just to be sure, original could be substring */
670 return copy;
673 /* -----------------------------------------------------------------------------
674 * Time related functions
675 * ---------------------------------------------------------------------------*/
677 /* Returns current time in microseconds */
678 static jim_wide JimClock(void)
680 struct timeval tv;
682 gettimeofday(&tv, NULL);
683 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
686 /* -----------------------------------------------------------------------------
687 * Hash Tables
688 * ---------------------------------------------------------------------------*/
690 /* -------------------------- private prototypes ---------------------------- */
691 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
692 static unsigned int JimHashTableNextPower(unsigned int size);
693 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
695 /* -------------------------- hash functions -------------------------------- */
697 /* Thomas Wang's 32 bit Mix Function */
698 unsigned int Jim_IntHashFunction(unsigned int key)
700 key += ~(key << 15);
701 key ^= (key >> 10);
702 key += (key << 3);
703 key ^= (key >> 6);
704 key += ~(key << 11);
705 key ^= (key >> 16);
706 return key;
709 /* Generic hash function (we are using to multiply by 9 and add the byte
710 * as Tcl) */
711 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
713 unsigned int h = 0;
715 while (len--)
716 h += (h << 3) + *buf++;
717 return h;
720 /* ----------------------------- API implementation ------------------------- */
722 /* reset a hashtable already initialized */
723 static void JimResetHashTable(Jim_HashTable *ht)
725 ht->table = NULL;
726 ht->size = 0;
727 ht->sizemask = 0;
728 ht->used = 0;
729 ht->collisions = 0;
730 #ifdef JIM_RANDOMISE_HASH
731 /* This is initialised to a random value to avoid a hash collision attack.
732 * See: n.runs-SA-2011.004
734 ht->uniq = (rand() ^ time(NULL) ^ clock());
735 #else
736 ht->uniq = 0;
737 #endif
740 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
742 iter->ht = ht;
743 iter->index = -1;
744 iter->entry = NULL;
745 iter->nextEntry = NULL;
748 /* Initialize the hash table */
749 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
751 JimResetHashTable(ht);
752 ht->type = type;
753 ht->privdata = privDataPtr;
754 return JIM_OK;
757 /* Resize the table to the minimal size that contains all the elements,
758 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
759 void Jim_ResizeHashTable(Jim_HashTable *ht)
761 int minimal = ht->used;
763 if (minimal < JIM_HT_INITIAL_SIZE)
764 minimal = JIM_HT_INITIAL_SIZE;
765 Jim_ExpandHashTable(ht, minimal);
768 /* Expand or create the hashtable */
769 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
771 Jim_HashTable n; /* the new hashtable */
772 unsigned int realsize = JimHashTableNextPower(size), i;
774 /* the size is invalid if it is smaller than the number of
775 * elements already inside the hashtable */
776 if (size <= ht->used)
777 return;
779 Jim_InitHashTable(&n, ht->type, ht->privdata);
780 n.size = realsize;
781 n.sizemask = realsize - 1;
782 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
783 /* Keep the same 'uniq' as the original */
784 n.uniq = ht->uniq;
786 /* Initialize all the pointers to NULL */
787 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
789 /* Copy all the elements from the old to the new table:
790 * note that if the old hash table is empty ht->used is zero,
791 * so Jim_ExpandHashTable just creates an empty hash table. */
792 n.used = ht->used;
793 for (i = 0; ht->used > 0; i++) {
794 Jim_HashEntry *he, *nextHe;
796 if (ht->table[i] == NULL)
797 continue;
799 /* For each hash entry on this slot... */
800 he = ht->table[i];
801 while (he) {
802 unsigned int h;
804 nextHe = he->next;
805 /* Get the new element index */
806 h = Jim_HashKey(ht, he->key) & n.sizemask;
807 he->next = n.table[h];
808 n.table[h] = he;
809 ht->used--;
810 /* Pass to the next element */
811 he = nextHe;
814 assert(ht->used == 0);
815 Jim_Free(ht->table);
817 /* Remap the new hashtable in the old */
818 *ht = n;
821 /* Add an element to the target hash table */
822 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
824 Jim_HashEntry *entry;
826 /* Get the index of the new element, or -1 if
827 * the element already exists. */
828 entry = JimInsertHashEntry(ht, key, 0);
829 if (entry == NULL)
830 return JIM_ERR;
832 /* Set the hash entry fields. */
833 Jim_SetHashKey(ht, entry, key);
834 Jim_SetHashVal(ht, entry, val);
835 return JIM_OK;
838 /* Add an element, discarding the old if the key already exists */
839 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
841 int existed;
842 Jim_HashEntry *entry;
844 /* Get the index of the new element, or -1 if
845 * the element already exists. */
846 entry = JimInsertHashEntry(ht, key, 1);
847 if (entry->key) {
848 /* It already exists, so only replace the value.
849 * Note if both a destructor and a duplicate function exist,
850 * need to dup before destroy. perhaps they are the same
851 * reference counted object
853 if (ht->type->valDestructor && ht->type->valDup) {
854 void *newval = ht->type->valDup(ht->privdata, val);
855 ht->type->valDestructor(ht->privdata, entry->u.val);
856 entry->u.val = newval;
858 else {
859 Jim_FreeEntryVal(ht, entry);
860 Jim_SetHashVal(ht, entry, val);
862 existed = 1;
864 else {
865 /* Doesn't exist, so set the key */
866 Jim_SetHashKey(ht, entry, key);
867 Jim_SetHashVal(ht, entry, val);
868 existed = 0;
871 return existed;
874 /* Search and remove an element */
875 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
877 unsigned int h;
878 Jim_HashEntry *he, *prevHe;
880 if (ht->used == 0)
881 return JIM_ERR;
882 h = Jim_HashKey(ht, key) & ht->sizemask;
883 he = ht->table[h];
885 prevHe = NULL;
886 while (he) {
887 if (Jim_CompareHashKeys(ht, key, he->key)) {
888 /* Unlink the element from the list */
889 if (prevHe)
890 prevHe->next = he->next;
891 else
892 ht->table[h] = he->next;
893 Jim_FreeEntryKey(ht, he);
894 Jim_FreeEntryVal(ht, he);
895 Jim_Free(he);
896 ht->used--;
897 return JIM_OK;
899 prevHe = he;
900 he = he->next;
902 return JIM_ERR; /* not found */
905 /* Destroy an entire hash table and leave it ready for reuse */
906 int Jim_FreeHashTable(Jim_HashTable *ht)
908 unsigned int i;
910 /* Free all the elements */
911 for (i = 0; ht->used > 0; i++) {
912 Jim_HashEntry *he, *nextHe;
914 if ((he = ht->table[i]) == NULL)
915 continue;
916 while (he) {
917 nextHe = he->next;
918 Jim_FreeEntryKey(ht, he);
919 Jim_FreeEntryVal(ht, he);
920 Jim_Free(he);
921 ht->used--;
922 he = nextHe;
925 /* Free the table and the allocated cache structure */
926 Jim_Free(ht->table);
927 /* Re-initialize the table */
928 JimResetHashTable(ht);
929 return JIM_OK; /* never fails */
932 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
934 Jim_HashEntry *he;
935 unsigned int h;
937 if (ht->used == 0)
938 return NULL;
939 h = Jim_HashKey(ht, key) & ht->sizemask;
940 he = ht->table[h];
941 while (he) {
942 if (Jim_CompareHashKeys(ht, key, he->key))
943 return he;
944 he = he->next;
946 return NULL;
949 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
951 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
952 JimInitHashTableIterator(ht, iter);
953 return iter;
956 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
958 while (1) {
959 if (iter->entry == NULL) {
960 iter->index++;
961 if (iter->index >= (signed)iter->ht->size)
962 break;
963 iter->entry = iter->ht->table[iter->index];
965 else {
966 iter->entry = iter->nextEntry;
968 if (iter->entry) {
969 /* We need to save the 'next' here, the iterator user
970 * may delete the entry we are returning. */
971 iter->nextEntry = iter->entry->next;
972 return iter->entry;
975 return NULL;
978 /* ------------------------- private functions ------------------------------ */
980 /* Expand the hash table if needed */
981 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
983 /* If the hash table is empty expand it to the intial size,
984 * if the table is "full" dobule its size. */
985 if (ht->size == 0)
986 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
987 if (ht->size == ht->used)
988 Jim_ExpandHashTable(ht, ht->size * 2);
991 /* Our hash table capability is a power of two */
992 static unsigned int JimHashTableNextPower(unsigned int size)
994 unsigned int i = JIM_HT_INITIAL_SIZE;
996 if (size >= 2147483648U)
997 return 2147483648U;
998 while (1) {
999 if (i >= size)
1000 return i;
1001 i *= 2;
1005 /* Returns the index of a free slot that can be populated with
1006 * a hash entry for the given 'key'.
1007 * If the key already exists, -1 is returned. */
1008 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1010 unsigned int h;
1011 Jim_HashEntry *he;
1013 /* Expand the hashtable if needed */
1014 JimExpandHashTableIfNeeded(ht);
1016 /* Compute the key hash value */
1017 h = Jim_HashKey(ht, key) & ht->sizemask;
1018 /* Search if this slot does not already contain the given key */
1019 he = ht->table[h];
1020 while (he) {
1021 if (Jim_CompareHashKeys(ht, key, he->key))
1022 return replace ? he : NULL;
1023 he = he->next;
1026 /* Allocates the memory and stores key */
1027 he = Jim_Alloc(sizeof(*he));
1028 he->next = ht->table[h];
1029 ht->table[h] = he;
1030 ht->used++;
1031 he->key = NULL;
1033 return he;
1036 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1038 static unsigned int JimStringCopyHTHashFunction(const void *key)
1040 return Jim_GenHashFunction(key, strlen(key));
1043 static void *JimStringCopyHTDup(void *privdata, const void *key)
1045 return Jim_StrDup(key);
1048 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1050 return strcmp(key1, key2) == 0;
1053 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1055 Jim_Free(key);
1058 static const Jim_HashTableType JimPackageHashTableType = {
1059 JimStringCopyHTHashFunction, /* hash function */
1060 JimStringCopyHTDup, /* key dup */
1061 NULL, /* val dup */
1062 JimStringCopyHTKeyCompare, /* key compare */
1063 JimStringCopyHTKeyDestructor, /* key destructor */
1064 NULL /* val destructor */
1067 typedef struct AssocDataValue
1069 Jim_InterpDeleteProc *delProc;
1070 void *data;
1071 } AssocDataValue;
1073 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1075 AssocDataValue *assocPtr = (AssocDataValue *) data;
1077 if (assocPtr->delProc != NULL)
1078 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1079 Jim_Free(data);
1082 static const Jim_HashTableType JimAssocDataHashTableType = {
1083 JimStringCopyHTHashFunction, /* hash function */
1084 JimStringCopyHTDup, /* key dup */
1085 NULL, /* val dup */
1086 JimStringCopyHTKeyCompare, /* key compare */
1087 JimStringCopyHTKeyDestructor, /* key destructor */
1088 JimAssocDataHashTableValueDestructor /* val destructor */
1091 /* -----------------------------------------------------------------------------
1092 * Stack - This is a simple generic stack implementation. It is used for
1093 * example in the 'expr' expression compiler.
1094 * ---------------------------------------------------------------------------*/
1095 void Jim_InitStack(Jim_Stack *stack)
1097 stack->len = 0;
1098 stack->maxlen = 0;
1099 stack->vector = NULL;
1102 void Jim_FreeStack(Jim_Stack *stack)
1104 Jim_Free(stack->vector);
1107 int Jim_StackLen(Jim_Stack *stack)
1109 return stack->len;
1112 void Jim_StackPush(Jim_Stack *stack, void *element)
1114 int neededLen = stack->len + 1;
1116 if (neededLen > stack->maxlen) {
1117 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1118 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1120 stack->vector[stack->len] = element;
1121 stack->len++;
1124 void *Jim_StackPop(Jim_Stack *stack)
1126 if (stack->len == 0)
1127 return NULL;
1128 stack->len--;
1129 return stack->vector[stack->len];
1132 void *Jim_StackPeek(Jim_Stack *stack)
1134 if (stack->len == 0)
1135 return NULL;
1136 return stack->vector[stack->len - 1];
1139 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1141 int i;
1143 for (i = 0; i < stack->len; i++)
1144 freeFunc(stack->vector[i]);
1147 /* -----------------------------------------------------------------------------
1148 * Tcl Parser
1149 * ---------------------------------------------------------------------------*/
1151 /* Token types */
1152 #define JIM_TT_NONE 0 /* No token returned */
1153 #define JIM_TT_STR 1 /* simple string */
1154 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1155 #define JIM_TT_VAR 3 /* var substitution */
1156 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1157 #define JIM_TT_CMD 5 /* command substitution */
1158 /* Note: Keep these three together for TOKEN_IS_SEP() */
1159 #define JIM_TT_SEP 6 /* word separator (white space) */
1160 #define JIM_TT_EOL 7 /* line separator */
1161 #define JIM_TT_EOF 8 /* end of script */
1163 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1164 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1166 /* Additional token types needed for expressions */
1167 #define JIM_TT_SUBEXPR_START 11
1168 #define JIM_TT_SUBEXPR_END 12
1169 #define JIM_TT_SUBEXPR_COMMA 13
1170 #define JIM_TT_EXPR_INT 14
1171 #define JIM_TT_EXPR_DOUBLE 15
1172 #define JIM_TT_EXPR_BOOLEAN 16
1174 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1176 /* Operator token types start here */
1177 #define JIM_TT_EXPR_OP 20
1179 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1180 /* Can this token start an expression? */
1181 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1182 /* Is this token an expression operator? */
1183 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1186 * Results of missing quotes, braces, etc. from parsing.
1188 struct JimParseMissing {
1189 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1190 int line; /* Line number starting the missing token */
1193 /* Parser context structure. The same context is used both to parse
1194 * Tcl scripts and lists. */
1195 struct JimParserCtx
1197 const char *p; /* Pointer to the point of the program we are parsing */
1198 int len; /* Remaining length */
1199 int linenr; /* Current line number */
1200 const char *tstart;
1201 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1202 int tline; /* Line number of the returned token */
1203 int tt; /* Token type */
1204 int eof; /* Non zero if EOF condition is true. */
1205 int inquote; /* Parsing a quoted string */
1206 int comment; /* Non zero if the next chars may be a comment. */
1207 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1210 static int JimParseScript(struct JimParserCtx *pc);
1211 static int JimParseSep(struct JimParserCtx *pc);
1212 static int JimParseEol(struct JimParserCtx *pc);
1213 static int JimParseCmd(struct JimParserCtx *pc);
1214 static int JimParseQuote(struct JimParserCtx *pc);
1215 static int JimParseVar(struct JimParserCtx *pc);
1216 static int JimParseBrace(struct JimParserCtx *pc);
1217 static int JimParseStr(struct JimParserCtx *pc);
1218 static int JimParseComment(struct JimParserCtx *pc);
1219 static void JimParseSubCmd(struct JimParserCtx *pc);
1220 static int JimParseSubQuote(struct JimParserCtx *pc);
1221 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1223 /* Initialize a parser context.
1224 * 'prg' is a pointer to the program text, linenr is the line
1225 * number of the first line contained in the program. */
1226 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1228 pc->p = prg;
1229 pc->len = len;
1230 pc->tstart = NULL;
1231 pc->tend = NULL;
1232 pc->tline = 0;
1233 pc->tt = JIM_TT_NONE;
1234 pc->eof = 0;
1235 pc->inquote = 0;
1236 pc->linenr = linenr;
1237 pc->comment = 1;
1238 pc->missing.ch = ' ';
1239 pc->missing.line = linenr;
1242 static int JimParseScript(struct JimParserCtx *pc)
1244 while (1) { /* the while is used to reiterate with continue if needed */
1245 if (!pc->len) {
1246 pc->tstart = pc->p;
1247 pc->tend = pc->p - 1;
1248 pc->tline = pc->linenr;
1249 pc->tt = JIM_TT_EOL;
1250 pc->eof = 1;
1251 return JIM_OK;
1253 switch (*(pc->p)) {
1254 case '\\':
1255 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1256 return JimParseSep(pc);
1258 pc->comment = 0;
1259 return JimParseStr(pc);
1260 case ' ':
1261 case '\t':
1262 case '\r':
1263 case '\f':
1264 if (!pc->inquote)
1265 return JimParseSep(pc);
1266 pc->comment = 0;
1267 return JimParseStr(pc);
1268 case '\n':
1269 case ';':
1270 pc->comment = 1;
1271 if (!pc->inquote)
1272 return JimParseEol(pc);
1273 return JimParseStr(pc);
1274 case '[':
1275 pc->comment = 0;
1276 return JimParseCmd(pc);
1277 case '$':
1278 pc->comment = 0;
1279 if (JimParseVar(pc) == JIM_ERR) {
1280 /* An orphan $. Create as a separate token */
1281 pc->tstart = pc->tend = pc->p++;
1282 pc->len--;
1283 pc->tt = JIM_TT_ESC;
1285 return JIM_OK;
1286 case '#':
1287 if (pc->comment) {
1288 JimParseComment(pc);
1289 continue;
1291 return JimParseStr(pc);
1292 default:
1293 pc->comment = 0;
1294 return JimParseStr(pc);
1296 return JIM_OK;
1300 static int JimParseSep(struct JimParserCtx *pc)
1302 pc->tstart = pc->p;
1303 pc->tline = pc->linenr;
1304 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1305 if (*pc->p == '\n') {
1306 break;
1308 if (*pc->p == '\\') {
1309 pc->p++;
1310 pc->len--;
1311 pc->linenr++;
1313 pc->p++;
1314 pc->len--;
1316 pc->tend = pc->p - 1;
1317 pc->tt = JIM_TT_SEP;
1318 return JIM_OK;
1321 static int JimParseEol(struct JimParserCtx *pc)
1323 pc->tstart = pc->p;
1324 pc->tline = pc->linenr;
1325 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1326 if (*pc->p == '\n')
1327 pc->linenr++;
1328 pc->p++;
1329 pc->len--;
1331 pc->tend = pc->p - 1;
1332 pc->tt = JIM_TT_EOL;
1333 return JIM_OK;
1337 ** Here are the rules for parsing:
1338 ** {braced expression}
1339 ** - Count open and closing braces
1340 ** - Backslash escapes meaning of braces
1342 ** "quoted expression"
1343 ** - First double quote at start of word terminates the expression
1344 ** - Backslash escapes quote and bracket
1345 ** - [commands brackets] are counted/nested
1346 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1348 ** [command expression]
1349 ** - Count open and closing brackets
1350 ** - Backslash escapes quote, bracket and brace
1351 ** - [commands brackets] are counted/nested
1352 ** - "quoted expressions" are parsed according to quoting rules
1353 ** - {braced expressions} are parsed according to brace rules
1355 ** For everything, backslash escapes the next char, newline increments current line
1359 * Parses a braced expression starting at pc->p.
1361 * Positions the parser at the end of the braced expression,
1362 * sets pc->tend and possibly pc->missing.
1364 static void JimParseSubBrace(struct JimParserCtx *pc)
1366 int level = 1;
1368 /* Skip the brace */
1369 pc->p++;
1370 pc->len--;
1371 while (pc->len) {
1372 switch (*pc->p) {
1373 case '\\':
1374 if (pc->len > 1) {
1375 if (*++pc->p == '\n') {
1376 pc->linenr++;
1378 pc->len--;
1380 break;
1382 case '{':
1383 level++;
1384 break;
1386 case '}':
1387 if (--level == 0) {
1388 pc->tend = pc->p - 1;
1389 pc->p++;
1390 pc->len--;
1391 return;
1393 break;
1395 case '\n':
1396 pc->linenr++;
1397 break;
1399 pc->p++;
1400 pc->len--;
1402 pc->missing.ch = '{';
1403 pc->missing.line = pc->tline;
1404 pc->tend = pc->p - 1;
1408 * Parses a quoted expression starting at pc->p.
1410 * Positions the parser at the end of the quoted expression,
1411 * sets pc->tend and possibly pc->missing.
1413 * Returns the type of the token of the string,
1414 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1415 * or JIM_TT_STR.
1417 static int JimParseSubQuote(struct JimParserCtx *pc)
1419 int tt = JIM_TT_STR;
1420 int line = pc->tline;
1422 /* Skip the quote */
1423 pc->p++;
1424 pc->len--;
1425 while (pc->len) {
1426 switch (*pc->p) {
1427 case '\\':
1428 if (pc->len > 1) {
1429 if (*++pc->p == '\n') {
1430 pc->linenr++;
1432 pc->len--;
1433 tt = JIM_TT_ESC;
1435 break;
1437 case '"':
1438 pc->tend = pc->p - 1;
1439 pc->p++;
1440 pc->len--;
1441 return tt;
1443 case '[':
1444 JimParseSubCmd(pc);
1445 tt = JIM_TT_ESC;
1446 continue;
1448 case '\n':
1449 pc->linenr++;
1450 break;
1452 case '$':
1453 tt = JIM_TT_ESC;
1454 break;
1456 pc->p++;
1457 pc->len--;
1459 pc->missing.ch = '"';
1460 pc->missing.line = line;
1461 pc->tend = pc->p - 1;
1462 return tt;
1466 * Parses a [command] expression starting at pc->p.
1468 * Positions the parser at the end of the command expression,
1469 * sets pc->tend and possibly pc->missing.
1471 static void JimParseSubCmd(struct JimParserCtx *pc)
1473 int level = 1;
1474 int startofword = 1;
1475 int line = pc->tline;
1477 /* Skip the bracket */
1478 pc->p++;
1479 pc->len--;
1480 while (pc->len) {
1481 switch (*pc->p) {
1482 case '\\':
1483 if (pc->len > 1) {
1484 if (*++pc->p == '\n') {
1485 pc->linenr++;
1487 pc->len--;
1489 break;
1491 case '[':
1492 level++;
1493 break;
1495 case ']':
1496 if (--level == 0) {
1497 pc->tend = pc->p - 1;
1498 pc->p++;
1499 pc->len--;
1500 return;
1502 break;
1504 case '"':
1505 if (startofword) {
1506 JimParseSubQuote(pc);
1507 continue;
1509 break;
1511 case '{':
1512 JimParseSubBrace(pc);
1513 startofword = 0;
1514 continue;
1516 case '\n':
1517 pc->linenr++;
1518 break;
1520 startofword = isspace(UCHAR(*pc->p));
1521 pc->p++;
1522 pc->len--;
1524 pc->missing.ch = '[';
1525 pc->missing.line = line;
1526 pc->tend = pc->p - 1;
1529 static int JimParseBrace(struct JimParserCtx *pc)
1531 pc->tstart = pc->p + 1;
1532 pc->tline = pc->linenr;
1533 pc->tt = JIM_TT_STR;
1534 JimParseSubBrace(pc);
1535 return JIM_OK;
1538 static int JimParseCmd(struct JimParserCtx *pc)
1540 pc->tstart = pc->p + 1;
1541 pc->tline = pc->linenr;
1542 pc->tt = JIM_TT_CMD;
1543 JimParseSubCmd(pc);
1544 return JIM_OK;
1547 static int JimParseQuote(struct JimParserCtx *pc)
1549 pc->tstart = pc->p + 1;
1550 pc->tline = pc->linenr;
1551 pc->tt = JimParseSubQuote(pc);
1552 return JIM_OK;
1555 static int JimParseVar(struct JimParserCtx *pc)
1557 /* skip the $ */
1558 pc->p++;
1559 pc->len--;
1561 #ifdef EXPRSUGAR_BRACKET
1562 if (*pc->p == '[') {
1563 /* Parse $[...] expr shorthand syntax */
1564 JimParseCmd(pc);
1565 pc->tt = JIM_TT_EXPRSUGAR;
1566 return JIM_OK;
1568 #endif
1570 pc->tstart = pc->p;
1571 pc->tt = JIM_TT_VAR;
1572 pc->tline = pc->linenr;
1574 if (*pc->p == '{') {
1575 pc->tstart = ++pc->p;
1576 pc->len--;
1578 while (pc->len && *pc->p != '}') {
1579 if (*pc->p == '\n') {
1580 pc->linenr++;
1582 pc->p++;
1583 pc->len--;
1585 pc->tend = pc->p - 1;
1586 if (pc->len) {
1587 pc->p++;
1588 pc->len--;
1591 else {
1592 while (1) {
1593 /* Skip double colon, but not single colon! */
1594 if (pc->p[0] == ':' && pc->p[1] == ':') {
1595 while (*pc->p == ':') {
1596 pc->p++;
1597 pc->len--;
1599 continue;
1601 /* Note that any char >= 0x80 must be part of a utf-8 char.
1602 * We consider all unicode points outside of ASCII as letters
1604 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1605 pc->p++;
1606 pc->len--;
1607 continue;
1609 break;
1611 /* Parse [dict get] syntax sugar. */
1612 if (*pc->p == '(') {
1613 int count = 1;
1614 const char *paren = NULL;
1616 pc->tt = JIM_TT_DICTSUGAR;
1618 while (count && pc->len) {
1619 pc->p++;
1620 pc->len--;
1621 if (*pc->p == '\\' && pc->len >= 1) {
1622 pc->p++;
1623 pc->len--;
1625 else if (*pc->p == '(') {
1626 count++;
1628 else if (*pc->p == ')') {
1629 paren = pc->p;
1630 count--;
1633 if (count == 0) {
1634 pc->p++;
1635 pc->len--;
1637 else if (paren) {
1638 /* Did not find a matching paren. Back up */
1639 paren++;
1640 pc->len += (pc->p - paren);
1641 pc->p = paren;
1643 #ifndef EXPRSUGAR_BRACKET
1644 if (*pc->tstart == '(') {
1645 pc->tt = JIM_TT_EXPRSUGAR;
1647 #endif
1649 pc->tend = pc->p - 1;
1651 /* Check if we parsed just the '$' character.
1652 * That's not a variable so an error is returned
1653 * to tell the state machine to consider this '$' just
1654 * a string. */
1655 if (pc->tstart == pc->p) {
1656 pc->p--;
1657 pc->len++;
1658 return JIM_ERR;
1660 return JIM_OK;
1663 static int JimParseStr(struct JimParserCtx *pc)
1665 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1666 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1667 /* Starting a new word */
1668 if (*pc->p == '{') {
1669 return JimParseBrace(pc);
1671 if (*pc->p == '"') {
1672 pc->inquote = 1;
1673 pc->p++;
1674 pc->len--;
1675 /* In case the end quote is missing */
1676 pc->missing.line = pc->tline;
1679 pc->tstart = pc->p;
1680 pc->tline = pc->linenr;
1681 while (1) {
1682 if (pc->len == 0) {
1683 if (pc->inquote) {
1684 pc->missing.ch = '"';
1686 pc->tend = pc->p - 1;
1687 pc->tt = JIM_TT_ESC;
1688 return JIM_OK;
1690 switch (*pc->p) {
1691 case '\\':
1692 if (!pc->inquote && *(pc->p + 1) == '\n') {
1693 pc->tend = pc->p - 1;
1694 pc->tt = JIM_TT_ESC;
1695 return JIM_OK;
1697 if (pc->len >= 2) {
1698 if (*(pc->p + 1) == '\n') {
1699 pc->linenr++;
1701 pc->p++;
1702 pc->len--;
1704 else if (pc->len == 1) {
1705 /* End of script with trailing backslash */
1706 pc->missing.ch = '\\';
1708 break;
1709 case '(':
1710 /* If the following token is not '$' just keep going */
1711 if (pc->len > 1 && pc->p[1] != '$') {
1712 break;
1714 /* fall through */
1715 case ')':
1716 /* Only need a separate ')' token if the previous was a var */
1717 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1718 if (pc->p == pc->tstart) {
1719 /* At the start of the token, so just return this char */
1720 pc->p++;
1721 pc->len--;
1723 pc->tend = pc->p - 1;
1724 pc->tt = JIM_TT_ESC;
1725 return JIM_OK;
1727 break;
1729 case '$':
1730 case '[':
1731 pc->tend = pc->p - 1;
1732 pc->tt = JIM_TT_ESC;
1733 return JIM_OK;
1734 case ' ':
1735 case '\t':
1736 case '\n':
1737 case '\r':
1738 case '\f':
1739 case ';':
1740 if (!pc->inquote) {
1741 pc->tend = pc->p - 1;
1742 pc->tt = JIM_TT_ESC;
1743 return JIM_OK;
1745 else if (*pc->p == '\n') {
1746 pc->linenr++;
1748 break;
1749 case '"':
1750 if (pc->inquote) {
1751 pc->tend = pc->p - 1;
1752 pc->tt = JIM_TT_ESC;
1753 pc->p++;
1754 pc->len--;
1755 pc->inquote = 0;
1756 return JIM_OK;
1758 break;
1760 pc->p++;
1761 pc->len--;
1763 return JIM_OK; /* unreached */
1766 static int JimParseComment(struct JimParserCtx *pc)
1768 while (*pc->p) {
1769 if (*pc->p == '\\') {
1770 pc->p++;
1771 pc->len--;
1772 if (pc->len == 0) {
1773 pc->missing.ch = '\\';
1774 return JIM_OK;
1776 if (*pc->p == '\n') {
1777 pc->linenr++;
1780 else if (*pc->p == '\n') {
1781 pc->p++;
1782 pc->len--;
1783 pc->linenr++;
1784 break;
1786 pc->p++;
1787 pc->len--;
1789 return JIM_OK;
1792 /* xdigitval and odigitval are helper functions for JimEscape() */
1793 static int xdigitval(int c)
1795 if (c >= '0' && c <= '9')
1796 return c - '0';
1797 if (c >= 'a' && c <= 'f')
1798 return c - 'a' + 10;
1799 if (c >= 'A' && c <= 'F')
1800 return c - 'A' + 10;
1801 return -1;
1804 static int odigitval(int c)
1806 if (c >= '0' && c <= '7')
1807 return c - '0';
1808 return -1;
1811 /* Perform Tcl escape substitution of 's', storing the result
1812 * string into 'dest'. The escaped string is guaranteed to
1813 * be the same length or shorted than the source string.
1814 * Slen is the length of the string at 's'.
1816 * The function returns the length of the resulting string. */
1817 static int JimEscape(char *dest, const char *s, int slen)
1819 char *p = dest;
1820 int i, len;
1822 for (i = 0; i < slen; i++) {
1823 switch (s[i]) {
1824 case '\\':
1825 switch (s[i + 1]) {
1826 case 'a':
1827 *p++ = 0x7;
1828 i++;
1829 break;
1830 case 'b':
1831 *p++ = 0x8;
1832 i++;
1833 break;
1834 case 'f':
1835 *p++ = 0xc;
1836 i++;
1837 break;
1838 case 'n':
1839 *p++ = 0xa;
1840 i++;
1841 break;
1842 case 'r':
1843 *p++ = 0xd;
1844 i++;
1845 break;
1846 case 't':
1847 *p++ = 0x9;
1848 i++;
1849 break;
1850 case 'u':
1851 case 'U':
1852 case 'x':
1853 /* A unicode or hex sequence.
1854 * \x Expect 1-2 hex chars and convert to hex.
1855 * \u Expect 1-4 hex chars and convert to utf-8.
1856 * \U Expect 1-8 hex chars and convert to utf-8.
1857 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1858 * An invalid sequence means simply the escaped char.
1861 unsigned val = 0;
1862 int k;
1863 int maxchars = 2;
1865 i++;
1867 if (s[i] == 'U') {
1868 maxchars = 8;
1870 else if (s[i] == 'u') {
1871 if (s[i + 1] == '{') {
1872 maxchars = 6;
1873 i++;
1875 else {
1876 maxchars = 4;
1880 for (k = 0; k < maxchars; k++) {
1881 int c = xdigitval(s[i + k + 1]);
1882 if (c == -1) {
1883 break;
1885 val = (val << 4) | c;
1887 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1888 if (s[i] == '{') {
1889 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1890 /* Back up */
1891 i--;
1892 k = 0;
1894 else {
1895 /* Skip the closing brace */
1896 k++;
1899 if (k) {
1900 /* Got a valid sequence, so convert */
1901 if (s[i] == 'x') {
1902 *p++ = val;
1904 else {
1905 p += utf8_fromunicode(p, val);
1907 i += k;
1908 break;
1910 /* Not a valid codepoint, just an escaped char */
1911 *p++ = s[i];
1913 break;
1914 case 'v':
1915 *p++ = 0xb;
1916 i++;
1917 break;
1918 case '\0':
1919 *p++ = '\\';
1920 i++;
1921 break;
1922 case '\n':
1923 /* Replace all spaces and tabs after backslash newline with a single space*/
1924 *p++ = ' ';
1925 do {
1926 i++;
1927 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1928 break;
1929 case '0':
1930 case '1':
1931 case '2':
1932 case '3':
1933 case '4':
1934 case '5':
1935 case '6':
1936 case '7':
1937 /* octal escape */
1939 int val = 0;
1940 int c = odigitval(s[i + 1]);
1942 val = c;
1943 c = odigitval(s[i + 2]);
1944 if (c == -1) {
1945 *p++ = val;
1946 i++;
1947 break;
1949 val = (val * 8) + c;
1950 c = odigitval(s[i + 3]);
1951 if (c == -1) {
1952 *p++ = val;
1953 i += 2;
1954 break;
1956 val = (val * 8) + c;
1957 *p++ = val;
1958 i += 3;
1960 break;
1961 default:
1962 *p++ = s[i + 1];
1963 i++;
1964 break;
1966 break;
1967 default:
1968 *p++ = s[i];
1969 break;
1972 len = p - dest;
1973 *p = '\0';
1974 return len;
1977 /* Returns a dynamically allocated copy of the current token in the
1978 * parser context. The function performs conversion of escapes if
1979 * the token is of type JIM_TT_ESC.
1981 * Note that after the conversion, tokens that are grouped with
1982 * braces in the source code, are always recognizable from the
1983 * identical string obtained in a different way from the type.
1985 * For example the string:
1987 * {*}$a
1989 * will return as first token "*", of type JIM_TT_STR
1991 * While the string:
1993 * *$a
1995 * will return as first token "*", of type JIM_TT_ESC
1997 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1999 const char *start, *end;
2000 char *token;
2001 int len;
2003 start = pc->tstart;
2004 end = pc->tend;
2005 if (start > end) {
2006 len = 0;
2007 token = Jim_Alloc(1);
2008 token[0] = '\0';
2010 else {
2011 len = (end - start) + 1;
2012 token = Jim_Alloc(len + 1);
2013 if (pc->tt != JIM_TT_ESC) {
2014 /* No escape conversion needed? Just copy it. */
2015 memcpy(token, start, len);
2016 token[len] = '\0';
2018 else {
2019 /* Else convert the escape chars. */
2020 len = JimEscape(token, start, len);
2024 return Jim_NewStringObjNoAlloc(interp, token, len);
2027 /* -----------------------------------------------------------------------------
2028 * Tcl Lists parsing
2029 * ---------------------------------------------------------------------------*/
2030 static int JimParseListSep(struct JimParserCtx *pc);
2031 static int JimParseListStr(struct JimParserCtx *pc);
2032 static int JimParseListQuote(struct JimParserCtx *pc);
2034 static int JimParseList(struct JimParserCtx *pc)
2036 if (isspace(UCHAR(*pc->p))) {
2037 return JimParseListSep(pc);
2039 switch (*pc->p) {
2040 case '"':
2041 return JimParseListQuote(pc);
2043 case '{':
2044 return JimParseBrace(pc);
2046 default:
2047 if (pc->len) {
2048 return JimParseListStr(pc);
2050 break;
2053 pc->tstart = pc->tend = pc->p;
2054 pc->tline = pc->linenr;
2055 pc->tt = JIM_TT_EOL;
2056 pc->eof = 1;
2057 return JIM_OK;
2060 static int JimParseListSep(struct JimParserCtx *pc)
2062 pc->tstart = pc->p;
2063 pc->tline = pc->linenr;
2064 while (isspace(UCHAR(*pc->p))) {
2065 if (*pc->p == '\n') {
2066 pc->linenr++;
2068 pc->p++;
2069 pc->len--;
2071 pc->tend = pc->p - 1;
2072 pc->tt = JIM_TT_SEP;
2073 return JIM_OK;
2076 static int JimParseListQuote(struct JimParserCtx *pc)
2078 pc->p++;
2079 pc->len--;
2081 pc->tstart = pc->p;
2082 pc->tline = pc->linenr;
2083 pc->tt = JIM_TT_STR;
2085 while (pc->len) {
2086 switch (*pc->p) {
2087 case '\\':
2088 pc->tt = JIM_TT_ESC;
2089 if (--pc->len == 0) {
2090 /* Trailing backslash */
2091 pc->tend = pc->p;
2092 return JIM_OK;
2094 pc->p++;
2095 break;
2096 case '\n':
2097 pc->linenr++;
2098 break;
2099 case '"':
2100 pc->tend = pc->p - 1;
2101 pc->p++;
2102 pc->len--;
2103 return JIM_OK;
2105 pc->p++;
2106 pc->len--;
2109 pc->tend = pc->p - 1;
2110 return JIM_OK;
2113 static int JimParseListStr(struct JimParserCtx *pc)
2115 pc->tstart = pc->p;
2116 pc->tline = pc->linenr;
2117 pc->tt = JIM_TT_STR;
2119 while (pc->len) {
2120 if (isspace(UCHAR(*pc->p))) {
2121 pc->tend = pc->p - 1;
2122 return JIM_OK;
2124 if (*pc->p == '\\') {
2125 if (--pc->len == 0) {
2126 /* Trailing backslash */
2127 pc->tend = pc->p;
2128 return JIM_OK;
2130 pc->tt = JIM_TT_ESC;
2131 pc->p++;
2133 pc->p++;
2134 pc->len--;
2136 pc->tend = pc->p - 1;
2137 return JIM_OK;
2140 /* -----------------------------------------------------------------------------
2141 * Jim_Obj related functions
2142 * ---------------------------------------------------------------------------*/
2144 /* Return a new initialized object. */
2145 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2147 Jim_Obj *objPtr;
2149 /* -- Check if there are objects in the free list -- */
2150 if (interp->freeList != NULL) {
2151 /* -- Unlink the object from the free list -- */
2152 objPtr = interp->freeList;
2153 interp->freeList = objPtr->nextObjPtr;
2155 else {
2156 /* -- No ready to use objects: allocate a new one -- */
2157 objPtr = Jim_Alloc(sizeof(*objPtr));
2160 /* Object is returned with refCount of 0. Every
2161 * kind of GC implemented should take care to don't try
2162 * to scan objects with refCount == 0. */
2163 objPtr->refCount = 0;
2164 /* All the other fields are left not initialized to save time.
2165 * The caller will probably want to set them to the right
2166 * value anyway. */
2168 /* -- Put the object into the live list -- */
2169 objPtr->prevObjPtr = NULL;
2170 objPtr->nextObjPtr = interp->liveList;
2171 if (interp->liveList)
2172 interp->liveList->prevObjPtr = objPtr;
2173 interp->liveList = objPtr;
2175 return objPtr;
2178 /* Free an object. Actually objects are never freed, but
2179 * just moved to the free objects list, where they will be
2180 * reused by Jim_NewObj(). */
2181 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2183 /* Check if the object was already freed, panic. */
2184 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2185 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2187 /* Free the internal representation */
2188 Jim_FreeIntRep(interp, objPtr);
2189 /* Free the string representation */
2190 if (objPtr->bytes != NULL) {
2191 if (objPtr->bytes != JimEmptyStringRep)
2192 Jim_Free(objPtr->bytes);
2194 /* Unlink the object from the live objects list */
2195 if (objPtr->prevObjPtr)
2196 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2197 if (objPtr->nextObjPtr)
2198 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2199 if (interp->liveList == objPtr)
2200 interp->liveList = objPtr->nextObjPtr;
2201 #ifdef JIM_DISABLE_OBJECT_POOL
2202 Jim_Free(objPtr);
2203 #else
2204 /* Link the object into the free objects list */
2205 objPtr->prevObjPtr = NULL;
2206 objPtr->nextObjPtr = interp->freeList;
2207 if (interp->freeList)
2208 interp->freeList->prevObjPtr = objPtr;
2209 interp->freeList = objPtr;
2210 objPtr->refCount = -1;
2211 #endif
2214 /* Invalidate the string representation of an object. */
2215 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2217 if (objPtr->bytes != NULL) {
2218 if (objPtr->bytes != JimEmptyStringRep)
2219 Jim_Free(objPtr->bytes);
2221 objPtr->bytes = NULL;
2224 /* Duplicate an object. The returned object has refcount = 0. */
2225 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2227 Jim_Obj *dupPtr;
2229 dupPtr = Jim_NewObj(interp);
2230 if (objPtr->bytes == NULL) {
2231 /* Object does not have a valid string representation. */
2232 dupPtr->bytes = NULL;
2234 else if (objPtr->length == 0) {
2235 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2236 dupPtr->bytes = JimEmptyStringRep;
2237 dupPtr->length = 0;
2238 dupPtr->typePtr = NULL;
2239 return dupPtr;
2241 else {
2242 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2243 dupPtr->length = objPtr->length;
2244 /* Copy the null byte too */
2245 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2248 /* By default, the new object has the same type as the old object */
2249 dupPtr->typePtr = objPtr->typePtr;
2250 if (objPtr->typePtr != NULL) {
2251 if (objPtr->typePtr->dupIntRepProc == NULL) {
2252 dupPtr->internalRep = objPtr->internalRep;
2254 else {
2255 /* The dup proc may set a different type, e.g. NULL */
2256 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2259 return dupPtr;
2262 /* Return the string representation for objPtr. If the object's
2263 * string representation is invalid, calls the updateStringProc method to create
2264 * a new one from the internal representation of the object.
2266 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2268 if (objPtr->bytes == NULL) {
2269 /* Invalid string repr. Generate it. */
2270 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2271 objPtr->typePtr->updateStringProc(objPtr);
2273 if (lenPtr)
2274 *lenPtr = objPtr->length;
2275 return objPtr->bytes;
2278 /* Just returns the length of the object's string rep */
2279 int Jim_Length(Jim_Obj *objPtr)
2281 if (objPtr->bytes == NULL) {
2282 /* Invalid string repr. Generate it. */
2283 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2284 objPtr->typePtr->updateStringProc(objPtr);
2286 return objPtr->length;
2289 /* Just returns object's string rep */
2290 const char *Jim_String(Jim_Obj *objPtr)
2292 if (objPtr->bytes == NULL) {
2293 /* Invalid string repr. Generate it. */
2294 JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value."));
2295 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2296 objPtr->typePtr->updateStringProc(objPtr);
2298 return objPtr->bytes;
2301 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2303 objPtr->bytes = Jim_StrDup(str);
2304 objPtr->length = strlen(str);
2307 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2308 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2310 static const Jim_ObjType dictSubstObjType = {
2311 "dict-substitution",
2312 FreeDictSubstInternalRep,
2313 DupDictSubstInternalRep,
2314 NULL,
2315 JIM_TYPE_NONE,
2318 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2320 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2323 static const Jim_ObjType interpolatedObjType = {
2324 "interpolated",
2325 FreeInterpolatedInternalRep,
2326 NULL,
2327 NULL,
2328 JIM_TYPE_NONE,
2331 /* -----------------------------------------------------------------------------
2332 * String Object
2333 * ---------------------------------------------------------------------------*/
2334 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2335 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2337 static const Jim_ObjType stringObjType = {
2338 "string",
2339 NULL,
2340 DupStringInternalRep,
2341 NULL,
2342 JIM_TYPE_REFERENCES,
2345 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2347 JIM_NOTUSED(interp);
2349 /* This is a bit subtle: the only caller of this function
2350 * should be Jim_DuplicateObj(), that will copy the
2351 * string representaion. After the copy, the duplicated
2352 * object will not have more room in the buffer than
2353 * srcPtr->length bytes. So we just set it to length. */
2354 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2355 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2358 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2360 if (objPtr->typePtr != &stringObjType) {
2361 /* Get a fresh string representation. */
2362 if (objPtr->bytes == NULL) {
2363 /* Invalid string repr. Generate it. */
2364 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2365 objPtr->typePtr->updateStringProc(objPtr);
2367 /* Free any other internal representation. */
2368 Jim_FreeIntRep(interp, objPtr);
2369 /* Set it as string, i.e. just set the maxLength field. */
2370 objPtr->typePtr = &stringObjType;
2371 objPtr->internalRep.strValue.maxLength = objPtr->length;
2372 /* Don't know the utf-8 length yet */
2373 objPtr->internalRep.strValue.charLength = -1;
2375 return JIM_OK;
2379 * Returns the length of the object string in chars, not bytes.
2381 * These may be different for a utf-8 string.
2383 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2385 #ifdef JIM_UTF8
2386 SetStringFromAny(interp, objPtr);
2388 if (objPtr->internalRep.strValue.charLength < 0) {
2389 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2391 return objPtr->internalRep.strValue.charLength;
2392 #else
2393 return Jim_Length(objPtr);
2394 #endif
2397 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2398 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2400 Jim_Obj *objPtr = Jim_NewObj(interp);
2402 /* Need to find out how many bytes the string requires */
2403 if (len == -1)
2404 len = strlen(s);
2405 /* Alloc/Set the string rep. */
2406 if (len == 0) {
2407 objPtr->bytes = JimEmptyStringRep;
2409 else {
2410 objPtr->bytes = Jim_Alloc(len + 1);
2411 memcpy(objPtr->bytes, s, len);
2412 objPtr->bytes[len] = '\0';
2414 objPtr->length = len;
2416 /* No typePtr field for the vanilla string object. */
2417 objPtr->typePtr = NULL;
2418 return objPtr;
2421 /* charlen is in characters -- see also Jim_NewStringObj() */
2422 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2424 #ifdef JIM_UTF8
2425 /* Need to find out how many bytes the string requires */
2426 int bytelen = utf8_index(s, charlen);
2428 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2430 /* Remember the utf8 length, so set the type */
2431 objPtr->typePtr = &stringObjType;
2432 objPtr->internalRep.strValue.maxLength = bytelen;
2433 objPtr->internalRep.strValue.charLength = charlen;
2435 return objPtr;
2436 #else
2437 return Jim_NewStringObj(interp, s, charlen);
2438 #endif
2441 /* This version does not try to duplicate the 's' pointer, but
2442 * use it directly. */
2443 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2445 Jim_Obj *objPtr = Jim_NewObj(interp);
2447 objPtr->bytes = s;
2448 objPtr->length = (len == -1) ? strlen(s) : len;
2449 objPtr->typePtr = NULL;
2450 return objPtr;
2453 /* Low-level string append. Use it only against unshared objects
2454 * of type "string". */
2455 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2457 int needlen;
2459 if (len == -1)
2460 len = strlen(str);
2461 needlen = objPtr->length + len;
2462 if (objPtr->internalRep.strValue.maxLength < needlen ||
2463 objPtr->internalRep.strValue.maxLength == 0) {
2464 needlen *= 2;
2465 /* Inefficient to malloc() for less than 8 bytes */
2466 if (needlen < 7) {
2467 needlen = 7;
2469 if (objPtr->bytes == JimEmptyStringRep) {
2470 objPtr->bytes = Jim_Alloc(needlen + 1);
2472 else {
2473 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2475 objPtr->internalRep.strValue.maxLength = needlen;
2477 memcpy(objPtr->bytes + objPtr->length, str, len);
2478 objPtr->bytes[objPtr->length + len] = '\0';
2480 if (objPtr->internalRep.strValue.charLength >= 0) {
2481 /* Update the utf-8 char length */
2482 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2484 objPtr->length += len;
2487 /* Higher level API to append strings to objects.
2488 * Object must not be unshared for each of these.
2490 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2492 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2493 SetStringFromAny(interp, objPtr);
2494 StringAppendString(objPtr, str, len);
2497 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2499 int len;
2500 const char *str = Jim_GetString(appendObjPtr, &len);
2501 Jim_AppendString(interp, objPtr, str, len);
2504 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2506 va_list ap;
2508 SetStringFromAny(interp, objPtr);
2509 va_start(ap, objPtr);
2510 while (1) {
2511 const char *s = va_arg(ap, const char *);
2513 if (s == NULL)
2514 break;
2515 Jim_AppendString(interp, objPtr, s, -1);
2517 va_end(ap);
2520 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2522 if (aObjPtr == bObjPtr) {
2523 return 1;
2525 else {
2526 int Alen, Blen;
2527 const char *sA = Jim_GetString(aObjPtr, &Alen);
2528 const char *sB = Jim_GetString(bObjPtr, &Blen);
2530 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2535 * Note. Does not support embedded nulls in either the pattern or the object.
2537 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2539 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2543 * Note: does not support embedded nulls for the nocase option.
2545 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2547 int l1, l2;
2548 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2549 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2551 if (nocase) {
2552 /* Do a character compare for nocase */
2553 return JimStringCompareLen(s1, s2, -1, nocase);
2555 return JimStringCompare(s1, l1, s2, l2);
2559 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2561 * Note: does not support embedded nulls
2563 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2565 const char *s1 = Jim_String(firstObjPtr);
2566 const char *s2 = Jim_String(secondObjPtr);
2568 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2571 /* Convert a range, as returned by Jim_GetRange(), into
2572 * an absolute index into an object of the specified length.
2573 * This function may return negative values, or values
2574 * greater than or equal to the length of the list if the index
2575 * is out of range. */
2576 static int JimRelToAbsIndex(int len, int idx)
2578 if (idx < 0)
2579 return len + idx;
2580 return idx;
2583 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2584 * into a form suitable for implementation of commands like [string range] and [lrange].
2586 * The resulting range is guaranteed to address valid elements of
2587 * the structure.
2589 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2591 int rangeLen;
2593 if (*firstPtr > *lastPtr) {
2594 rangeLen = 0;
2596 else {
2597 rangeLen = *lastPtr - *firstPtr + 1;
2598 if (rangeLen) {
2599 if (*firstPtr < 0) {
2600 rangeLen += *firstPtr;
2601 *firstPtr = 0;
2603 if (*lastPtr >= len) {
2604 rangeLen -= (*lastPtr - (len - 1));
2605 *lastPtr = len - 1;
2609 if (rangeLen < 0)
2610 rangeLen = 0;
2612 *rangeLenPtr = rangeLen;
2615 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2616 int len, int *first, int *last, int *range)
2618 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2619 return JIM_ERR;
2621 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2622 return JIM_ERR;
2624 *first = JimRelToAbsIndex(len, *first);
2625 *last = JimRelToAbsIndex(len, *last);
2626 JimRelToAbsRange(len, first, last, range);
2627 return JIM_OK;
2630 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2631 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2633 int first, last;
2634 const char *str;
2635 int rangeLen;
2636 int bytelen;
2638 str = Jim_GetString(strObjPtr, &bytelen);
2640 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2641 return NULL;
2644 if (first == 0 && rangeLen == bytelen) {
2645 return strObjPtr;
2647 return Jim_NewStringObj(interp, str + first, rangeLen);
2650 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2651 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2653 #ifdef JIM_UTF8
2654 int first, last;
2655 const char *str;
2656 int len, rangeLen;
2657 int bytelen;
2659 str = Jim_GetString(strObjPtr, &bytelen);
2660 len = Jim_Utf8Length(interp, strObjPtr);
2662 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2663 return NULL;
2666 if (first == 0 && rangeLen == len) {
2667 return strObjPtr;
2669 if (len == bytelen) {
2670 /* ASCII optimisation */
2671 return Jim_NewStringObj(interp, str + first, rangeLen);
2673 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2674 #else
2675 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2676 #endif
2679 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2680 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2682 int first, last;
2683 const char *str;
2684 int len, rangeLen;
2685 Jim_Obj *objPtr;
2687 len = Jim_Utf8Length(interp, strObjPtr);
2689 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2690 return NULL;
2693 if (last < first) {
2694 return strObjPtr;
2697 str = Jim_String(strObjPtr);
2699 /* Before part */
2700 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2702 /* Replacement */
2703 if (newStrObj) {
2704 Jim_AppendObj(interp, objPtr, newStrObj);
2707 /* After part */
2708 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2710 return objPtr;
2714 * Note: does not support embedded nulls.
2716 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2718 while (*str) {
2719 int c;
2720 str += utf8_tounicode(str, &c);
2721 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2723 *dest = 0;
2727 * Note: does not support embedded nulls.
2729 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2731 char *buf;
2732 int len;
2733 const char *str;
2735 SetStringFromAny(interp, strObjPtr);
2737 str = Jim_GetString(strObjPtr, &len);
2739 #ifdef JIM_UTF8
2740 /* Case mapping can change the utf-8 length of the string.
2741 * But at worst it will be by one extra byte per char
2743 len *= 2;
2744 #endif
2745 buf = Jim_Alloc(len + 1);
2746 JimStrCopyUpperLower(buf, str, 0);
2747 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2751 * Note: does not support embedded nulls.
2753 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2755 char *buf;
2756 const char *str;
2757 int len;
2759 if (strObjPtr->typePtr != &stringObjType) {
2760 SetStringFromAny(interp, strObjPtr);
2763 str = Jim_GetString(strObjPtr, &len);
2765 #ifdef JIM_UTF8
2766 /* Case mapping can change the utf-8 length of the string.
2767 * But at worst it will be by one extra byte per char
2769 len *= 2;
2770 #endif
2771 buf = Jim_Alloc(len + 1);
2772 JimStrCopyUpperLower(buf, str, 1);
2773 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2777 * Note: does not support embedded nulls.
2779 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2781 char *buf, *p;
2782 int len;
2783 int c;
2784 const char *str;
2786 str = Jim_GetString(strObjPtr, &len);
2787 if (len == 0) {
2788 return strObjPtr;
2790 #ifdef JIM_UTF8
2791 /* Case mapping can change the utf-8 length of the string.
2792 * But at worst it will be by one extra byte per char
2794 len *= 2;
2795 #endif
2796 buf = p = Jim_Alloc(len + 1);
2798 str += utf8_tounicode(str, &c);
2799 p += utf8_getchars(p, utf8_title(c));
2801 JimStrCopyUpperLower(p, str, 0);
2803 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2806 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2807 * for unicode character 'c'.
2808 * Returns the position if found or NULL if not
2810 static const char *utf8_memchr(const char *str, int len, int c)
2812 #ifdef JIM_UTF8
2813 while (len) {
2814 int sc;
2815 int n = utf8_tounicode(str, &sc);
2816 if (sc == c) {
2817 return str;
2819 str += n;
2820 len -= n;
2822 return NULL;
2823 #else
2824 return memchr(str, c, len);
2825 #endif
2829 * Searches for the first non-trim char in string (str, len)
2831 * If none is found, returns just past the last char.
2833 * Lengths are in bytes.
2835 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2837 while (len) {
2838 int c;
2839 int n = utf8_tounicode(str, &c);
2841 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2842 /* Not a trim char, so stop */
2843 break;
2845 str += n;
2846 len -= n;
2848 return str;
2852 * Searches backwards for a non-trim char in string (str, len).
2854 * Returns a pointer to just after the non-trim char, or NULL if not found.
2856 * Lengths are in bytes.
2858 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2860 str += len;
2862 while (len) {
2863 int c;
2864 int n = utf8_prev_len(str, len);
2866 len -= n;
2867 str -= n;
2869 n = utf8_tounicode(str, &c);
2871 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2872 return str + n;
2876 return NULL;
2879 static const char default_trim_chars[] = " \t\n\r";
2880 /* sizeof() here includes the null byte */
2881 static int default_trim_chars_len = sizeof(default_trim_chars);
2883 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2885 int len;
2886 const char *str = Jim_GetString(strObjPtr, &len);
2887 const char *trimchars = default_trim_chars;
2888 int trimcharslen = default_trim_chars_len;
2889 const char *newstr;
2891 if (trimcharsObjPtr) {
2892 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2895 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2896 if (newstr == str) {
2897 return strObjPtr;
2900 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2903 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2905 int len;
2906 const char *trimchars = default_trim_chars;
2907 int trimcharslen = default_trim_chars_len;
2908 const char *nontrim;
2910 if (trimcharsObjPtr) {
2911 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2914 SetStringFromAny(interp, strObjPtr);
2916 len = Jim_Length(strObjPtr);
2917 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2919 if (nontrim == NULL) {
2920 /* All trim, so return a zero-length string */
2921 return Jim_NewEmptyStringObj(interp);
2923 if (nontrim == strObjPtr->bytes + len) {
2924 /* All non-trim, so return the original object */
2925 return strObjPtr;
2928 if (Jim_IsShared(strObjPtr)) {
2929 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2931 else {
2932 /* Can modify this string in place */
2933 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2934 strObjPtr->length = (nontrim - strObjPtr->bytes);
2937 return strObjPtr;
2940 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2942 /* First trim left. */
2943 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2945 /* Now trim right */
2946 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2948 /* Note: refCount check is needed since objPtr may be emptyObj */
2949 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2950 /* We don't want this object to be leaked */
2951 Jim_FreeNewObj(interp, objPtr);
2954 return strObjPtr;
2957 /* Some platforms don't have isascii - need a non-macro version */
2958 #ifdef HAVE_ISASCII
2959 #define jim_isascii isascii
2960 #else
2961 static int jim_isascii(int c)
2963 return !(c & ~0x7f);
2965 #endif
2967 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2969 static const char * const strclassnames[] = {
2970 "integer", "alpha", "alnum", "ascii", "digit",
2971 "double", "lower", "upper", "space", "xdigit",
2972 "control", "print", "graph", "punct", "boolean",
2973 NULL
2975 enum {
2976 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2977 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2978 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2980 int strclass;
2981 int len;
2982 int i;
2983 const char *str;
2984 int (*isclassfunc)(int c) = NULL;
2986 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2987 return JIM_ERR;
2990 str = Jim_GetString(strObjPtr, &len);
2991 if (len == 0) {
2992 Jim_SetResultBool(interp, !strict);
2993 return JIM_OK;
2996 switch (strclass) {
2997 case STR_IS_INTEGER:
2999 jim_wide w;
3000 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3001 return JIM_OK;
3004 case STR_IS_DOUBLE:
3006 double d;
3007 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3008 return JIM_OK;
3011 case STR_IS_BOOLEAN:
3013 int b;
3014 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3015 return JIM_OK;
3018 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3019 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3020 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3021 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3022 case STR_IS_LOWER: isclassfunc = islower; break;
3023 case STR_IS_UPPER: isclassfunc = isupper; break;
3024 case STR_IS_SPACE: isclassfunc = isspace; break;
3025 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3026 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3027 case STR_IS_PRINT: isclassfunc = isprint; break;
3028 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3029 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3030 default:
3031 return JIM_ERR;
3034 for (i = 0; i < len; i++) {
3035 if (!isclassfunc(str[i])) {
3036 Jim_SetResultBool(interp, 0);
3037 return JIM_OK;
3040 Jim_SetResultBool(interp, 1);
3041 return JIM_OK;
3044 /* -----------------------------------------------------------------------------
3045 * Compared String Object
3046 * ---------------------------------------------------------------------------*/
3048 /* This is strange object that allows comparison of a C literal string
3049 * with a Jim object in a very short time if the same comparison is done
3050 * multiple times. For example every time the [if] command is executed,
3051 * Jim has to check if a given argument is "else".
3052 * If the code has no errors, this comparison is true most of the time,
3053 * so we can cache the pointer of the string of the last matching
3054 * comparison inside the object. Because most C compilers perform literal sharing,
3055 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3056 * this works pretty well even if comparisons are at different places
3057 * inside the C code. */
3059 static const Jim_ObjType comparedStringObjType = {
3060 "compared-string",
3061 NULL,
3062 NULL,
3063 NULL,
3064 JIM_TYPE_REFERENCES,
3067 /* The only way this object is exposed to the API is via the following
3068 * function. Returns true if the string and the object string repr.
3069 * are the same, otherwise zero is returned.
3071 * Note: this isn't binary safe, but it hardly needs to be.*/
3072 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3074 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3075 return 1;
3077 else {
3078 const char *objStr = Jim_String(objPtr);
3080 if (strcmp(str, objStr) != 0)
3081 return 0;
3083 if (objPtr->typePtr != &comparedStringObjType) {
3084 Jim_FreeIntRep(interp, objPtr);
3085 objPtr->typePtr = &comparedStringObjType;
3087 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3088 return 1;
3092 static int qsortCompareStringPointers(const void *a, const void *b)
3094 char *const *sa = (char *const *)a;
3095 char *const *sb = (char *const *)b;
3097 return strcmp(*sa, *sb);
3101 /* -----------------------------------------------------------------------------
3102 * Source Object
3104 * This object is just a string from the language point of view, but
3105 * the internal representation contains the filename and line number
3106 * where this token was read. This information is used by
3107 * Jim_EvalObj() if the object passed happens to be of type "source".
3109 * This allows propagation of the information about line numbers and file
3110 * names and gives error messages with absolute line numbers.
3112 * Note that this object uses the internal representation of the Jim_Object,
3113 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3115 * Also the object will be converted to something else if the given
3116 * token it represents in the source file is not something to be
3117 * evaluated (not a script), and will be specialized in some other way,
3118 * so the time overhead is also almost zero.
3119 * ---------------------------------------------------------------------------*/
3121 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3122 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3124 static const Jim_ObjType sourceObjType = {
3125 "source",
3126 FreeSourceInternalRep,
3127 DupSourceInternalRep,
3128 NULL,
3129 JIM_TYPE_REFERENCES,
3132 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3134 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3137 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3139 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3140 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3143 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3144 Jim_Obj *fileNameObj, int lineNumber)
3146 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3147 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3148 Jim_IncrRefCount(fileNameObj);
3149 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3150 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3151 objPtr->typePtr = &sourceObjType;
3154 /* -----------------------------------------------------------------------------
3155 * ScriptLine Object
3157 * This object is used only in the Script internal represenation.
3158 * For each line of the script, it holds the number of tokens on the line
3159 * and the source line number.
3161 static const Jim_ObjType scriptLineObjType = {
3162 "scriptline",
3163 NULL,
3164 NULL,
3165 NULL,
3166 JIM_NONE,
3169 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3171 Jim_Obj *objPtr;
3173 #ifdef DEBUG_SHOW_SCRIPT
3174 char buf[100];
3175 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3176 objPtr = Jim_NewStringObj(interp, buf, -1);
3177 #else
3178 objPtr = Jim_NewEmptyStringObj(interp);
3179 #endif
3180 objPtr->typePtr = &scriptLineObjType;
3181 objPtr->internalRep.scriptLineValue.argc = argc;
3182 objPtr->internalRep.scriptLineValue.line = line;
3184 return objPtr;
3187 /* -----------------------------------------------------------------------------
3188 * Script Object
3190 * This object holds the parsed internal representation of a script.
3191 * This representation is help within an allocated ScriptObj (see below)
3193 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3194 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3196 static const Jim_ObjType scriptObjType = {
3197 "script",
3198 FreeScriptInternalRep,
3199 DupScriptInternalRep,
3200 NULL,
3201 JIM_TYPE_REFERENCES,
3204 /* Each token of a script is represented by a ScriptToken.
3205 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3206 * can be specialized by commands operating on it.
3208 typedef struct ScriptToken
3210 Jim_Obj *objPtr;
3211 int type;
3212 } ScriptToken;
3214 /* This is the script object internal representation. An array of
3215 * ScriptToken structures, including a pre-computed representation of the
3216 * command length and arguments.
3218 * For example the script:
3220 * puts hello
3221 * set $i $x$y [foo]BAR
3223 * will produce a ScriptObj with the following ScriptToken's:
3225 * LIN 2
3226 * ESC puts
3227 * ESC hello
3228 * LIN 4
3229 * ESC set
3230 * VAR i
3231 * WRD 2
3232 * VAR x
3233 * VAR y
3234 * WRD 2
3235 * CMD foo
3236 * ESC BAR
3238 * "puts hello" has two args (LIN 2), composed of single tokens.
3239 * (Note that the WRD token is omitted for the common case of a single token.)
3241 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3242 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3244 * The precomputation of the command structure makes Jim_Eval() faster,
3245 * and simpler because there aren't dynamic lengths / allocations.
3247 * -- {expand}/{*} handling --
3249 * Expand is handled in a special way.
3251 * If a "word" begins with {*}, the word token count is -ve.
3253 * For example the command:
3255 * list {*}{a b}
3257 * Will produce the following cmdstruct array:
3259 * LIN 2
3260 * ESC list
3261 * WRD -1
3262 * STR a b
3264 * Note that the 'LIN' token also contains the source information for the
3265 * first word of the line for error reporting purposes
3267 * -- the substFlags field of the structure --
3269 * The scriptObj structure is used to represent both "script" objects
3270 * and "subst" objects. In the second case, there are no LIN and WRD
3271 * tokens. Instead SEP and EOL tokens are added as-is.
3272 * In addition, the field 'substFlags' is used to represent the flags used to turn
3273 * the string into the internal representation.
3274 * If these flags do not match what the application requires,
3275 * the scriptObj is created again. For example the script:
3277 * subst -nocommands $string
3278 * subst -novariables $string
3280 * Will (re)create the internal representation of the $string object
3281 * two times.
3283 typedef struct ScriptObj
3285 ScriptToken *token; /* Tokens array. */
3286 Jim_Obj *fileNameObj; /* Filename */
3287 int len; /* Length of token[] */
3288 int substFlags; /* flags used for the compilation of "subst" objects */
3289 int inUse; /* Used to share a ScriptObj. Currently
3290 only used by Jim_EvalObj() as protection against
3291 shimmering of the currently evaluated object. */
3292 int firstline; /* Line number of the first line */
3293 int linenr; /* Error line number, if any */
3294 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3295 } ScriptObj;
3297 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3298 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3299 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3301 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3303 int i;
3304 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3306 if (--script->inUse != 0)
3307 return;
3308 for (i = 0; i < script->len; i++) {
3309 Jim_DecrRefCount(interp, script->token[i].objPtr);
3311 Jim_Free(script->token);
3312 Jim_DecrRefCount(interp, script->fileNameObj);
3313 Jim_Free(script);
3316 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3318 JIM_NOTUSED(interp);
3319 JIM_NOTUSED(srcPtr);
3321 /* Just return a simple string. We don't try to preserve the source info
3322 * since in practice scripts are never duplicated
3324 dupPtr->typePtr = NULL;
3327 /* A simple parse token.
3328 * As the script is parsed, the created tokens point into the script string rep.
3330 typedef struct
3332 const char *token; /* Pointer to the start of the token */
3333 int len; /* Length of this token */
3334 int type; /* Token type */
3335 int line; /* Line number */
3336 } ParseToken;
3338 /* A list of parsed tokens representing a script.
3339 * Tokens are added to this list as the script is parsed.
3340 * It grows as needed.
3342 typedef struct
3344 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3345 ParseToken *list; /* Array of tokens */
3346 int size; /* Current size of the list */
3347 int count; /* Number of entries used */
3348 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3349 } ParseTokenList;
3351 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3353 tokenlist->list = tokenlist->static_list;
3354 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3355 tokenlist->count = 0;
3358 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3360 if (tokenlist->list != tokenlist->static_list) {
3361 Jim_Free(tokenlist->list);
3366 * Adds the new token to the tokenlist.
3367 * The token has the given length, type and line number.
3368 * The token list is resized as necessary.
3370 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3371 int line)
3373 ParseToken *t;
3375 if (tokenlist->count == tokenlist->size) {
3376 /* Resize the list */
3377 tokenlist->size *= 2;
3378 if (tokenlist->list != tokenlist->static_list) {
3379 tokenlist->list =
3380 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3382 else {
3383 /* The list needs to become allocated */
3384 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3385 memcpy(tokenlist->list, tokenlist->static_list,
3386 tokenlist->count * sizeof(*tokenlist->list));
3389 t = &tokenlist->list[tokenlist->count++];
3390 t->token = token;
3391 t->len = len;
3392 t->type = type;
3393 t->line = line;
3396 /* Counts the number of adjoining non-separator tokens.
3398 * Returns -ve if the first token is the expansion
3399 * operator (in which case the count doesn't include
3400 * that token).
3402 static int JimCountWordTokens(ParseToken *t)
3404 int expand = 1;
3405 int count = 0;
3407 /* Is the first word {*} or {expand}? */
3408 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3409 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3410 /* Create an expand token */
3411 expand = -1;
3412 t++;
3416 /* Now count non-separator words */
3417 while (!TOKEN_IS_SEP(t->type)) {
3418 t++;
3419 count++;
3422 return count * expand;
3426 * Create a script/subst object from the given token.
3428 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3430 Jim_Obj *objPtr;
3432 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3433 /* Convert backlash escapes. The result will never be longer than the original */
3434 int len = t->len;
3435 char *str = Jim_Alloc(len + 1);
3436 len = JimEscape(str, t->token, len);
3437 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3439 else {
3440 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3441 * with a single space.
3443 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3445 return objPtr;
3449 * Takes a tokenlist and creates the allocated list of script tokens
3450 * in script->token, of length script->len.
3452 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3453 * as required.
3455 * Also sets script->line to the line number of the first token
3457 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3458 ParseTokenList *tokenlist)
3460 int i;
3461 struct ScriptToken *token;
3462 /* Number of tokens so far for the current command */
3463 int lineargs = 0;
3464 /* This is the first token for the current command */
3465 ScriptToken *linefirst;
3466 int count;
3467 int linenr;
3469 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3470 printf("==== Tokens ====\n");
3471 for (i = 0; i < tokenlist->count; i++) {
3472 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3473 tokenlist->list[i].len, tokenlist->list[i].token);
3475 #endif
3477 /* May need up to one extra script token for each EOL in the worst case */
3478 count = tokenlist->count;
3479 for (i = 0; i < tokenlist->count; i++) {
3480 if (tokenlist->list[i].type == JIM_TT_EOL) {
3481 count++;
3484 linenr = script->firstline = tokenlist->list[0].line;
3486 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3488 /* This is the first token for the current command */
3489 linefirst = token++;
3491 for (i = 0; i < tokenlist->count; ) {
3492 /* Look ahead to find out how many tokens make up the next word */
3493 int wordtokens;
3495 /* Skip any leading separators */
3496 while (tokenlist->list[i].type == JIM_TT_SEP) {
3497 i++;
3500 wordtokens = JimCountWordTokens(tokenlist->list + i);
3502 if (wordtokens == 0) {
3503 /* None, so at end of line */
3504 if (lineargs) {
3505 linefirst->type = JIM_TT_LINE;
3506 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3507 Jim_IncrRefCount(linefirst->objPtr);
3509 /* Reset for new line */
3510 lineargs = 0;
3511 linefirst = token++;
3513 i++;
3514 continue;
3516 else if (wordtokens != 1) {
3517 /* More than 1, or {*}, so insert a WORD token */
3518 token->type = JIM_TT_WORD;
3519 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3520 Jim_IncrRefCount(token->objPtr);
3521 token++;
3522 if (wordtokens < 0) {
3523 /* Skip the expand token */
3524 i++;
3525 wordtokens = -wordtokens - 1;
3526 lineargs--;
3530 if (lineargs == 0) {
3531 /* First real token on the line, so record the line number */
3532 linenr = tokenlist->list[i].line;
3534 lineargs++;
3536 /* Add each non-separator word token to the line */
3537 while (wordtokens--) {
3538 const ParseToken *t = &tokenlist->list[i++];
3540 token->type = t->type;
3541 token->objPtr = JimMakeScriptObj(interp, t);
3542 Jim_IncrRefCount(token->objPtr);
3544 /* Every object is initially a string of type 'source', but the
3545 * internal type may be specialized during execution of the
3546 * script. */
3547 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3548 token++;
3552 if (lineargs == 0) {
3553 token--;
3556 script->len = token - script->token;
3558 JimPanic((script->len >= count, "allocated script array is too short"));
3560 #ifdef DEBUG_SHOW_SCRIPT
3561 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3562 for (i = 0; i < script->len; i++) {
3563 const ScriptToken *t = &script->token[i];
3564 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3566 #endif
3570 /* Parses the given string object to determine if it represents a complete script.
3572 * This is useful for interactive shells implementation, for [info complete].
3574 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3575 * '{' on scripts incomplete missing one or more '}' to be balanced.
3576 * '[' on scripts incomplete missing one or more ']' to be balanced.
3577 * '"' on scripts incomplete missing a '"' char.
3578 * '\\' on scripts with a trailing backslash.
3580 * If the script is complete, 1 is returned, otherwise 0.
3582 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3584 ScriptObj *script = JimGetScript(interp, scriptObj);
3585 if (stateCharPtr) {
3586 *stateCharPtr = script->missing;
3588 return (script->missing == ' ');
3592 * Sets an appropriate error message for a missing script/expression terminator.
3594 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3596 * Note that a trailing backslash is not considered to be an error.
3598 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3600 const char *msg;
3602 switch (ch) {
3603 case '\\':
3604 case ' ':
3605 return JIM_OK;
3607 case '[':
3608 msg = "unmatched \"[\"";
3609 break;
3610 case '{':
3611 msg = "missing close-brace";
3612 break;
3613 case '"':
3614 default:
3615 msg = "missing quote";
3616 break;
3619 Jim_SetResultString(interp, msg, -1);
3620 return JIM_ERR;
3624 * Similar to ScriptObjAddTokens(), but for subst objects.
3626 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3627 ParseTokenList *tokenlist)
3629 int i;
3630 struct ScriptToken *token;
3632 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3634 for (i = 0; i < tokenlist->count; i++) {
3635 const ParseToken *t = &tokenlist->list[i];
3637 /* Create a token for 't' */
3638 token->type = t->type;
3639 token->objPtr = JimMakeScriptObj(interp, t);
3640 Jim_IncrRefCount(token->objPtr);
3641 token++;
3644 script->len = i;
3647 /* This method takes the string representation of an object
3648 * as a Tcl script, and generates the pre-parsed internal representation
3649 * of the script.
3651 * On parse error, sets an error message and returns JIM_ERR
3652 * (Note: the object is still converted to a script, even if an error occurs)
3654 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3656 int scriptTextLen;
3657 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3658 struct JimParserCtx parser;
3659 struct ScriptObj *script;
3660 ParseTokenList tokenlist;
3661 int line = 1;
3663 /* Try to get information about filename / line number */
3664 if (objPtr->typePtr == &sourceObjType) {
3665 line = objPtr->internalRep.sourceValue.lineNumber;
3668 /* Initially parse the script into tokens (in tokenlist) */
3669 ScriptTokenListInit(&tokenlist);
3671 JimParserInit(&parser, scriptText, scriptTextLen, line);
3672 while (!parser.eof) {
3673 JimParseScript(&parser);
3674 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3675 parser.tline);
3678 /* Add a final EOF token */
3679 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3681 /* Create the "real" script tokens from the parsed tokens */
3682 script = Jim_Alloc(sizeof(*script));
3683 memset(script, 0, sizeof(*script));
3684 script->inUse = 1;
3685 if (objPtr->typePtr == &sourceObjType) {
3686 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3688 else {
3689 script->fileNameObj = interp->emptyObj;
3691 Jim_IncrRefCount(script->fileNameObj);
3692 script->missing = parser.missing.ch;
3693 script->linenr = parser.missing.line;
3695 ScriptObjAddTokens(interp, script, &tokenlist);
3697 /* No longer need the token list */
3698 ScriptTokenListFree(&tokenlist);
3700 /* Free the old internal rep and set the new one. */
3701 Jim_FreeIntRep(interp, objPtr);
3702 Jim_SetIntRepPtr(objPtr, script);
3703 objPtr->typePtr = &scriptObjType;
3706 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3709 * Returns the parsed script.
3710 * Note that if there is any possibility that the script is not valid,
3711 * call JimScriptValid() to check
3713 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3715 if (objPtr == interp->emptyObj) {
3716 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3717 objPtr = interp->nullScriptObj;
3720 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3721 JimSetScriptFromAny(interp, objPtr);
3724 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3728 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3729 * and leaves an error message in the interp result.
3732 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3734 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3735 JimAddErrorToStack(interp, script);
3736 return 0;
3738 return 1;
3742 /* -----------------------------------------------------------------------------
3743 * Commands
3744 * ---------------------------------------------------------------------------*/
3745 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3747 cmdPtr->inUse++;
3750 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3752 if (--cmdPtr->inUse == 0) {
3753 if (cmdPtr->isproc) {
3754 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3755 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3756 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3757 if (cmdPtr->u.proc.staticVars) {
3758 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3759 Jim_Free(cmdPtr->u.proc.staticVars);
3762 else {
3763 /* native (C) */
3764 if (cmdPtr->u.native.delProc) {
3765 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3768 if (cmdPtr->prevCmd) {
3769 /* Delete any pushed command too */
3770 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3772 Jim_Free(cmdPtr);
3776 /* Variables HashTable Type.
3778 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3781 /* Variables HashTable Type.
3783 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3784 static void JimVariablesHTValDestructor(void *interp, void *val)
3786 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3787 Jim_Free(val);
3790 static const Jim_HashTableType JimVariablesHashTableType = {
3791 JimStringCopyHTHashFunction, /* hash function */
3792 JimStringCopyHTDup, /* key dup */
3793 NULL, /* val dup */
3794 JimStringCopyHTKeyCompare, /* key compare */
3795 JimStringCopyHTKeyDestructor, /* key destructor */
3796 JimVariablesHTValDestructor /* val destructor */
3799 /* Commands HashTable Type.
3801 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3803 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3805 JimDecrCmdRefCount(interp, val);
3808 static const Jim_HashTableType JimCommandsHashTableType = {
3809 JimStringCopyHTHashFunction, /* hash function */
3810 JimStringCopyHTDup, /* key dup */
3811 NULL, /* val dup */
3812 JimStringCopyHTKeyCompare, /* key compare */
3813 JimStringCopyHTKeyDestructor, /* key destructor */
3814 JimCommandsHT_ValDestructor /* val destructor */
3817 /* ------------------------- Commands related functions --------------------- */
3819 #ifdef jim_ext_namespace
3821 * Returns the "unscoped" version of the given namespace.
3822 * That is, the fully qualified name without the leading ::
3823 * The returned value is either nsObj, or an object with a zero ref count.
3825 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3827 const char *name = Jim_String(nsObj);
3828 if (name[0] == ':' && name[1] == ':') {
3829 /* This command is being defined in the global namespace */
3830 while (*++name == ':') {
3832 nsObj = Jim_NewStringObj(interp, name, -1);
3834 else if (Jim_Length(interp->framePtr->nsObj)) {
3835 /* This command is being defined in a non-global namespace */
3836 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3837 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3839 return nsObj;
3842 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3844 Jim_Obj *resultObj;
3846 const char *name = Jim_String(nameObjPtr);
3847 if (name[0] == ':' && name[1] == ':') {
3848 return nameObjPtr;
3850 Jim_IncrRefCount(nameObjPtr);
3851 resultObj = Jim_NewStringObj(interp, "::", -1);
3852 Jim_AppendObj(interp, resultObj, nameObjPtr);
3853 Jim_DecrRefCount(interp, nameObjPtr);
3855 return resultObj;
3859 * An efficient version of JimQualifyNameObj() where the name is
3860 * available (and needed) as a 'const char *'.
3861 * Avoids creating an object if not necessary.
3862 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3864 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3866 Jim_Obj *objPtr = interp->emptyObj;
3868 if (name[0] == ':' && name[1] == ':') {
3869 /* This command is being defined in the global namespace */
3870 while (*++name == ':') {
3873 else if (Jim_Length(interp->framePtr->nsObj)) {
3874 /* This command is being defined in a non-global namespace */
3875 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3876 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3877 name = Jim_String(objPtr);
3879 Jim_IncrRefCount(objPtr);
3880 *objPtrPtr = objPtr;
3881 return name;
3884 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3886 #else
3887 /* We can be more efficient in the no-namespace case */
3888 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3889 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3891 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3893 return nameObjPtr;
3895 #endif
3897 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3899 /* It may already exist, so we try to delete the old one.
3900 * Note that reference count means that it won't be deleted yet if
3901 * it exists in the call stack.
3903 * BUT, if 'local' is in force, instead of deleting the existing
3904 * proc, we stash a reference to the old proc here.
3906 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3907 if (he) {
3908 /* There was an old cmd with the same name,
3909 * so this requires a 'proc epoch' update. */
3911 /* If a procedure with the same name didn't exist there is no need
3912 * to increment the 'proc epoch' because creation of a new procedure
3913 * can never affect existing cached commands. We don't do
3914 * negative caching. */
3915 Jim_InterpIncrProcEpoch(interp);
3918 if (he && interp->local) {
3919 /* Push this command over the top of the previous one */
3920 cmd->prevCmd = Jim_GetHashEntryVal(he);
3921 Jim_SetHashVal(&interp->commands, he, cmd);
3923 else {
3924 if (he) {
3925 /* Replace the existing command */
3926 Jim_DeleteHashEntry(&interp->commands, name);
3929 Jim_AddHashEntry(&interp->commands, name, cmd);
3931 return JIM_OK;
3935 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3936 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3938 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3940 /* Store the new details for this command */
3941 memset(cmdPtr, 0, sizeof(*cmdPtr));
3942 cmdPtr->inUse = 1;
3943 cmdPtr->u.native.delProc = delProc;
3944 cmdPtr->u.native.cmdProc = cmdProc;
3945 cmdPtr->u.native.privData = privData;
3947 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3949 return JIM_OK;
3952 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3954 int len, i;
3956 len = Jim_ListLength(interp, staticsListObjPtr);
3957 if (len == 0) {
3958 return JIM_OK;
3961 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3962 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3963 for (i = 0; i < len; i++) {
3964 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3965 Jim_Var *varPtr;
3966 int subLen;
3968 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3969 /* Check if it's composed of two elements. */
3970 subLen = Jim_ListLength(interp, objPtr);
3971 if (subLen == 1 || subLen == 2) {
3972 /* Try to get the variable value from the current
3973 * environment. */
3974 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3975 if (subLen == 1) {
3976 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3977 if (initObjPtr == NULL) {
3978 Jim_SetResultFormatted(interp,
3979 "variable for initialization of static \"%#s\" not found in the local context",
3980 nameObjPtr);
3981 return JIM_ERR;
3984 else {
3985 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3987 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3988 return JIM_ERR;
3991 varPtr = Jim_Alloc(sizeof(*varPtr));
3992 varPtr->objPtr = initObjPtr;
3993 Jim_IncrRefCount(initObjPtr);
3994 varPtr->linkFramePtr = NULL;
3995 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3996 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3997 Jim_SetResultFormatted(interp,
3998 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3999 Jim_DecrRefCount(interp, initObjPtr);
4000 Jim_Free(varPtr);
4001 return JIM_ERR;
4004 else {
4005 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4006 objPtr);
4007 return JIM_ERR;
4010 return JIM_OK;
4013 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4015 #ifdef jim_ext_namespace
4016 if (cmdPtr->isproc) {
4017 /* XXX: Really need JimNamespaceSplit() */
4018 const char *pt = strrchr(cmdname, ':');
4019 if (pt && pt != cmdname && pt[-1] == ':') {
4020 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4021 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4022 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4024 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4025 /* This commands shadows a global command, so a proc epoch update is required */
4026 Jim_InterpIncrProcEpoch(interp);
4030 #endif
4033 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4034 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4036 Jim_Cmd *cmdPtr;
4037 int argListLen;
4038 int i;
4040 argListLen = Jim_ListLength(interp, argListObjPtr);
4042 /* Allocate space for both the command pointer and the arg list */
4043 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4044 memset(cmdPtr, 0, sizeof(*cmdPtr));
4045 cmdPtr->inUse = 1;
4046 cmdPtr->isproc = 1;
4047 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4048 cmdPtr->u.proc.argListLen = argListLen;
4049 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4050 cmdPtr->u.proc.argsPos = -1;
4051 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4052 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4053 Jim_IncrRefCount(argListObjPtr);
4054 Jim_IncrRefCount(bodyObjPtr);
4055 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4057 /* Create the statics hash table. */
4058 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4059 goto err;
4062 /* Parse the args out into arglist, validating as we go */
4063 /* Examine the argument list for default parameters and 'args' */
4064 for (i = 0; i < argListLen; i++) {
4065 Jim_Obj *argPtr;
4066 Jim_Obj *nameObjPtr;
4067 Jim_Obj *defaultObjPtr;
4068 int len;
4070 /* Examine a parameter */
4071 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4072 len = Jim_ListLength(interp, argPtr);
4073 if (len == 0) {
4074 Jim_SetResultString(interp, "argument with no name", -1);
4075 err:
4076 JimDecrCmdRefCount(interp, cmdPtr);
4077 return NULL;
4079 if (len > 2) {
4080 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4081 goto err;
4084 if (len == 2) {
4085 /* Optional parameter */
4086 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4087 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4089 else {
4090 /* Required parameter */
4091 nameObjPtr = argPtr;
4092 defaultObjPtr = NULL;
4096 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4097 if (cmdPtr->u.proc.argsPos >= 0) {
4098 Jim_SetResultString(interp, "'args' specified more than once", -1);
4099 goto err;
4101 cmdPtr->u.proc.argsPos = i;
4103 else {
4104 if (len == 2) {
4105 cmdPtr->u.proc.optArity++;
4107 else {
4108 cmdPtr->u.proc.reqArity++;
4112 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4113 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4116 return cmdPtr;
4119 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4121 int ret = JIM_OK;
4122 Jim_Obj *qualifiedNameObj;
4123 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4125 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4126 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4127 ret = JIM_ERR;
4129 else {
4130 Jim_InterpIncrProcEpoch(interp);
4133 JimFreeQualifiedName(interp, qualifiedNameObj);
4135 return ret;
4138 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4140 int ret = JIM_ERR;
4141 Jim_HashEntry *he;
4142 Jim_Cmd *cmdPtr;
4143 Jim_Obj *qualifiedOldNameObj;
4144 Jim_Obj *qualifiedNewNameObj;
4145 const char *fqold;
4146 const char *fqnew;
4148 if (newName[0] == 0) {
4149 return Jim_DeleteCommand(interp, oldName);
4152 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4153 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4155 /* Does it exist? */
4156 he = Jim_FindHashEntry(&interp->commands, fqold);
4157 if (he == NULL) {
4158 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4160 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4161 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4163 else {
4164 /* Add the new name first */
4165 cmdPtr = Jim_GetHashEntryVal(he);
4166 JimIncrCmdRefCount(cmdPtr);
4167 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4168 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4170 /* Now remove the old name */
4171 Jim_DeleteHashEntry(&interp->commands, fqold);
4173 /* Increment the epoch */
4174 Jim_InterpIncrProcEpoch(interp);
4176 ret = JIM_OK;
4179 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4180 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4182 return ret;
4185 /* -----------------------------------------------------------------------------
4186 * Command object
4187 * ---------------------------------------------------------------------------*/
4189 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4191 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4194 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4196 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4197 dupPtr->typePtr = srcPtr->typePtr;
4198 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4201 static const Jim_ObjType commandObjType = {
4202 "command",
4203 FreeCommandInternalRep,
4204 DupCommandInternalRep,
4205 NULL,
4206 JIM_TYPE_REFERENCES,
4209 /* This function returns the command structure for the command name
4210 * stored in objPtr. It tries to specialize the objPtr to contain
4211 * a cached info instead to perform the lookup into the hash table
4212 * every time. The information cached may not be uptodate, in such
4213 * a case the lookup is performed and the cache updated.
4215 * Respects the 'upcall' setting
4217 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4219 Jim_Cmd *cmd;
4221 /* In order to be valid, the proc epoch must match and
4222 * the lookup must have occurred in the same namespace
4224 if (objPtr->typePtr != &commandObjType ||
4225 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4226 #ifdef jim_ext_namespace
4227 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4228 #endif
4230 /* Not cached or out of date, so lookup */
4232 /* Do we need to try the local namespace? */
4233 const char *name = Jim_String(objPtr);
4234 Jim_HashEntry *he;
4236 if (name[0] == ':' && name[1] == ':') {
4237 while (*++name == ':') {
4240 #ifdef jim_ext_namespace
4241 else if (Jim_Length(interp->framePtr->nsObj)) {
4242 /* This command is being defined in a non-global namespace */
4243 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4244 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4245 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4246 Jim_FreeNewObj(interp, nameObj);
4247 if (he) {
4248 goto found;
4251 #endif
4253 /* Lookup in the global namespace */
4254 he = Jim_FindHashEntry(&interp->commands, name);
4255 if (he == NULL) {
4256 if (flags & JIM_ERRMSG) {
4257 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4259 return NULL;
4261 #ifdef jim_ext_namespace
4262 found:
4263 #endif
4264 cmd = Jim_GetHashEntryVal(he);
4266 /* Free the old internal repr and set the new one. */
4267 Jim_FreeIntRep(interp, objPtr);
4268 objPtr->typePtr = &commandObjType;
4269 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4270 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4271 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4272 Jim_IncrRefCount(interp->framePtr->nsObj);
4274 else {
4275 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4277 while (cmd->u.proc.upcall) {
4278 cmd = cmd->prevCmd;
4280 return cmd;
4283 /* -----------------------------------------------------------------------------
4284 * Variables
4285 * ---------------------------------------------------------------------------*/
4287 /* -----------------------------------------------------------------------------
4288 * Variable object
4289 * ---------------------------------------------------------------------------*/
4291 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4293 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4295 static const Jim_ObjType variableObjType = {
4296 "variable",
4297 NULL,
4298 NULL,
4299 NULL,
4300 JIM_TYPE_REFERENCES,
4304 * Check that the name does not contain embedded nulls.
4306 * Variable and procedure names are manipulated as null terminated strings, so
4307 * don't allow names with embedded nulls.
4309 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4311 /* Variable names and proc names can't contain embedded nulls */
4312 if (nameObjPtr->typePtr != &variableObjType) {
4313 int len;
4314 const char *str = Jim_GetString(nameObjPtr, &len);
4315 if (memchr(str, '\0', len)) {
4316 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4317 return JIM_ERR;
4320 return JIM_OK;
4323 /* This method should be called only by the variable API.
4324 * It returns JIM_OK on success (variable already exists),
4325 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4326 * a variable name, but syntax glue for [dict] i.e. the last
4327 * character is ')' */
4328 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4330 const char *varName;
4331 Jim_CallFrame *framePtr;
4332 Jim_HashEntry *he;
4333 int global;
4334 int len;
4336 /* Check if the object is already an uptodate variable */
4337 if (objPtr->typePtr == &variableObjType) {
4338 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4339 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4340 /* nothing to do */
4341 return JIM_OK;
4343 /* Need to re-resolve the variable in the updated callframe */
4345 else if (objPtr->typePtr == &dictSubstObjType) {
4346 return JIM_DICT_SUGAR;
4348 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4349 return JIM_ERR;
4353 varName = Jim_GetString(objPtr, &len);
4355 /* Make sure it's not syntax glue to get/set dict. */
4356 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4357 return JIM_DICT_SUGAR;
4360 if (varName[0] == ':' && varName[1] == ':') {
4361 while (*++varName == ':') {
4363 global = 1;
4364 framePtr = interp->topFramePtr;
4366 else {
4367 global = 0;
4368 framePtr = interp->framePtr;
4371 /* Resolve this name in the variables hash table */
4372 he = Jim_FindHashEntry(&framePtr->vars, varName);
4373 if (he == NULL) {
4374 if (!global && framePtr->staticVars) {
4375 /* Try with static vars. */
4376 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4378 if (he == NULL) {
4379 return JIM_ERR;
4383 /* Free the old internal repr and set the new one. */
4384 Jim_FreeIntRep(interp, objPtr);
4385 objPtr->typePtr = &variableObjType;
4386 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4387 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4388 objPtr->internalRep.varValue.global = global;
4389 return JIM_OK;
4392 /* -------------------- Variables related functions ------------------------- */
4393 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4394 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4396 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4398 const char *name;
4399 Jim_CallFrame *framePtr;
4400 int global;
4402 /* New variable to create */
4403 Jim_Var *var = Jim_Alloc(sizeof(*var));
4405 var->objPtr = valObjPtr;
4406 Jim_IncrRefCount(valObjPtr);
4407 var->linkFramePtr = NULL;
4409 name = Jim_String(nameObjPtr);
4410 if (name[0] == ':' && name[1] == ':') {
4411 while (*++name == ':') {
4413 framePtr = interp->topFramePtr;
4414 global = 1;
4416 else {
4417 framePtr = interp->framePtr;
4418 global = 0;
4421 /* Insert the new variable */
4422 Jim_AddHashEntry(&framePtr->vars, name, var);
4424 /* Make the object int rep a variable */
4425 Jim_FreeIntRep(interp, nameObjPtr);
4426 nameObjPtr->typePtr = &variableObjType;
4427 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4428 nameObjPtr->internalRep.varValue.varPtr = var;
4429 nameObjPtr->internalRep.varValue.global = global;
4431 return var;
4434 /* For now that's dummy. Variables lookup should be optimized
4435 * in many ways, with caching of lookups, and possibly with
4436 * a table of pre-allocated vars in every CallFrame for local vars.
4437 * All the caching should also have an 'epoch' mechanism similar
4438 * to the one used by Tcl for procedures lookup caching. */
4440 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4442 int err;
4443 Jim_Var *var;
4445 switch (SetVariableFromAny(interp, nameObjPtr)) {
4446 case JIM_DICT_SUGAR:
4447 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4449 case JIM_ERR:
4450 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4451 return JIM_ERR;
4453 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4454 break;
4456 case JIM_OK:
4457 var = nameObjPtr->internalRep.varValue.varPtr;
4458 if (var->linkFramePtr == NULL) {
4459 Jim_IncrRefCount(valObjPtr);
4460 Jim_DecrRefCount(interp, var->objPtr);
4461 var->objPtr = valObjPtr;
4463 else { /* Else handle the link */
4464 Jim_CallFrame *savedCallFrame;
4466 savedCallFrame = interp->framePtr;
4467 interp->framePtr = var->linkFramePtr;
4468 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4469 interp->framePtr = savedCallFrame;
4470 if (err != JIM_OK)
4471 return err;
4474 return JIM_OK;
4477 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4479 Jim_Obj *nameObjPtr;
4480 int result;
4482 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4483 Jim_IncrRefCount(nameObjPtr);
4484 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4485 Jim_DecrRefCount(interp, nameObjPtr);
4486 return result;
4489 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4491 Jim_CallFrame *savedFramePtr;
4492 int result;
4494 savedFramePtr = interp->framePtr;
4495 interp->framePtr = interp->topFramePtr;
4496 result = Jim_SetVariableStr(interp, name, objPtr);
4497 interp->framePtr = savedFramePtr;
4498 return result;
4501 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4503 Jim_Obj *nameObjPtr, *valObjPtr;
4504 int result;
4506 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4507 valObjPtr = Jim_NewStringObj(interp, val, -1);
4508 Jim_IncrRefCount(nameObjPtr);
4509 Jim_IncrRefCount(valObjPtr);
4510 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4511 Jim_DecrRefCount(interp, nameObjPtr);
4512 Jim_DecrRefCount(interp, valObjPtr);
4513 return result;
4516 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4517 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4519 const char *varName;
4520 const char *targetName;
4521 Jim_CallFrame *framePtr;
4522 Jim_Var *varPtr;
4524 /* Check for an existing variable or link */
4525 switch (SetVariableFromAny(interp, nameObjPtr)) {
4526 case JIM_DICT_SUGAR:
4527 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4528 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4529 return JIM_ERR;
4531 case JIM_OK:
4532 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4534 if (varPtr->linkFramePtr == NULL) {
4535 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4536 return JIM_ERR;
4539 /* It exists, but is a link, so first delete the link */
4540 varPtr->linkFramePtr = NULL;
4541 break;
4544 /* Resolve the call frames for both variables */
4545 /* XXX: SetVariableFromAny() already did this! */
4546 varName = Jim_String(nameObjPtr);
4548 if (varName[0] == ':' && varName[1] == ':') {
4549 while (*++varName == ':') {
4551 /* Linking a global var does nothing */
4552 framePtr = interp->topFramePtr;
4554 else {
4555 framePtr = interp->framePtr;
4558 targetName = Jim_String(targetNameObjPtr);
4559 if (targetName[0] == ':' && targetName[1] == ':') {
4560 while (*++targetName == ':') {
4562 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4563 targetCallFrame = interp->topFramePtr;
4565 Jim_IncrRefCount(targetNameObjPtr);
4567 if (framePtr->level < targetCallFrame->level) {
4568 Jim_SetResultFormatted(interp,
4569 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4570 nameObjPtr);
4571 Jim_DecrRefCount(interp, targetNameObjPtr);
4572 return JIM_ERR;
4575 /* Check for cycles. */
4576 if (framePtr == targetCallFrame) {
4577 Jim_Obj *objPtr = targetNameObjPtr;
4579 /* Cycles are only possible with 'uplevel 0' */
4580 while (1) {
4581 if (strcmp(Jim_String(objPtr), varName) == 0) {
4582 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4583 Jim_DecrRefCount(interp, targetNameObjPtr);
4584 return JIM_ERR;
4586 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4587 break;
4588 varPtr = objPtr->internalRep.varValue.varPtr;
4589 if (varPtr->linkFramePtr != targetCallFrame)
4590 break;
4591 objPtr = varPtr->objPtr;
4595 /* Perform the binding */
4596 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4597 /* We are now sure 'nameObjPtr' type is variableObjType */
4598 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4599 Jim_DecrRefCount(interp, targetNameObjPtr);
4600 return JIM_OK;
4603 /* Return the Jim_Obj pointer associated with a variable name,
4604 * or NULL if the variable was not found in the current context.
4605 * The same optimization discussed in the comment to the
4606 * 'SetVariable' function should apply here.
4608 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4609 * in a dictionary which is shared, the array variable value is duplicated first.
4610 * This allows the array element to be updated (e.g. append, lappend) without
4611 * affecting other references to the dictionary.
4613 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4615 switch (SetVariableFromAny(interp, nameObjPtr)) {
4616 case JIM_OK:{
4617 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4619 if (varPtr->linkFramePtr == NULL) {
4620 return varPtr->objPtr;
4622 else {
4623 Jim_Obj *objPtr;
4625 /* The variable is a link? Resolve it. */
4626 Jim_CallFrame *savedCallFrame = interp->framePtr;
4628 interp->framePtr = varPtr->linkFramePtr;
4629 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4630 interp->framePtr = savedCallFrame;
4631 if (objPtr) {
4632 return objPtr;
4634 /* Error, so fall through to the error message */
4637 break;
4639 case JIM_DICT_SUGAR:
4640 /* [dict] syntax sugar. */
4641 return JimDictSugarGet(interp, nameObjPtr, flags);
4643 if (flags & JIM_ERRMSG) {
4644 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4646 return NULL;
4649 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4651 Jim_CallFrame *savedFramePtr;
4652 Jim_Obj *objPtr;
4654 savedFramePtr = interp->framePtr;
4655 interp->framePtr = interp->topFramePtr;
4656 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4657 interp->framePtr = savedFramePtr;
4659 return objPtr;
4662 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4664 Jim_Obj *nameObjPtr, *varObjPtr;
4666 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4667 Jim_IncrRefCount(nameObjPtr);
4668 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4669 Jim_DecrRefCount(interp, nameObjPtr);
4670 return varObjPtr;
4673 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4675 Jim_CallFrame *savedFramePtr;
4676 Jim_Obj *objPtr;
4678 savedFramePtr = interp->framePtr;
4679 interp->framePtr = interp->topFramePtr;
4680 objPtr = Jim_GetVariableStr(interp, name, flags);
4681 interp->framePtr = savedFramePtr;
4683 return objPtr;
4686 /* Unset a variable.
4687 * Note: On success unset invalidates all the variable objects created
4688 * in the current call frame incrementing. */
4689 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4691 Jim_Var *varPtr;
4692 int retval;
4693 Jim_CallFrame *framePtr;
4695 retval = SetVariableFromAny(interp, nameObjPtr);
4696 if (retval == JIM_DICT_SUGAR) {
4697 /* [dict] syntax sugar. */
4698 return JimDictSugarSet(interp, nameObjPtr, NULL);
4700 else if (retval == JIM_OK) {
4701 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4703 /* If it's a link call UnsetVariable recursively */
4704 if (varPtr->linkFramePtr) {
4705 framePtr = interp->framePtr;
4706 interp->framePtr = varPtr->linkFramePtr;
4707 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4708 interp->framePtr = framePtr;
4710 else {
4711 const char *name = Jim_String(nameObjPtr);
4712 if (nameObjPtr->internalRep.varValue.global) {
4713 name += 2;
4714 framePtr = interp->topFramePtr;
4716 else {
4717 framePtr = interp->framePtr;
4720 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4721 if (retval == JIM_OK) {
4722 /* Change the callframe id, invalidating var lookup caching */
4723 framePtr->id = interp->callFrameEpoch++;
4727 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4728 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4730 return retval;
4733 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4735 /* Given a variable name for [dict] operation syntax sugar,
4736 * this function returns two objects, the first with the name
4737 * of the variable to set, and the second with the respective key.
4738 * For example "foo(bar)" will return objects with string repr. of
4739 * "foo" and "bar".
4741 * The returned objects have refcount = 1. The function can't fail. */
4742 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4743 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4745 const char *str, *p;
4746 int len, keyLen;
4747 Jim_Obj *varObjPtr, *keyObjPtr;
4749 str = Jim_GetString(objPtr, &len);
4751 p = strchr(str, '(');
4752 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4754 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4756 p++;
4757 keyLen = (str + len) - p;
4758 if (str[len - 1] == ')') {
4759 keyLen--;
4762 /* Create the objects with the variable name and key. */
4763 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4765 Jim_IncrRefCount(varObjPtr);
4766 Jim_IncrRefCount(keyObjPtr);
4767 *varPtrPtr = varObjPtr;
4768 *keyPtrPtr = keyObjPtr;
4771 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4772 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4773 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4775 int err;
4777 SetDictSubstFromAny(interp, objPtr);
4779 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4780 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4782 if (err == JIM_OK) {
4783 /* Don't keep an extra ref to the result */
4784 Jim_SetEmptyResult(interp);
4786 else {
4787 if (!valObjPtr) {
4788 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4789 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4790 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4791 objPtr);
4792 return err;
4795 /* Make the error more informative and Tcl-compatible */
4796 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4797 (valObjPtr ? "set" : "unset"), objPtr);
4799 return err;
4803 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4805 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4806 * and stored back to the variable before expansion.
4808 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4809 Jim_Obj *keyObjPtr, int flags)
4811 Jim_Obj *dictObjPtr;
4812 Jim_Obj *resObjPtr = NULL;
4813 int ret;
4815 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4816 if (!dictObjPtr) {
4817 return NULL;
4820 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4821 if (ret != JIM_OK) {
4822 Jim_SetResultFormatted(interp,
4823 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4824 ret < 0 ? "variable isn't" : "no such element in");
4826 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4827 /* Update the variable to have an unshared copy */
4828 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4831 return resObjPtr;
4834 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4835 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4837 SetDictSubstFromAny(interp, objPtr);
4839 return JimDictExpandArrayVariable(interp,
4840 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4841 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4844 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4846 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4848 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4849 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4852 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4854 JIM_NOTUSED(interp);
4856 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4857 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4858 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4859 dupPtr->typePtr = &dictSubstObjType;
4862 /* Note: The object *must* be in dict-sugar format */
4863 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4865 if (objPtr->typePtr != &dictSubstObjType) {
4866 Jim_Obj *varObjPtr, *keyObjPtr;
4868 if (objPtr->typePtr == &interpolatedObjType) {
4869 /* An interpolated object in dict-sugar form */
4871 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4872 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4874 Jim_IncrRefCount(varObjPtr);
4875 Jim_IncrRefCount(keyObjPtr);
4877 else {
4878 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4881 Jim_FreeIntRep(interp, objPtr);
4882 objPtr->typePtr = &dictSubstObjType;
4883 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4884 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4888 /* This function is used to expand [dict get] sugar in the form
4889 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4890 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4891 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4892 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4893 * the [dict]ionary contained in variable VARNAME. */
4894 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4896 Jim_Obj *resObjPtr = NULL;
4897 Jim_Obj *substKeyObjPtr = NULL;
4899 SetDictSubstFromAny(interp, objPtr);
4901 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4902 &substKeyObjPtr, JIM_NONE)
4903 != JIM_OK) {
4904 return NULL;
4906 Jim_IncrRefCount(substKeyObjPtr);
4907 resObjPtr =
4908 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4909 substKeyObjPtr, 0);
4910 Jim_DecrRefCount(interp, substKeyObjPtr);
4912 return resObjPtr;
4915 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4917 Jim_Obj *resultObjPtr;
4919 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4920 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4921 resultObjPtr->refCount--;
4922 return resultObjPtr;
4924 return NULL;
4927 /* -----------------------------------------------------------------------------
4928 * CallFrame
4929 * ---------------------------------------------------------------------------*/
4931 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4933 Jim_CallFrame *cf;
4935 if (interp->freeFramesList) {
4936 cf = interp->freeFramesList;
4937 interp->freeFramesList = cf->next;
4939 cf->argv = NULL;
4940 cf->argc = 0;
4941 cf->procArgsObjPtr = NULL;
4942 cf->procBodyObjPtr = NULL;
4943 cf->next = NULL;
4944 cf->staticVars = NULL;
4945 cf->localCommands = NULL;
4946 cf->tailcallObj = NULL;
4947 cf->tailcallCmd = NULL;
4949 else {
4950 cf = Jim_Alloc(sizeof(*cf));
4951 memset(cf, 0, sizeof(*cf));
4953 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4956 cf->id = interp->callFrameEpoch++;
4957 cf->parent = parent;
4958 cf->level = parent ? parent->level + 1 : 0;
4959 cf->nsObj = nsObj;
4960 Jim_IncrRefCount(nsObj);
4962 return cf;
4965 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4967 /* Delete any local procs */
4968 if (localCommands) {
4969 Jim_Obj *cmdNameObj;
4971 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4972 Jim_HashEntry *he;
4973 Jim_Obj *fqObjName;
4974 Jim_HashTable *ht = &interp->commands;
4976 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4978 he = Jim_FindHashEntry(ht, fqname);
4980 if (he) {
4981 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4982 if (cmd->prevCmd) {
4983 Jim_Cmd *prevCmd = cmd->prevCmd;
4984 cmd->prevCmd = NULL;
4986 /* Delete the old command */
4987 JimDecrCmdRefCount(interp, cmd);
4989 /* And restore the original */
4990 Jim_SetHashVal(ht, he, prevCmd);
4992 else {
4993 Jim_DeleteHashEntry(ht, fqname);
4994 Jim_InterpIncrProcEpoch(interp);
4997 Jim_DecrRefCount(interp, cmdNameObj);
4998 JimFreeQualifiedName(interp, fqObjName);
5000 Jim_FreeStack(localCommands);
5001 Jim_Free(localCommands);
5003 return JIM_OK;
5007 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5008 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5009 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5011 JimDeleteLocalProcs(interp, cf->localCommands);
5013 if (cf->procArgsObjPtr)
5014 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5015 if (cf->procBodyObjPtr)
5016 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5017 Jim_DecrRefCount(interp, cf->nsObj);
5018 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5019 Jim_FreeHashTable(&cf->vars);
5020 else {
5021 int i;
5022 Jim_HashEntry **table = cf->vars.table, *he;
5024 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5025 he = table[i];
5026 while (he != NULL) {
5027 Jim_HashEntry *nextEntry = he->next;
5028 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5030 Jim_DecrRefCount(interp, varPtr->objPtr);
5031 Jim_Free(Jim_GetHashEntryKey(he));
5032 Jim_Free(varPtr);
5033 Jim_Free(he);
5034 table[i] = NULL;
5035 he = nextEntry;
5038 cf->vars.used = 0;
5040 cf->next = interp->freeFramesList;
5041 interp->freeFramesList = cf;
5045 /* -----------------------------------------------------------------------------
5046 * References
5047 * ---------------------------------------------------------------------------*/
5048 #ifdef JIM_REFERENCES
5050 /* References HashTable Type.
5052 * Keys are unsigned long integers, dynamically allocated for now but in the
5053 * future it's worth to cache this 4 bytes objects. Values are pointers
5054 * to Jim_References. */
5055 static void JimReferencesHTValDestructor(void *interp, void *val)
5057 Jim_Reference *refPtr = (void *)val;
5059 Jim_DecrRefCount(interp, refPtr->objPtr);
5060 if (refPtr->finalizerCmdNamePtr != NULL) {
5061 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5063 Jim_Free(val);
5066 static unsigned int JimReferencesHTHashFunction(const void *key)
5068 /* Only the least significant bits are used. */
5069 const unsigned long *widePtr = key;
5070 unsigned int intValue = (unsigned int)*widePtr;
5072 return Jim_IntHashFunction(intValue);
5075 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5077 void *copy = Jim_Alloc(sizeof(unsigned long));
5079 JIM_NOTUSED(privdata);
5081 memcpy(copy, key, sizeof(unsigned long));
5082 return copy;
5085 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5087 JIM_NOTUSED(privdata);
5089 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5092 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5094 JIM_NOTUSED(privdata);
5096 Jim_Free(key);
5099 static const Jim_HashTableType JimReferencesHashTableType = {
5100 JimReferencesHTHashFunction, /* hash function */
5101 JimReferencesHTKeyDup, /* key dup */
5102 NULL, /* val dup */
5103 JimReferencesHTKeyCompare, /* key compare */
5104 JimReferencesHTKeyDestructor, /* key destructor */
5105 JimReferencesHTValDestructor /* val destructor */
5108 /* -----------------------------------------------------------------------------
5109 * Reference object type and References API
5110 * ---------------------------------------------------------------------------*/
5112 /* The string representation of references has two features in order
5113 * to make the GC faster. The first is that every reference starts
5114 * with a non common character '<', in order to make the string matching
5115 * faster. The second is that the reference string rep is 42 characters
5116 * in length, this means that it is not necessary to check any object with a string
5117 * repr < 42, and usually there aren't many of these objects. */
5119 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5121 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5123 const char *fmt = "<reference.<%s>.%020lu>";
5125 sprintf(buf, fmt, refPtr->tag, id);
5126 return JIM_REFERENCE_SPACE;
5129 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5131 static const Jim_ObjType referenceObjType = {
5132 "reference",
5133 NULL,
5134 NULL,
5135 UpdateStringOfReference,
5136 JIM_TYPE_REFERENCES,
5139 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5141 char buf[JIM_REFERENCE_SPACE + 1];
5143 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5144 JimSetStringBytes(objPtr, buf);
5147 /* returns true if 'c' is a valid reference tag character.
5148 * i.e. inside the range [_a-zA-Z0-9] */
5149 static int isrefchar(int c)
5151 return (c == '_' || isalnum(c));
5154 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5156 unsigned long value;
5157 int i, len;
5158 const char *str, *start, *end;
5159 char refId[21];
5160 Jim_Reference *refPtr;
5161 Jim_HashEntry *he;
5162 char *endptr;
5164 /* Get the string representation */
5165 str = Jim_GetString(objPtr, &len);
5166 /* Check if it looks like a reference */
5167 if (len < JIM_REFERENCE_SPACE)
5168 goto badformat;
5169 /* Trim spaces */
5170 start = str;
5171 end = str + len - 1;
5172 while (*start == ' ')
5173 start++;
5174 while (*end == ' ' && end > start)
5175 end--;
5176 if (end - start + 1 != JIM_REFERENCE_SPACE)
5177 goto badformat;
5178 /* <reference.<1234567>.%020> */
5179 if (memcmp(start, "<reference.<", 12) != 0)
5180 goto badformat;
5181 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5182 goto badformat;
5183 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5184 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5185 if (!isrefchar(start[12 + i]))
5186 goto badformat;
5188 /* Extract info from the reference. */
5189 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5190 refId[20] = '\0';
5191 /* Try to convert the ID into an unsigned long */
5192 value = strtoul(refId, &endptr, 10);
5193 if (JimCheckConversion(refId, endptr) != JIM_OK)
5194 goto badformat;
5195 /* Check if the reference really exists! */
5196 he = Jim_FindHashEntry(&interp->references, &value);
5197 if (he == NULL) {
5198 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5199 return JIM_ERR;
5201 refPtr = Jim_GetHashEntryVal(he);
5202 /* Free the old internal repr and set the new one. */
5203 Jim_FreeIntRep(interp, objPtr);
5204 objPtr->typePtr = &referenceObjType;
5205 objPtr->internalRep.refValue.id = value;
5206 objPtr->internalRep.refValue.refPtr = refPtr;
5207 return JIM_OK;
5209 badformat:
5210 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5211 return JIM_ERR;
5214 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5215 * as finalizer command (or NULL if there is no finalizer).
5216 * The returned reference object has refcount = 0. */
5217 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5219 struct Jim_Reference *refPtr;
5220 unsigned long id;
5221 Jim_Obj *refObjPtr;
5222 const char *tag;
5223 int tagLen, i;
5225 /* Perform the Garbage Collection if needed. */
5226 Jim_CollectIfNeeded(interp);
5228 refPtr = Jim_Alloc(sizeof(*refPtr));
5229 refPtr->objPtr = objPtr;
5230 Jim_IncrRefCount(objPtr);
5231 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5232 if (cmdNamePtr)
5233 Jim_IncrRefCount(cmdNamePtr);
5234 id = interp->referenceNextId++;
5235 Jim_AddHashEntry(&interp->references, &id, refPtr);
5236 refObjPtr = Jim_NewObj(interp);
5237 refObjPtr->typePtr = &referenceObjType;
5238 refObjPtr->bytes = NULL;
5239 refObjPtr->internalRep.refValue.id = id;
5240 refObjPtr->internalRep.refValue.refPtr = refPtr;
5241 interp->referenceNextId++;
5242 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5243 * that does not pass the 'isrefchar' test is replaced with '_' */
5244 tag = Jim_GetString(tagPtr, &tagLen);
5245 if (tagLen > JIM_REFERENCE_TAGLEN)
5246 tagLen = JIM_REFERENCE_TAGLEN;
5247 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5248 if (i < tagLen && isrefchar(tag[i]))
5249 refPtr->tag[i] = tag[i];
5250 else
5251 refPtr->tag[i] = '_';
5253 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5254 return refObjPtr;
5257 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5259 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5260 return NULL;
5261 return objPtr->internalRep.refValue.refPtr;
5264 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5266 Jim_Reference *refPtr;
5268 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5269 return JIM_ERR;
5270 Jim_IncrRefCount(cmdNamePtr);
5271 if (refPtr->finalizerCmdNamePtr)
5272 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5273 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5274 return JIM_OK;
5277 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5279 Jim_Reference *refPtr;
5281 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5282 return JIM_ERR;
5283 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5284 return JIM_OK;
5287 /* -----------------------------------------------------------------------------
5288 * References Garbage Collection
5289 * ---------------------------------------------------------------------------*/
5291 /* This the hash table type for the "MARK" phase of the GC */
5292 static const Jim_HashTableType JimRefMarkHashTableType = {
5293 JimReferencesHTHashFunction, /* hash function */
5294 JimReferencesHTKeyDup, /* key dup */
5295 NULL, /* val dup */
5296 JimReferencesHTKeyCompare, /* key compare */
5297 JimReferencesHTKeyDestructor, /* key destructor */
5298 NULL /* val destructor */
5301 /* Performs the garbage collection. */
5302 int Jim_Collect(Jim_Interp *interp)
5304 int collected = 0;
5305 #ifndef JIM_BOOTSTRAP
5306 Jim_HashTable marks;
5307 Jim_HashTableIterator htiter;
5308 Jim_HashEntry *he;
5309 Jim_Obj *objPtr;
5311 /* Avoid recursive calls */
5312 if (interp->lastCollectId == -1) {
5313 /* Jim_Collect() already running. Return just now. */
5314 return 0;
5316 interp->lastCollectId = -1;
5318 /* Mark all the references found into the 'mark' hash table.
5319 * The references are searched in every live object that
5320 * is of a type that can contain references. */
5321 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5322 objPtr = interp->liveList;
5323 while (objPtr) {
5324 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5325 const char *str, *p;
5326 int len;
5328 /* If the object is of type reference, to get the
5329 * Id is simple... */
5330 if (objPtr->typePtr == &referenceObjType) {
5331 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5332 #ifdef JIM_DEBUG_GC
5333 printf("MARK (reference): %d refcount: %d\n",
5334 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5335 #endif
5336 objPtr = objPtr->nextObjPtr;
5337 continue;
5339 /* Get the string repr of the object we want
5340 * to scan for references. */
5341 p = str = Jim_GetString(objPtr, &len);
5342 /* Skip objects too little to contain references. */
5343 if (len < JIM_REFERENCE_SPACE) {
5344 objPtr = objPtr->nextObjPtr;
5345 continue;
5347 /* Extract references from the object string repr. */
5348 while (1) {
5349 int i;
5350 unsigned long id;
5352 if ((p = strstr(p, "<reference.<")) == NULL)
5353 break;
5354 /* Check if it's a valid reference. */
5355 if (len - (p - str) < JIM_REFERENCE_SPACE)
5356 break;
5357 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5358 break;
5359 for (i = 21; i <= 40; i++)
5360 if (!isdigit(UCHAR(p[i])))
5361 break;
5362 /* Get the ID */
5363 id = strtoul(p + 21, NULL, 10);
5365 /* Ok, a reference for the given ID
5366 * was found. Mark it. */
5367 Jim_AddHashEntry(&marks, &id, NULL);
5368 #ifdef JIM_DEBUG_GC
5369 printf("MARK: %d\n", (int)id);
5370 #endif
5371 p += JIM_REFERENCE_SPACE;
5374 objPtr = objPtr->nextObjPtr;
5377 /* Run the references hash table to destroy every reference that
5378 * is not referenced outside (not present in the mark HT). */
5379 JimInitHashTableIterator(&interp->references, &htiter);
5380 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5381 const unsigned long *refId;
5382 Jim_Reference *refPtr;
5384 refId = he->key;
5385 /* Check if in the mark phase we encountered
5386 * this reference. */
5387 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5388 #ifdef JIM_DEBUG_GC
5389 printf("COLLECTING %d\n", (int)*refId);
5390 #endif
5391 collected++;
5392 /* Drop the reference, but call the
5393 * finalizer first if registered. */
5394 refPtr = Jim_GetHashEntryVal(he);
5395 if (refPtr->finalizerCmdNamePtr) {
5396 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5397 Jim_Obj *objv[3], *oldResult;
5399 JimFormatReference(refstr, refPtr, *refId);
5401 objv[0] = refPtr->finalizerCmdNamePtr;
5402 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5403 objv[2] = refPtr->objPtr;
5405 /* Drop the reference itself */
5406 /* Avoid the finaliser being freed here */
5407 Jim_IncrRefCount(objv[0]);
5408 /* Don't remove the reference from the hash table just yet
5409 * since that will free refPtr, and hence refPtr->objPtr
5412 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5413 oldResult = interp->result;
5414 Jim_IncrRefCount(oldResult);
5415 Jim_EvalObjVector(interp, 3, objv);
5416 Jim_SetResult(interp, oldResult);
5417 Jim_DecrRefCount(interp, oldResult);
5419 Jim_DecrRefCount(interp, objv[0]);
5421 Jim_DeleteHashEntry(&interp->references, refId);
5424 Jim_FreeHashTable(&marks);
5425 interp->lastCollectId = interp->referenceNextId;
5426 interp->lastCollectTime = time(NULL);
5427 #endif /* JIM_BOOTSTRAP */
5428 return collected;
5431 #define JIM_COLLECT_ID_PERIOD 5000
5432 #define JIM_COLLECT_TIME_PERIOD 300
5434 void Jim_CollectIfNeeded(Jim_Interp *interp)
5436 unsigned long elapsedId;
5437 int elapsedTime;
5439 elapsedId = interp->referenceNextId - interp->lastCollectId;
5440 elapsedTime = time(NULL) - interp->lastCollectTime;
5443 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5444 Jim_Collect(interp);
5447 #endif
5449 int Jim_IsBigEndian(void)
5451 union {
5452 unsigned short s;
5453 unsigned char c[2];
5454 } uval = {0x0102};
5456 return uval.c[0] == 1;
5459 /* -----------------------------------------------------------------------------
5460 * Interpreter related functions
5461 * ---------------------------------------------------------------------------*/
5463 Jim_Interp *Jim_CreateInterp(void)
5465 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5467 memset(i, 0, sizeof(*i));
5469 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5470 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5471 i->lastCollectTime = time(NULL);
5473 /* Note that we can create objects only after the
5474 * interpreter liveList and freeList pointers are
5475 * initialized to NULL. */
5476 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5477 #ifdef JIM_REFERENCES
5478 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5479 #endif
5480 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5481 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5482 i->emptyObj = Jim_NewEmptyStringObj(i);
5483 i->trueObj = Jim_NewIntObj(i, 1);
5484 i->falseObj = Jim_NewIntObj(i, 0);
5485 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5486 i->errorFileNameObj = i->emptyObj;
5487 i->result = i->emptyObj;
5488 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5489 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5490 i->errorProc = i->emptyObj;
5491 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5492 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5493 Jim_IncrRefCount(i->emptyObj);
5494 Jim_IncrRefCount(i->errorFileNameObj);
5495 Jim_IncrRefCount(i->result);
5496 Jim_IncrRefCount(i->stackTrace);
5497 Jim_IncrRefCount(i->unknown);
5498 Jim_IncrRefCount(i->currentScriptObj);
5499 Jim_IncrRefCount(i->nullScriptObj);
5500 Jim_IncrRefCount(i->errorProc);
5501 Jim_IncrRefCount(i->trueObj);
5502 Jim_IncrRefCount(i->falseObj);
5504 /* Initialize key variables every interpreter should contain */
5505 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5506 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5508 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5509 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5510 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5511 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5512 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5513 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5514 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5515 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5517 return i;
5520 void Jim_FreeInterp(Jim_Interp *i)
5522 Jim_CallFrame *cf, *cfx;
5524 Jim_Obj *objPtr, *nextObjPtr;
5526 /* Free the active call frames list - must be done before i->commands is destroyed */
5527 for (cf = i->framePtr; cf; cf = cfx) {
5528 cfx = cf->parent;
5529 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5532 Jim_DecrRefCount(i, i->emptyObj);
5533 Jim_DecrRefCount(i, i->trueObj);
5534 Jim_DecrRefCount(i, i->falseObj);
5535 Jim_DecrRefCount(i, i->result);
5536 Jim_DecrRefCount(i, i->stackTrace);
5537 Jim_DecrRefCount(i, i->errorProc);
5538 Jim_DecrRefCount(i, i->unknown);
5539 Jim_DecrRefCount(i, i->errorFileNameObj);
5540 Jim_DecrRefCount(i, i->currentScriptObj);
5541 Jim_DecrRefCount(i, i->nullScriptObj);
5542 Jim_FreeHashTable(&i->commands);
5543 #ifdef JIM_REFERENCES
5544 Jim_FreeHashTable(&i->references);
5545 #endif
5546 Jim_FreeHashTable(&i->packages);
5547 Jim_Free(i->prngState);
5548 Jim_FreeHashTable(&i->assocData);
5550 /* Check that the live object list is empty, otherwise
5551 * there is a memory leak. */
5552 #ifdef JIM_MAINTAINER
5553 if (i->liveList != NULL) {
5554 objPtr = i->liveList;
5556 printf("\n-------------------------------------\n");
5557 printf("Objects still in the free list:\n");
5558 while (objPtr) {
5559 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5561 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5562 printf("%p (%d) %-10s: '%.20s...'\n",
5563 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5565 else {
5566 printf("%p (%d) %-10s: '%s'\n",
5567 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5569 if (objPtr->typePtr == &sourceObjType) {
5570 printf("FILE %s LINE %d\n",
5571 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5572 objPtr->internalRep.sourceValue.lineNumber);
5574 objPtr = objPtr->nextObjPtr;
5576 printf("-------------------------------------\n\n");
5577 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5579 #endif
5581 /* Free all the freed objects. */
5582 objPtr = i->freeList;
5583 while (objPtr) {
5584 nextObjPtr = objPtr->nextObjPtr;
5585 Jim_Free(objPtr);
5586 objPtr = nextObjPtr;
5589 /* Free the free call frames list */
5590 for (cf = i->freeFramesList; cf; cf = cfx) {
5591 cfx = cf->next;
5592 if (cf->vars.table)
5593 Jim_FreeHashTable(&cf->vars);
5594 Jim_Free(cf);
5597 /* Free the interpreter structure. */
5598 Jim_Free(i);
5601 /* Returns the call frame relative to the level represented by
5602 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5604 * This function accepts the 'level' argument in the form
5605 * of the commands [uplevel] and [upvar].
5607 * Returns NULL on error.
5609 * Note: for a function accepting a relative integer as level suitable
5610 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5612 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5614 long level;
5615 const char *str;
5616 Jim_CallFrame *framePtr;
5618 if (levelObjPtr) {
5619 str = Jim_String(levelObjPtr);
5620 if (str[0] == '#') {
5621 char *endptr;
5623 level = jim_strtol(str + 1, &endptr);
5624 if (str[1] == '\0' || endptr[0] != '\0') {
5625 level = -1;
5628 else {
5629 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5630 level = -1;
5632 else {
5633 /* Convert from a relative to an absolute level */
5634 level = interp->framePtr->level - level;
5638 else {
5639 str = "1"; /* Needed to format the error message. */
5640 level = interp->framePtr->level - 1;
5643 if (level == 0) {
5644 return interp->topFramePtr;
5646 if (level > 0) {
5647 /* Lookup */
5648 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5649 if (framePtr->level == level) {
5650 return framePtr;
5655 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5656 return NULL;
5659 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5660 * as a relative integer like in the [info level ?level?] command.
5662 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5664 long level;
5665 Jim_CallFrame *framePtr;
5667 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5668 if (level <= 0) {
5669 /* Convert from a relative to an absolute level */
5670 level = interp->framePtr->level + level;
5673 if (level == 0) {
5674 return interp->topFramePtr;
5677 /* Lookup */
5678 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5679 if (framePtr->level == level) {
5680 return framePtr;
5685 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5686 return NULL;
5689 static void JimResetStackTrace(Jim_Interp *interp)
5691 Jim_DecrRefCount(interp, interp->stackTrace);
5692 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5693 Jim_IncrRefCount(interp->stackTrace);
5696 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5698 int len;
5700 /* Increment reference first in case these are the same object */
5701 Jim_IncrRefCount(stackTraceObj);
5702 Jim_DecrRefCount(interp, interp->stackTrace);
5703 interp->stackTrace = stackTraceObj;
5704 interp->errorFlag = 1;
5706 /* This is a bit ugly.
5707 * If the filename of the last entry of the stack trace is empty,
5708 * the next stack level should be added.
5710 len = Jim_ListLength(interp, interp->stackTrace);
5711 if (len >= 3) {
5712 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5713 interp->addStackTrace = 1;
5718 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5719 Jim_Obj *fileNameObj, int linenr)
5721 if (strcmp(procname, "unknown") == 0) {
5722 procname = "";
5724 if (!*procname && !Jim_Length(fileNameObj)) {
5725 /* No useful info here */
5726 return;
5729 if (Jim_IsShared(interp->stackTrace)) {
5730 Jim_DecrRefCount(interp, interp->stackTrace);
5731 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5732 Jim_IncrRefCount(interp->stackTrace);
5735 /* If we have no procname but the previous element did, merge with that frame */
5736 if (!*procname && Jim_Length(fileNameObj)) {
5737 /* Just a filename. Check the previous entry */
5738 int len = Jim_ListLength(interp, interp->stackTrace);
5740 if (len >= 3) {
5741 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5742 if (Jim_Length(objPtr)) {
5743 /* Yes, the previous level had procname */
5744 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5745 if (Jim_Length(objPtr) == 0) {
5746 /* But no filename, so merge the new info with that frame */
5747 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5748 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5749 return;
5755 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5756 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5757 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5760 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5761 void *data)
5763 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5765 assocEntryPtr->delProc = delProc;
5766 assocEntryPtr->data = data;
5767 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5770 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5772 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5774 if (entryPtr != NULL) {
5775 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5776 return assocEntryPtr->data;
5778 return NULL;
5781 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5783 return Jim_DeleteHashEntry(&interp->assocData, key);
5786 int Jim_GetExitCode(Jim_Interp *interp)
5788 return interp->exitCode;
5791 /* -----------------------------------------------------------------------------
5792 * Integer object
5793 * ---------------------------------------------------------------------------*/
5794 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5795 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5797 static const Jim_ObjType intObjType = {
5798 "int",
5799 NULL,
5800 NULL,
5801 UpdateStringOfInt,
5802 JIM_TYPE_NONE,
5805 /* A coerced double is closer to an int than a double.
5806 * It is an int value temporarily masquerading as a double value.
5807 * i.e. it has the same string value as an int and Jim_GetWide()
5808 * succeeds, but also Jim_GetDouble() returns the value directly.
5810 static const Jim_ObjType coercedDoubleObjType = {
5811 "coerced-double",
5812 NULL,
5813 NULL,
5814 UpdateStringOfInt,
5815 JIM_TYPE_NONE,
5819 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5821 char buf[JIM_INTEGER_SPACE + 1];
5822 jim_wide wideValue = JimWideValue(objPtr);
5823 int pos = 0;
5825 if (wideValue == 0) {
5826 buf[pos++] = '0';
5828 else {
5829 char tmp[JIM_INTEGER_SPACE];
5830 int num = 0;
5831 int i;
5833 if (wideValue < 0) {
5834 buf[pos++] = '-';
5835 i = wideValue % 10;
5836 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5837 * whereas C99 is always -6
5838 * coverity[dead_error_line]
5840 tmp[num++] = (i > 0) ? (10 - i) : -i;
5841 wideValue /= -10;
5844 while (wideValue) {
5845 tmp[num++] = wideValue % 10;
5846 wideValue /= 10;
5849 for (i = 0; i < num; i++) {
5850 buf[pos++] = '0' + tmp[num - i - 1];
5853 buf[pos] = 0;
5855 JimSetStringBytes(objPtr, buf);
5858 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5860 jim_wide wideValue;
5861 const char *str;
5863 if (objPtr->typePtr == &coercedDoubleObjType) {
5864 /* Simple switch */
5865 objPtr->typePtr = &intObjType;
5866 return JIM_OK;
5869 /* Get the string representation */
5870 str = Jim_String(objPtr);
5871 /* Try to convert into a jim_wide */
5872 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5873 if (flags & JIM_ERRMSG) {
5874 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5876 return JIM_ERR;
5878 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5879 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5880 return JIM_ERR;
5882 /* Free the old internal repr and set the new one. */
5883 Jim_FreeIntRep(interp, objPtr);
5884 objPtr->typePtr = &intObjType;
5885 objPtr->internalRep.wideValue = wideValue;
5886 return JIM_OK;
5889 #ifdef JIM_OPTIMIZATION
5890 static int JimIsWide(Jim_Obj *objPtr)
5892 return objPtr->typePtr == &intObjType;
5894 #endif
5896 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5898 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5899 return JIM_ERR;
5900 *widePtr = JimWideValue(objPtr);
5901 return JIM_OK;
5904 /* Get a wide but does not set an error if the format is bad. */
5905 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5907 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5908 return JIM_ERR;
5909 *widePtr = JimWideValue(objPtr);
5910 return JIM_OK;
5913 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5915 jim_wide wideValue;
5916 int retval;
5918 retval = Jim_GetWide(interp, objPtr, &wideValue);
5919 if (retval == JIM_OK) {
5920 *longPtr = (long)wideValue;
5921 return JIM_OK;
5923 return JIM_ERR;
5926 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5928 Jim_Obj *objPtr;
5930 objPtr = Jim_NewObj(interp);
5931 objPtr->typePtr = &intObjType;
5932 objPtr->bytes = NULL;
5933 objPtr->internalRep.wideValue = wideValue;
5934 return objPtr;
5937 /* -----------------------------------------------------------------------------
5938 * Double object
5939 * ---------------------------------------------------------------------------*/
5940 #define JIM_DOUBLE_SPACE 30
5942 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5943 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5945 static const Jim_ObjType doubleObjType = {
5946 "double",
5947 NULL,
5948 NULL,
5949 UpdateStringOfDouble,
5950 JIM_TYPE_NONE,
5953 #ifndef HAVE_ISNAN
5954 #undef isnan
5955 #define isnan(X) ((X) != (X))
5956 #endif
5957 #ifndef HAVE_ISINF
5958 #undef isinf
5959 #define isinf(X) (1.0 / (X) == 0.0)
5960 #endif
5962 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5964 double value = objPtr->internalRep.doubleValue;
5966 if (isnan(value)) {
5967 JimSetStringBytes(objPtr, "NaN");
5968 return;
5970 if (isinf(value)) {
5971 if (value < 0) {
5972 JimSetStringBytes(objPtr, "-Inf");
5974 else {
5975 JimSetStringBytes(objPtr, "Inf");
5977 return;
5980 char buf[JIM_DOUBLE_SPACE + 1];
5981 int i;
5982 int len = sprintf(buf, "%.12g", value);
5984 /* Add a final ".0" if necessary */
5985 for (i = 0; i < len; i++) {
5986 if (buf[i] == '.' || buf[i] == 'e') {
5987 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5988 /* If 'buf' ends in e-0nn or e+0nn, remove
5989 * the 0 after the + or - and reduce the length by 1
5991 char *e = strchr(buf, 'e');
5992 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5993 /* Move it up */
5994 e += 2;
5995 memmove(e, e + 1, len - (e - buf));
5997 #endif
5998 break;
6001 if (buf[i] == '\0') {
6002 buf[i++] = '.';
6003 buf[i++] = '0';
6004 buf[i] = '\0';
6006 JimSetStringBytes(objPtr, buf);
6010 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6012 double doubleValue;
6013 jim_wide wideValue;
6014 const char *str;
6016 /* Preserve the string representation.
6017 * Needed so we can convert back to int without loss
6019 str = Jim_String(objPtr);
6021 #ifdef HAVE_LONG_LONG
6022 /* Assume a 53 bit mantissa */
6023 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6024 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6026 if (objPtr->typePtr == &intObjType
6027 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6028 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6030 /* Direct conversion to coerced double */
6031 objPtr->typePtr = &coercedDoubleObjType;
6032 return JIM_OK;
6034 else
6035 #endif
6036 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6037 /* Managed to convert to an int, so we can use this as a cooerced double */
6038 Jim_FreeIntRep(interp, objPtr);
6039 objPtr->typePtr = &coercedDoubleObjType;
6040 objPtr->internalRep.wideValue = wideValue;
6041 return JIM_OK;
6043 else {
6044 /* Try to convert into a double */
6045 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6046 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6047 return JIM_ERR;
6049 /* Free the old internal repr and set the new one. */
6050 Jim_FreeIntRep(interp, objPtr);
6052 objPtr->typePtr = &doubleObjType;
6053 objPtr->internalRep.doubleValue = doubleValue;
6054 return JIM_OK;
6057 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6059 if (objPtr->typePtr == &coercedDoubleObjType) {
6060 *doublePtr = JimWideValue(objPtr);
6061 return JIM_OK;
6063 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6064 return JIM_ERR;
6066 if (objPtr->typePtr == &coercedDoubleObjType) {
6067 *doublePtr = JimWideValue(objPtr);
6069 else {
6070 *doublePtr = objPtr->internalRep.doubleValue;
6072 return JIM_OK;
6075 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6077 Jim_Obj *objPtr;
6079 objPtr = Jim_NewObj(interp);
6080 objPtr->typePtr = &doubleObjType;
6081 objPtr->bytes = NULL;
6082 objPtr->internalRep.doubleValue = doubleValue;
6083 return objPtr;
6086 /* -----------------------------------------------------------------------------
6087 * Boolean conversion
6088 * ---------------------------------------------------------------------------*/
6089 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6091 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6093 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6094 return JIM_ERR;
6095 *booleanPtr = (int) JimWideValue(objPtr);
6096 return JIM_OK;
6099 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6101 static const char * const falses[] = {
6102 "0", "false", "no", "off", NULL
6104 static const char * const trues[] = {
6105 "1", "true", "yes", "on", NULL
6108 int boolean;
6110 int index;
6111 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6112 boolean = 0;
6113 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6114 boolean = 1;
6115 } else {
6116 if (flags & JIM_ERRMSG) {
6117 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6119 return JIM_ERR;
6122 /* Free the old internal repr and set the new one. */
6123 Jim_FreeIntRep(interp, objPtr);
6124 objPtr->typePtr = &intObjType;
6125 objPtr->internalRep.wideValue = boolean;
6126 return JIM_OK;
6129 /* -----------------------------------------------------------------------------
6130 * List object
6131 * ---------------------------------------------------------------------------*/
6132 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6133 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6134 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6135 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6136 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6137 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6139 /* Note that while the elements of the list may contain references,
6140 * the list object itself can't. This basically means that the
6141 * list object string representation as a whole can't contain references
6142 * that are not presents in the single elements. */
6143 static const Jim_ObjType listObjType = {
6144 "list",
6145 FreeListInternalRep,
6146 DupListInternalRep,
6147 UpdateStringOfList,
6148 JIM_TYPE_NONE,
6151 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6153 int i;
6155 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6156 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6158 Jim_Free(objPtr->internalRep.listValue.ele);
6161 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6163 int i;
6165 JIM_NOTUSED(interp);
6167 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6168 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6169 dupPtr->internalRep.listValue.ele =
6170 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6171 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6172 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6173 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6174 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6176 dupPtr->typePtr = &listObjType;
6179 /* The following function checks if a given string can be encoded
6180 * into a list element without any kind of quoting, surrounded by braces,
6181 * or using escapes to quote. */
6182 #define JIM_ELESTR_SIMPLE 0
6183 #define JIM_ELESTR_BRACE 1
6184 #define JIM_ELESTR_QUOTE 2
6185 static unsigned char ListElementQuotingType(const char *s, int len)
6187 int i, level, blevel, trySimple = 1;
6189 /* Try with the SIMPLE case */
6190 if (len == 0)
6191 return JIM_ELESTR_BRACE;
6192 if (s[0] == '"' || s[0] == '{') {
6193 trySimple = 0;
6194 goto testbrace;
6196 for (i = 0; i < len; i++) {
6197 switch (s[i]) {
6198 case ' ':
6199 case '$':
6200 case '"':
6201 case '[':
6202 case ']':
6203 case ';':
6204 case '\\':
6205 case '\r':
6206 case '\n':
6207 case '\t':
6208 case '\f':
6209 case '\v':
6210 trySimple = 0;
6211 /* fall through */
6212 case '{':
6213 case '}':
6214 goto testbrace;
6217 return JIM_ELESTR_SIMPLE;
6219 testbrace:
6220 /* Test if it's possible to do with braces */
6221 if (s[len - 1] == '\\')
6222 return JIM_ELESTR_QUOTE;
6223 level = 0;
6224 blevel = 0;
6225 for (i = 0; i < len; i++) {
6226 switch (s[i]) {
6227 case '{':
6228 level++;
6229 break;
6230 case '}':
6231 level--;
6232 if (level < 0)
6233 return JIM_ELESTR_QUOTE;
6234 break;
6235 case '[':
6236 blevel++;
6237 break;
6238 case ']':
6239 blevel--;
6240 break;
6241 case '\\':
6242 if (s[i + 1] == '\n')
6243 return JIM_ELESTR_QUOTE;
6244 else if (s[i + 1] != '\0')
6245 i++;
6246 break;
6249 if (blevel < 0) {
6250 return JIM_ELESTR_QUOTE;
6253 if (level == 0) {
6254 if (!trySimple)
6255 return JIM_ELESTR_BRACE;
6256 for (i = 0; i < len; i++) {
6257 switch (s[i]) {
6258 case ' ':
6259 case '$':
6260 case '"':
6261 case '[':
6262 case ']':
6263 case ';':
6264 case '\\':
6265 case '\r':
6266 case '\n':
6267 case '\t':
6268 case '\f':
6269 case '\v':
6270 return JIM_ELESTR_BRACE;
6271 break;
6274 return JIM_ELESTR_SIMPLE;
6276 return JIM_ELESTR_QUOTE;
6279 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6280 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6281 * scenario.
6282 * Returns the length of the result.
6284 static int BackslashQuoteString(const char *s, int len, char *q)
6286 char *p = q;
6288 while (len--) {
6289 switch (*s) {
6290 case ' ':
6291 case '$':
6292 case '"':
6293 case '[':
6294 case ']':
6295 case '{':
6296 case '}':
6297 case ';':
6298 case '\\':
6299 *p++ = '\\';
6300 *p++ = *s++;
6301 break;
6302 case '\n':
6303 *p++ = '\\';
6304 *p++ = 'n';
6305 s++;
6306 break;
6307 case '\r':
6308 *p++ = '\\';
6309 *p++ = 'r';
6310 s++;
6311 break;
6312 case '\t':
6313 *p++ = '\\';
6314 *p++ = 't';
6315 s++;
6316 break;
6317 case '\f':
6318 *p++ = '\\';
6319 *p++ = 'f';
6320 s++;
6321 break;
6322 case '\v':
6323 *p++ = '\\';
6324 *p++ = 'v';
6325 s++;
6326 break;
6327 default:
6328 *p++ = *s++;
6329 break;
6332 *p = '\0';
6334 return p - q;
6337 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6339 #define STATIC_QUOTING_LEN 32
6340 int i, bufLen, realLength;
6341 const char *strRep;
6342 char *p;
6343 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6345 /* Estimate the space needed. */
6346 if (objc > STATIC_QUOTING_LEN) {
6347 quotingType = Jim_Alloc(objc);
6349 else {
6350 quotingType = staticQuoting;
6352 bufLen = 0;
6353 for (i = 0; i < objc; i++) {
6354 int len;
6356 strRep = Jim_GetString(objv[i], &len);
6357 quotingType[i] = ListElementQuotingType(strRep, len);
6358 switch (quotingType[i]) {
6359 case JIM_ELESTR_SIMPLE:
6360 if (i != 0 || strRep[0] != '#') {
6361 bufLen += len;
6362 break;
6364 /* Special case '#' on first element needs braces */
6365 quotingType[i] = JIM_ELESTR_BRACE;
6366 /* fall through */
6367 case JIM_ELESTR_BRACE:
6368 bufLen += len + 2;
6369 break;
6370 case JIM_ELESTR_QUOTE:
6371 bufLen += len * 2;
6372 break;
6374 bufLen++; /* elements separator. */
6376 bufLen++;
6378 /* Generate the string rep. */
6379 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6380 realLength = 0;
6381 for (i = 0; i < objc; i++) {
6382 int len, qlen;
6384 strRep = Jim_GetString(objv[i], &len);
6386 switch (quotingType[i]) {
6387 case JIM_ELESTR_SIMPLE:
6388 memcpy(p, strRep, len);
6389 p += len;
6390 realLength += len;
6391 break;
6392 case JIM_ELESTR_BRACE:
6393 *p++ = '{';
6394 memcpy(p, strRep, len);
6395 p += len;
6396 *p++ = '}';
6397 realLength += len + 2;
6398 break;
6399 case JIM_ELESTR_QUOTE:
6400 if (i == 0 && strRep[0] == '#') {
6401 *p++ = '\\';
6402 realLength++;
6404 qlen = BackslashQuoteString(strRep, len, p);
6405 p += qlen;
6406 realLength += qlen;
6407 break;
6409 /* Add a separating space */
6410 if (i + 1 != objc) {
6411 *p++ = ' ';
6412 realLength++;
6415 *p = '\0'; /* nul term. */
6416 objPtr->length = realLength;
6418 if (quotingType != staticQuoting) {
6419 Jim_Free(quotingType);
6423 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6425 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6428 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6430 struct JimParserCtx parser;
6431 const char *str;
6432 int strLen;
6433 Jim_Obj *fileNameObj;
6434 int linenr;
6436 if (objPtr->typePtr == &listObjType) {
6437 return JIM_OK;
6440 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6441 * it also preserves any source location of the dict elements
6442 * which can be very useful
6444 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6445 Jim_Obj **listObjPtrPtr;
6446 int len;
6447 int i;
6449 listObjPtrPtr = JimDictPairs(objPtr, &len);
6450 for (i = 0; i < len; i++) {
6451 Jim_IncrRefCount(listObjPtrPtr[i]);
6454 /* Now just switch the internal rep */
6455 Jim_FreeIntRep(interp, objPtr);
6456 objPtr->typePtr = &listObjType;
6457 objPtr->internalRep.listValue.len = len;
6458 objPtr->internalRep.listValue.maxLen = len;
6459 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6461 return JIM_OK;
6464 /* Try to preserve information about filename / line number */
6465 if (objPtr->typePtr == &sourceObjType) {
6466 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6467 linenr = objPtr->internalRep.sourceValue.lineNumber;
6469 else {
6470 fileNameObj = interp->emptyObj;
6471 linenr = 1;
6473 Jim_IncrRefCount(fileNameObj);
6475 /* Get the string representation */
6476 str = Jim_GetString(objPtr, &strLen);
6478 /* Free the old internal repr just now and initialize the
6479 * new one just now. The string->list conversion can't fail. */
6480 Jim_FreeIntRep(interp, objPtr);
6481 objPtr->typePtr = &listObjType;
6482 objPtr->internalRep.listValue.len = 0;
6483 objPtr->internalRep.listValue.maxLen = 0;
6484 objPtr->internalRep.listValue.ele = NULL;
6486 /* Convert into a list */
6487 if (strLen) {
6488 JimParserInit(&parser, str, strLen, linenr);
6489 while (!parser.eof) {
6490 Jim_Obj *elementPtr;
6492 JimParseList(&parser);
6493 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6494 continue;
6495 elementPtr = JimParserGetTokenObj(interp, &parser);
6496 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6497 ListAppendElement(objPtr, elementPtr);
6500 Jim_DecrRefCount(interp, fileNameObj);
6501 return JIM_OK;
6504 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6506 Jim_Obj *objPtr;
6508 objPtr = Jim_NewObj(interp);
6509 objPtr->typePtr = &listObjType;
6510 objPtr->bytes = NULL;
6511 objPtr->internalRep.listValue.ele = NULL;
6512 objPtr->internalRep.listValue.len = 0;
6513 objPtr->internalRep.listValue.maxLen = 0;
6515 if (len) {
6516 ListInsertElements(objPtr, 0, len, elements);
6519 return objPtr;
6522 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6523 * length of the vector. Note that the user of this function should make
6524 * sure that the list object can't shimmer while the vector returned
6525 * is in use, this vector is the one stored inside the internal representation
6526 * of the list object. This function is not exported, extensions should
6527 * always access to the List object elements using Jim_ListIndex(). */
6528 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6529 Jim_Obj ***listVec)
6531 *listLen = Jim_ListLength(interp, listObj);
6532 *listVec = listObj->internalRep.listValue.ele;
6535 /* Sorting uses ints, but commands may return wide */
6536 static int JimSign(jim_wide w)
6538 if (w == 0) {
6539 return 0;
6541 else if (w < 0) {
6542 return -1;
6544 return 1;
6547 /* ListSortElements type values */
6548 struct lsort_info {
6549 jmp_buf jmpbuf;
6550 Jim_Obj *command;
6551 Jim_Interp *interp;
6552 enum {
6553 JIM_LSORT_ASCII,
6554 JIM_LSORT_NOCASE,
6555 JIM_LSORT_INTEGER,
6556 JIM_LSORT_REAL,
6557 JIM_LSORT_COMMAND
6558 } type;
6559 int order;
6560 int index;
6561 int indexed;
6562 int unique;
6563 int (*subfn)(Jim_Obj **, Jim_Obj **);
6566 static struct lsort_info *sort_info;
6568 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6570 Jim_Obj *lObj, *rObj;
6572 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6573 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6574 longjmp(sort_info->jmpbuf, JIM_ERR);
6576 return sort_info->subfn(&lObj, &rObj);
6579 /* Sort the internal rep of a list. */
6580 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6582 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6585 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6587 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6590 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6592 jim_wide lhs = 0, rhs = 0;
6594 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6595 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6596 longjmp(sort_info->jmpbuf, JIM_ERR);
6599 return JimSign(lhs - rhs) * sort_info->order;
6602 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6604 double lhs = 0, rhs = 0;
6606 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6607 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6608 longjmp(sort_info->jmpbuf, JIM_ERR);
6610 if (lhs == rhs) {
6611 return 0;
6613 if (lhs > rhs) {
6614 return sort_info->order;
6616 return -sort_info->order;
6619 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6621 Jim_Obj *compare_script;
6622 int rc;
6624 jim_wide ret = 0;
6626 /* This must be a valid list */
6627 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6628 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6629 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6631 rc = Jim_EvalObj(sort_info->interp, compare_script);
6633 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6634 longjmp(sort_info->jmpbuf, rc);
6637 return JimSign(ret) * sort_info->order;
6640 /* Remove duplicate elements from the (sorted) list in-place, according to the
6641 * comparison function, comp.
6643 * Note that the last unique value is kept, not the first
6645 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6647 int src;
6648 int dst = 0;
6649 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6651 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6652 if (comp(&ele[dst], &ele[src]) == 0) {
6653 /* Match, so replace the dest with the current source */
6654 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6656 else {
6657 /* No match, so keep the current source and move to the next destination */
6658 dst++;
6660 ele[dst] = ele[src];
6662 /* At end of list, keep the final element */
6663 ele[++dst] = ele[src];
6665 /* Set the new length */
6666 listObjPtr->internalRep.listValue.len = dst;
6669 /* Sort a list *in place*. MUST be called with a non-shared list. */
6670 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6672 struct lsort_info *prev_info;
6674 typedef int (qsort_comparator) (const void *, const void *);
6675 int (*fn) (Jim_Obj **, Jim_Obj **);
6676 Jim_Obj **vector;
6677 int len;
6678 int rc;
6680 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6681 SetListFromAny(interp, listObjPtr);
6683 /* Allow lsort to be called reentrantly */
6684 prev_info = sort_info;
6685 sort_info = info;
6687 vector = listObjPtr->internalRep.listValue.ele;
6688 len = listObjPtr->internalRep.listValue.len;
6689 switch (info->type) {
6690 case JIM_LSORT_ASCII:
6691 fn = ListSortString;
6692 break;
6693 case JIM_LSORT_NOCASE:
6694 fn = ListSortStringNoCase;
6695 break;
6696 case JIM_LSORT_INTEGER:
6697 fn = ListSortInteger;
6698 break;
6699 case JIM_LSORT_REAL:
6700 fn = ListSortReal;
6701 break;
6702 case JIM_LSORT_COMMAND:
6703 fn = ListSortCommand;
6704 break;
6705 default:
6706 fn = NULL; /* avoid warning */
6707 JimPanic((1, "ListSort called with invalid sort type"));
6708 return -1; /* Should not be run but keeps static analysers happy */
6711 if (info->indexed) {
6712 /* Need to interpose a "list index" function */
6713 info->subfn = fn;
6714 fn = ListSortIndexHelper;
6717 if ((rc = setjmp(info->jmpbuf)) == 0) {
6718 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6720 if (info->unique && len > 1) {
6721 ListRemoveDuplicates(listObjPtr, fn);
6724 Jim_InvalidateStringRep(listObjPtr);
6726 sort_info = prev_info;
6728 return rc;
6731 /* This is the low-level function to insert elements into a list.
6732 * The higher-level Jim_ListInsertElements() performs shared object
6733 * check and invalidates the string repr. This version is used
6734 * in the internals of the List Object and is not exported.
6736 * NOTE: this function can be called only against objects
6737 * with internal type of List.
6739 * An insertion point (idx) of -1 means end-of-list.
6741 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6743 int currentLen = listPtr->internalRep.listValue.len;
6744 int requiredLen = currentLen + elemc;
6745 int i;
6746 Jim_Obj **point;
6748 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6749 if (requiredLen < 2) {
6750 /* Don't do allocations of under 4 pointers. */
6751 requiredLen = 4;
6753 else {
6754 requiredLen *= 2;
6757 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6758 sizeof(Jim_Obj *) * requiredLen);
6760 listPtr->internalRep.listValue.maxLen = requiredLen;
6762 if (idx < 0) {
6763 idx = currentLen;
6765 point = listPtr->internalRep.listValue.ele + idx;
6766 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6767 for (i = 0; i < elemc; ++i) {
6768 point[i] = elemVec[i];
6769 Jim_IncrRefCount(point[i]);
6771 listPtr->internalRep.listValue.len += elemc;
6774 /* Convenience call to ListInsertElements() to append a single element.
6776 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6778 ListInsertElements(listPtr, -1, 1, &objPtr);
6781 /* Appends every element of appendListPtr into listPtr.
6782 * Both have to be of the list type.
6783 * Convenience call to ListInsertElements()
6785 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6787 ListInsertElements(listPtr, -1,
6788 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6791 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6793 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6794 SetListFromAny(interp, listPtr);
6795 Jim_InvalidateStringRep(listPtr);
6796 ListAppendElement(listPtr, objPtr);
6799 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6801 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6802 SetListFromAny(interp, listPtr);
6803 SetListFromAny(interp, appendListPtr);
6804 Jim_InvalidateStringRep(listPtr);
6805 ListAppendList(listPtr, appendListPtr);
6808 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6810 SetListFromAny(interp, objPtr);
6811 return objPtr->internalRep.listValue.len;
6814 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6815 int objc, Jim_Obj *const *objVec)
6817 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6818 SetListFromAny(interp, listPtr);
6819 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6820 idx = listPtr->internalRep.listValue.len;
6821 else if (idx < 0)
6822 idx = 0;
6823 Jim_InvalidateStringRep(listPtr);
6824 ListInsertElements(listPtr, idx, objc, objVec);
6827 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6829 SetListFromAny(interp, listPtr);
6830 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6831 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6832 return NULL;
6834 if (idx < 0)
6835 idx = listPtr->internalRep.listValue.len + idx;
6836 return listPtr->internalRep.listValue.ele[idx];
6839 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6841 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6842 if (*objPtrPtr == NULL) {
6843 if (flags & JIM_ERRMSG) {
6844 Jim_SetResultString(interp, "list index out of range", -1);
6846 return JIM_ERR;
6848 return JIM_OK;
6851 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6852 Jim_Obj *newObjPtr, int flags)
6854 SetListFromAny(interp, listPtr);
6855 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6856 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6857 if (flags & JIM_ERRMSG) {
6858 Jim_SetResultString(interp, "list index out of range", -1);
6860 return JIM_ERR;
6862 if (idx < 0)
6863 idx = listPtr->internalRep.listValue.len + idx;
6864 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6865 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6866 Jim_IncrRefCount(newObjPtr);
6867 return JIM_OK;
6870 /* Modify the list stored in the variable named 'varNamePtr'
6871 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6872 * with the new element 'newObjptr'. (implements the [lset] command) */
6873 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6874 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6876 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6877 int shared, i, idx;
6879 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6880 if (objPtr == NULL)
6881 return JIM_ERR;
6882 if ((shared = Jim_IsShared(objPtr)))
6883 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6884 for (i = 0; i < indexc - 1; i++) {
6885 listObjPtr = objPtr;
6886 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6887 goto err;
6888 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6889 goto err;
6891 if (Jim_IsShared(objPtr)) {
6892 objPtr = Jim_DuplicateObj(interp, objPtr);
6893 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6895 Jim_InvalidateStringRep(listObjPtr);
6897 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6898 goto err;
6899 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6900 goto err;
6901 Jim_InvalidateStringRep(objPtr);
6902 Jim_InvalidateStringRep(varObjPtr);
6903 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6904 goto err;
6905 Jim_SetResult(interp, varObjPtr);
6906 return JIM_OK;
6907 err:
6908 if (shared) {
6909 Jim_FreeNewObj(interp, varObjPtr);
6911 return JIM_ERR;
6914 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6916 int i;
6917 int listLen = Jim_ListLength(interp, listObjPtr);
6918 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6920 for (i = 0; i < listLen; ) {
6921 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6922 if (++i != listLen) {
6923 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6926 return resObjPtr;
6929 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6931 int i;
6933 /* If all the objects in objv are lists,
6934 * it's possible to return a list as result, that's the
6935 * concatenation of all the lists. */
6936 for (i = 0; i < objc; i++) {
6937 if (!Jim_IsList(objv[i]))
6938 break;
6940 if (i == objc) {
6941 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6943 for (i = 0; i < objc; i++)
6944 ListAppendList(objPtr, objv[i]);
6945 return objPtr;
6947 else {
6948 /* Else... we have to glue strings together */
6949 int len = 0, objLen;
6950 char *bytes, *p;
6952 /* Compute the length */
6953 for (i = 0; i < objc; i++) {
6954 len += Jim_Length(objv[i]);
6956 if (objc)
6957 len += objc - 1;
6958 /* Create the string rep, and a string object holding it. */
6959 p = bytes = Jim_Alloc(len + 1);
6960 for (i = 0; i < objc; i++) {
6961 const char *s = Jim_GetString(objv[i], &objLen);
6963 /* Remove leading space */
6964 while (objLen && isspace(UCHAR(*s))) {
6965 s++;
6966 objLen--;
6967 len--;
6969 /* And trailing space */
6970 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6971 /* Handle trailing backslash-space case */
6972 if (objLen > 1 && s[objLen - 2] == '\\') {
6973 break;
6975 objLen--;
6976 len--;
6978 memcpy(p, s, objLen);
6979 p += objLen;
6980 if (i + 1 != objc) {
6981 if (objLen)
6982 *p++ = ' ';
6983 else {
6984 /* Drop the space calculated for this
6985 * element that is instead null. */
6986 len--;
6990 *p = '\0';
6991 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6995 /* Returns a list composed of the elements in the specified range.
6996 * first and start are directly accepted as Jim_Objects and
6997 * processed for the end?-index? case. */
6998 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6999 Jim_Obj *lastObjPtr)
7001 int first, last;
7002 int len, rangeLen;
7004 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7005 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7006 return NULL;
7007 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7008 first = JimRelToAbsIndex(len, first);
7009 last = JimRelToAbsIndex(len, last);
7010 JimRelToAbsRange(len, &first, &last, &rangeLen);
7011 if (first == 0 && last == len) {
7012 return listObjPtr;
7014 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7017 /* -----------------------------------------------------------------------------
7018 * Dict object
7019 * ---------------------------------------------------------------------------*/
7020 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7021 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7022 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7023 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7025 /* Dict HashTable Type.
7027 * Keys and Values are Jim objects. */
7029 static unsigned int JimObjectHTHashFunction(const void *key)
7031 int len;
7032 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7033 return Jim_GenHashFunction((const unsigned char *)str, len);
7036 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7038 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7041 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7043 Jim_IncrRefCount((Jim_Obj *)val);
7044 return (void *)val;
7047 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7049 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7052 static const Jim_HashTableType JimDictHashTableType = {
7053 JimObjectHTHashFunction, /* hash function */
7054 JimObjectHTKeyValDup, /* key dup */
7055 JimObjectHTKeyValDup, /* val dup */
7056 JimObjectHTKeyCompare, /* key compare */
7057 JimObjectHTKeyValDestructor, /* key destructor */
7058 JimObjectHTKeyValDestructor /* val destructor */
7061 /* Note that while the elements of the dict may contain references,
7062 * the list object itself can't. This basically means that the
7063 * dict object string representation as a whole can't contain references
7064 * that are not presents in the single elements. */
7065 static const Jim_ObjType dictObjType = {
7066 "dict",
7067 FreeDictInternalRep,
7068 DupDictInternalRep,
7069 UpdateStringOfDict,
7070 JIM_TYPE_NONE,
7073 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7075 JIM_NOTUSED(interp);
7077 Jim_FreeHashTable(objPtr->internalRep.ptr);
7078 Jim_Free(objPtr->internalRep.ptr);
7081 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7083 Jim_HashTable *ht, *dupHt;
7084 Jim_HashTableIterator htiter;
7085 Jim_HashEntry *he;
7087 /* Create a new hash table */
7088 ht = srcPtr->internalRep.ptr;
7089 dupHt = Jim_Alloc(sizeof(*dupHt));
7090 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7091 if (ht->size != 0)
7092 Jim_ExpandHashTable(dupHt, ht->size);
7093 /* Copy every element from the source to the dup hash table */
7094 JimInitHashTableIterator(ht, &htiter);
7095 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7096 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7099 dupPtr->internalRep.ptr = dupHt;
7100 dupPtr->typePtr = &dictObjType;
7103 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7105 Jim_HashTable *ht;
7106 Jim_HashTableIterator htiter;
7107 Jim_HashEntry *he;
7108 Jim_Obj **objv;
7109 int i;
7111 ht = dictPtr->internalRep.ptr;
7113 /* Turn the hash table into a flat vector of Jim_Objects. */
7114 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7115 JimInitHashTableIterator(ht, &htiter);
7116 i = 0;
7117 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7118 objv[i++] = Jim_GetHashEntryKey(he);
7119 objv[i++] = Jim_GetHashEntryVal(he);
7121 *len = i;
7122 return objv;
7125 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7127 /* Turn the hash table into a flat vector of Jim_Objects. */
7128 int len;
7129 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7131 /* And now generate the string rep as a list */
7132 JimMakeListStringRep(objPtr, objv, len);
7134 Jim_Free(objv);
7137 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7139 int listlen;
7141 if (objPtr->typePtr == &dictObjType) {
7142 return JIM_OK;
7145 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7146 /* A shared list, so get the string representation now to avoid
7147 * changing the order in case of fast conversion to dict.
7149 Jim_String(objPtr);
7152 /* For simplicity, convert a non-list object to a list and then to a dict */
7153 listlen = Jim_ListLength(interp, objPtr);
7154 if (listlen % 2) {
7155 Jim_SetResultString(interp, "missing value to go with key", -1);
7156 return JIM_ERR;
7158 else {
7159 /* Converting from a list to a dict can't fail */
7160 Jim_HashTable *ht;
7161 int i;
7163 ht = Jim_Alloc(sizeof(*ht));
7164 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7166 for (i = 0; i < listlen; i += 2) {
7167 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7168 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7170 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7173 Jim_FreeIntRep(interp, objPtr);
7174 objPtr->typePtr = &dictObjType;
7175 objPtr->internalRep.ptr = ht;
7177 return JIM_OK;
7181 /* Dict object API */
7183 /* Add an element to a dict. objPtr must be of the "dict" type.
7184 * The higher-level exported function is Jim_DictAddElement().
7185 * If an element with the specified key already exists, the value
7186 * associated is replaced with the new one.
7188 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7189 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7190 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7192 Jim_HashTable *ht = objPtr->internalRep.ptr;
7194 if (valueObjPtr == NULL) { /* unset */
7195 return Jim_DeleteHashEntry(ht, keyObjPtr);
7197 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7198 return JIM_OK;
7201 /* Add an element, higher-level interface for DictAddElement().
7202 * If valueObjPtr == NULL, the key is removed if it exists. */
7203 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7204 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7206 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7207 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7208 return JIM_ERR;
7210 Jim_InvalidateStringRep(objPtr);
7211 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7214 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7216 Jim_Obj *objPtr;
7217 int i;
7219 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7221 objPtr = Jim_NewObj(interp);
7222 objPtr->typePtr = &dictObjType;
7223 objPtr->bytes = NULL;
7224 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7225 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7226 for (i = 0; i < len; i += 2)
7227 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7228 return objPtr;
7231 /* Return the value associated to the specified dict key
7232 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7234 * Sets *objPtrPtr to non-NULL only upon success.
7236 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7237 Jim_Obj **objPtrPtr, int flags)
7239 Jim_HashEntry *he;
7240 Jim_HashTable *ht;
7242 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7243 return -1;
7245 ht = dictPtr->internalRep.ptr;
7246 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7247 if (flags & JIM_ERRMSG) {
7248 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7250 return JIM_ERR;
7252 *objPtrPtr = he->u.val;
7253 return JIM_OK;
7256 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7257 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7259 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7260 return JIM_ERR;
7262 *objPtrPtr = JimDictPairs(dictPtr, len);
7264 return JIM_OK;
7268 /* Return the value associated to the specified dict keys */
7269 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7270 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7272 int i;
7274 if (keyc == 0) {
7275 *objPtrPtr = dictPtr;
7276 return JIM_OK;
7279 for (i = 0; i < keyc; i++) {
7280 Jim_Obj *objPtr;
7282 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7283 if (rc != JIM_OK) {
7284 return rc;
7286 dictPtr = objPtr;
7288 *objPtrPtr = dictPtr;
7289 return JIM_OK;
7292 /* Modify the dict stored into the variable named 'varNamePtr'
7293 * setting the element specified by the 'keyc' keys objects in 'keyv',
7294 * with the new value of the element 'newObjPtr'.
7296 * If newObjPtr == NULL the operation is to remove the given key
7297 * from the dictionary.
7299 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7300 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7302 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7303 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7305 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7306 int shared, i;
7308 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7309 if (objPtr == NULL) {
7310 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7311 /* Cannot remove a key from non existing var */
7312 return JIM_ERR;
7314 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7315 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7316 Jim_FreeNewObj(interp, varObjPtr);
7317 return JIM_ERR;
7320 if ((shared = Jim_IsShared(objPtr)))
7321 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7322 for (i = 0; i < keyc; i++) {
7323 dictObjPtr = objPtr;
7325 /* Check if it's a valid dictionary */
7326 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7327 goto err;
7330 if (i == keyc - 1) {
7331 /* Last key: Note that error on unset with missing last key is OK */
7332 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7333 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7334 goto err;
7337 break;
7340 /* Check if the given key exists. */
7341 Jim_InvalidateStringRep(dictObjPtr);
7342 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7343 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7344 /* This key exists at the current level.
7345 * Make sure it's not shared!. */
7346 if (Jim_IsShared(objPtr)) {
7347 objPtr = Jim_DuplicateObj(interp, objPtr);
7348 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7351 else {
7352 /* Key not found. If it's an [unset] operation
7353 * this is an error. Only the last key may not
7354 * exist. */
7355 if (newObjPtr == NULL) {
7356 goto err;
7358 /* Otherwise set an empty dictionary
7359 * as key's value. */
7360 objPtr = Jim_NewDictObj(interp, NULL, 0);
7361 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7364 /* XXX: Is this necessary? */
7365 Jim_InvalidateStringRep(objPtr);
7366 Jim_InvalidateStringRep(varObjPtr);
7367 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7368 goto err;
7370 Jim_SetResult(interp, varObjPtr);
7371 return JIM_OK;
7372 err:
7373 if (shared) {
7374 Jim_FreeNewObj(interp, varObjPtr);
7376 return JIM_ERR;
7379 /* -----------------------------------------------------------------------------
7380 * Index object
7381 * ---------------------------------------------------------------------------*/
7382 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7383 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7385 static const Jim_ObjType indexObjType = {
7386 "index",
7387 NULL,
7388 NULL,
7389 UpdateStringOfIndex,
7390 JIM_TYPE_NONE,
7393 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7395 if (objPtr->internalRep.intValue == -1) {
7396 JimSetStringBytes(objPtr, "end");
7398 else {
7399 char buf[JIM_INTEGER_SPACE + 1];
7400 if (objPtr->internalRep.intValue >= 0) {
7401 sprintf(buf, "%d", objPtr->internalRep.intValue);
7403 else {
7404 /* Must be <= -2 */
7405 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7407 JimSetStringBytes(objPtr, buf);
7411 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7413 int idx, end = 0;
7414 const char *str;
7415 char *endptr;
7417 /* Get the string representation */
7418 str = Jim_String(objPtr);
7420 /* Try to convert into an index */
7421 if (strncmp(str, "end", 3) == 0) {
7422 end = 1;
7423 str += 3;
7424 idx = 0;
7426 else {
7427 idx = jim_strtol(str, &endptr);
7429 if (endptr == str) {
7430 goto badindex;
7432 str = endptr;
7435 /* Now str may include or +<num> or -<num> */
7436 if (*str == '+' || *str == '-') {
7437 int sign = (*str == '+' ? 1 : -1);
7439 idx += sign * jim_strtol(++str, &endptr);
7440 if (str == endptr || *endptr) {
7441 goto badindex;
7443 str = endptr;
7445 /* The only thing left should be spaces */
7446 while (isspace(UCHAR(*str))) {
7447 str++;
7449 if (*str) {
7450 goto badindex;
7452 if (end) {
7453 if (idx > 0) {
7454 idx = INT_MAX;
7456 else {
7457 /* end-1 is repesented as -2 */
7458 idx--;
7461 else if (idx < 0) {
7462 idx = -INT_MAX;
7465 /* Free the old internal repr and set the new one. */
7466 Jim_FreeIntRep(interp, objPtr);
7467 objPtr->typePtr = &indexObjType;
7468 objPtr->internalRep.intValue = idx;
7469 return JIM_OK;
7471 badindex:
7472 Jim_SetResultFormatted(interp,
7473 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7474 return JIM_ERR;
7477 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7479 /* Avoid shimmering if the object is an integer. */
7480 if (objPtr->typePtr == &intObjType) {
7481 jim_wide val = JimWideValue(objPtr);
7483 if (val < 0)
7484 *indexPtr = -INT_MAX;
7485 else if (val > INT_MAX)
7486 *indexPtr = INT_MAX;
7487 else
7488 *indexPtr = (int)val;
7489 return JIM_OK;
7491 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7492 return JIM_ERR;
7493 *indexPtr = objPtr->internalRep.intValue;
7494 return JIM_OK;
7497 /* -----------------------------------------------------------------------------
7498 * Return Code Object.
7499 * ---------------------------------------------------------------------------*/
7501 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7502 static const char * const jimReturnCodes[] = {
7503 "ok",
7504 "error",
7505 "return",
7506 "break",
7507 "continue",
7508 "signal",
7509 "exit",
7510 "eval",
7511 NULL
7514 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7516 static const Jim_ObjType returnCodeObjType = {
7517 "return-code",
7518 NULL,
7519 NULL,
7520 NULL,
7521 JIM_TYPE_NONE,
7524 /* Converts a (standard) return code to a string. Returns "?" for
7525 * non-standard return codes.
7527 const char *Jim_ReturnCode(int code)
7529 if (code < 0 || code >= (int)jimReturnCodesSize) {
7530 return "?";
7532 else {
7533 return jimReturnCodes[code];
7537 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7539 int returnCode;
7540 jim_wide wideValue;
7542 /* Try to convert into an integer */
7543 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7544 returnCode = (int)wideValue;
7545 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7546 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7547 return JIM_ERR;
7549 /* Free the old internal repr and set the new one. */
7550 Jim_FreeIntRep(interp, objPtr);
7551 objPtr->typePtr = &returnCodeObjType;
7552 objPtr->internalRep.intValue = returnCode;
7553 return JIM_OK;
7556 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7558 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7559 return JIM_ERR;
7560 *intPtr = objPtr->internalRep.intValue;
7561 return JIM_OK;
7564 /* -----------------------------------------------------------------------------
7565 * Expression Parsing
7566 * ---------------------------------------------------------------------------*/
7567 static int JimParseExprOperator(struct JimParserCtx *pc);
7568 static int JimParseExprNumber(struct JimParserCtx *pc);
7569 static int JimParseExprIrrational(struct JimParserCtx *pc);
7570 static int JimParseExprBoolean(struct JimParserCtx *pc);
7572 /* Exrp's Stack machine operators opcodes. */
7574 /* Binary operators (numbers) */
7575 enum
7577 /* Continues on from the JIM_TT_ space */
7578 /* Operations */
7579 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7580 JIM_EXPROP_DIV,
7581 JIM_EXPROP_MOD,
7582 JIM_EXPROP_SUB,
7583 JIM_EXPROP_ADD,
7584 JIM_EXPROP_LSHIFT,
7585 JIM_EXPROP_RSHIFT,
7586 JIM_EXPROP_ROTL,
7587 JIM_EXPROP_ROTR,
7588 JIM_EXPROP_LT,
7589 JIM_EXPROP_GT,
7590 JIM_EXPROP_LTE,
7591 JIM_EXPROP_GTE,
7592 JIM_EXPROP_NUMEQ,
7593 JIM_EXPROP_NUMNE,
7594 JIM_EXPROP_BITAND, /* 35 */
7595 JIM_EXPROP_BITXOR,
7596 JIM_EXPROP_BITOR,
7598 /* Note must keep these together */
7599 JIM_EXPROP_LOGICAND, /* 38 */
7600 JIM_EXPROP_LOGICAND_LEFT,
7601 JIM_EXPROP_LOGICAND_RIGHT,
7603 /* and these */
7604 JIM_EXPROP_LOGICOR, /* 41 */
7605 JIM_EXPROP_LOGICOR_LEFT,
7606 JIM_EXPROP_LOGICOR_RIGHT,
7608 /* and these */
7609 /* Ternary operators */
7610 JIM_EXPROP_TERNARY, /* 44 */
7611 JIM_EXPROP_TERNARY_LEFT,
7612 JIM_EXPROP_TERNARY_RIGHT,
7614 /* and these */
7615 JIM_EXPROP_COLON, /* 47 */
7616 JIM_EXPROP_COLON_LEFT,
7617 JIM_EXPROP_COLON_RIGHT,
7619 JIM_EXPROP_POW, /* 50 */
7621 /* Binary operators (strings) */
7622 JIM_EXPROP_STREQ, /* 51 */
7623 JIM_EXPROP_STRNE,
7624 JIM_EXPROP_STRIN,
7625 JIM_EXPROP_STRNI,
7627 /* Unary operators (numbers) */
7628 JIM_EXPROP_NOT, /* 55 */
7629 JIM_EXPROP_BITNOT,
7630 JIM_EXPROP_UNARYMINUS,
7631 JIM_EXPROP_UNARYPLUS,
7633 /* Functions */
7634 JIM_EXPROP_FUNC_FIRST, /* 59 */
7635 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7636 JIM_EXPROP_FUNC_WIDE,
7637 JIM_EXPROP_FUNC_ABS,
7638 JIM_EXPROP_FUNC_DOUBLE,
7639 JIM_EXPROP_FUNC_ROUND,
7640 JIM_EXPROP_FUNC_RAND,
7641 JIM_EXPROP_FUNC_SRAND,
7643 /* math functions from libm */
7644 JIM_EXPROP_FUNC_SIN, /* 65 */
7645 JIM_EXPROP_FUNC_COS,
7646 JIM_EXPROP_FUNC_TAN,
7647 JIM_EXPROP_FUNC_ASIN,
7648 JIM_EXPROP_FUNC_ACOS,
7649 JIM_EXPROP_FUNC_ATAN,
7650 JIM_EXPROP_FUNC_ATAN2,
7651 JIM_EXPROP_FUNC_SINH,
7652 JIM_EXPROP_FUNC_COSH,
7653 JIM_EXPROP_FUNC_TANH,
7654 JIM_EXPROP_FUNC_CEIL,
7655 JIM_EXPROP_FUNC_FLOOR,
7656 JIM_EXPROP_FUNC_EXP,
7657 JIM_EXPROP_FUNC_LOG,
7658 JIM_EXPROP_FUNC_LOG10,
7659 JIM_EXPROP_FUNC_SQRT,
7660 JIM_EXPROP_FUNC_POW,
7661 JIM_EXPROP_FUNC_HYPOT,
7662 JIM_EXPROP_FUNC_FMOD,
7665 struct JimExprState
7667 Jim_Obj **stack;
7668 int stacklen;
7669 int opcode;
7670 int skip;
7673 /* Operators table */
7674 typedef struct Jim_ExprOperator
7676 const char *name;
7677 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7678 unsigned char precedence;
7679 unsigned char arity;
7680 unsigned char lazy;
7681 unsigned char namelen;
7682 } Jim_ExprOperator;
7684 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7686 Jim_IncrRefCount(obj);
7687 e->stack[e->stacklen++] = obj;
7690 static Jim_Obj *ExprPop(struct JimExprState *e)
7692 return e->stack[--e->stacklen];
7695 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7697 int intresult = 1;
7698 int rc = JIM_OK;
7699 Jim_Obj *A = ExprPop(e);
7700 double dA, dC = 0;
7701 jim_wide wA, wC = 0;
7703 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7704 switch (e->opcode) {
7705 case JIM_EXPROP_FUNC_INT:
7706 case JIM_EXPROP_FUNC_WIDE:
7707 case JIM_EXPROP_FUNC_ROUND:
7708 case JIM_EXPROP_UNARYPLUS:
7709 wC = wA;
7710 break;
7711 case JIM_EXPROP_FUNC_DOUBLE:
7712 dC = wA;
7713 intresult = 0;
7714 break;
7715 case JIM_EXPROP_FUNC_ABS:
7716 wC = wA >= 0 ? wA : -wA;
7717 break;
7718 case JIM_EXPROP_UNARYMINUS:
7719 wC = -wA;
7720 break;
7721 case JIM_EXPROP_NOT:
7722 wC = !wA;
7723 break;
7724 default:
7725 abort();
7728 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7729 switch (e->opcode) {
7730 case JIM_EXPROP_FUNC_INT:
7731 case JIM_EXPROP_FUNC_WIDE:
7732 wC = dA;
7733 break;
7734 case JIM_EXPROP_FUNC_ROUND:
7735 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7736 break;
7737 case JIM_EXPROP_FUNC_DOUBLE:
7738 case JIM_EXPROP_UNARYPLUS:
7739 dC = dA;
7740 intresult = 0;
7741 break;
7742 case JIM_EXPROP_FUNC_ABS:
7743 #ifdef JIM_MATH_FUNCTIONS
7744 dC = fabs(dA);
7745 #else
7746 dC = dA >= 0 ? dA : -dA;
7747 #endif
7748 intresult = 0;
7749 break;
7750 case JIM_EXPROP_UNARYMINUS:
7751 dC = -dA;
7752 intresult = 0;
7753 break;
7754 case JIM_EXPROP_NOT:
7755 wC = !dA;
7756 break;
7757 default:
7758 abort();
7762 if (rc == JIM_OK) {
7763 if (intresult) {
7764 ExprPush(e, Jim_NewIntObj(interp, wC));
7766 else {
7767 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7771 Jim_DecrRefCount(interp, A);
7773 return rc;
7776 static double JimRandDouble(Jim_Interp *interp)
7778 unsigned long x;
7779 JimRandomBytes(interp, &x, sizeof(x));
7781 return (double)x / (unsigned long)~0;
7784 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7786 Jim_Obj *A = ExprPop(e);
7787 jim_wide wA;
7789 int rc = Jim_GetWide(interp, A, &wA);
7790 if (rc == JIM_OK) {
7791 switch (e->opcode) {
7792 case JIM_EXPROP_BITNOT:
7793 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7794 break;
7795 case JIM_EXPROP_FUNC_SRAND:
7796 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7797 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7798 break;
7799 default:
7800 abort();
7804 Jim_DecrRefCount(interp, A);
7806 return rc;
7809 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7811 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7813 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7815 return JIM_OK;
7818 #ifdef JIM_MATH_FUNCTIONS
7819 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7821 int rc;
7822 Jim_Obj *A = ExprPop(e);
7823 double dA, dC;
7825 rc = Jim_GetDouble(interp, A, &dA);
7826 if (rc == JIM_OK) {
7827 switch (e->opcode) {
7828 case JIM_EXPROP_FUNC_SIN:
7829 dC = sin(dA);
7830 break;
7831 case JIM_EXPROP_FUNC_COS:
7832 dC = cos(dA);
7833 break;
7834 case JIM_EXPROP_FUNC_TAN:
7835 dC = tan(dA);
7836 break;
7837 case JIM_EXPROP_FUNC_ASIN:
7838 dC = asin(dA);
7839 break;
7840 case JIM_EXPROP_FUNC_ACOS:
7841 dC = acos(dA);
7842 break;
7843 case JIM_EXPROP_FUNC_ATAN:
7844 dC = atan(dA);
7845 break;
7846 case JIM_EXPROP_FUNC_SINH:
7847 dC = sinh(dA);
7848 break;
7849 case JIM_EXPROP_FUNC_COSH:
7850 dC = cosh(dA);
7851 break;
7852 case JIM_EXPROP_FUNC_TANH:
7853 dC = tanh(dA);
7854 break;
7855 case JIM_EXPROP_FUNC_CEIL:
7856 dC = ceil(dA);
7857 break;
7858 case JIM_EXPROP_FUNC_FLOOR:
7859 dC = floor(dA);
7860 break;
7861 case JIM_EXPROP_FUNC_EXP:
7862 dC = exp(dA);
7863 break;
7864 case JIM_EXPROP_FUNC_LOG:
7865 dC = log(dA);
7866 break;
7867 case JIM_EXPROP_FUNC_LOG10:
7868 dC = log10(dA);
7869 break;
7870 case JIM_EXPROP_FUNC_SQRT:
7871 dC = sqrt(dA);
7872 break;
7873 default:
7874 abort();
7876 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7879 Jim_DecrRefCount(interp, A);
7881 return rc;
7883 #endif
7885 /* A binary operation on two ints */
7886 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7888 Jim_Obj *B = ExprPop(e);
7889 Jim_Obj *A = ExprPop(e);
7890 jim_wide wA, wB;
7891 int rc = JIM_ERR;
7893 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7894 jim_wide wC;
7896 rc = JIM_OK;
7898 switch (e->opcode) {
7899 case JIM_EXPROP_LSHIFT:
7900 wC = wA << wB;
7901 break;
7902 case JIM_EXPROP_RSHIFT:
7903 wC = wA >> wB;
7904 break;
7905 case JIM_EXPROP_BITAND:
7906 wC = wA & wB;
7907 break;
7908 case JIM_EXPROP_BITXOR:
7909 wC = wA ^ wB;
7910 break;
7911 case JIM_EXPROP_BITOR:
7912 wC = wA | wB;
7913 break;
7914 case JIM_EXPROP_MOD:
7915 if (wB == 0) {
7916 wC = 0;
7917 Jim_SetResultString(interp, "Division by zero", -1);
7918 rc = JIM_ERR;
7920 else {
7922 * From Tcl 8.x
7924 * This code is tricky: C doesn't guarantee much
7925 * about the quotient or remainder, but Tcl does.
7926 * The remainder always has the same sign as the
7927 * divisor and a smaller absolute value.
7929 int negative = 0;
7931 if (wB < 0) {
7932 wB = -wB;
7933 wA = -wA;
7934 negative = 1;
7936 wC = wA % wB;
7937 if (wC < 0) {
7938 wC += wB;
7940 if (negative) {
7941 wC = -wC;
7944 break;
7945 case JIM_EXPROP_ROTL:
7946 case JIM_EXPROP_ROTR:{
7947 /* uint32_t would be better. But not everyone has inttypes.h? */
7948 unsigned long uA = (unsigned long)wA;
7949 unsigned long uB = (unsigned long)wB;
7950 const unsigned int S = sizeof(unsigned long) * 8;
7952 /* Shift left by the word size or more is undefined. */
7953 uB %= S;
7955 if (e->opcode == JIM_EXPROP_ROTR) {
7956 uB = S - uB;
7958 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7959 break;
7961 default:
7962 abort();
7964 ExprPush(e, Jim_NewIntObj(interp, wC));
7968 Jim_DecrRefCount(interp, A);
7969 Jim_DecrRefCount(interp, B);
7971 return rc;
7975 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7976 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7978 int rc = JIM_OK;
7979 double dA, dB, dC = 0;
7980 jim_wide wA, wB, wC = 0;
7982 Jim_Obj *B = ExprPop(e);
7983 Jim_Obj *A = ExprPop(e);
7985 if ((A->typePtr != &doubleObjType || A->bytes) &&
7986 (B->typePtr != &doubleObjType || B->bytes) &&
7987 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7989 /* Both are ints */
7991 switch (e->opcode) {
7992 case JIM_EXPROP_POW:
7993 case JIM_EXPROP_FUNC_POW:
7994 if (wA == 0 && wB < 0) {
7995 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
7996 rc = JIM_ERR;
7997 goto done;
7999 wC = JimPowWide(wA, wB);
8000 goto intresult;
8001 case JIM_EXPROP_ADD:
8002 wC = wA + wB;
8003 goto intresult;
8004 case JIM_EXPROP_SUB:
8005 wC = wA - wB;
8006 goto intresult;
8007 case JIM_EXPROP_MUL:
8008 wC = wA * wB;
8009 goto intresult;
8010 case JIM_EXPROP_DIV:
8011 if (wB == 0) {
8012 Jim_SetResultString(interp, "Division by zero", -1);
8013 rc = JIM_ERR;
8014 goto done;
8016 else {
8018 * From Tcl 8.x
8020 * This code is tricky: C doesn't guarantee much
8021 * about the quotient or remainder, but Tcl does.
8022 * The remainder always has the same sign as the
8023 * divisor and a smaller absolute value.
8025 if (wB < 0) {
8026 wB = -wB;
8027 wA = -wA;
8029 wC = wA / wB;
8030 if (wA % wB < 0) {
8031 wC--;
8033 goto intresult;
8035 case JIM_EXPROP_LT:
8036 wC = wA < wB;
8037 goto intresult;
8038 case JIM_EXPROP_GT:
8039 wC = wA > wB;
8040 goto intresult;
8041 case JIM_EXPROP_LTE:
8042 wC = wA <= wB;
8043 goto intresult;
8044 case JIM_EXPROP_GTE:
8045 wC = wA >= wB;
8046 goto intresult;
8047 case JIM_EXPROP_NUMEQ:
8048 wC = wA == wB;
8049 goto intresult;
8050 case JIM_EXPROP_NUMNE:
8051 wC = wA != wB;
8052 goto intresult;
8055 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8056 switch (e->opcode) {
8057 #ifndef JIM_MATH_FUNCTIONS
8058 case JIM_EXPROP_POW:
8059 case JIM_EXPROP_FUNC_POW:
8060 case JIM_EXPROP_FUNC_ATAN2:
8061 case JIM_EXPROP_FUNC_HYPOT:
8062 case JIM_EXPROP_FUNC_FMOD:
8063 Jim_SetResultString(interp, "unsupported", -1);
8064 rc = JIM_ERR;
8065 goto done;
8066 #else
8067 case JIM_EXPROP_POW:
8068 case JIM_EXPROP_FUNC_POW:
8069 dC = pow(dA, dB);
8070 goto doubleresult;
8071 case JIM_EXPROP_FUNC_ATAN2:
8072 dC = atan2(dA, dB);
8073 goto doubleresult;
8074 case JIM_EXPROP_FUNC_HYPOT:
8075 dC = hypot(dA, dB);
8076 goto doubleresult;
8077 case JIM_EXPROP_FUNC_FMOD:
8078 dC = fmod(dA, dB);
8079 goto doubleresult;
8080 #endif
8081 case JIM_EXPROP_ADD:
8082 dC = dA + dB;
8083 goto doubleresult;
8084 case JIM_EXPROP_SUB:
8085 dC = dA - dB;
8086 goto doubleresult;
8087 case JIM_EXPROP_MUL:
8088 dC = dA * dB;
8089 goto doubleresult;
8090 case JIM_EXPROP_DIV:
8091 if (dB == 0) {
8092 #ifdef INFINITY
8093 dC = dA < 0 ? -INFINITY : INFINITY;
8094 #else
8095 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8096 #endif
8098 else {
8099 dC = dA / dB;
8101 goto doubleresult;
8102 case JIM_EXPROP_LT:
8103 wC = dA < dB;
8104 goto intresult;
8105 case JIM_EXPROP_GT:
8106 wC = dA > dB;
8107 goto intresult;
8108 case JIM_EXPROP_LTE:
8109 wC = dA <= dB;
8110 goto intresult;
8111 case JIM_EXPROP_GTE:
8112 wC = dA >= dB;
8113 goto intresult;
8114 case JIM_EXPROP_NUMEQ:
8115 wC = dA == dB;
8116 goto intresult;
8117 case JIM_EXPROP_NUMNE:
8118 wC = dA != dB;
8119 goto intresult;
8122 else {
8123 /* Handle the string case */
8125 /* XXX: Could optimise the eq/ne case by checking lengths */
8126 int i = Jim_StringCompareObj(interp, A, B, 0);
8128 switch (e->opcode) {
8129 case JIM_EXPROP_LT:
8130 wC = i < 0;
8131 goto intresult;
8132 case JIM_EXPROP_GT:
8133 wC = i > 0;
8134 goto intresult;
8135 case JIM_EXPROP_LTE:
8136 wC = i <= 0;
8137 goto intresult;
8138 case JIM_EXPROP_GTE:
8139 wC = i >= 0;
8140 goto intresult;
8141 case JIM_EXPROP_NUMEQ:
8142 wC = i == 0;
8143 goto intresult;
8144 case JIM_EXPROP_NUMNE:
8145 wC = i != 0;
8146 goto intresult;
8149 /* If we get here, it is an error */
8150 rc = JIM_ERR;
8151 done:
8152 Jim_DecrRefCount(interp, A);
8153 Jim_DecrRefCount(interp, B);
8154 return rc;
8155 intresult:
8156 ExprPush(e, Jim_NewIntObj(interp, wC));
8157 goto done;
8158 doubleresult:
8159 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8160 goto done;
8163 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8165 int listlen;
8166 int i;
8168 listlen = Jim_ListLength(interp, listObjPtr);
8169 for (i = 0; i < listlen; i++) {
8170 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8171 return 1;
8174 return 0;
8177 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8179 Jim_Obj *B = ExprPop(e);
8180 Jim_Obj *A = ExprPop(e);
8182 jim_wide wC;
8184 switch (e->opcode) {
8185 case JIM_EXPROP_STREQ:
8186 case JIM_EXPROP_STRNE:
8187 wC = Jim_StringEqObj(A, B);
8188 if (e->opcode == JIM_EXPROP_STRNE) {
8189 wC = !wC;
8191 break;
8192 case JIM_EXPROP_STRIN:
8193 wC = JimSearchList(interp, B, A);
8194 break;
8195 case JIM_EXPROP_STRNI:
8196 wC = !JimSearchList(interp, B, A);
8197 break;
8198 default:
8199 abort();
8201 ExprPush(e, Jim_NewIntObj(interp, wC));
8203 Jim_DecrRefCount(interp, A);
8204 Jim_DecrRefCount(interp, B);
8206 return JIM_OK;
8209 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8211 long l;
8212 double d;
8213 int b;
8215 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8216 return l != 0;
8218 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8219 return d != 0;
8221 if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8222 return b != 0;
8224 return -1;
8227 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8229 Jim_Obj *skip = ExprPop(e);
8230 Jim_Obj *A = ExprPop(e);
8231 int rc = JIM_OK;
8233 switch (ExprBool(interp, A)) {
8234 case 0:
8235 /* false, so skip RHS opcodes with a 0 result */
8236 e->skip = JimWideValue(skip);
8237 ExprPush(e, Jim_NewIntObj(interp, 0));
8238 break;
8240 case 1:
8241 /* true so continue */
8242 break;
8244 case -1:
8245 /* Invalid */
8246 rc = JIM_ERR;
8248 Jim_DecrRefCount(interp, A);
8249 Jim_DecrRefCount(interp, skip);
8251 return rc;
8254 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8256 Jim_Obj *skip = ExprPop(e);
8257 Jim_Obj *A = ExprPop(e);
8258 int rc = JIM_OK;
8260 switch (ExprBool(interp, A)) {
8261 case 0:
8262 /* false, so do nothing */
8263 break;
8265 case 1:
8266 /* true so skip RHS opcodes with a 1 result */
8267 e->skip = JimWideValue(skip);
8268 ExprPush(e, Jim_NewIntObj(interp, 1));
8269 break;
8271 case -1:
8272 /* Invalid */
8273 rc = JIM_ERR;
8274 break;
8276 Jim_DecrRefCount(interp, A);
8277 Jim_DecrRefCount(interp, skip);
8279 return rc;
8282 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8284 Jim_Obj *A = ExprPop(e);
8285 int rc = JIM_OK;
8287 switch (ExprBool(interp, A)) {
8288 case 0:
8289 ExprPush(e, Jim_NewIntObj(interp, 0));
8290 break;
8292 case 1:
8293 ExprPush(e, Jim_NewIntObj(interp, 1));
8294 break;
8296 case -1:
8297 /* Invalid */
8298 rc = JIM_ERR;
8299 break;
8301 Jim_DecrRefCount(interp, A);
8303 return rc;
8306 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8308 Jim_Obj *skip = ExprPop(e);
8309 Jim_Obj *A = ExprPop(e);
8310 int rc = JIM_OK;
8312 /* Repush A */
8313 ExprPush(e, A);
8315 switch (ExprBool(interp, A)) {
8316 case 0:
8317 /* false, skip RHS opcodes */
8318 e->skip = JimWideValue(skip);
8319 /* Push a dummy value */
8320 ExprPush(e, Jim_NewIntObj(interp, 0));
8321 break;
8323 case 1:
8324 /* true so do nothing */
8325 break;
8327 case -1:
8328 /* Invalid */
8329 rc = JIM_ERR;
8330 break;
8332 Jim_DecrRefCount(interp, A);
8333 Jim_DecrRefCount(interp, skip);
8335 return rc;
8338 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8340 Jim_Obj *skip = ExprPop(e);
8341 Jim_Obj *B = ExprPop(e);
8342 Jim_Obj *A = ExprPop(e);
8344 /* No need to check for A as non-boolean */
8345 if (ExprBool(interp, A)) {
8346 /* true, so skip RHS opcodes */
8347 e->skip = JimWideValue(skip);
8348 /* Repush B as the answer */
8349 ExprPush(e, B);
8352 Jim_DecrRefCount(interp, skip);
8353 Jim_DecrRefCount(interp, A);
8354 Jim_DecrRefCount(interp, B);
8355 return JIM_OK;
8358 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8360 return JIM_OK;
8363 enum
8365 LAZY_NONE,
8366 LAZY_OP,
8367 LAZY_LEFT,
8368 LAZY_RIGHT,
8369 RIGHT_ASSOC, /* reuse this field for right associativity too */
8372 /* name - precedence - arity - opcode
8374 * This array *must* be kept in sync with the JIM_EXPROP enum.
8376 * The following macros pre-compute the string length at compile time.
8378 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8379 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, LAZY_NONE)
8381 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8382 OPRINIT("*", 110, 2, JimExprOpBin),
8383 OPRINIT("/", 110, 2, JimExprOpBin),
8384 OPRINIT("%", 110, 2, JimExprOpIntBin),
8386 OPRINIT("-", 100, 2, JimExprOpBin),
8387 OPRINIT("+", 100, 2, JimExprOpBin),
8389 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8390 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8392 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8393 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8395 OPRINIT("<", 80, 2, JimExprOpBin),
8396 OPRINIT(">", 80, 2, JimExprOpBin),
8397 OPRINIT("<=", 80, 2, JimExprOpBin),
8398 OPRINIT(">=", 80, 2, JimExprOpBin),
8400 OPRINIT("==", 70, 2, JimExprOpBin),
8401 OPRINIT("!=", 70, 2, JimExprOpBin),
8403 OPRINIT("&", 50, 2, JimExprOpIntBin),
8404 OPRINIT("^", 49, 2, JimExprOpIntBin),
8405 OPRINIT("|", 48, 2, JimExprOpIntBin),
8407 OPRINIT_ATTR("&&", 10, 2, NULL, LAZY_OP),
8408 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8409 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8411 OPRINIT_ATTR("||", 9, 2, NULL, LAZY_OP),
8412 OPRINIT_ATTR(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8413 OPRINIT_ATTR(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8415 OPRINIT_ATTR("?", 5, 2, JimExprOpNull, LAZY_OP),
8416 OPRINIT_ATTR(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8417 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8419 OPRINIT_ATTR(":", 5, 2, JimExprOpNull, LAZY_OP),
8420 OPRINIT_ATTR(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8421 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8423 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8424 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, RIGHT_ASSOC),
8426 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8427 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8429 OPRINIT("in", 55, 2, JimExprOpStrBin),
8430 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8432 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8433 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8434 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8435 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8439 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8440 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8441 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8442 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8443 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8444 OPRINIT("rand", 200, 0, JimExprOpNone),
8445 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8447 #ifdef JIM_MATH_FUNCTIONS
8448 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8449 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8450 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8451 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8452 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8453 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8454 OPRINIT("atan2", 200, 2, JimExprOpBin),
8455 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8456 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8457 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8458 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8459 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8460 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8461 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8462 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8463 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8464 OPRINIT("pow", 200, 2, JimExprOpBin),
8465 OPRINIT("hypot", 200, 2, JimExprOpBin),
8466 OPRINIT("fmod", 200, 2, JimExprOpBin),
8467 #endif
8469 #undef OPRINIT
8470 #undef OPRINIT_LAZY
8472 #define JIM_EXPR_OPERATORS_NUM \
8473 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8475 static int JimParseExpression(struct JimParserCtx *pc)
8477 /* Discard spaces and quoted newline */
8478 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8479 if (*pc->p == '\n') {
8480 pc->linenr++;
8482 pc->p++;
8483 pc->len--;
8486 /* Common case */
8487 pc->tline = pc->linenr;
8488 pc->tstart = pc->p;
8490 if (pc->len == 0) {
8491 pc->tend = pc->p;
8492 pc->tt = JIM_TT_EOL;
8493 pc->eof = 1;
8494 return JIM_OK;
8496 switch (*(pc->p)) {
8497 case '(':
8498 pc->tt = JIM_TT_SUBEXPR_START;
8499 goto singlechar;
8500 case ')':
8501 pc->tt = JIM_TT_SUBEXPR_END;
8502 goto singlechar;
8503 case ',':
8504 pc->tt = JIM_TT_SUBEXPR_COMMA;
8505 singlechar:
8506 pc->tend = pc->p;
8507 pc->p++;
8508 pc->len--;
8509 break;
8510 case '[':
8511 return JimParseCmd(pc);
8512 case '$':
8513 if (JimParseVar(pc) == JIM_ERR)
8514 return JimParseExprOperator(pc);
8515 else {
8516 /* Don't allow expr sugar in expressions */
8517 if (pc->tt == JIM_TT_EXPRSUGAR) {
8518 return JIM_ERR;
8520 return JIM_OK;
8522 break;
8523 case '0':
8524 case '1':
8525 case '2':
8526 case '3':
8527 case '4':
8528 case '5':
8529 case '6':
8530 case '7':
8531 case '8':
8532 case '9':
8533 case '.':
8534 return JimParseExprNumber(pc);
8535 case '"':
8536 return JimParseQuote(pc);
8537 case '{':
8538 return JimParseBrace(pc);
8540 case 'N':
8541 case 'I':
8542 case 'n':
8543 case 'i':
8544 if (JimParseExprIrrational(pc) == JIM_ERR)
8545 if (JimParseExprBoolean(pc) == JIM_ERR)
8546 return JimParseExprOperator(pc);
8547 break;
8548 case 't':
8549 case 'f':
8550 case 'o':
8551 case 'y':
8552 if (JimParseExprBoolean(pc) == JIM_ERR)
8553 return JimParseExprOperator(pc);
8554 break;
8555 default:
8556 return JimParseExprOperator(pc);
8557 break;
8559 return JIM_OK;
8562 static int JimParseExprNumber(struct JimParserCtx *pc)
8564 char *end;
8566 /* Assume an integer for now */
8567 pc->tt = JIM_TT_EXPR_INT;
8569 jim_strtoull(pc->p, (char **)&pc->p);
8570 /* Tried as an integer, but perhaps it parses as a double */
8571 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8572 /* Some stupid compilers insist they are cleverer that
8573 * we are. Even a (void) cast doesn't prevent this warning!
8575 if (strtod(pc->tstart, &end)) { /* nothing */ }
8576 if (end == pc->tstart)
8577 return JIM_ERR;
8578 if (end > pc->p) {
8579 /* Yes, double captured more chars */
8580 pc->tt = JIM_TT_EXPR_DOUBLE;
8581 pc->p = end;
8584 pc->tend = pc->p - 1;
8585 pc->len -= (pc->p - pc->tstart);
8586 return JIM_OK;
8589 static int JimParseExprIrrational(struct JimParserCtx *pc)
8591 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8592 int i;
8594 for (i = 0; irrationals[i]; i++) {
8595 const char *irr = irrationals[i];
8597 if (strncmp(irr, pc->p, 3) == 0) {
8598 pc->p += 3;
8599 pc->len -= 3;
8600 pc->tend = pc->p - 1;
8601 pc->tt = JIM_TT_EXPR_DOUBLE;
8602 return JIM_OK;
8605 return JIM_ERR;
8608 static int JimParseExprBoolean(struct JimParserCtx *pc)
8610 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8611 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8612 int i;
8614 for (i = 0; booleans[i]; i++) {
8615 const char *boolean = booleans[i];
8616 int length = lengths[i];
8618 if (strncmp(boolean, pc->p, length) == 0) {
8619 pc->p += length;
8620 pc->len -= length;
8621 pc->tend = pc->p - 1;
8622 pc->tt = JIM_TT_EXPR_BOOLEAN;
8623 return JIM_OK;
8626 return JIM_ERR;
8629 static int JimParseExprOperator(struct JimParserCtx *pc)
8631 int i;
8632 int bestIdx = -1, bestLen = 0;
8634 /* Try to get the longest match. */
8635 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8636 const char * const opname = Jim_ExprOperators[i].name;
8637 const int oplen = Jim_ExprOperators[i].namelen;
8639 if (opname == NULL || opname[0] != pc->p[0]) {
8640 continue;
8643 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8644 bestIdx = i + JIM_TT_EXPR_OP;
8645 bestLen = oplen;
8648 if (bestIdx == -1) {
8649 return JIM_ERR;
8652 /* Validate paretheses around function arguments */
8653 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8654 const char *p = pc->p + bestLen;
8655 int len = pc->len - bestLen;
8657 while (len && isspace(UCHAR(*p))) {
8658 len--;
8659 p++;
8661 if (*p != '(') {
8662 return JIM_ERR;
8665 pc->tend = pc->p + bestLen - 1;
8666 pc->p += bestLen;
8667 pc->len -= bestLen;
8669 pc->tt = bestIdx;
8670 return JIM_OK;
8673 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8675 static Jim_ExprOperator dummy_op;
8676 if (opcode < JIM_TT_EXPR_OP) {
8677 return &dummy_op;
8679 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8682 const char *jim_tt_name(int type)
8684 static const char * const tt_names[JIM_TT_EXPR_OP] =
8685 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8686 "DBL", "BOO", "$()" };
8687 if (type < JIM_TT_EXPR_OP) {
8688 return tt_names[type];
8690 else if (type == JIM_EXPROP_UNARYMINUS) {
8691 return "-VE";
8693 else if (type == JIM_EXPROP_UNARYPLUS) {
8694 return "+VE";
8696 else {
8697 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8698 static char buf[20];
8700 if (op->name) {
8701 return op->name;
8703 sprintf(buf, "(%d)", type);
8704 return buf;
8708 /* -----------------------------------------------------------------------------
8709 * Expression Object
8710 * ---------------------------------------------------------------------------*/
8711 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8712 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8713 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8715 static const Jim_ObjType exprObjType = {
8716 "expression",
8717 FreeExprInternalRep,
8718 DupExprInternalRep,
8719 NULL,
8720 JIM_TYPE_REFERENCES,
8723 /* Expr bytecode structure */
8724 typedef struct ExprByteCode
8726 ScriptToken *token; /* Tokens array. */
8727 int len; /* Length as number of tokens. */
8728 int inUse; /* Used for sharing. */
8729 } ExprByteCode;
8731 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8733 int i;
8735 for (i = 0; i < expr->len; i++) {
8736 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8738 Jim_Free(expr->token);
8739 Jim_Free(expr);
8742 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8744 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8746 if (expr) {
8747 if (--expr->inUse != 0) {
8748 return;
8751 ExprFreeByteCode(interp, expr);
8755 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8757 JIM_NOTUSED(interp);
8758 JIM_NOTUSED(srcPtr);
8760 /* Just returns an simple string. */
8761 dupPtr->typePtr = NULL;
8764 /* Check if an expr program looks correct
8765 * Sets an error result on invalid
8767 static int ExprCheckCorrectness(Jim_Interp *interp, Jim_Obj *exprObjPtr, ExprByteCode * expr)
8769 int i;
8770 int stacklen = 0;
8771 int ternary = 0;
8772 int lasttt = JIM_TT_NONE;
8773 const char *errmsg;
8775 /* Try to check if there are stack underflows,
8776 * and make sure at the end of the program there is
8777 * a single result on the stack. */
8778 for (i = 0; i < expr->len; i++) {
8779 ScriptToken *t = &expr->token[i];
8780 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8781 lasttt = t->type;
8783 stacklen -= op->arity;
8785 if (stacklen < 0) {
8786 break;
8788 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8789 ternary++;
8791 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8792 ternary--;
8795 /* All operations and operands add one to the stack */
8796 stacklen++;
8798 if (stacklen == 1 && ternary == 0) {
8799 return JIM_OK;
8802 if (stacklen <= 0) {
8803 /* Too few args */
8804 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8805 errmsg = "too few arguments for math function";
8806 Jim_SetResultString(interp, "too few arguments for math function", -1);
8807 } else {
8808 errmsg = "premature end of expression";
8811 else if (stacklen > 1) {
8812 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8813 errmsg = "too many arguments for math function";
8814 } else {
8815 errmsg = "extra tokens at end of expression";
8818 else {
8819 errmsg = "invalid ternary expression";
8821 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": %s", exprObjPtr, errmsg);
8822 return JIM_ERR;
8825 /* This procedure converts every occurrence of || and && opereators
8826 * in lazy unary versions.
8828 * a b || is converted into:
8830 * a <offset> |L b |R
8832 * a b && is converted into:
8834 * a <offset> &L b &R
8836 * "|L" checks if 'a' is true:
8837 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8838 * the opcode just after |R.
8839 * 2) if it is false does nothing.
8840 * "|R" checks if 'b' is true:
8841 * 1) if it is true pushes 1, otherwise pushes 0.
8843 * "&L" checks if 'a' is true:
8844 * 1) if it is true does nothing.
8845 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8846 * the opcode just after &R
8847 * "&R" checks if 'a' is true:
8848 * if it is true pushes 1, otherwise pushes 0.
8850 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8852 int i;
8854 int leftindex, arity, offset;
8856 /* Search for the end of the first operator */
8857 leftindex = expr->len - 1;
8859 arity = 1;
8860 while (arity) {
8861 ScriptToken *tt = &expr->token[leftindex];
8863 if (tt->type >= JIM_TT_EXPR_OP) {
8864 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8866 arity--;
8867 if (--leftindex < 0) {
8868 return JIM_ERR;
8871 leftindex++;
8873 /* Move them up */
8874 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8875 sizeof(*expr->token) * (expr->len - leftindex));
8876 expr->len += 2;
8877 offset = (expr->len - leftindex) - 1;
8879 /* Now we rely on the fact that the left and right version have opcodes
8880 * 1 and 2 after the main opcode respectively
8882 expr->token[leftindex + 1].type = t->type + 1;
8883 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8885 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8886 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8888 /* Now add the 'R' operator */
8889 expr->token[expr->len].objPtr = interp->emptyObj;
8890 expr->token[expr->len].type = t->type + 2;
8891 expr->len++;
8893 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8894 for (i = leftindex - 1; i > 0; i--) {
8895 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8896 if (op->lazy == LAZY_LEFT) {
8897 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8898 JimWideValue(expr->token[i - 1].objPtr) += 2;
8902 return JIM_OK;
8905 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8907 struct ScriptToken *token = &expr->token[expr->len];
8908 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8910 if (op->lazy == LAZY_OP) {
8911 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8912 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8913 return JIM_ERR;
8916 else {
8917 token->objPtr = interp->emptyObj;
8918 token->type = t->type;
8919 expr->len++;
8921 return JIM_OK;
8925 * Returns the index of the COLON_LEFT to the left of 'right_index'
8926 * taking into account nesting.
8928 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8930 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8932 int ternary_count = 1;
8934 right_index--;
8936 while (right_index > 1) {
8937 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8938 ternary_count--;
8940 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8941 ternary_count++;
8943 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8944 return right_index;
8946 right_index--;
8949 /*notreached*/
8950 return -1;
8954 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8956 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8957 * Otherwise returns 0.
8959 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8961 int i = right_index - 1;
8962 int ternary_count = 1;
8964 while (i > 1) {
8965 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8966 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8967 *prev_right_index = i - 2;
8968 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8969 return 1;
8972 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8973 if (ternary_count == 0) {
8974 return 0;
8976 ternary_count++;
8978 i--;
8980 return 0;
8984 * ExprTernaryReorderExpression description
8985 * ========================================
8987 * ?: is right-to-left associative which doesn't work with the stack-based
8988 * expression engine. The fix is to reorder the bytecode.
8990 * The expression:
8992 * expr 1?2:0?3:4
8994 * Has initial bytecode:
8996 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8997 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8999 * The fix involves simulating this expression instead:
9001 * expr 1?2:(0?3:4)
9003 * With the following bytecode:
9005 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
9006 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
9008 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
9009 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
9010 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
9011 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
9013 * ExprTernaryReorderExpression works thus as follows :
9014 * - start from the end of the stack
9015 * - while walking towards the beginning of the stack
9016 * if token=JIM_EXPROP_COLON_RIGHT then
9017 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
9018 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
9019 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
9020 * if all found then
9021 * perform the rotation
9022 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
9023 * end if
9024 * end if
9026 * Note: care has to be taken for nested ternary constructs!!!
9028 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
9030 int i;
9032 for (i = expr->len - 1; i > 1; i--) {
9033 int prev_right_index;
9034 int prev_left_index;
9035 int j;
9036 ScriptToken tmp;
9038 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
9039 continue;
9042 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
9043 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
9044 continue;
9048 ** rotate tokens down
9050 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
9051 ** | | |
9052 ** | V V
9053 ** | [...] : ...
9054 ** | | |
9055 ** | V V
9056 ** | [...] : ...
9057 ** | | |
9058 ** | V V
9059 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
9061 tmp = expr->token[prev_right_index];
9062 for (j = prev_right_index; j < i; j++) {
9063 expr->token[j] = expr->token[j + 1];
9065 expr->token[i] = tmp;
9067 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
9069 * This is 'colon left increment' = i - prev_right_index
9071 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
9072 * [prev_left_index-1] : skip_count
9075 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
9077 /* Adjust for i-- in the loop */
9078 i++;
9082 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9084 Jim_Stack stack;
9085 ExprByteCode *expr;
9086 int ok = 1;
9087 int i;
9088 int prevtt = JIM_TT_NONE;
9089 int have_ternary = 0;
9091 /* -1 for EOL */
9092 int count = tokenlist->count - 1;
9094 expr = Jim_Alloc(sizeof(*expr));
9095 expr->inUse = 1;
9096 expr->len = 0;
9098 Jim_InitStack(&stack);
9100 /* Need extra bytecodes for lazy operators.
9101 * Also check for the ternary operator
9103 for (i = 0; i < tokenlist->count; i++) {
9104 ParseToken *t = &tokenlist->list[i];
9105 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
9107 if (op->lazy == LAZY_OP) {
9108 count += 2;
9109 /* Ternary is a lazy op but also needs reordering */
9110 if (t->type == JIM_EXPROP_TERNARY) {
9111 have_ternary = 1;
9116 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
9118 for (i = 0; i < tokenlist->count && ok; i++) {
9119 ParseToken *t = &tokenlist->list[i];
9121 /* Next token will be stored here */
9122 struct ScriptToken *token = &expr->token[expr->len];
9124 if (t->type == JIM_TT_EOL) {
9125 break;
9128 if (TOKEN_IS_EXPR_OP(t->type)) {
9129 const struct Jim_ExprOperator *op;
9130 ParseToken *tt;
9132 /* Convert -/+ to unary minus or unary plus if necessary */
9133 if (prevtt == JIM_TT_NONE || prevtt == JIM_TT_SUBEXPR_START || prevtt == JIM_TT_SUBEXPR_COMMA || prevtt >= JIM_TT_EXPR_OP) {
9134 if (t->type == JIM_EXPROP_SUB) {
9135 t->type = JIM_EXPROP_UNARYMINUS;
9137 else if (t->type == JIM_EXPROP_ADD) {
9138 t->type = JIM_EXPROP_UNARYPLUS;
9142 op = JimExprOperatorInfoByOpcode(t->type);
9144 /* Handle precedence */
9145 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9146 const struct Jim_ExprOperator *tt_op =
9147 JimExprOperatorInfoByOpcode(tt->type);
9149 /* Note that right-to-left associativity of ?: operator is handled later.
9152 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9153 /* Don't reduce if right associative with equal precedence? */
9154 if (tt_op->precedence == op->precedence && tt_op->lazy == RIGHT_ASSOC) {
9155 break;
9157 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9158 ok = 0;
9159 goto err;
9161 Jim_StackPop(&stack);
9163 else {
9164 break;
9167 Jim_StackPush(&stack, t);
9169 else if (t->type == JIM_TT_SUBEXPR_START) {
9170 Jim_StackPush(&stack, t);
9172 else if (t->type == JIM_TT_SUBEXPR_END || t->type == JIM_TT_SUBEXPR_COMMA) {
9173 /* Reduce the expression back to the previous ( or , */
9174 ok = 0;
9175 while (Jim_StackLen(&stack)) {
9176 ParseToken *tt = Jim_StackPop(&stack);
9178 if (tt->type == JIM_TT_SUBEXPR_START || tt->type == JIM_TT_SUBEXPR_COMMA) {
9179 if (t->type == JIM_TT_SUBEXPR_COMMA) {
9180 /* Need to push back the previous START or COMMA in the case of comma */
9181 Jim_StackPush(&stack, tt);
9183 ok = 1;
9184 break;
9186 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9187 goto err;
9190 if (!ok) {
9191 Jim_SetResultFormatted(interp, "Unexpected close parenthesis in expression: \"%#s\"", exprObjPtr);
9192 goto err;
9195 else {
9196 Jim_Obj *objPtr = NULL;
9198 /* This is a simple non-operator term, so create and push the appropriate object */
9199 token->type = t->type;
9201 /* Two consecutive terms without an operator is invalid */
9202 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9203 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", exprObjPtr);
9204 ok = 0;
9205 goto err;
9208 /* Immediately create a double or int object? */
9209 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9210 char *endptr;
9211 if (t->type == JIM_TT_EXPR_INT) {
9212 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9214 else {
9215 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9217 if (endptr != t->token + t->len) {
9218 /* Conversion failed, so just store it as a string */
9219 Jim_FreeNewObj(interp, objPtr);
9220 objPtr = NULL;
9224 if (objPtr) {
9225 token->objPtr = objPtr;
9227 else {
9228 /* Everything else is stored a simple string term */
9229 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
9230 if (t->type == JIM_TT_CMD) {
9231 /* Only commands need source info */
9232 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
9235 expr->len++;
9237 prevtt = t->type;
9240 /* Reduce any remaining subexpr */
9241 while (Jim_StackLen(&stack)) {
9242 ParseToken *tt = Jim_StackPop(&stack);
9244 if (tt->type == JIM_TT_SUBEXPR_START) {
9245 ok = 0;
9246 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9247 goto err;
9249 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9250 ok = 0;
9251 goto err;
9255 if (have_ternary) {
9256 ExprTernaryReorderExpression(interp, expr);
9259 err:
9260 /* Free the stack used for the compilation. */
9261 Jim_FreeStack(&stack);
9263 for (i = 0; i < expr->len; i++) {
9264 Jim_IncrRefCount(expr->token[i].objPtr);
9267 if (!ok) {
9268 ExprFreeByteCode(interp, expr);
9269 return NULL;
9272 return expr;
9276 /* This method takes the string representation of an expression
9277 * and generates a program for the Expr's stack-based VM. */
9278 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9280 int exprTextLen;
9281 const char *exprText;
9282 struct JimParserCtx parser;
9283 struct ExprByteCode *expr;
9284 ParseTokenList tokenlist;
9285 int line;
9286 Jim_Obj *fileNameObj;
9287 int rc = JIM_ERR;
9289 /* Try to get information about filename / line number */
9290 if (objPtr->typePtr == &sourceObjType) {
9291 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9292 line = objPtr->internalRep.sourceValue.lineNumber;
9294 else {
9295 fileNameObj = interp->emptyObj;
9296 line = 1;
9298 Jim_IncrRefCount(fileNameObj);
9300 exprText = Jim_GetString(objPtr, &exprTextLen);
9302 /* Initially tokenise the expression into tokenlist */
9303 ScriptTokenListInit(&tokenlist);
9305 JimParserInit(&parser, exprText, exprTextLen, line);
9306 while (!parser.eof) {
9307 if (JimParseExpression(&parser) != JIM_OK) {
9308 ScriptTokenListFree(&tokenlist);
9309 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9310 expr = NULL;
9311 goto err;
9314 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9315 parser.tline);
9318 #ifdef DEBUG_SHOW_EXPR_TOKENS
9320 int i;
9321 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9322 for (i = 0; i < tokenlist.count; i++) {
9323 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9324 tokenlist.list[i].len, tokenlist.list[i].token);
9327 #endif
9329 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9330 ScriptTokenListFree(&tokenlist);
9331 Jim_DecrRefCount(interp, fileNameObj);
9332 return JIM_ERR;
9335 /* Now create the expression bytecode from the tokenlist */
9336 expr = ExprCreateByteCode(interp, &tokenlist, objPtr, fileNameObj);
9338 /* No longer need the token list */
9339 ScriptTokenListFree(&tokenlist);
9341 if (!expr) {
9342 goto err;
9345 #ifdef DEBUG_SHOW_EXPR
9347 int i;
9349 printf("==== Expr ====\n");
9350 for (i = 0; i < expr->len; i++) {
9351 ScriptToken *t = &expr->token[i];
9353 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9356 #endif
9358 /* Check program correctness. */
9359 if (ExprCheckCorrectness(interp, objPtr, expr) != JIM_OK) {
9360 /* ExprCheckCorrectness set an error in this case */
9361 ExprFreeByteCode(interp, expr);
9362 expr = NULL;
9363 goto err;
9366 rc = JIM_OK;
9368 err:
9369 /* Free the old internal rep and set the new one. */
9370 Jim_DecrRefCount(interp, fileNameObj);
9371 Jim_FreeIntRep(interp, objPtr);
9372 Jim_SetIntRepPtr(objPtr, expr);
9373 objPtr->typePtr = &exprObjType;
9374 return rc;
9377 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9379 if (objPtr->typePtr != &exprObjType) {
9380 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9381 return NULL;
9384 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9387 #ifdef JIM_OPTIMIZATION
9388 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9390 if (token->type == JIM_TT_EXPR_INT)
9391 return token->objPtr;
9392 else if (token->type == JIM_TT_VAR)
9393 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9394 else if (token->type == JIM_TT_DICTSUGAR)
9395 return JimExpandDictSugar(interp, token->objPtr);
9396 else
9397 return NULL;
9399 #endif
9401 /* -----------------------------------------------------------------------------
9402 * Expressions evaluation.
9403 * Jim uses a specialized stack-based virtual machine for expressions,
9404 * that takes advantage of the fact that expr's operators
9405 * can't be redefined.
9407 * Jim_EvalExpression() uses the bytecode compiled by
9408 * SetExprFromAny() method of the "expression" object.
9410 * On success a Tcl Object containing the result of the evaluation
9411 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9412 * returned.
9413 * On error the function returns a retcode != to JIM_OK and set a suitable
9414 * error on the interp.
9415 * ---------------------------------------------------------------------------*/
9416 #define JIM_EE_STATICSTACK_LEN 10
9418 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9420 ExprByteCode *expr;
9421 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9422 int i;
9423 int retcode = JIM_OK;
9424 struct JimExprState e;
9426 expr = JimGetExpression(interp, exprObjPtr);
9427 if (!expr) {
9428 return JIM_ERR; /* error in expression. */
9431 #ifdef JIM_OPTIMIZATION
9432 /* Check for one of the following common expressions used by while/for
9434 * CONST
9435 * $a
9436 * !$a
9437 * $a < CONST, $a < $b
9438 * $a <= CONST, $a <= $b
9439 * $a > CONST, $a > $b
9440 * $a >= CONST, $a >= $b
9441 * $a != CONST, $a != $b
9442 * $a == CONST, $a == $b
9445 Jim_Obj *objPtr;
9447 /* STEP 1 -- Check if there are the conditions to run the specialized
9448 * version of while */
9450 switch (expr->len) {
9451 case 1:
9452 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9453 if (objPtr) {
9454 Jim_IncrRefCount(objPtr);
9455 *exprResultPtrPtr = objPtr;
9456 return JIM_OK;
9458 break;
9460 case 2:
9461 if (expr->token[1].type == JIM_EXPROP_NOT) {
9462 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9464 if (objPtr && JimIsWide(objPtr)) {
9465 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9466 Jim_IncrRefCount(*exprResultPtrPtr);
9467 return JIM_OK;
9470 break;
9472 case 3:
9473 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9474 if (objPtr && JimIsWide(objPtr)) {
9475 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9476 if (objPtr2 && JimIsWide(objPtr2)) {
9477 jim_wide wideValueA = JimWideValue(objPtr);
9478 jim_wide wideValueB = JimWideValue(objPtr2);
9479 int cmpRes;
9480 switch (expr->token[2].type) {
9481 case JIM_EXPROP_LT:
9482 cmpRes = wideValueA < wideValueB;
9483 break;
9484 case JIM_EXPROP_LTE:
9485 cmpRes = wideValueA <= wideValueB;
9486 break;
9487 case JIM_EXPROP_GT:
9488 cmpRes = wideValueA > wideValueB;
9489 break;
9490 case JIM_EXPROP_GTE:
9491 cmpRes = wideValueA >= wideValueB;
9492 break;
9493 case JIM_EXPROP_NUMEQ:
9494 cmpRes = wideValueA == wideValueB;
9495 break;
9496 case JIM_EXPROP_NUMNE:
9497 cmpRes = wideValueA != wideValueB;
9498 break;
9499 default:
9500 goto noopt;
9502 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9503 Jim_IncrRefCount(*exprResultPtrPtr);
9504 return JIM_OK;
9507 break;
9510 noopt:
9511 #endif
9513 /* In order to avoid that the internal repr gets freed due to
9514 * shimmering of the exprObjPtr's object, we make the internal rep
9515 * shared. */
9516 expr->inUse++;
9518 /* The stack-based expr VM itself */
9520 /* Stack allocation. Expr programs have the feature that
9521 * a program of length N can't require a stack longer than
9522 * N. */
9523 if (expr->len > JIM_EE_STATICSTACK_LEN)
9524 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9525 else
9526 e.stack = staticStack;
9528 e.stacklen = 0;
9530 /* Execute every instruction */
9531 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9532 Jim_Obj *objPtr;
9534 switch (expr->token[i].type) {
9535 case JIM_TT_EXPR_INT:
9536 case JIM_TT_EXPR_DOUBLE:
9537 case JIM_TT_EXPR_BOOLEAN:
9538 case JIM_TT_STR:
9539 ExprPush(&e, expr->token[i].objPtr);
9540 break;
9542 case JIM_TT_VAR:
9543 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9544 if (objPtr) {
9545 ExprPush(&e, objPtr);
9547 else {
9548 retcode = JIM_ERR;
9550 break;
9552 case JIM_TT_DICTSUGAR:
9553 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9554 if (objPtr) {
9555 ExprPush(&e, objPtr);
9557 else {
9558 retcode = JIM_ERR;
9560 break;
9562 case JIM_TT_ESC:
9563 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9564 if (retcode == JIM_OK) {
9565 ExprPush(&e, objPtr);
9567 break;
9569 case JIM_TT_CMD:
9570 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9571 if (retcode == JIM_OK) {
9572 ExprPush(&e, Jim_GetResult(interp));
9574 break;
9576 default:{
9577 /* Find and execute the operation */
9578 e.skip = 0;
9579 e.opcode = expr->token[i].type;
9581 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9582 /* Skip some opcodes if necessary */
9583 i += e.skip;
9584 continue;
9589 expr->inUse--;
9591 if (retcode == JIM_OK) {
9592 *exprResultPtrPtr = ExprPop(&e);
9594 else {
9595 for (i = 0; i < e.stacklen; i++) {
9596 Jim_DecrRefCount(interp, e.stack[i]);
9599 if (e.stack != staticStack) {
9600 Jim_Free(e.stack);
9602 return retcode;
9605 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9607 int retcode;
9608 jim_wide wideValue;
9609 double doubleValue;
9610 int booleanValue;
9611 Jim_Obj *exprResultPtr;
9613 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9614 if (retcode != JIM_OK)
9615 return retcode;
9617 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9618 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9619 if (Jim_GetBoolean(interp, exprResultPtr, &booleanValue) != JIM_OK) {
9620 Jim_DecrRefCount(interp, exprResultPtr);
9621 return JIM_ERR;
9622 } else {
9623 Jim_DecrRefCount(interp, exprResultPtr);
9624 *boolPtr = booleanValue;
9625 return JIM_OK;
9628 else {
9629 Jim_DecrRefCount(interp, exprResultPtr);
9630 *boolPtr = doubleValue != 0;
9631 return JIM_OK;
9634 *boolPtr = wideValue != 0;
9636 Jim_DecrRefCount(interp, exprResultPtr);
9637 return JIM_OK;
9640 /* -----------------------------------------------------------------------------
9641 * ScanFormat String Object
9642 * ---------------------------------------------------------------------------*/
9644 /* This Jim_Obj will held a parsed representation of a format string passed to
9645 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9646 * to be parsed in its entirely first and then, if correct, can be used for
9647 * scanning. To avoid endless re-parsing, the parsed representation will be
9648 * stored in an internal representation and re-used for performance reason. */
9650 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9651 * scanformat string. This part will later be used to extract information
9652 * out from the string to be parsed by Jim_ScanString */
9654 typedef struct ScanFmtPartDescr
9656 char *arg; /* Specification of a CHARSET conversion */
9657 char *prefix; /* Prefix to be scanned literally before conversion */
9658 size_t width; /* Maximal width of input to be converted */
9659 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9660 char type; /* Type of conversion (e.g. c, d, f) */
9661 char modifier; /* Modify type (e.g. l - long, h - short */
9662 } ScanFmtPartDescr;
9664 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9665 * string parsed and separated in part descriptions. Furthermore it contains
9666 * the original string representation of the scanformat string to allow for
9667 * fast update of the Jim_Obj's string representation part.
9669 * As an add-on the internal object representation adds some scratch pad area
9670 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9671 * memory for purpose of string scanning.
9673 * The error member points to a static allocated string in case of a mal-
9674 * formed scanformat string or it contains '0' (NULL) in case of a valid
9675 * parse representation.
9677 * The whole memory of the internal representation is allocated as a single
9678 * area of memory that will be internally separated. So freeing and duplicating
9679 * of such an object is cheap */
9681 typedef struct ScanFmtStringObj
9683 jim_wide size; /* Size of internal repr in bytes */
9684 char *stringRep; /* Original string representation */
9685 size_t count; /* Number of ScanFmtPartDescr contained */
9686 size_t convCount; /* Number of conversions that will assign */
9687 size_t maxPos; /* Max position index if XPG3 is used */
9688 const char *error; /* Ptr to error text (NULL if no error */
9689 char *scratch; /* Some scratch pad used by Jim_ScanString */
9690 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9691 } ScanFmtStringObj;
9694 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9695 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9696 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9698 static const Jim_ObjType scanFmtStringObjType = {
9699 "scanformatstring",
9700 FreeScanFmtInternalRep,
9701 DupScanFmtInternalRep,
9702 UpdateStringOfScanFmt,
9703 JIM_TYPE_NONE,
9706 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9708 JIM_NOTUSED(interp);
9709 Jim_Free((char *)objPtr->internalRep.ptr);
9710 objPtr->internalRep.ptr = 0;
9713 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9715 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9716 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9718 JIM_NOTUSED(interp);
9719 memcpy(newVec, srcPtr->internalRep.ptr, size);
9720 dupPtr->internalRep.ptr = newVec;
9721 dupPtr->typePtr = &scanFmtStringObjType;
9724 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9726 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9729 /* SetScanFmtFromAny will parse a given string and create the internal
9730 * representation of the format specification. In case of an error
9731 * the error data member of the internal representation will be set
9732 * to an descriptive error text and the function will be left with
9733 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9734 * specification */
9736 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9738 ScanFmtStringObj *fmtObj;
9739 char *buffer;
9740 int maxCount, i, approxSize, lastPos = -1;
9741 const char *fmt = objPtr->bytes;
9742 int maxFmtLen = objPtr->length;
9743 const char *fmtEnd = fmt + maxFmtLen;
9744 int curr;
9746 Jim_FreeIntRep(interp, objPtr);
9747 /* Count how many conversions could take place maximally */
9748 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9749 if (fmt[i] == '%')
9750 ++maxCount;
9751 /* Calculate an approximation of the memory necessary */
9752 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9753 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9754 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9755 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9756 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9757 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9758 +1; /* safety byte */
9759 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9760 memset(fmtObj, 0, approxSize);
9761 fmtObj->size = approxSize;
9762 fmtObj->maxPos = 0;
9763 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9764 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9765 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9766 buffer = fmtObj->stringRep + maxFmtLen + 1;
9767 objPtr->internalRep.ptr = fmtObj;
9768 objPtr->typePtr = &scanFmtStringObjType;
9769 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9770 int width = 0, skip;
9771 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9773 fmtObj->count++;
9774 descr->width = 0; /* Assume width unspecified */
9775 /* Overread and store any "literal" prefix */
9776 if (*fmt != '%' || fmt[1] == '%') {
9777 descr->type = 0;
9778 descr->prefix = &buffer[i];
9779 for (; fmt < fmtEnd; ++fmt) {
9780 if (*fmt == '%') {
9781 if (fmt[1] != '%')
9782 break;
9783 ++fmt;
9785 buffer[i++] = *fmt;
9787 buffer[i++] = 0;
9789 /* Skip the conversion introducing '%' sign */
9790 ++fmt;
9791 /* End reached due to non-conversion literal only? */
9792 if (fmt >= fmtEnd)
9793 goto done;
9794 descr->pos = 0; /* Assume "natural" positioning */
9795 if (*fmt == '*') {
9796 descr->pos = -1; /* Okay, conversion will not be assigned */
9797 ++fmt;
9799 else
9800 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9801 /* Check if next token is a number (could be width or pos */
9802 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9803 fmt += skip;
9804 /* Was the number a XPG3 position specifier? */
9805 if (descr->pos != -1 && *fmt == '$') {
9806 int prev;
9808 ++fmt;
9809 descr->pos = width;
9810 width = 0;
9811 /* Look if "natural" postioning and XPG3 one was mixed */
9812 if ((lastPos == 0 && descr->pos > 0)
9813 || (lastPos > 0 && descr->pos == 0)) {
9814 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9815 return JIM_ERR;
9817 /* Look if this position was already used */
9818 for (prev = 0; prev < curr; ++prev) {
9819 if (fmtObj->descr[prev].pos == -1)
9820 continue;
9821 if (fmtObj->descr[prev].pos == descr->pos) {
9822 fmtObj->error =
9823 "variable is assigned by multiple \"%n$\" conversion specifiers";
9824 return JIM_ERR;
9827 /* Try to find a width after the XPG3 specifier */
9828 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9829 descr->width = width;
9830 fmt += skip;
9832 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9833 fmtObj->maxPos = descr->pos;
9835 else {
9836 /* Number was not a XPG3, so it has to be a width */
9837 descr->width = width;
9840 /* If positioning mode was undetermined yet, fix this */
9841 if (lastPos == -1)
9842 lastPos = descr->pos;
9843 /* Handle CHARSET conversion type ... */
9844 if (*fmt == '[') {
9845 int swapped = 1, beg = i, end, j;
9847 descr->type = '[';
9848 descr->arg = &buffer[i];
9849 ++fmt;
9850 if (*fmt == '^')
9851 buffer[i++] = *fmt++;
9852 if (*fmt == ']')
9853 buffer[i++] = *fmt++;
9854 while (*fmt && *fmt != ']')
9855 buffer[i++] = *fmt++;
9856 if (*fmt != ']') {
9857 fmtObj->error = "unmatched [ in format string";
9858 return JIM_ERR;
9860 end = i;
9861 buffer[i++] = 0;
9862 /* In case a range fence was given "backwards", swap it */
9863 while (swapped) {
9864 swapped = 0;
9865 for (j = beg + 1; j < end - 1; ++j) {
9866 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9867 char tmp = buffer[j - 1];
9869 buffer[j - 1] = buffer[j + 1];
9870 buffer[j + 1] = tmp;
9871 swapped = 1;
9876 else {
9877 /* Remember any valid modifier if given */
9878 if (strchr("hlL", *fmt) != 0)
9879 descr->modifier = tolower((int)*fmt++);
9881 descr->type = *fmt;
9882 if (strchr("efgcsndoxui", *fmt) == 0) {
9883 fmtObj->error = "bad scan conversion character";
9884 return JIM_ERR;
9886 else if (*fmt == 'c' && descr->width != 0) {
9887 fmtObj->error = "field width may not be specified in %c " "conversion";
9888 return JIM_ERR;
9890 else if (*fmt == 'u' && descr->modifier == 'l') {
9891 fmtObj->error = "unsigned wide not supported";
9892 return JIM_ERR;
9895 curr++;
9897 done:
9898 return JIM_OK;
9901 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9903 #define FormatGetCnvCount(_fo_) \
9904 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9905 #define FormatGetMaxPos(_fo_) \
9906 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9907 #define FormatGetError(_fo_) \
9908 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9910 /* JimScanAString is used to scan an unspecified string that ends with
9911 * next WS, or a string that is specified via a charset.
9914 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9916 char *buffer = Jim_StrDup(str);
9917 char *p = buffer;
9919 while (*str) {
9920 int c;
9921 int n;
9923 if (!sdescr && isspace(UCHAR(*str)))
9924 break; /* EOS via WS if unspecified */
9926 n = utf8_tounicode(str, &c);
9927 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9928 break;
9929 while (n--)
9930 *p++ = *str++;
9932 *p = 0;
9933 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9936 /* ScanOneEntry will scan one entry out of the string passed as argument.
9937 * It use the sscanf() function for this task. After extracting and
9938 * converting of the value, the count of scanned characters will be
9939 * returned of -1 in case of no conversion tool place and string was
9940 * already scanned thru */
9942 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9943 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9945 const char *tok;
9946 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9947 size_t scanned = 0;
9948 size_t anchor = pos;
9949 int i;
9950 Jim_Obj *tmpObj = NULL;
9952 /* First pessimistically assume, we will not scan anything :-) */
9953 *valObjPtr = 0;
9954 if (descr->prefix) {
9955 /* There was a prefix given before the conversion, skip it and adjust
9956 * the string-to-be-parsed accordingly */
9957 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9958 /* If prefix require, skip WS */
9959 if (isspace(UCHAR(descr->prefix[i])))
9960 while (pos < strLen && isspace(UCHAR(str[pos])))
9961 ++pos;
9962 else if (descr->prefix[i] != str[pos])
9963 break; /* Prefix do not match here, leave the loop */
9964 else
9965 ++pos; /* Prefix matched so far, next round */
9967 if (pos >= strLen) {
9968 return -1; /* All of str consumed: EOF condition */
9970 else if (descr->prefix[i] != 0)
9971 return 0; /* Not whole prefix consumed, no conversion possible */
9973 /* For all but following conversion, skip leading WS */
9974 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9975 while (isspace(UCHAR(str[pos])))
9976 ++pos;
9977 /* Determine how much skipped/scanned so far */
9978 scanned = pos - anchor;
9980 /* %c is a special, simple case. no width */
9981 if (descr->type == 'n') {
9982 /* Return pseudo conversion means: how much scanned so far? */
9983 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9985 else if (pos >= strLen) {
9986 /* Cannot scan anything, as str is totally consumed */
9987 return -1;
9989 else if (descr->type == 'c') {
9990 int c;
9991 scanned += utf8_tounicode(&str[pos], &c);
9992 *valObjPtr = Jim_NewIntObj(interp, c);
9993 return scanned;
9995 else {
9996 /* Processing of conversions follows ... */
9997 if (descr->width > 0) {
9998 /* Do not try to scan as fas as possible but only the given width.
9999 * To ensure this, we copy the part that should be scanned. */
10000 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
10001 size_t tLen = descr->width > sLen ? sLen : descr->width;
10003 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
10004 tok = tmpObj->bytes;
10006 else {
10007 /* As no width was given, simply refer to the original string */
10008 tok = &str[pos];
10010 switch (descr->type) {
10011 case 'd':
10012 case 'o':
10013 case 'x':
10014 case 'u':
10015 case 'i':{
10016 char *endp; /* Position where the number finished */
10017 jim_wide w;
10019 int base = descr->type == 'o' ? 8
10020 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
10022 /* Try to scan a number with the given base */
10023 if (base == 0) {
10024 w = jim_strtoull(tok, &endp);
10026 else {
10027 w = strtoull(tok, &endp, base);
10030 if (endp != tok) {
10031 /* There was some number sucessfully scanned! */
10032 *valObjPtr = Jim_NewIntObj(interp, w);
10034 /* Adjust the number-of-chars scanned so far */
10035 scanned += endp - tok;
10037 else {
10038 /* Nothing was scanned. We have to determine if this
10039 * happened due to e.g. prefix mismatch or input str
10040 * exhausted */
10041 scanned = *tok ? 0 : -1;
10043 break;
10045 case 's':
10046 case '[':{
10047 *valObjPtr = JimScanAString(interp, descr->arg, tok);
10048 scanned += Jim_Length(*valObjPtr);
10049 break;
10051 case 'e':
10052 case 'f':
10053 case 'g':{
10054 char *endp;
10055 double value = strtod(tok, &endp);
10057 if (endp != tok) {
10058 /* There was some number sucessfully scanned! */
10059 *valObjPtr = Jim_NewDoubleObj(interp, value);
10060 /* Adjust the number-of-chars scanned so far */
10061 scanned += endp - tok;
10063 else {
10064 /* Nothing was scanned. We have to determine if this
10065 * happened due to e.g. prefix mismatch or input str
10066 * exhausted */
10067 scanned = *tok ? 0 : -1;
10069 break;
10072 /* If a substring was allocated (due to pre-defined width) do not
10073 * forget to free it */
10074 if (tmpObj) {
10075 Jim_FreeNewObj(interp, tmpObj);
10078 return scanned;
10081 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
10082 * string and returns all converted (and not ignored) values in a list back
10083 * to the caller. If an error occured, a NULL pointer will be returned */
10085 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
10087 size_t i, pos;
10088 int scanned = 1;
10089 const char *str = Jim_String(strObjPtr);
10090 int strLen = Jim_Utf8Length(interp, strObjPtr);
10091 Jim_Obj *resultList = 0;
10092 Jim_Obj **resultVec = 0;
10093 int resultc;
10094 Jim_Obj *emptyStr = 0;
10095 ScanFmtStringObj *fmtObj;
10097 /* This should never happen. The format object should already be of the correct type */
10098 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
10100 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
10101 /* Check if format specification was valid */
10102 if (fmtObj->error != 0) {
10103 if (flags & JIM_ERRMSG)
10104 Jim_SetResultString(interp, fmtObj->error, -1);
10105 return 0;
10107 /* Allocate a new "shared" empty string for all unassigned conversions */
10108 emptyStr = Jim_NewEmptyStringObj(interp);
10109 Jim_IncrRefCount(emptyStr);
10110 /* Create a list and fill it with empty strings up to max specified XPG3 */
10111 resultList = Jim_NewListObj(interp, NULL, 0);
10112 if (fmtObj->maxPos > 0) {
10113 for (i = 0; i < fmtObj->maxPos; ++i)
10114 Jim_ListAppendElement(interp, resultList, emptyStr);
10115 JimListGetElements(interp, resultList, &resultc, &resultVec);
10117 /* Now handle every partial format description */
10118 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
10119 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
10120 Jim_Obj *value = 0;
10122 /* Only last type may be "literal" w/o conversion - skip it! */
10123 if (descr->type == 0)
10124 continue;
10125 /* As long as any conversion could be done, we will proceed */
10126 if (scanned > 0)
10127 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
10128 /* In case our first try results in EOF, we will leave */
10129 if (scanned == -1 && i == 0)
10130 goto eof;
10131 /* Advance next pos-to-be-scanned for the amount scanned already */
10132 pos += scanned;
10134 /* value == 0 means no conversion took place so take empty string */
10135 if (value == 0)
10136 value = Jim_NewEmptyStringObj(interp);
10137 /* If value is a non-assignable one, skip it */
10138 if (descr->pos == -1) {
10139 Jim_FreeNewObj(interp, value);
10141 else if (descr->pos == 0)
10142 /* Otherwise append it to the result list if no XPG3 was given */
10143 Jim_ListAppendElement(interp, resultList, value);
10144 else if (resultVec[descr->pos - 1] == emptyStr) {
10145 /* But due to given XPG3, put the value into the corr. slot */
10146 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
10147 Jim_IncrRefCount(value);
10148 resultVec[descr->pos - 1] = value;
10150 else {
10151 /* Otherwise, the slot was already used - free obj and ERROR */
10152 Jim_FreeNewObj(interp, value);
10153 goto err;
10156 Jim_DecrRefCount(interp, emptyStr);
10157 return resultList;
10158 eof:
10159 Jim_DecrRefCount(interp, emptyStr);
10160 Jim_FreeNewObj(interp, resultList);
10161 return (Jim_Obj *)EOF;
10162 err:
10163 Jim_DecrRefCount(interp, emptyStr);
10164 Jim_FreeNewObj(interp, resultList);
10165 return 0;
10168 /* -----------------------------------------------------------------------------
10169 * Pseudo Random Number Generation
10170 * ---------------------------------------------------------------------------*/
10171 /* Initialize the sbox with the numbers from 0 to 255 */
10172 static void JimPrngInit(Jim_Interp *interp)
10174 #define PRNG_SEED_SIZE 256
10175 int i;
10176 unsigned int *seed;
10177 time_t t = time(NULL);
10179 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10181 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10182 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10183 seed[i] = (rand() ^ t ^ clock());
10185 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10186 Jim_Free(seed);
10189 /* Generates N bytes of random data */
10190 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10192 Jim_PrngState *prng;
10193 unsigned char *destByte = (unsigned char *)dest;
10194 unsigned int si, sj, x;
10196 /* initialization, only needed the first time */
10197 if (interp->prngState == NULL)
10198 JimPrngInit(interp);
10199 prng = interp->prngState;
10200 /* generates 'len' bytes of pseudo-random numbers */
10201 for (x = 0; x < len; x++) {
10202 prng->i = (prng->i + 1) & 0xff;
10203 si = prng->sbox[prng->i];
10204 prng->j = (prng->j + si) & 0xff;
10205 sj = prng->sbox[prng->j];
10206 prng->sbox[prng->i] = sj;
10207 prng->sbox[prng->j] = si;
10208 *destByte++ = prng->sbox[(si + sj) & 0xff];
10212 /* Re-seed the generator with user-provided bytes */
10213 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10215 int i;
10216 Jim_PrngState *prng;
10218 /* initialization, only needed the first time */
10219 if (interp->prngState == NULL)
10220 JimPrngInit(interp);
10221 prng = interp->prngState;
10223 /* Set the sbox[i] with i */
10224 for (i = 0; i < 256; i++)
10225 prng->sbox[i] = i;
10226 /* Now use the seed to perform a random permutation of the sbox */
10227 for (i = 0; i < seedLen; i++) {
10228 unsigned char t;
10230 t = prng->sbox[i & 0xFF];
10231 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10232 prng->sbox[seed[i]] = t;
10234 prng->i = prng->j = 0;
10236 /* discard at least the first 256 bytes of stream.
10237 * borrow the seed buffer for this
10239 for (i = 0; i < 256; i += seedLen) {
10240 JimRandomBytes(interp, seed, seedLen);
10244 /* [incr] */
10245 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10247 jim_wide wideValue, increment = 1;
10248 Jim_Obj *intObjPtr;
10250 if (argc != 2 && argc != 3) {
10251 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10252 return JIM_ERR;
10254 if (argc == 3) {
10255 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10256 return JIM_ERR;
10258 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10259 if (!intObjPtr) {
10260 /* Set missing variable to 0 */
10261 wideValue = 0;
10263 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10264 return JIM_ERR;
10266 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10267 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10268 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10269 Jim_FreeNewObj(interp, intObjPtr);
10270 return JIM_ERR;
10273 else {
10274 /* Can do it the quick way */
10275 Jim_InvalidateStringRep(intObjPtr);
10276 JimWideValue(intObjPtr) = wideValue + increment;
10278 /* The following step is required in order to invalidate the
10279 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10280 if (argv[1]->typePtr != &variableObjType) {
10281 /* Note that this can't fail since GetVariable already succeeded */
10282 Jim_SetVariable(interp, argv[1], intObjPtr);
10285 Jim_SetResult(interp, intObjPtr);
10286 return JIM_OK;
10290 /* -----------------------------------------------------------------------------
10291 * Eval
10292 * ---------------------------------------------------------------------------*/
10293 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10294 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10296 /* Handle calls to the [unknown] command */
10297 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10299 int retcode;
10301 /* If JimUnknown() is recursively called too many times...
10302 * done here
10304 if (interp->unknown_called > 50) {
10305 return JIM_ERR;
10308 /* The object interp->unknown just contains
10309 * the "unknown" string, it is used in order to
10310 * avoid to lookup the unknown command every time
10311 * but instead to cache the result. */
10313 /* If the [unknown] command does not exist ... */
10314 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10315 return JIM_ERR;
10317 interp->unknown_called++;
10318 /* XXX: Are we losing fileNameObj and linenr? */
10319 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10320 interp->unknown_called--;
10322 return retcode;
10325 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10327 int retcode;
10328 Jim_Cmd *cmdPtr;
10330 #if 0
10331 printf("invoke");
10332 int j;
10333 for (j = 0; j < objc; j++) {
10334 printf(" '%s'", Jim_String(objv[j]));
10336 printf("\n");
10337 #endif
10339 if (interp->framePtr->tailcallCmd) {
10340 /* Special tailcall command was pre-resolved */
10341 cmdPtr = interp->framePtr->tailcallCmd;
10342 interp->framePtr->tailcallCmd = NULL;
10344 else {
10345 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10346 if (cmdPtr == NULL) {
10347 return JimUnknown(interp, objc, objv);
10349 JimIncrCmdRefCount(cmdPtr);
10352 if (interp->evalDepth == interp->maxEvalDepth) {
10353 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10354 retcode = JIM_ERR;
10355 goto out;
10357 interp->evalDepth++;
10359 /* Call it -- Make sure result is an empty object. */
10360 Jim_SetEmptyResult(interp);
10361 if (cmdPtr->isproc) {
10362 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10364 else {
10365 interp->cmdPrivData = cmdPtr->u.native.privData;
10366 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10368 interp->evalDepth--;
10370 out:
10371 JimDecrCmdRefCount(interp, cmdPtr);
10373 return retcode;
10376 /* Eval the object vector 'objv' composed of 'objc' elements.
10377 * Every element is used as single argument.
10378 * Jim_EvalObj() will call this function every time its object
10379 * argument is of "list" type, with no string representation.
10381 * This is possible because the string representation of a
10382 * list object generated by the UpdateStringOfList is made
10383 * in a way that ensures that every list element is a different
10384 * command argument. */
10385 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10387 int i, retcode;
10389 /* Incr refcount of arguments. */
10390 for (i = 0; i < objc; i++)
10391 Jim_IncrRefCount(objv[i]);
10393 retcode = JimInvokeCommand(interp, objc, objv);
10395 /* Decr refcount of arguments and return the retcode */
10396 for (i = 0; i < objc; i++)
10397 Jim_DecrRefCount(interp, objv[i]);
10399 return retcode;
10403 * Invokes 'prefix' as a command with the objv array as arguments.
10405 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10407 int ret;
10408 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10410 nargv[0] = prefix;
10411 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10412 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10413 Jim_Free(nargv);
10414 return ret;
10417 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10419 if (!interp->errorFlag) {
10420 /* This is the first error, so save the file/line information and reset the stack */
10421 interp->errorFlag = 1;
10422 Jim_IncrRefCount(script->fileNameObj);
10423 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10424 interp->errorFileNameObj = script->fileNameObj;
10425 interp->errorLine = script->linenr;
10427 JimResetStackTrace(interp);
10428 /* Always add a level where the error first occurs */
10429 interp->addStackTrace++;
10432 /* Now if this is an "interesting" level, add it to the stack trace */
10433 if (interp->addStackTrace > 0) {
10434 /* Add the stack info for the current level */
10436 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10438 /* Note: if we didn't have a filename for this level,
10439 * don't clear the addStackTrace flag
10440 * so we can pick it up at the next level
10442 if (Jim_Length(script->fileNameObj)) {
10443 interp->addStackTrace = 0;
10446 Jim_DecrRefCount(interp, interp->errorProc);
10447 interp->errorProc = interp->emptyObj;
10448 Jim_IncrRefCount(interp->errorProc);
10452 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10454 Jim_Obj *objPtr;
10456 switch (token->type) {
10457 case JIM_TT_STR:
10458 case JIM_TT_ESC:
10459 objPtr = token->objPtr;
10460 break;
10461 case JIM_TT_VAR:
10462 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10463 break;
10464 case JIM_TT_DICTSUGAR:
10465 objPtr = JimExpandDictSugar(interp, token->objPtr);
10466 break;
10467 case JIM_TT_EXPRSUGAR:
10468 objPtr = JimExpandExprSugar(interp, token->objPtr);
10469 break;
10470 case JIM_TT_CMD:
10471 switch (Jim_EvalObj(interp, token->objPtr)) {
10472 case JIM_OK:
10473 case JIM_RETURN:
10474 objPtr = interp->result;
10475 break;
10476 case JIM_BREAK:
10477 /* Stop substituting */
10478 return JIM_BREAK;
10479 case JIM_CONTINUE:
10480 /* just skip this one */
10481 return JIM_CONTINUE;
10482 default:
10483 return JIM_ERR;
10485 break;
10486 default:
10487 JimPanic((1,
10488 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10489 objPtr = NULL;
10490 break;
10492 if (objPtr) {
10493 *objPtrPtr = objPtr;
10494 return JIM_OK;
10496 return JIM_ERR;
10499 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10500 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10501 * The returned object has refcount = 0.
10503 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10505 int totlen = 0, i;
10506 Jim_Obj **intv;
10507 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10508 Jim_Obj *objPtr;
10509 char *s;
10511 if (tokens <= JIM_EVAL_SINTV_LEN)
10512 intv = sintv;
10513 else
10514 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10516 /* Compute every token forming the argument
10517 * in the intv objects vector. */
10518 for (i = 0; i < tokens; i++) {
10519 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10520 case JIM_OK:
10521 case JIM_RETURN:
10522 break;
10523 case JIM_BREAK:
10524 if (flags & JIM_SUBST_FLAG) {
10525 /* Stop here */
10526 tokens = i;
10527 continue;
10529 /* XXX: Should probably set an error about break outside loop */
10530 /* fall through to error */
10531 case JIM_CONTINUE:
10532 if (flags & JIM_SUBST_FLAG) {
10533 intv[i] = NULL;
10534 continue;
10536 /* XXX: Ditto continue outside loop */
10537 /* fall through to error */
10538 default:
10539 while (i--) {
10540 Jim_DecrRefCount(interp, intv[i]);
10542 if (intv != sintv) {
10543 Jim_Free(intv);
10545 return NULL;
10547 Jim_IncrRefCount(intv[i]);
10548 Jim_String(intv[i]);
10549 totlen += intv[i]->length;
10552 /* Fast path return for a single token */
10553 if (tokens == 1 && intv[0] && intv == sintv) {
10554 Jim_DecrRefCount(interp, intv[0]);
10555 return intv[0];
10558 /* Concatenate every token in an unique
10559 * object. */
10560 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10562 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10563 && token[2].type == JIM_TT_VAR) {
10564 /* May be able to do fast interpolated object -> dictSubst */
10565 objPtr->typePtr = &interpolatedObjType;
10566 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10567 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10568 Jim_IncrRefCount(intv[2]);
10570 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10571 /* The first interpolated token is source, so preserve the source info */
10572 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10576 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10577 objPtr->length = totlen;
10578 for (i = 0; i < tokens; i++) {
10579 if (intv[i]) {
10580 memcpy(s, intv[i]->bytes, intv[i]->length);
10581 s += intv[i]->length;
10582 Jim_DecrRefCount(interp, intv[i]);
10585 objPtr->bytes[totlen] = '\0';
10586 /* Free the intv vector if not static. */
10587 if (intv != sintv) {
10588 Jim_Free(intv);
10591 return objPtr;
10595 /* listPtr *must* be a list.
10596 * The contents of the list is evaluated with the first element as the command and
10597 * the remaining elements as the arguments.
10599 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10601 int retcode = JIM_OK;
10603 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10605 if (listPtr->internalRep.listValue.len) {
10606 Jim_IncrRefCount(listPtr);
10607 retcode = JimInvokeCommand(interp,
10608 listPtr->internalRep.listValue.len,
10609 listPtr->internalRep.listValue.ele);
10610 Jim_DecrRefCount(interp, listPtr);
10612 return retcode;
10615 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10617 SetListFromAny(interp, listPtr);
10618 return JimEvalObjList(interp, listPtr);
10621 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10623 int i;
10624 ScriptObj *script;
10625 ScriptToken *token;
10626 int retcode = JIM_OK;
10627 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10628 Jim_Obj *prevScriptObj;
10630 /* If the object is of type "list", with no string rep we can call
10631 * a specialized version of Jim_EvalObj() */
10632 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10633 return JimEvalObjList(interp, scriptObjPtr);
10636 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10637 script = JimGetScript(interp, scriptObjPtr);
10638 if (!JimScriptValid(interp, script)) {
10639 Jim_DecrRefCount(interp, scriptObjPtr);
10640 return JIM_ERR;
10643 /* Reset the interpreter result. This is useful to
10644 * return the empty result in the case of empty program. */
10645 Jim_SetEmptyResult(interp);
10647 token = script->token;
10649 #ifdef JIM_OPTIMIZATION
10650 /* Check for one of the following common scripts used by for, while
10652 * {}
10653 * incr a
10655 if (script->len == 0) {
10656 Jim_DecrRefCount(interp, scriptObjPtr);
10657 return JIM_OK;
10659 if (script->len == 3
10660 && token[1].objPtr->typePtr == &commandObjType
10661 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10662 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10663 && token[2].objPtr->typePtr == &variableObjType) {
10665 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10667 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10668 JimWideValue(objPtr)++;
10669 Jim_InvalidateStringRep(objPtr);
10670 Jim_DecrRefCount(interp, scriptObjPtr);
10671 Jim_SetResult(interp, objPtr);
10672 return JIM_OK;
10675 #endif
10677 /* Now we have to make sure the internal repr will not be
10678 * freed on shimmering.
10680 * Think for example to this:
10682 * set x {llength $x; ... some more code ...}; eval $x
10684 * In order to preserve the internal rep, we increment the
10685 * inUse field of the script internal rep structure. */
10686 script->inUse++;
10688 /* Stash the current script */
10689 prevScriptObj = interp->currentScriptObj;
10690 interp->currentScriptObj = scriptObjPtr;
10692 interp->errorFlag = 0;
10693 argv = sargv;
10695 /* Execute every command sequentially until the end of the script
10696 * or an error occurs.
10698 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10699 int argc;
10700 int j;
10702 /* First token of the line is always JIM_TT_LINE */
10703 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10704 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10706 /* Allocate the arguments vector if required */
10707 if (argc > JIM_EVAL_SARGV_LEN)
10708 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10710 /* Skip the JIM_TT_LINE token */
10711 i++;
10713 /* Populate the arguments objects.
10714 * If an error occurs, retcode will be set and
10715 * 'j' will be set to the number of args expanded
10717 for (j = 0; j < argc; j++) {
10718 long wordtokens = 1;
10719 int expand = 0;
10720 Jim_Obj *wordObjPtr = NULL;
10722 if (token[i].type == JIM_TT_WORD) {
10723 wordtokens = JimWideValue(token[i++].objPtr);
10724 if (wordtokens < 0) {
10725 expand = 1;
10726 wordtokens = -wordtokens;
10730 if (wordtokens == 1) {
10731 /* Fast path if the token does not
10732 * need interpolation */
10734 switch (token[i].type) {
10735 case JIM_TT_ESC:
10736 case JIM_TT_STR:
10737 wordObjPtr = token[i].objPtr;
10738 break;
10739 case JIM_TT_VAR:
10740 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10741 break;
10742 case JIM_TT_EXPRSUGAR:
10743 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10744 break;
10745 case JIM_TT_DICTSUGAR:
10746 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10747 break;
10748 case JIM_TT_CMD:
10749 retcode = Jim_EvalObj(interp, token[i].objPtr);
10750 if (retcode == JIM_OK) {
10751 wordObjPtr = Jim_GetResult(interp);
10753 break;
10754 default:
10755 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10758 else {
10759 /* For interpolation we call a helper
10760 * function to do the work for us. */
10761 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10764 if (!wordObjPtr) {
10765 if (retcode == JIM_OK) {
10766 retcode = JIM_ERR;
10768 break;
10771 Jim_IncrRefCount(wordObjPtr);
10772 i += wordtokens;
10774 if (!expand) {
10775 argv[j] = wordObjPtr;
10777 else {
10778 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10779 int len = Jim_ListLength(interp, wordObjPtr);
10780 int newargc = argc + len - 1;
10781 int k;
10783 if (len > 1) {
10784 if (argv == sargv) {
10785 if (newargc > JIM_EVAL_SARGV_LEN) {
10786 argv = Jim_Alloc(sizeof(*argv) * newargc);
10787 memcpy(argv, sargv, sizeof(*argv) * j);
10790 else {
10791 /* Need to realloc to make room for (len - 1) more entries */
10792 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10796 /* Now copy in the expanded version */
10797 for (k = 0; k < len; k++) {
10798 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10799 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10802 /* The original object reference is no longer needed,
10803 * after the expansion it is no longer present on
10804 * the argument vector, but the single elements are
10805 * in its place. */
10806 Jim_DecrRefCount(interp, wordObjPtr);
10808 /* And update the indexes */
10809 j--;
10810 argc += len - 1;
10814 if (retcode == JIM_OK && argc) {
10815 /* Invoke the command */
10816 retcode = JimInvokeCommand(interp, argc, argv);
10817 /* Check for a signal after each command */
10818 if (Jim_CheckSignal(interp)) {
10819 retcode = JIM_SIGNAL;
10823 /* Finished with the command, so decrement ref counts of each argument */
10824 while (j-- > 0) {
10825 Jim_DecrRefCount(interp, argv[j]);
10828 if (argv != sargv) {
10829 Jim_Free(argv);
10830 argv = sargv;
10834 /* Possibly add to the error stack trace */
10835 if (retcode == JIM_ERR) {
10836 JimAddErrorToStack(interp, script);
10838 /* Propagate the addStackTrace value through 'return -code error' */
10839 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10840 /* No need to add stack trace */
10841 interp->addStackTrace = 0;
10844 /* Restore the current script */
10845 interp->currentScriptObj = prevScriptObj;
10847 /* Note that we don't have to decrement inUse, because the
10848 * following code transfers our use of the reference again to
10849 * the script object. */
10850 Jim_FreeIntRep(interp, scriptObjPtr);
10851 scriptObjPtr->typePtr = &scriptObjType;
10852 Jim_SetIntRepPtr(scriptObjPtr, script);
10853 Jim_DecrRefCount(interp, scriptObjPtr);
10855 return retcode;
10858 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10860 int retcode;
10861 /* If argObjPtr begins with '&', do an automatic upvar */
10862 const char *varname = Jim_String(argNameObj);
10863 if (*varname == '&') {
10864 /* First check that the target variable exists */
10865 Jim_Obj *objPtr;
10866 Jim_CallFrame *savedCallFrame = interp->framePtr;
10868 interp->framePtr = interp->framePtr->parent;
10869 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10870 interp->framePtr = savedCallFrame;
10871 if (!objPtr) {
10872 return JIM_ERR;
10875 /* It exists, so perform the binding. */
10876 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10877 Jim_IncrRefCount(objPtr);
10878 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10879 Jim_DecrRefCount(interp, objPtr);
10881 else {
10882 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10884 return retcode;
10888 * Sets the interp result to be an error message indicating the required proc args.
10890 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10892 /* Create a nice error message, consistent with Tcl 8.5 */
10893 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10894 int i;
10896 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10897 Jim_AppendString(interp, argmsg, " ", 1);
10899 if (i == cmd->u.proc.argsPos) {
10900 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10901 /* Renamed args */
10902 Jim_AppendString(interp, argmsg, "?", 1);
10903 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10904 Jim_AppendString(interp, argmsg, " ...?", -1);
10906 else {
10907 /* We have plain args */
10908 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10911 else {
10912 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10913 Jim_AppendString(interp, argmsg, "?", 1);
10914 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10915 Jim_AppendString(interp, argmsg, "?", 1);
10917 else {
10918 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10919 if (*arg == '&') {
10920 arg++;
10922 Jim_AppendString(interp, argmsg, arg, -1);
10926 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10927 Jim_FreeNewObj(interp, argmsg);
10930 #ifdef jim_ext_namespace
10932 * [namespace eval]
10934 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10936 Jim_CallFrame *callFramePtr;
10937 int retcode;
10939 /* Create a new callframe */
10940 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10941 callFramePtr->argv = &interp->emptyObj;
10942 callFramePtr->argc = 0;
10943 callFramePtr->procArgsObjPtr = NULL;
10944 callFramePtr->procBodyObjPtr = scriptObj;
10945 callFramePtr->staticVars = NULL;
10946 callFramePtr->fileNameObj = interp->emptyObj;
10947 callFramePtr->line = 0;
10948 Jim_IncrRefCount(scriptObj);
10949 interp->framePtr = callFramePtr;
10951 /* Check if there are too nested calls */
10952 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10953 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10954 retcode = JIM_ERR;
10956 else {
10957 /* Eval the body */
10958 retcode = Jim_EvalObj(interp, scriptObj);
10961 /* Destroy the callframe */
10962 interp->framePtr = interp->framePtr->parent;
10963 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10965 return retcode;
10967 #endif
10969 /* Call a procedure implemented in Tcl.
10970 * It's possible to speed-up a lot this function, currently
10971 * the callframes are not cached, but allocated and
10972 * destroied every time. What is expecially costly is
10973 * to create/destroy the local vars hash table every time.
10975 * This can be fixed just implementing callframes caching
10976 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10977 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10979 Jim_CallFrame *callFramePtr;
10980 int i, d, retcode, optargs;
10981 ScriptObj *script;
10983 /* Check arity */
10984 if (argc - 1 < cmd->u.proc.reqArity ||
10985 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10986 JimSetProcWrongArgs(interp, argv[0], cmd);
10987 return JIM_ERR;
10990 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10991 /* Optimise for procedure with no body - useful for optional debugging */
10992 return JIM_OK;
10995 /* Check if there are too nested calls */
10996 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10997 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10998 return JIM_ERR;
11001 /* Create a new callframe */
11002 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
11003 callFramePtr->argv = argv;
11004 callFramePtr->argc = argc;
11005 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
11006 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
11007 callFramePtr->staticVars = cmd->u.proc.staticVars;
11009 /* Remember where we were called from. */
11010 script = JimGetScript(interp, interp->currentScriptObj);
11011 callFramePtr->fileNameObj = script->fileNameObj;
11012 callFramePtr->line = script->linenr;
11014 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
11015 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
11016 interp->framePtr = callFramePtr;
11018 /* How many optional args are available */
11019 optargs = (argc - 1 - cmd->u.proc.reqArity);
11021 /* Step 'i' along the actual args, and step 'd' along the formal args */
11022 i = 1;
11023 for (d = 0; d < cmd->u.proc.argListLen; d++) {
11024 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
11025 if (d == cmd->u.proc.argsPos) {
11026 /* assign $args */
11027 Jim_Obj *listObjPtr;
11028 int argsLen = 0;
11029 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
11030 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
11032 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
11034 /* It is possible to rename args. */
11035 if (cmd->u.proc.arglist[d].defaultObjPtr) {
11036 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
11038 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
11039 if (retcode != JIM_OK) {
11040 goto badargset;
11043 i += argsLen;
11044 continue;
11047 /* Optional or required? */
11048 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
11049 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
11051 else {
11052 /* Ran out, so use the default */
11053 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
11055 if (retcode != JIM_OK) {
11056 goto badargset;
11060 /* Eval the body */
11061 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
11063 badargset:
11065 /* Free the callframe */
11066 interp->framePtr = interp->framePtr->parent;
11067 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
11069 /* Now chain any tailcalls in the parent frame */
11070 if (interp->framePtr->tailcallObj) {
11071 do {
11072 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
11074 interp->framePtr->tailcallObj = NULL;
11076 if (retcode == JIM_EVAL) {
11077 retcode = Jim_EvalObjList(interp, tailcallObj);
11078 if (retcode == JIM_RETURN) {
11079 /* If the result of the tailcall is 'return', push
11080 * it up to the caller
11082 interp->returnLevel++;
11085 Jim_DecrRefCount(interp, tailcallObj);
11086 } while (interp->framePtr->tailcallObj);
11088 /* If the tailcall chain finished early, may need to manually discard the command */
11089 if (interp->framePtr->tailcallCmd) {
11090 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
11091 interp->framePtr->tailcallCmd = NULL;
11095 /* Handle the JIM_RETURN return code */
11096 if (retcode == JIM_RETURN) {
11097 if (--interp->returnLevel <= 0) {
11098 retcode = interp->returnCode;
11099 interp->returnCode = JIM_OK;
11100 interp->returnLevel = 0;
11103 else if (retcode == JIM_ERR) {
11104 interp->addStackTrace++;
11105 Jim_DecrRefCount(interp, interp->errorProc);
11106 interp->errorProc = argv[0];
11107 Jim_IncrRefCount(interp->errorProc);
11110 return retcode;
11113 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
11115 int retval;
11116 Jim_Obj *scriptObjPtr;
11118 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
11119 Jim_IncrRefCount(scriptObjPtr);
11121 if (filename) {
11122 Jim_Obj *prevScriptObj;
11124 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
11126 prevScriptObj = interp->currentScriptObj;
11127 interp->currentScriptObj = scriptObjPtr;
11129 retval = Jim_EvalObj(interp, scriptObjPtr);
11131 interp->currentScriptObj = prevScriptObj;
11133 else {
11134 retval = Jim_EvalObj(interp, scriptObjPtr);
11136 Jim_DecrRefCount(interp, scriptObjPtr);
11137 return retval;
11140 int Jim_Eval(Jim_Interp *interp, const char *script)
11142 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
11145 /* Execute script in the scope of the global level */
11146 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
11148 int retval;
11149 Jim_CallFrame *savedFramePtr = interp->framePtr;
11151 interp->framePtr = interp->topFramePtr;
11152 retval = Jim_Eval(interp, script);
11153 interp->framePtr = savedFramePtr;
11155 return retval;
11158 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
11160 int retval;
11161 Jim_CallFrame *savedFramePtr = interp->framePtr;
11163 interp->framePtr = interp->topFramePtr;
11164 retval = Jim_EvalFile(interp, filename);
11165 interp->framePtr = savedFramePtr;
11167 return retval;
11170 #include <sys/stat.h>
11172 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11174 FILE *fp;
11175 char *buf;
11176 Jim_Obj *scriptObjPtr;
11177 Jim_Obj *prevScriptObj;
11178 struct stat sb;
11179 int retcode;
11180 int readlen;
11182 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11183 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11184 return JIM_ERR;
11186 if (sb.st_size == 0) {
11187 fclose(fp);
11188 return JIM_OK;
11191 buf = Jim_Alloc(sb.st_size + 1);
11192 readlen = fread(buf, 1, sb.st_size, fp);
11193 if (ferror(fp)) {
11194 fclose(fp);
11195 Jim_Free(buf);
11196 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11197 return JIM_ERR;
11199 fclose(fp);
11200 buf[readlen] = 0;
11202 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11203 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11204 Jim_IncrRefCount(scriptObjPtr);
11206 prevScriptObj = interp->currentScriptObj;
11207 interp->currentScriptObj = scriptObjPtr;
11209 retcode = Jim_EvalObj(interp, scriptObjPtr);
11211 /* Handle the JIM_RETURN return code */
11212 if (retcode == JIM_RETURN) {
11213 if (--interp->returnLevel <= 0) {
11214 retcode = interp->returnCode;
11215 interp->returnCode = JIM_OK;
11216 interp->returnLevel = 0;
11219 if (retcode == JIM_ERR) {
11220 /* EvalFile changes context, so add a stack frame here */
11221 interp->addStackTrace++;
11224 interp->currentScriptObj = prevScriptObj;
11226 Jim_DecrRefCount(interp, scriptObjPtr);
11228 return retcode;
11231 /* -----------------------------------------------------------------------------
11232 * Subst
11233 * ---------------------------------------------------------------------------*/
11234 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11236 pc->tstart = pc->p;
11237 pc->tline = pc->linenr;
11239 if (pc->len == 0) {
11240 pc->tend = pc->p;
11241 pc->tt = JIM_TT_EOL;
11242 pc->eof = 1;
11243 return;
11245 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11246 JimParseCmd(pc);
11247 return;
11249 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11250 if (JimParseVar(pc) == JIM_OK) {
11251 return;
11253 /* Not a var, so treat as a string */
11254 pc->tstart = pc->p;
11255 flags |= JIM_SUBST_NOVAR;
11257 while (pc->len) {
11258 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11259 break;
11261 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11262 break;
11264 if (*pc->p == '\\' && pc->len > 1) {
11265 pc->p++;
11266 pc->len--;
11268 pc->p++;
11269 pc->len--;
11271 pc->tend = pc->p - 1;
11272 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11275 /* The subst object type reuses most of the data structures and functions
11276 * of the script object. Script's data structures are a bit more complex
11277 * for what is needed for [subst]itution tasks, but the reuse helps to
11278 * deal with a single data structure at the cost of some more memory
11279 * usage for substitutions. */
11281 /* This method takes the string representation of an object
11282 * as a Tcl string where to perform [subst]itution, and generates
11283 * the pre-parsed internal representation. */
11284 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11286 int scriptTextLen;
11287 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11288 struct JimParserCtx parser;
11289 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11290 ParseTokenList tokenlist;
11292 /* Initially parse the subst into tokens (in tokenlist) */
11293 ScriptTokenListInit(&tokenlist);
11295 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11296 while (1) {
11297 JimParseSubst(&parser, flags);
11298 if (parser.eof) {
11299 /* Note that subst doesn't need the EOL token */
11300 break;
11302 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11303 parser.tline);
11306 /* Create the "real" subst/script tokens from the initial token list */
11307 script->inUse = 1;
11308 script->substFlags = flags;
11309 script->fileNameObj = interp->emptyObj;
11310 Jim_IncrRefCount(script->fileNameObj);
11311 SubstObjAddTokens(interp, script, &tokenlist);
11313 /* No longer need the token list */
11314 ScriptTokenListFree(&tokenlist);
11316 #ifdef DEBUG_SHOW_SUBST
11318 int i;
11320 printf("==== Subst ====\n");
11321 for (i = 0; i < script->len; i++) {
11322 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11323 Jim_String(script->token[i].objPtr));
11326 #endif
11328 /* Free the old internal rep and set the new one. */
11329 Jim_FreeIntRep(interp, objPtr);
11330 Jim_SetIntRepPtr(objPtr, script);
11331 objPtr->typePtr = &scriptObjType;
11332 return JIM_OK;
11335 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11337 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11338 SetSubstFromAny(interp, objPtr, flags);
11339 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11342 /* Performs commands,variables,blackslashes substitution,
11343 * storing the result object (with refcount 0) into
11344 * resObjPtrPtr. */
11345 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11347 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11349 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11350 /* In order to preserve the internal rep, we increment the
11351 * inUse field of the script internal rep structure. */
11352 script->inUse++;
11354 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11356 script->inUse--;
11357 Jim_DecrRefCount(interp, substObjPtr);
11358 if (*resObjPtrPtr == NULL) {
11359 return JIM_ERR;
11361 return JIM_OK;
11364 /* -----------------------------------------------------------------------------
11365 * Core commands utility functions
11366 * ---------------------------------------------------------------------------*/
11367 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11369 Jim_Obj *objPtr;
11370 Jim_Obj *listObjPtr;
11372 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11374 listObjPtr = Jim_NewListObj(interp, argv, argc);
11376 if (*msg) {
11377 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11379 Jim_IncrRefCount(listObjPtr);
11380 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11381 Jim_DecrRefCount(interp, listObjPtr);
11383 Jim_IncrRefCount(objPtr);
11384 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11385 Jim_DecrRefCount(interp, objPtr);
11389 * May add the key and/or value to the list.
11391 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11392 Jim_HashEntry *he, int type);
11394 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11397 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11398 * invoke the callback to add entries to a list.
11399 * Returns the list.
11401 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11402 JimHashtableIteratorCallbackType *callback, int type)
11404 Jim_HashEntry *he;
11405 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11407 /* Check for the non-pattern case. We can do this much more efficiently. */
11408 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11409 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11410 if (he) {
11411 callback(interp, listObjPtr, he, type);
11414 else {
11415 Jim_HashTableIterator htiter;
11416 JimInitHashTableIterator(ht, &htiter);
11417 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11418 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11419 callback(interp, listObjPtr, he, type);
11423 return listObjPtr;
11426 /* Keep these in order */
11427 #define JIM_CMDLIST_COMMANDS 0
11428 #define JIM_CMDLIST_PROCS 1
11429 #define JIM_CMDLIST_CHANNELS 2
11432 * Adds matching command names (procs, channels) to the list.
11434 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11435 Jim_HashEntry *he, int type)
11437 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11438 Jim_Obj *objPtr;
11440 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11441 /* not a proc */
11442 return;
11445 objPtr = Jim_NewStringObj(interp, he->key, -1);
11446 Jim_IncrRefCount(objPtr);
11448 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11449 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11451 Jim_DecrRefCount(interp, objPtr);
11454 /* type is JIM_CMDLIST_xxx */
11455 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11457 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11460 /* Keep these in order */
11461 #define JIM_VARLIST_GLOBALS 0
11462 #define JIM_VARLIST_LOCALS 1
11463 #define JIM_VARLIST_VARS 2
11465 #define JIM_VARLIST_VALUES 0x1000
11468 * Adds matching variable names to the list.
11470 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11471 Jim_HashEntry *he, int type)
11473 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11475 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11476 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11477 if (type & JIM_VARLIST_VALUES) {
11478 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11483 /* mode is JIM_VARLIST_xxx */
11484 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11486 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11487 /* For [info locals], if we are at top level an emtpy list
11488 * is returned. I don't agree, but we aim at compatibility (SS) */
11489 return interp->emptyObj;
11491 else {
11492 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11493 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11497 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11498 Jim_Obj **objPtrPtr, int info_level_cmd)
11500 Jim_CallFrame *targetCallFrame;
11502 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11503 if (targetCallFrame == NULL) {
11504 return JIM_ERR;
11506 /* No proc call at toplevel callframe */
11507 if (targetCallFrame == interp->topFramePtr) {
11508 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11509 return JIM_ERR;
11511 if (info_level_cmd) {
11512 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11514 else {
11515 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11517 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11518 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11519 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11520 *objPtrPtr = listObj;
11522 return JIM_OK;
11525 /* -----------------------------------------------------------------------------
11526 * Core commands
11527 * ---------------------------------------------------------------------------*/
11529 /* fake [puts] -- not the real puts, just for debugging. */
11530 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11532 if (argc != 2 && argc != 3) {
11533 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11534 return JIM_ERR;
11536 if (argc == 3) {
11537 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11538 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11539 return JIM_ERR;
11541 else {
11542 fputs(Jim_String(argv[2]), stdout);
11545 else {
11546 puts(Jim_String(argv[1]));
11548 return JIM_OK;
11551 /* Helper for [+] and [*] */
11552 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11554 jim_wide wideValue, res;
11555 double doubleValue, doubleRes;
11556 int i;
11558 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11560 for (i = 1; i < argc; i++) {
11561 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11562 goto trydouble;
11563 if (op == JIM_EXPROP_ADD)
11564 res += wideValue;
11565 else
11566 res *= wideValue;
11568 Jim_SetResultInt(interp, res);
11569 return JIM_OK;
11570 trydouble:
11571 doubleRes = (double)res;
11572 for (; i < argc; i++) {
11573 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11574 return JIM_ERR;
11575 if (op == JIM_EXPROP_ADD)
11576 doubleRes += doubleValue;
11577 else
11578 doubleRes *= doubleValue;
11580 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11581 return JIM_OK;
11584 /* Helper for [-] and [/] */
11585 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11587 jim_wide wideValue, res = 0;
11588 double doubleValue, doubleRes = 0;
11589 int i = 2;
11591 if (argc < 2) {
11592 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11593 return JIM_ERR;
11595 else if (argc == 2) {
11596 /* The arity = 2 case is different. For [- x] returns -x,
11597 * while [/ x] returns 1/x. */
11598 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11599 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11600 return JIM_ERR;
11602 else {
11603 if (op == JIM_EXPROP_SUB)
11604 doubleRes = -doubleValue;
11605 else
11606 doubleRes = 1.0 / doubleValue;
11607 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11608 return JIM_OK;
11611 if (op == JIM_EXPROP_SUB) {
11612 res = -wideValue;
11613 Jim_SetResultInt(interp, res);
11615 else {
11616 doubleRes = 1.0 / wideValue;
11617 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11619 return JIM_OK;
11621 else {
11622 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11623 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11624 != JIM_OK) {
11625 return JIM_ERR;
11627 else {
11628 goto trydouble;
11632 for (i = 2; i < argc; i++) {
11633 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11634 doubleRes = (double)res;
11635 goto trydouble;
11637 if (op == JIM_EXPROP_SUB)
11638 res -= wideValue;
11639 else
11640 res /= wideValue;
11642 Jim_SetResultInt(interp, res);
11643 return JIM_OK;
11644 trydouble:
11645 for (; i < argc; i++) {
11646 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11647 return JIM_ERR;
11648 if (op == JIM_EXPROP_SUB)
11649 doubleRes -= doubleValue;
11650 else
11651 doubleRes /= doubleValue;
11653 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11654 return JIM_OK;
11658 /* [+] */
11659 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11661 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11664 /* [*] */
11665 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11667 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11670 /* [-] */
11671 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11673 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11676 /* [/] */
11677 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11679 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11682 /* [set] */
11683 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11685 if (argc != 2 && argc != 3) {
11686 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11687 return JIM_ERR;
11689 if (argc == 2) {
11690 Jim_Obj *objPtr;
11692 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11693 if (!objPtr)
11694 return JIM_ERR;
11695 Jim_SetResult(interp, objPtr);
11696 return JIM_OK;
11698 /* argc == 3 case. */
11699 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11700 return JIM_ERR;
11701 Jim_SetResult(interp, argv[2]);
11702 return JIM_OK;
11705 /* [unset]
11707 * unset ?-nocomplain? ?--? ?varName ...?
11709 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11711 int i = 1;
11712 int complain = 1;
11714 while (i < argc) {
11715 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11716 i++;
11717 break;
11719 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11720 complain = 0;
11721 i++;
11722 continue;
11724 break;
11727 while (i < argc) {
11728 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11729 && complain) {
11730 return JIM_ERR;
11732 i++;
11734 return JIM_OK;
11737 /* [while] */
11738 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11740 if (argc != 3) {
11741 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11742 return JIM_ERR;
11745 /* The general purpose implementation of while starts here */
11746 while (1) {
11747 int boolean, retval;
11749 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11750 return retval;
11751 if (!boolean)
11752 break;
11754 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11755 switch (retval) {
11756 case JIM_BREAK:
11757 goto out;
11758 break;
11759 case JIM_CONTINUE:
11760 continue;
11761 break;
11762 default:
11763 return retval;
11767 out:
11768 Jim_SetEmptyResult(interp);
11769 return JIM_OK;
11772 /* [for] */
11773 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11775 int retval;
11776 int boolean = 1;
11777 Jim_Obj *varNamePtr = NULL;
11778 Jim_Obj *stopVarNamePtr = NULL;
11780 if (argc != 5) {
11781 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11782 return JIM_ERR;
11785 /* Do the initialisation */
11786 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11787 return retval;
11790 /* And do the first test now. Better for optimisation
11791 * if we can do next/test at the bottom of the loop
11793 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11795 /* Ready to do the body as follows:
11796 * while (1) {
11797 * body // check retcode
11798 * next // check retcode
11799 * test // check retcode/test bool
11803 #ifdef JIM_OPTIMIZATION
11804 /* Check if the for is on the form:
11805 * for ... {$i < CONST} {incr i}
11806 * for ... {$i < $j} {incr i}
11808 if (retval == JIM_OK && boolean) {
11809 ScriptObj *incrScript;
11810 ExprByteCode *expr;
11811 jim_wide stop, currentVal;
11812 Jim_Obj *objPtr;
11813 int cmpOffset;
11815 /* Do it only if there aren't shared arguments */
11816 expr = JimGetExpression(interp, argv[2]);
11817 incrScript = JimGetScript(interp, argv[3]);
11819 /* Ensure proper lengths to start */
11820 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11821 goto evalstart;
11823 /* Ensure proper token types. */
11824 if (incrScript->token[1].type != JIM_TT_ESC ||
11825 expr->token[0].type != JIM_TT_VAR ||
11826 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11827 goto evalstart;
11830 if (expr->token[2].type == JIM_EXPROP_LT) {
11831 cmpOffset = 0;
11833 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11834 cmpOffset = 1;
11836 else {
11837 goto evalstart;
11840 /* Update command must be incr */
11841 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11842 goto evalstart;
11845 /* incr, expression must be about the same variable */
11846 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11847 goto evalstart;
11850 /* Get the stop condition (must be a variable or integer) */
11851 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11852 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11853 goto evalstart;
11856 else {
11857 stopVarNamePtr = expr->token[1].objPtr;
11858 Jim_IncrRefCount(stopVarNamePtr);
11859 /* Keep the compiler happy */
11860 stop = 0;
11863 /* Initialization */
11864 varNamePtr = expr->token[0].objPtr;
11865 Jim_IncrRefCount(varNamePtr);
11867 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11868 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11869 goto testcond;
11872 /* --- OPTIMIZED FOR --- */
11873 while (retval == JIM_OK) {
11874 /* === Check condition === */
11875 /* Note that currentVal is already set here */
11877 /* Immediate or Variable? get the 'stop' value if the latter. */
11878 if (stopVarNamePtr) {
11879 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11880 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11881 goto testcond;
11885 if (currentVal >= stop + cmpOffset) {
11886 break;
11889 /* Eval body */
11890 retval = Jim_EvalObj(interp, argv[4]);
11891 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11892 retval = JIM_OK;
11894 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11896 /* Increment */
11897 if (objPtr == NULL) {
11898 retval = JIM_ERR;
11899 goto out;
11901 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11902 currentVal = ++JimWideValue(objPtr);
11903 Jim_InvalidateStringRep(objPtr);
11905 else {
11906 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11907 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11908 ++currentVal)) != JIM_OK) {
11909 goto evalnext;
11914 goto out;
11916 evalstart:
11917 #endif
11919 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11920 /* Body */
11921 retval = Jim_EvalObj(interp, argv[4]);
11923 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11924 /* increment */
11925 JIM_IF_OPTIM(evalnext:)
11926 retval = Jim_EvalObj(interp, argv[3]);
11927 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11928 /* test */
11929 JIM_IF_OPTIM(testcond:)
11930 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11934 JIM_IF_OPTIM(out:)
11935 if (stopVarNamePtr) {
11936 Jim_DecrRefCount(interp, stopVarNamePtr);
11938 if (varNamePtr) {
11939 Jim_DecrRefCount(interp, varNamePtr);
11942 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11943 Jim_SetEmptyResult(interp);
11944 return JIM_OK;
11947 return retval;
11950 /* [loop] */
11951 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11953 int retval;
11954 jim_wide i;
11955 jim_wide limit;
11956 jim_wide incr = 1;
11957 Jim_Obj *bodyObjPtr;
11959 if (argc != 5 && argc != 6) {
11960 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11961 return JIM_ERR;
11964 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11965 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11966 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11967 return JIM_ERR;
11969 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11971 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11973 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11974 retval = Jim_EvalObj(interp, bodyObjPtr);
11975 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11976 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11978 retval = JIM_OK;
11980 /* Increment */
11981 i += incr;
11983 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11984 if (argv[1]->typePtr != &variableObjType) {
11985 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11986 return JIM_ERR;
11989 JimWideValue(objPtr) = i;
11990 Jim_InvalidateStringRep(objPtr);
11992 /* The following step is required in order to invalidate the
11993 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11994 if (argv[1]->typePtr != &variableObjType) {
11995 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11996 retval = JIM_ERR;
11997 break;
12001 else {
12002 objPtr = Jim_NewIntObj(interp, i);
12003 retval = Jim_SetVariable(interp, argv[1], objPtr);
12004 if (retval != JIM_OK) {
12005 Jim_FreeNewObj(interp, objPtr);
12011 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
12012 Jim_SetEmptyResult(interp);
12013 return JIM_OK;
12015 return retval;
12018 /* List iterators make it easy to iterate over a list.
12019 * At some point iterators will be expanded to support generators.
12021 typedef struct {
12022 Jim_Obj *objPtr;
12023 int idx;
12024 } Jim_ListIter;
12027 * Initialise the iterator at the start of the list.
12029 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
12031 iter->objPtr = objPtr;
12032 iter->idx = 0;
12036 * Returns the next object from the list, or NULL on end-of-list.
12038 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
12040 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
12041 return NULL;
12043 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
12047 * Returns 1 if end-of-list has been reached.
12049 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
12051 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
12054 /* foreach + lmap implementation. */
12055 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
12057 int result = JIM_OK;
12058 int i, numargs;
12059 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
12060 Jim_ListIter *iters;
12061 Jim_Obj *script;
12062 Jim_Obj *resultObj;
12064 if (argc < 4 || argc % 2 != 0) {
12065 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
12066 return JIM_ERR;
12068 script = argv[argc - 1]; /* Last argument is a script */
12069 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
12071 if (numargs == 2) {
12072 iters = twoiters;
12074 else {
12075 iters = Jim_Alloc(numargs * sizeof(*iters));
12077 for (i = 0; i < numargs; i++) {
12078 JimListIterInit(&iters[i], argv[i + 1]);
12079 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
12080 result = JIM_ERR;
12083 if (result != JIM_OK) {
12084 Jim_SetResultString(interp, "foreach varlist is empty", -1);
12085 return result;
12088 if (doMap) {
12089 resultObj = Jim_NewListObj(interp, NULL, 0);
12091 else {
12092 resultObj = interp->emptyObj;
12094 Jim_IncrRefCount(resultObj);
12096 while (1) {
12097 /* Have we expired all lists? */
12098 for (i = 0; i < numargs; i += 2) {
12099 if (!JimListIterDone(interp, &iters[i + 1])) {
12100 break;
12103 if (i == numargs) {
12104 /* All done */
12105 break;
12108 /* For each list */
12109 for (i = 0; i < numargs; i += 2) {
12110 Jim_Obj *varName;
12112 /* foreach var */
12113 JimListIterInit(&iters[i], argv[i + 1]);
12114 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
12115 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
12116 if (!valObj) {
12117 /* Ran out, so store the empty string */
12118 valObj = interp->emptyObj;
12120 /* Avoid shimmering */
12121 Jim_IncrRefCount(valObj);
12122 result = Jim_SetVariable(interp, varName, valObj);
12123 Jim_DecrRefCount(interp, valObj);
12124 if (result != JIM_OK) {
12125 goto err;
12129 switch (result = Jim_EvalObj(interp, script)) {
12130 case JIM_OK:
12131 if (doMap) {
12132 Jim_ListAppendElement(interp, resultObj, interp->result);
12134 break;
12135 case JIM_CONTINUE:
12136 break;
12137 case JIM_BREAK:
12138 goto out;
12139 default:
12140 goto err;
12143 out:
12144 result = JIM_OK;
12145 Jim_SetResult(interp, resultObj);
12146 err:
12147 Jim_DecrRefCount(interp, resultObj);
12148 if (numargs > 2) {
12149 Jim_Free(iters);
12151 return result;
12154 /* [foreach] */
12155 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12157 return JimForeachMapHelper(interp, argc, argv, 0);
12160 /* [lmap] */
12161 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12163 return JimForeachMapHelper(interp, argc, argv, 1);
12166 /* [lassign] */
12167 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12169 int result = JIM_ERR;
12170 int i;
12171 Jim_ListIter iter;
12172 Jim_Obj *resultObj;
12174 if (argc < 2) {
12175 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12176 return JIM_ERR;
12179 JimListIterInit(&iter, argv[1]);
12181 for (i = 2; i < argc; i++) {
12182 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12183 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12184 if (result != JIM_OK) {
12185 return result;
12189 resultObj = Jim_NewListObj(interp, NULL, 0);
12190 while (!JimListIterDone(interp, &iter)) {
12191 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12194 Jim_SetResult(interp, resultObj);
12196 return JIM_OK;
12199 /* [if] */
12200 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12202 int boolean, retval, current = 1, falsebody = 0;
12204 if (argc >= 3) {
12205 while (1) {
12206 /* Far not enough arguments given! */
12207 if (current >= argc)
12208 goto err;
12209 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12210 != JIM_OK)
12211 return retval;
12212 /* There lacks something, isn't it? */
12213 if (current >= argc)
12214 goto err;
12215 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12216 current++;
12217 /* Tsk tsk, no then-clause? */
12218 if (current >= argc)
12219 goto err;
12220 if (boolean)
12221 return Jim_EvalObj(interp, argv[current]);
12222 /* Ok: no else-clause follows */
12223 if (++current >= argc) {
12224 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12225 return JIM_OK;
12227 falsebody = current++;
12228 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12229 /* IIICKS - else-clause isn't last cmd? */
12230 if (current != argc - 1)
12231 goto err;
12232 return Jim_EvalObj(interp, argv[current]);
12234 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12235 /* Ok: elseif follows meaning all the stuff
12236 * again (how boring...) */
12237 continue;
12238 /* OOPS - else-clause is not last cmd? */
12239 else if (falsebody != argc - 1)
12240 goto err;
12241 return Jim_EvalObj(interp, argv[falsebody]);
12243 return JIM_OK;
12245 err:
12246 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12247 return JIM_ERR;
12251 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12252 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12253 Jim_Obj *stringObj, int nocase)
12255 Jim_Obj *parms[4];
12256 int argc = 0;
12257 long eq;
12258 int rc;
12260 parms[argc++] = commandObj;
12261 if (nocase) {
12262 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12264 parms[argc++] = patternObj;
12265 parms[argc++] = stringObj;
12267 rc = Jim_EvalObjVector(interp, argc, parms);
12269 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12270 eq = -rc;
12273 return eq;
12276 enum
12277 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12279 /* [switch] */
12280 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12282 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12283 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12284 Jim_Obj *script = 0;
12286 if (argc < 3) {
12287 wrongnumargs:
12288 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12289 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12290 return JIM_ERR;
12292 for (opt = 1; opt < argc; ++opt) {
12293 const char *option = Jim_String(argv[opt]);
12295 if (*option != '-')
12296 break;
12297 else if (strncmp(option, "--", 2) == 0) {
12298 ++opt;
12299 break;
12301 else if (strncmp(option, "-exact", 2) == 0)
12302 matchOpt = SWITCH_EXACT;
12303 else if (strncmp(option, "-glob", 2) == 0)
12304 matchOpt = SWITCH_GLOB;
12305 else if (strncmp(option, "-regexp", 2) == 0)
12306 matchOpt = SWITCH_RE;
12307 else if (strncmp(option, "-command", 2) == 0) {
12308 matchOpt = SWITCH_CMD;
12309 if ((argc - opt) < 2)
12310 goto wrongnumargs;
12311 command = argv[++opt];
12313 else {
12314 Jim_SetResultFormatted(interp,
12315 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12316 argv[opt]);
12317 return JIM_ERR;
12319 if ((argc - opt) < 2)
12320 goto wrongnumargs;
12322 strObj = argv[opt++];
12323 patCount = argc - opt;
12324 if (patCount == 1) {
12325 Jim_Obj **vector;
12327 JimListGetElements(interp, argv[opt], &patCount, &vector);
12328 caseList = vector;
12330 else
12331 caseList = &argv[opt];
12332 if (patCount == 0 || patCount % 2 != 0)
12333 goto wrongnumargs;
12334 for (i = 0; script == 0 && i < patCount; i += 2) {
12335 Jim_Obj *patObj = caseList[i];
12337 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12338 || i < (patCount - 2)) {
12339 switch (matchOpt) {
12340 case SWITCH_EXACT:
12341 if (Jim_StringEqObj(strObj, patObj))
12342 script = caseList[i + 1];
12343 break;
12344 case SWITCH_GLOB:
12345 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12346 script = caseList[i + 1];
12347 break;
12348 case SWITCH_RE:
12349 command = Jim_NewStringObj(interp, "regexp", -1);
12350 /* Fall thru intentionally */
12351 case SWITCH_CMD:{
12352 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12354 /* After the execution of a command we need to
12355 * make sure to reconvert the object into a list
12356 * again. Only for the single-list style [switch]. */
12357 if (argc - opt == 1) {
12358 Jim_Obj **vector;
12360 JimListGetElements(interp, argv[opt], &patCount, &vector);
12361 caseList = vector;
12363 /* command is here already decref'd */
12364 if (rc < 0) {
12365 return -rc;
12367 if (rc)
12368 script = caseList[i + 1];
12369 break;
12373 else {
12374 script = caseList[i + 1];
12377 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12378 script = caseList[i + 1];
12379 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12380 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12381 return JIM_ERR;
12383 Jim_SetEmptyResult(interp);
12384 if (script) {
12385 return Jim_EvalObj(interp, script);
12387 return JIM_OK;
12390 /* [list] */
12391 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12393 Jim_Obj *listObjPtr;
12395 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12396 Jim_SetResult(interp, listObjPtr);
12397 return JIM_OK;
12400 /* [lindex] */
12401 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12403 Jim_Obj *objPtr, *listObjPtr;
12404 int i;
12405 int idx;
12407 if (argc < 2) {
12408 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12409 return JIM_ERR;
12411 objPtr = argv[1];
12412 Jim_IncrRefCount(objPtr);
12413 for (i = 2; i < argc; i++) {
12414 listObjPtr = objPtr;
12415 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12416 Jim_DecrRefCount(interp, listObjPtr);
12417 return JIM_ERR;
12419 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12420 /* Returns an empty object if the index
12421 * is out of range. */
12422 Jim_DecrRefCount(interp, listObjPtr);
12423 Jim_SetEmptyResult(interp);
12424 return JIM_OK;
12426 Jim_IncrRefCount(objPtr);
12427 Jim_DecrRefCount(interp, listObjPtr);
12429 Jim_SetResult(interp, objPtr);
12430 Jim_DecrRefCount(interp, objPtr);
12431 return JIM_OK;
12434 /* [llength] */
12435 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12437 if (argc != 2) {
12438 Jim_WrongNumArgs(interp, 1, argv, "list");
12439 return JIM_ERR;
12441 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12442 return JIM_OK;
12445 /* [lsearch] */
12446 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12448 static const char * const options[] = {
12449 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12450 NULL
12452 enum
12453 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12454 OPT_COMMAND };
12455 int i;
12456 int opt_bool = 0;
12457 int opt_not = 0;
12458 int opt_nocase = 0;
12459 int opt_all = 0;
12460 int opt_inline = 0;
12461 int opt_match = OPT_EXACT;
12462 int listlen;
12463 int rc = JIM_OK;
12464 Jim_Obj *listObjPtr = NULL;
12465 Jim_Obj *commandObj = NULL;
12467 if (argc < 3) {
12468 wrongargs:
12469 Jim_WrongNumArgs(interp, 1, argv,
12470 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12471 return JIM_ERR;
12474 for (i = 1; i < argc - 2; i++) {
12475 int option;
12477 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12478 return JIM_ERR;
12480 switch (option) {
12481 case OPT_BOOL:
12482 opt_bool = 1;
12483 opt_inline = 0;
12484 break;
12485 case OPT_NOT:
12486 opt_not = 1;
12487 break;
12488 case OPT_NOCASE:
12489 opt_nocase = 1;
12490 break;
12491 case OPT_INLINE:
12492 opt_inline = 1;
12493 opt_bool = 0;
12494 break;
12495 case OPT_ALL:
12496 opt_all = 1;
12497 break;
12498 case OPT_COMMAND:
12499 if (i >= argc - 2) {
12500 goto wrongargs;
12502 commandObj = argv[++i];
12503 /* fallthru */
12504 case OPT_EXACT:
12505 case OPT_GLOB:
12506 case OPT_REGEXP:
12507 opt_match = option;
12508 break;
12512 argv += i;
12514 if (opt_all) {
12515 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12517 if (opt_match == OPT_REGEXP) {
12518 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12520 if (commandObj) {
12521 Jim_IncrRefCount(commandObj);
12524 listlen = Jim_ListLength(interp, argv[0]);
12525 for (i = 0; i < listlen; i++) {
12526 int eq = 0;
12527 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12529 switch (opt_match) {
12530 case OPT_EXACT:
12531 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12532 break;
12534 case OPT_GLOB:
12535 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12536 break;
12538 case OPT_REGEXP:
12539 case OPT_COMMAND:
12540 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12541 if (eq < 0) {
12542 if (listObjPtr) {
12543 Jim_FreeNewObj(interp, listObjPtr);
12545 rc = JIM_ERR;
12546 goto done;
12548 break;
12551 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12552 if (!eq && opt_bool && opt_not && !opt_all) {
12553 continue;
12556 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12557 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12558 Jim_Obj *resultObj;
12560 if (opt_bool) {
12561 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12563 else if (!opt_inline) {
12564 resultObj = Jim_NewIntObj(interp, i);
12566 else {
12567 resultObj = objPtr;
12570 if (opt_all) {
12571 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12573 else {
12574 Jim_SetResult(interp, resultObj);
12575 goto done;
12580 if (opt_all) {
12581 Jim_SetResult(interp, listObjPtr);
12583 else {
12584 /* No match */
12585 if (opt_bool) {
12586 Jim_SetResultBool(interp, opt_not);
12588 else if (!opt_inline) {
12589 Jim_SetResultInt(interp, -1);
12593 done:
12594 if (commandObj) {
12595 Jim_DecrRefCount(interp, commandObj);
12597 return rc;
12600 /* [lappend] */
12601 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12603 Jim_Obj *listObjPtr;
12604 int new_obj = 0;
12605 int i;
12607 if (argc < 2) {
12608 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12609 return JIM_ERR;
12611 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12612 if (!listObjPtr) {
12613 /* Create the list if it does not exist */
12614 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12615 new_obj = 1;
12617 else if (Jim_IsShared(listObjPtr)) {
12618 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12619 new_obj = 1;
12621 for (i = 2; i < argc; i++)
12622 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12623 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12624 if (new_obj)
12625 Jim_FreeNewObj(interp, listObjPtr);
12626 return JIM_ERR;
12628 Jim_SetResult(interp, listObjPtr);
12629 return JIM_OK;
12632 /* [linsert] */
12633 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12635 int idx, len;
12636 Jim_Obj *listPtr;
12638 if (argc < 3) {
12639 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12640 return JIM_ERR;
12642 listPtr = argv[1];
12643 if (Jim_IsShared(listPtr))
12644 listPtr = Jim_DuplicateObj(interp, listPtr);
12645 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12646 goto err;
12647 len = Jim_ListLength(interp, listPtr);
12648 if (idx >= len)
12649 idx = len;
12650 else if (idx < 0)
12651 idx = len + idx + 1;
12652 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12653 Jim_SetResult(interp, listPtr);
12654 return JIM_OK;
12655 err:
12656 if (listPtr != argv[1]) {
12657 Jim_FreeNewObj(interp, listPtr);
12659 return JIM_ERR;
12662 /* [lreplace] */
12663 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12665 int first, last, len, rangeLen;
12666 Jim_Obj *listObj;
12667 Jim_Obj *newListObj;
12669 if (argc < 4) {
12670 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12671 return JIM_ERR;
12673 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12674 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12675 return JIM_ERR;
12678 listObj = argv[1];
12679 len = Jim_ListLength(interp, listObj);
12681 first = JimRelToAbsIndex(len, first);
12682 last = JimRelToAbsIndex(len, last);
12683 JimRelToAbsRange(len, &first, &last, &rangeLen);
12685 /* Now construct a new list which consists of:
12686 * <elements before first> <supplied elements> <elements after last>
12689 /* Check to see if trying to replace past the end of the list */
12690 if (first < len) {
12691 /* OK. Not past the end */
12693 else if (len == 0) {
12694 /* Special for empty list, adjust first to 0 */
12695 first = 0;
12697 else {
12698 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12699 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12700 return JIM_ERR;
12703 /* Add the first set of elements */
12704 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12706 /* Add supplied elements */
12707 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12709 /* Add the remaining elements */
12710 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12712 Jim_SetResult(interp, newListObj);
12713 return JIM_OK;
12716 /* [lset] */
12717 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12719 if (argc < 3) {
12720 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12721 return JIM_ERR;
12723 else if (argc == 3) {
12724 /* With no indexes, simply implements [set] */
12725 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12726 return JIM_ERR;
12727 Jim_SetResult(interp, argv[2]);
12728 return JIM_OK;
12730 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12733 /* [lsort] */
12734 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12736 static const char * const options[] = {
12737 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12739 enum
12740 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12741 Jim_Obj *resObj;
12742 int i;
12743 int retCode;
12745 struct lsort_info info;
12747 if (argc < 2) {
12748 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12749 return JIM_ERR;
12752 info.type = JIM_LSORT_ASCII;
12753 info.order = 1;
12754 info.indexed = 0;
12755 info.unique = 0;
12756 info.command = NULL;
12757 info.interp = interp;
12759 for (i = 1; i < (argc - 1); i++) {
12760 int option;
12762 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12763 != JIM_OK)
12764 return JIM_ERR;
12765 switch (option) {
12766 case OPT_ASCII:
12767 info.type = JIM_LSORT_ASCII;
12768 break;
12769 case OPT_NOCASE:
12770 info.type = JIM_LSORT_NOCASE;
12771 break;
12772 case OPT_INTEGER:
12773 info.type = JIM_LSORT_INTEGER;
12774 break;
12775 case OPT_REAL:
12776 info.type = JIM_LSORT_REAL;
12777 break;
12778 case OPT_INCREASING:
12779 info.order = 1;
12780 break;
12781 case OPT_DECREASING:
12782 info.order = -1;
12783 break;
12784 case OPT_UNIQUE:
12785 info.unique = 1;
12786 break;
12787 case OPT_COMMAND:
12788 if (i >= (argc - 2)) {
12789 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12790 return JIM_ERR;
12792 info.type = JIM_LSORT_COMMAND;
12793 info.command = argv[i + 1];
12794 i++;
12795 break;
12796 case OPT_INDEX:
12797 if (i >= (argc - 2)) {
12798 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12799 return JIM_ERR;
12801 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12802 return JIM_ERR;
12804 info.indexed = 1;
12805 i++;
12806 break;
12809 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12810 retCode = ListSortElements(interp, resObj, &info);
12811 if (retCode == JIM_OK) {
12812 Jim_SetResult(interp, resObj);
12814 else {
12815 Jim_FreeNewObj(interp, resObj);
12817 return retCode;
12820 /* [append] */
12821 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12823 Jim_Obj *stringObjPtr;
12824 int i;
12826 if (argc < 2) {
12827 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12828 return JIM_ERR;
12830 if (argc == 2) {
12831 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12832 if (!stringObjPtr)
12833 return JIM_ERR;
12835 else {
12836 int new_obj = 0;
12837 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12838 if (!stringObjPtr) {
12839 /* Create the string if it doesn't exist */
12840 stringObjPtr = Jim_NewEmptyStringObj(interp);
12841 new_obj = 1;
12843 else if (Jim_IsShared(stringObjPtr)) {
12844 new_obj = 1;
12845 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12847 for (i = 2; i < argc; i++) {
12848 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12850 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12851 if (new_obj) {
12852 Jim_FreeNewObj(interp, stringObjPtr);
12854 return JIM_ERR;
12857 Jim_SetResult(interp, stringObjPtr);
12858 return JIM_OK;
12861 /* [debug] */
12862 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12864 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12865 static const char * const options[] = {
12866 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12867 "exprbc", "show",
12868 NULL
12870 enum
12872 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12873 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12875 int option;
12877 if (argc < 2) {
12878 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12879 return JIM_ERR;
12881 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12882 return JIM_ERR;
12883 if (option == OPT_REFCOUNT) {
12884 if (argc != 3) {
12885 Jim_WrongNumArgs(interp, 2, argv, "object");
12886 return JIM_ERR;
12888 Jim_SetResultInt(interp, argv[2]->refCount);
12889 return JIM_OK;
12891 else if (option == OPT_OBJCOUNT) {
12892 int freeobj = 0, liveobj = 0;
12893 char buf[256];
12894 Jim_Obj *objPtr;
12896 if (argc != 2) {
12897 Jim_WrongNumArgs(interp, 2, argv, "");
12898 return JIM_ERR;
12900 /* Count the number of free objects. */
12901 objPtr = interp->freeList;
12902 while (objPtr) {
12903 freeobj++;
12904 objPtr = objPtr->nextObjPtr;
12906 /* Count the number of live objects. */
12907 objPtr = interp->liveList;
12908 while (objPtr) {
12909 liveobj++;
12910 objPtr = objPtr->nextObjPtr;
12912 /* Set the result string and return. */
12913 sprintf(buf, "free %d used %d", freeobj, liveobj);
12914 Jim_SetResultString(interp, buf, -1);
12915 return JIM_OK;
12917 else if (option == OPT_OBJECTS) {
12918 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12920 /* Count the number of live objects. */
12921 objPtr = interp->liveList;
12922 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12923 while (objPtr) {
12924 char buf[128];
12925 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12927 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12928 sprintf(buf, "%p", objPtr);
12929 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12930 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12931 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12932 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12933 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12934 objPtr = objPtr->nextObjPtr;
12936 Jim_SetResult(interp, listObjPtr);
12937 return JIM_OK;
12939 else if (option == OPT_INVSTR) {
12940 Jim_Obj *objPtr;
12942 if (argc != 3) {
12943 Jim_WrongNumArgs(interp, 2, argv, "object");
12944 return JIM_ERR;
12946 objPtr = argv[2];
12947 if (objPtr->typePtr != NULL)
12948 Jim_InvalidateStringRep(objPtr);
12949 Jim_SetEmptyResult(interp);
12950 return JIM_OK;
12952 else if (option == OPT_SHOW) {
12953 const char *s;
12954 int len, charlen;
12956 if (argc != 3) {
12957 Jim_WrongNumArgs(interp, 2, argv, "object");
12958 return JIM_ERR;
12960 s = Jim_GetString(argv[2], &len);
12961 #ifdef JIM_UTF8
12962 charlen = utf8_strlen(s, len);
12963 #else
12964 charlen = len;
12965 #endif
12966 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12967 printf("chars (%d): <<%s>>\n", charlen, s);
12968 printf("bytes (%d):", len);
12969 while (len--) {
12970 printf(" %02x", (unsigned char)*s++);
12972 printf("\n");
12973 return JIM_OK;
12975 else if (option == OPT_SCRIPTLEN) {
12976 ScriptObj *script;
12978 if (argc != 3) {
12979 Jim_WrongNumArgs(interp, 2, argv, "script");
12980 return JIM_ERR;
12982 script = JimGetScript(interp, argv[2]);
12983 if (script == NULL)
12984 return JIM_ERR;
12985 Jim_SetResultInt(interp, script->len);
12986 return JIM_OK;
12988 else if (option == OPT_EXPRLEN) {
12989 ExprByteCode *expr;
12991 if (argc != 3) {
12992 Jim_WrongNumArgs(interp, 2, argv, "expression");
12993 return JIM_ERR;
12995 expr = JimGetExpression(interp, argv[2]);
12996 if (expr == NULL)
12997 return JIM_ERR;
12998 Jim_SetResultInt(interp, expr->len);
12999 return JIM_OK;
13001 else if (option == OPT_EXPRBC) {
13002 Jim_Obj *objPtr;
13003 ExprByteCode *expr;
13004 int i;
13006 if (argc != 3) {
13007 Jim_WrongNumArgs(interp, 2, argv, "expression");
13008 return JIM_ERR;
13010 expr = JimGetExpression(interp, argv[2]);
13011 if (expr == NULL)
13012 return JIM_ERR;
13013 objPtr = Jim_NewListObj(interp, NULL, 0);
13014 for (i = 0; i < expr->len; i++) {
13015 const char *type;
13016 const Jim_ExprOperator *op;
13017 Jim_Obj *obj = expr->token[i].objPtr;
13019 switch (expr->token[i].type) {
13020 case JIM_TT_EXPR_INT:
13021 type = "int";
13022 break;
13023 case JIM_TT_EXPR_DOUBLE:
13024 type = "double";
13025 break;
13026 case JIM_TT_EXPR_BOOLEAN:
13027 type = "boolean";
13028 break;
13029 case JIM_TT_CMD:
13030 type = "command";
13031 break;
13032 case JIM_TT_VAR:
13033 type = "variable";
13034 break;
13035 case JIM_TT_DICTSUGAR:
13036 type = "dictsugar";
13037 break;
13038 case JIM_TT_EXPRSUGAR:
13039 type = "exprsugar";
13040 break;
13041 case JIM_TT_ESC:
13042 type = "subst";
13043 break;
13044 case JIM_TT_STR:
13045 type = "string";
13046 break;
13047 default:
13048 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
13049 if (op == NULL) {
13050 type = "private";
13052 else {
13053 type = "operator";
13055 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
13056 break;
13058 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
13059 Jim_ListAppendElement(interp, objPtr, obj);
13061 Jim_SetResult(interp, objPtr);
13062 return JIM_OK;
13064 else {
13065 Jim_SetResultString(interp,
13066 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
13067 return JIM_ERR;
13069 /* unreached */
13070 #endif /* JIM_BOOTSTRAP */
13071 #if !defined(JIM_DEBUG_COMMAND)
13072 Jim_SetResultString(interp, "unsupported", -1);
13073 return JIM_ERR;
13074 #endif
13077 /* [eval] */
13078 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13080 int rc;
13082 if (argc < 2) {
13083 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
13084 return JIM_ERR;
13087 if (argc == 2) {
13088 rc = Jim_EvalObj(interp, argv[1]);
13090 else {
13091 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13094 if (rc == JIM_ERR) {
13095 /* eval is "interesting", so add a stack frame here */
13096 interp->addStackTrace++;
13098 return rc;
13101 /* [uplevel] */
13102 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13104 if (argc >= 2) {
13105 int retcode;
13106 Jim_CallFrame *savedCallFrame, *targetCallFrame;
13107 const char *str;
13109 /* Save the old callframe pointer */
13110 savedCallFrame = interp->framePtr;
13112 /* Lookup the target frame pointer */
13113 str = Jim_String(argv[1]);
13114 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
13115 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13116 argc--;
13117 argv++;
13119 else {
13120 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13122 if (targetCallFrame == NULL) {
13123 return JIM_ERR;
13125 if (argc < 2) {
13126 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
13127 return JIM_ERR;
13129 /* Eval the code in the target callframe. */
13130 interp->framePtr = targetCallFrame;
13131 if (argc == 2) {
13132 retcode = Jim_EvalObj(interp, argv[1]);
13134 else {
13135 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13137 interp->framePtr = savedCallFrame;
13138 return retcode;
13140 else {
13141 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
13142 return JIM_ERR;
13146 /* [expr] */
13147 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13149 Jim_Obj *exprResultPtr;
13150 int retcode;
13152 if (argc == 2) {
13153 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
13155 else if (argc > 2) {
13156 Jim_Obj *objPtr;
13158 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13159 Jim_IncrRefCount(objPtr);
13160 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
13161 Jim_DecrRefCount(interp, objPtr);
13163 else {
13164 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13165 return JIM_ERR;
13167 if (retcode != JIM_OK)
13168 return retcode;
13169 Jim_SetResult(interp, exprResultPtr);
13170 Jim_DecrRefCount(interp, exprResultPtr);
13171 return JIM_OK;
13174 /* [break] */
13175 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13177 if (argc != 1) {
13178 Jim_WrongNumArgs(interp, 1, argv, "");
13179 return JIM_ERR;
13181 return JIM_BREAK;
13184 /* [continue] */
13185 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13187 if (argc != 1) {
13188 Jim_WrongNumArgs(interp, 1, argv, "");
13189 return JIM_ERR;
13191 return JIM_CONTINUE;
13194 /* [return] */
13195 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13197 int i;
13198 Jim_Obj *stackTraceObj = NULL;
13199 Jim_Obj *errorCodeObj = NULL;
13200 int returnCode = JIM_OK;
13201 long level = 1;
13203 for (i = 1; i < argc - 1; i += 2) {
13204 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13205 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13206 return JIM_ERR;
13209 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13210 stackTraceObj = argv[i + 1];
13212 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13213 errorCodeObj = argv[i + 1];
13215 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13216 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13217 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13218 return JIM_ERR;
13221 else {
13222 break;
13226 if (i != argc - 1 && i != argc) {
13227 Jim_WrongNumArgs(interp, 1, argv,
13228 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13231 /* If a stack trace is supplied and code is error, set the stack trace */
13232 if (stackTraceObj && returnCode == JIM_ERR) {
13233 JimSetStackTrace(interp, stackTraceObj);
13235 /* If an error code list is supplied, set the global $errorCode */
13236 if (errorCodeObj && returnCode == JIM_ERR) {
13237 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13239 interp->returnCode = returnCode;
13240 interp->returnLevel = level;
13242 if (i == argc - 1) {
13243 Jim_SetResult(interp, argv[i]);
13245 return JIM_RETURN;
13248 /* [tailcall] */
13249 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13251 if (interp->framePtr->level == 0) {
13252 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13253 return JIM_ERR;
13255 else if (argc >= 2) {
13256 /* Need to resolve the tailcall command in the current context */
13257 Jim_CallFrame *cf = interp->framePtr->parent;
13259 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13260 if (cmdPtr == NULL) {
13261 return JIM_ERR;
13264 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13266 /* And stash this pre-resolved command */
13267 JimIncrCmdRefCount(cmdPtr);
13268 cf->tailcallCmd = cmdPtr;
13270 /* And stash the command list */
13271 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13273 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13274 Jim_IncrRefCount(cf->tailcallObj);
13276 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13277 return JIM_EVAL;
13279 return JIM_OK;
13282 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13284 Jim_Obj *cmdList;
13285 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13287 /* prefixListObj is a list to which the args need to be appended */
13288 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13289 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13291 return JimEvalObjList(interp, cmdList);
13294 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13296 Jim_Obj *prefixListObj = privData;
13297 Jim_DecrRefCount(interp, prefixListObj);
13300 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13302 Jim_Obj *prefixListObj;
13303 const char *newname;
13305 if (argc < 3) {
13306 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13307 return JIM_ERR;
13310 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13311 Jim_IncrRefCount(prefixListObj);
13312 newname = Jim_String(argv[1]);
13313 if (newname[0] == ':' && newname[1] == ':') {
13314 while (*++newname == ':') {
13318 Jim_SetResult(interp, argv[1]);
13320 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13323 /* [proc] */
13324 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13326 Jim_Cmd *cmd;
13328 if (argc != 4 && argc != 5) {
13329 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13330 return JIM_ERR;
13333 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13334 return JIM_ERR;
13337 if (argc == 4) {
13338 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13340 else {
13341 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13344 if (cmd) {
13345 /* Add the new command */
13346 Jim_Obj *qualifiedCmdNameObj;
13347 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13349 JimCreateCommand(interp, cmdname, cmd);
13351 /* Calculate and set the namespace for this proc */
13352 JimUpdateProcNamespace(interp, cmd, cmdname);
13354 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13356 /* Unlike Tcl, set the name of the proc as the result */
13357 Jim_SetResult(interp, argv[1]);
13358 return JIM_OK;
13360 return JIM_ERR;
13363 /* [local] */
13364 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13366 int retcode;
13368 if (argc < 2) {
13369 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13370 return JIM_ERR;
13373 /* Evaluate the arguments with 'local' in force */
13374 interp->local++;
13375 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13376 interp->local--;
13379 /* If OK, and the result is a proc, add it to the list of local procs */
13380 if (retcode == 0) {
13381 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13383 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13384 return JIM_ERR;
13386 if (interp->framePtr->localCommands == NULL) {
13387 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13388 Jim_InitStack(interp->framePtr->localCommands);
13390 Jim_IncrRefCount(cmdNameObj);
13391 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13394 return retcode;
13397 /* [upcall] */
13398 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13400 if (argc < 2) {
13401 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13402 return JIM_ERR;
13404 else {
13405 int retcode;
13407 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13408 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13409 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13410 return JIM_ERR;
13412 /* OK. Mark this command as being in an upcall */
13413 cmdPtr->u.proc.upcall++;
13414 JimIncrCmdRefCount(cmdPtr);
13416 /* Invoke the command as normal */
13417 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13419 /* No longer in an upcall */
13420 cmdPtr->u.proc.upcall--;
13421 JimDecrCmdRefCount(interp, cmdPtr);
13423 return retcode;
13427 /* [apply] */
13428 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13430 if (argc < 2) {
13431 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13432 return JIM_ERR;
13434 else {
13435 int ret;
13436 Jim_Cmd *cmd;
13437 Jim_Obj *argListObjPtr;
13438 Jim_Obj *bodyObjPtr;
13439 Jim_Obj *nsObj = NULL;
13440 Jim_Obj **nargv;
13442 int len = Jim_ListLength(interp, argv[1]);
13443 if (len != 2 && len != 3) {
13444 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13445 return JIM_ERR;
13448 if (len == 3) {
13449 #ifdef jim_ext_namespace
13450 /* Need to canonicalise the given namespace. */
13451 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13452 #else
13453 Jim_SetResultString(interp, "namespaces not enabled", -1);
13454 return JIM_ERR;
13455 #endif
13457 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13458 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13460 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13462 if (cmd) {
13463 /* Create a new argv array with a dummy argv[0], for error messages */
13464 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13465 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13466 Jim_IncrRefCount(nargv[0]);
13467 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13468 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13469 Jim_DecrRefCount(interp, nargv[0]);
13470 Jim_Free(nargv);
13472 JimDecrCmdRefCount(interp, cmd);
13473 return ret;
13475 return JIM_ERR;
13480 /* [concat] */
13481 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13483 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13484 return JIM_OK;
13487 /* [upvar] */
13488 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13490 int i;
13491 Jim_CallFrame *targetCallFrame;
13493 /* Lookup the target frame pointer */
13494 if (argc > 3 && (argc % 2 == 0)) {
13495 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13496 argc--;
13497 argv++;
13499 else {
13500 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13502 if (targetCallFrame == NULL) {
13503 return JIM_ERR;
13506 /* Check for arity */
13507 if (argc < 3) {
13508 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13509 return JIM_ERR;
13512 /* Now... for every other/local couple: */
13513 for (i = 1; i < argc; i += 2) {
13514 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13515 return JIM_ERR;
13517 return JIM_OK;
13520 /* [global] */
13521 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13523 int i;
13525 if (argc < 2) {
13526 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13527 return JIM_ERR;
13529 /* Link every var to the toplevel having the same name */
13530 if (interp->framePtr->level == 0)
13531 return JIM_OK; /* global at toplevel... */
13532 for (i = 1; i < argc; i++) {
13533 /* global ::blah does nothing */
13534 const char *name = Jim_String(argv[i]);
13535 if (name[0] != ':' || name[1] != ':') {
13536 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13537 return JIM_ERR;
13540 return JIM_OK;
13543 /* does the [string map] operation. On error NULL is returned,
13544 * otherwise a new string object with the result, having refcount = 0,
13545 * is returned. */
13546 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13547 Jim_Obj *objPtr, int nocase)
13549 int numMaps;
13550 const char *str, *noMatchStart = NULL;
13551 int strLen, i;
13552 Jim_Obj *resultObjPtr;
13554 numMaps = Jim_ListLength(interp, mapListObjPtr);
13555 if (numMaps % 2) {
13556 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13557 return NULL;
13560 str = Jim_String(objPtr);
13561 strLen = Jim_Utf8Length(interp, objPtr);
13563 /* Map it */
13564 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13565 while (strLen) {
13566 for (i = 0; i < numMaps; i += 2) {
13567 Jim_Obj *eachObjPtr;
13568 const char *k;
13569 int kl;
13571 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13572 k = Jim_String(eachObjPtr);
13573 kl = Jim_Utf8Length(interp, eachObjPtr);
13575 if (strLen >= kl && kl) {
13576 int rc;
13577 rc = JimStringCompareLen(str, k, kl, nocase);
13578 if (rc == 0) {
13579 if (noMatchStart) {
13580 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13581 noMatchStart = NULL;
13583 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13584 str += utf8_index(str, kl);
13585 strLen -= kl;
13586 break;
13590 if (i == numMaps) { /* no match */
13591 int c;
13592 if (noMatchStart == NULL)
13593 noMatchStart = str;
13594 str += utf8_tounicode(str, &c);
13595 strLen--;
13598 if (noMatchStart) {
13599 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13601 return resultObjPtr;
13604 /* [string] */
13605 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13607 int len;
13608 int opt_case = 1;
13609 int option;
13610 static const char * const options[] = {
13611 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13612 "map", "repeat", "reverse", "index", "first", "last", "cat",
13613 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13615 enum
13617 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13618 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13619 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13621 static const char * const nocase_options[] = {
13622 "-nocase", NULL
13624 static const char * const nocase_length_options[] = {
13625 "-nocase", "-length", NULL
13628 if (argc < 2) {
13629 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13630 return JIM_ERR;
13632 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13633 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13634 return JIM_ERR;
13636 switch (option) {
13637 case OPT_LENGTH:
13638 case OPT_BYTELENGTH:
13639 if (argc != 3) {
13640 Jim_WrongNumArgs(interp, 2, argv, "string");
13641 return JIM_ERR;
13643 if (option == OPT_LENGTH) {
13644 len = Jim_Utf8Length(interp, argv[2]);
13646 else {
13647 len = Jim_Length(argv[2]);
13649 Jim_SetResultInt(interp, len);
13650 return JIM_OK;
13652 case OPT_CAT:{
13653 Jim_Obj *objPtr;
13654 if (argc == 3) {
13655 /* optimise the one-arg case */
13656 objPtr = argv[2];
13658 else {
13659 int i;
13661 objPtr = Jim_NewStringObj(interp, "", 0);
13663 for (i = 2; i < argc; i++) {
13664 Jim_AppendObj(interp, objPtr, argv[i]);
13667 Jim_SetResult(interp, objPtr);
13668 return JIM_OK;
13671 case OPT_COMPARE:
13672 case OPT_EQUAL:
13674 /* n is the number of remaining option args */
13675 long opt_length = -1;
13676 int n = argc - 4;
13677 int i = 2;
13678 while (n > 0) {
13679 int subopt;
13680 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13681 JIM_ENUM_ABBREV) != JIM_OK) {
13682 badcompareargs:
13683 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13684 return JIM_ERR;
13686 if (subopt == 0) {
13687 /* -nocase */
13688 opt_case = 0;
13689 n--;
13691 else {
13692 /* -length */
13693 if (n < 2) {
13694 goto badcompareargs;
13696 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13697 return JIM_ERR;
13699 n -= 2;
13702 if (n) {
13703 goto badcompareargs;
13705 argv += argc - 2;
13706 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13707 /* Fast version - [string equal], case sensitive, no length */
13708 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13710 else {
13711 if (opt_length >= 0) {
13712 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13714 else {
13715 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13717 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13719 return JIM_OK;
13722 case OPT_MATCH:
13723 if (argc != 4 &&
13724 (argc != 5 ||
13725 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13726 JIM_ENUM_ABBREV) != JIM_OK)) {
13727 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13728 return JIM_ERR;
13730 if (opt_case == 0) {
13731 argv++;
13733 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13734 return JIM_OK;
13736 case OPT_MAP:{
13737 Jim_Obj *objPtr;
13739 if (argc != 4 &&
13740 (argc != 5 ||
13741 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13742 JIM_ENUM_ABBREV) != JIM_OK)) {
13743 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13744 return JIM_ERR;
13747 if (opt_case == 0) {
13748 argv++;
13750 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13751 if (objPtr == NULL) {
13752 return JIM_ERR;
13754 Jim_SetResult(interp, objPtr);
13755 return JIM_OK;
13758 case OPT_RANGE:
13759 case OPT_BYTERANGE:{
13760 Jim_Obj *objPtr;
13762 if (argc != 5) {
13763 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13764 return JIM_ERR;
13766 if (option == OPT_RANGE) {
13767 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13769 else
13771 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13774 if (objPtr == NULL) {
13775 return JIM_ERR;
13777 Jim_SetResult(interp, objPtr);
13778 return JIM_OK;
13781 case OPT_REPLACE:{
13782 Jim_Obj *objPtr;
13784 if (argc != 5 && argc != 6) {
13785 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13786 return JIM_ERR;
13788 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13789 if (objPtr == NULL) {
13790 return JIM_ERR;
13792 Jim_SetResult(interp, objPtr);
13793 return JIM_OK;
13797 case OPT_REPEAT:{
13798 Jim_Obj *objPtr;
13799 jim_wide count;
13801 if (argc != 4) {
13802 Jim_WrongNumArgs(interp, 2, argv, "string count");
13803 return JIM_ERR;
13805 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13806 return JIM_ERR;
13808 objPtr = Jim_NewStringObj(interp, "", 0);
13809 if (count > 0) {
13810 while (count--) {
13811 Jim_AppendObj(interp, objPtr, argv[2]);
13814 Jim_SetResult(interp, objPtr);
13815 return JIM_OK;
13818 case OPT_REVERSE:{
13819 char *buf, *p;
13820 const char *str;
13821 int i;
13823 if (argc != 3) {
13824 Jim_WrongNumArgs(interp, 2, argv, "string");
13825 return JIM_ERR;
13828 str = Jim_GetString(argv[2], &len);
13829 buf = Jim_Alloc(len + 1);
13830 p = buf + len;
13831 *p = 0;
13832 for (i = 0; i < len; ) {
13833 int c;
13834 int l = utf8_tounicode(str, &c);
13835 memcpy(p - l, str, l);
13836 p -= l;
13837 i += l;
13838 str += l;
13840 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13841 return JIM_OK;
13844 case OPT_INDEX:{
13845 int idx;
13846 const char *str;
13848 if (argc != 4) {
13849 Jim_WrongNumArgs(interp, 2, argv, "string index");
13850 return JIM_ERR;
13852 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13853 return JIM_ERR;
13855 str = Jim_String(argv[2]);
13856 len = Jim_Utf8Length(interp, argv[2]);
13857 if (idx != INT_MIN && idx != INT_MAX) {
13858 idx = JimRelToAbsIndex(len, idx);
13860 if (idx < 0 || idx >= len || str == NULL) {
13861 Jim_SetResultString(interp, "", 0);
13863 else if (len == Jim_Length(argv[2])) {
13864 /* ASCII optimisation */
13865 Jim_SetResultString(interp, str + idx, 1);
13867 else {
13868 int c;
13869 int i = utf8_index(str, idx);
13870 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13872 return JIM_OK;
13875 case OPT_FIRST:
13876 case OPT_LAST:{
13877 int idx = 0, l1, l2;
13878 const char *s1, *s2;
13880 if (argc != 4 && argc != 5) {
13881 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13882 return JIM_ERR;
13884 s1 = Jim_String(argv[2]);
13885 s2 = Jim_String(argv[3]);
13886 l1 = Jim_Utf8Length(interp, argv[2]);
13887 l2 = Jim_Utf8Length(interp, argv[3]);
13888 if (argc == 5) {
13889 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13890 return JIM_ERR;
13892 idx = JimRelToAbsIndex(l2, idx);
13894 else if (option == OPT_LAST) {
13895 idx = l2;
13897 if (option == OPT_FIRST) {
13898 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13900 else {
13901 #ifdef JIM_UTF8
13902 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13903 #else
13904 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13905 #endif
13907 return JIM_OK;
13910 case OPT_TRIM:
13911 case OPT_TRIMLEFT:
13912 case OPT_TRIMRIGHT:{
13913 Jim_Obj *trimchars;
13915 if (argc != 3 && argc != 4) {
13916 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13917 return JIM_ERR;
13919 trimchars = (argc == 4 ? argv[3] : NULL);
13920 if (option == OPT_TRIM) {
13921 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13923 else if (option == OPT_TRIMLEFT) {
13924 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13926 else if (option == OPT_TRIMRIGHT) {
13927 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13929 return JIM_OK;
13932 case OPT_TOLOWER:
13933 case OPT_TOUPPER:
13934 case OPT_TOTITLE:
13935 if (argc != 3) {
13936 Jim_WrongNumArgs(interp, 2, argv, "string");
13937 return JIM_ERR;
13939 if (option == OPT_TOLOWER) {
13940 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13942 else if (option == OPT_TOUPPER) {
13943 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13945 else {
13946 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13948 return JIM_OK;
13950 case OPT_IS:
13951 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13952 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13954 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13955 return JIM_ERR;
13957 return JIM_OK;
13960 /* [time] */
13961 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13963 long i, count = 1;
13964 jim_wide start, elapsed;
13965 char buf[60];
13966 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13968 if (argc < 2) {
13969 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13970 return JIM_ERR;
13972 if (argc == 3) {
13973 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13974 return JIM_ERR;
13976 if (count < 0)
13977 return JIM_OK;
13978 i = count;
13979 start = JimClock();
13980 while (i-- > 0) {
13981 int retval;
13983 retval = Jim_EvalObj(interp, argv[1]);
13984 if (retval != JIM_OK) {
13985 return retval;
13988 elapsed = JimClock() - start;
13989 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13990 Jim_SetResultString(interp, buf, -1);
13991 return JIM_OK;
13994 /* [exit] */
13995 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13997 long exitCode = 0;
13999 if (argc > 2) {
14000 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
14001 return JIM_ERR;
14003 if (argc == 2) {
14004 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
14005 return JIM_ERR;
14007 interp->exitCode = exitCode;
14008 return JIM_EXIT;
14011 /* [catch] */
14012 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14014 int exitCode = 0;
14015 int i;
14016 int sig = 0;
14018 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
14019 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
14020 static const int max_ignore_code = sizeof(ignore_mask) * 8;
14022 /* Reset the error code before catch.
14023 * Note that this is not strictly correct.
14025 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
14027 for (i = 1; i < argc - 1; i++) {
14028 const char *arg = Jim_String(argv[i]);
14029 jim_wide option;
14030 int ignore;
14032 /* It's a pity we can't use Jim_GetEnum here :-( */
14033 if (strcmp(arg, "--") == 0) {
14034 i++;
14035 break;
14037 if (*arg != '-') {
14038 break;
14041 if (strncmp(arg, "-no", 3) == 0) {
14042 arg += 3;
14043 ignore = 1;
14045 else {
14046 arg++;
14047 ignore = 0;
14050 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
14051 option = -1;
14053 if (option < 0) {
14054 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
14056 if (option < 0) {
14057 goto wrongargs;
14060 if (ignore) {
14061 ignore_mask |= ((jim_wide)1 << option);
14063 else {
14064 ignore_mask &= (~((jim_wide)1 << option));
14068 argc -= i;
14069 if (argc < 1 || argc > 3) {
14070 wrongargs:
14071 Jim_WrongNumArgs(interp, 1, argv,
14072 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
14073 return JIM_ERR;
14075 argv += i;
14077 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
14078 sig++;
14081 interp->signal_level += sig;
14082 if (Jim_CheckSignal(interp)) {
14083 /* If a signal is set, don't even try to execute the body */
14084 exitCode = JIM_SIGNAL;
14086 else {
14087 exitCode = Jim_EvalObj(interp, argv[0]);
14088 /* Don't want any caught error included in a later stack trace */
14089 interp->errorFlag = 0;
14091 interp->signal_level -= sig;
14093 /* Catch or pass through? Only the first 32/64 codes can be passed through */
14094 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
14095 /* Not caught, pass it up */
14096 return exitCode;
14099 if (sig && exitCode == JIM_SIGNAL) {
14100 /* Catch the signal at this level */
14101 if (interp->signal_set_result) {
14102 interp->signal_set_result(interp, interp->sigmask);
14104 else {
14105 Jim_SetResultInt(interp, interp->sigmask);
14107 interp->sigmask = 0;
14110 if (argc >= 2) {
14111 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
14112 return JIM_ERR;
14114 if (argc == 3) {
14115 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
14117 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
14118 Jim_ListAppendElement(interp, optListObj,
14119 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
14120 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
14121 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
14122 if (exitCode == JIM_ERR) {
14123 Jim_Obj *errorCode;
14124 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
14125 -1));
14126 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
14128 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
14129 if (errorCode) {
14130 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
14131 Jim_ListAppendElement(interp, optListObj, errorCode);
14134 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
14135 return JIM_ERR;
14139 Jim_SetResultInt(interp, exitCode);
14140 return JIM_OK;
14143 #ifdef JIM_REFERENCES
14145 /* [ref] */
14146 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14148 if (argc != 3 && argc != 4) {
14149 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
14150 return JIM_ERR;
14152 if (argc == 3) {
14153 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
14155 else {
14156 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
14158 return JIM_OK;
14161 /* [getref] */
14162 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14164 Jim_Reference *refPtr;
14166 if (argc != 2) {
14167 Jim_WrongNumArgs(interp, 1, argv, "reference");
14168 return JIM_ERR;
14170 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14171 return JIM_ERR;
14172 Jim_SetResult(interp, refPtr->objPtr);
14173 return JIM_OK;
14176 /* [setref] */
14177 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14179 Jim_Reference *refPtr;
14181 if (argc != 3) {
14182 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14183 return JIM_ERR;
14185 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14186 return JIM_ERR;
14187 Jim_IncrRefCount(argv[2]);
14188 Jim_DecrRefCount(interp, refPtr->objPtr);
14189 refPtr->objPtr = argv[2];
14190 Jim_SetResult(interp, argv[2]);
14191 return JIM_OK;
14194 /* [collect] */
14195 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14197 if (argc != 1) {
14198 Jim_WrongNumArgs(interp, 1, argv, "");
14199 return JIM_ERR;
14201 Jim_SetResultInt(interp, Jim_Collect(interp));
14203 /* Free all the freed objects. */
14204 while (interp->freeList) {
14205 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14206 Jim_Free(interp->freeList);
14207 interp->freeList = nextObjPtr;
14210 return JIM_OK;
14213 /* [finalize] reference ?newValue? */
14214 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14216 if (argc != 2 && argc != 3) {
14217 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14218 return JIM_ERR;
14220 if (argc == 2) {
14221 Jim_Obj *cmdNamePtr;
14223 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14224 return JIM_ERR;
14225 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14226 Jim_SetResult(interp, cmdNamePtr);
14228 else {
14229 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14230 return JIM_ERR;
14231 Jim_SetResult(interp, argv[2]);
14233 return JIM_OK;
14236 /* [info references] */
14237 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14239 Jim_Obj *listObjPtr;
14240 Jim_HashTableIterator htiter;
14241 Jim_HashEntry *he;
14243 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14245 JimInitHashTableIterator(&interp->references, &htiter);
14246 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14247 char buf[JIM_REFERENCE_SPACE + 1];
14248 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14249 const unsigned long *refId = he->key;
14251 JimFormatReference(buf, refPtr, *refId);
14252 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14254 Jim_SetResult(interp, listObjPtr);
14255 return JIM_OK;
14257 #endif
14259 /* [rename] */
14260 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14262 if (argc != 3) {
14263 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14264 return JIM_ERR;
14267 if (JimValidName(interp, "new procedure", argv[2])) {
14268 return JIM_ERR;
14271 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14274 #define JIM_DICTMATCH_VALUES 0x0001
14276 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14278 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14280 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14281 if (type & JIM_DICTMATCH_VALUES) {
14282 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14287 * Like JimHashtablePatternMatch, but for dictionaries.
14289 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14290 JimDictMatchCallbackType *callback, int type)
14292 Jim_HashEntry *he;
14293 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14295 /* Check for the non-pattern case. We can do this much more efficiently. */
14296 Jim_HashTableIterator htiter;
14297 JimInitHashTableIterator(ht, &htiter);
14298 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14299 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14300 callback(interp, listObjPtr, he, type);
14304 return listObjPtr;
14308 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14310 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14311 return JIM_ERR;
14313 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14314 return JIM_OK;
14317 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14319 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14320 return JIM_ERR;
14322 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14323 return JIM_OK;
14326 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14328 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14329 return -1;
14331 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14334 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14336 Jim_HashTable *ht;
14337 unsigned int i;
14339 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14340 return JIM_ERR;
14343 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14345 /* Note that this uses internal knowledge of the hash table */
14346 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14348 for (i = 0; i < ht->size; i++) {
14349 Jim_HashEntry *he = ht->table[i];
14351 if (he) {
14352 printf("%d: ", i);
14354 while (he) {
14355 printf(" %s", Jim_String(he->key));
14356 he = he->next;
14358 printf("\n");
14361 return JIM_OK;
14364 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14366 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14368 Jim_AppendString(interp, prefixObj, " ", 1);
14369 Jim_AppendString(interp, prefixObj, subcmd, -1);
14371 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14374 /* [dict] */
14375 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14377 Jim_Obj *objPtr;
14378 int option;
14379 static const char * const options[] = {
14380 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14381 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14382 "replace", "update", NULL
14384 enum
14386 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14387 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14388 OPT_REPLACE, OPT_UPDATE,
14391 if (argc < 2) {
14392 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14393 return JIM_ERR;
14396 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14397 return JIM_ERR;
14400 switch (option) {
14401 case OPT_GET:
14402 if (argc < 3) {
14403 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14404 return JIM_ERR;
14406 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14407 JIM_ERRMSG) != JIM_OK) {
14408 return JIM_ERR;
14410 Jim_SetResult(interp, objPtr);
14411 return JIM_OK;
14413 case OPT_SET:
14414 if (argc < 5) {
14415 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14416 return JIM_ERR;
14418 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14420 case OPT_EXISTS:
14421 if (argc < 4) {
14422 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14423 return JIM_ERR;
14425 else {
14426 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14427 if (rc < 0) {
14428 return JIM_ERR;
14430 Jim_SetResultBool(interp, rc == JIM_OK);
14431 return JIM_OK;
14434 case OPT_UNSET:
14435 if (argc < 4) {
14436 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14437 return JIM_ERR;
14439 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14440 return JIM_ERR;
14442 return JIM_OK;
14444 case OPT_KEYS:
14445 if (argc != 3 && argc != 4) {
14446 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14447 return JIM_ERR;
14449 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14451 case OPT_SIZE:
14452 if (argc != 3) {
14453 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14454 return JIM_ERR;
14456 else if (Jim_DictSize(interp, argv[2]) < 0) {
14457 return JIM_ERR;
14459 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14460 return JIM_OK;
14462 case OPT_MERGE:
14463 if (argc == 2) {
14464 return JIM_OK;
14466 if (Jim_DictSize(interp, argv[2]) < 0) {
14467 return JIM_ERR;
14469 /* Handle as ensemble */
14470 break;
14472 case OPT_UPDATE:
14473 if (argc < 6 || argc % 2) {
14474 /* Better error message */
14475 argc = 2;
14477 break;
14479 case OPT_CREATE:
14480 if (argc % 2) {
14481 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14482 return JIM_ERR;
14484 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14485 Jim_SetResult(interp, objPtr);
14486 return JIM_OK;
14488 case OPT_INFO:
14489 if (argc != 3) {
14490 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14491 return JIM_ERR;
14493 return Jim_DictInfo(interp, argv[2]);
14495 /* Handle command as an ensemble */
14496 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14499 /* [subst] */
14500 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14502 static const char * const options[] = {
14503 "-nobackslashes", "-nocommands", "-novariables", NULL
14505 enum
14506 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14507 int i;
14508 int flags = JIM_SUBST_FLAG;
14509 Jim_Obj *objPtr;
14511 if (argc < 2) {
14512 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14513 return JIM_ERR;
14515 for (i = 1; i < (argc - 1); i++) {
14516 int option;
14518 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14519 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14520 return JIM_ERR;
14522 switch (option) {
14523 case OPT_NOBACKSLASHES:
14524 flags |= JIM_SUBST_NOESC;
14525 break;
14526 case OPT_NOCOMMANDS:
14527 flags |= JIM_SUBST_NOCMD;
14528 break;
14529 case OPT_NOVARIABLES:
14530 flags |= JIM_SUBST_NOVAR;
14531 break;
14534 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14535 return JIM_ERR;
14537 Jim_SetResult(interp, objPtr);
14538 return JIM_OK;
14541 /* [info] */
14542 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14544 int cmd;
14545 Jim_Obj *objPtr;
14546 int mode = 0;
14548 static const char * const commands[] = {
14549 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14550 "vars", "version", "patchlevel", "complete", "args", "hostname",
14551 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14552 "references", "alias", NULL
14554 enum
14555 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14556 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14557 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14558 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14561 #ifdef jim_ext_namespace
14562 int nons = 0;
14564 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14565 /* This is for internal use only */
14566 argc--;
14567 argv++;
14568 nons = 1;
14570 #endif
14572 if (argc < 2) {
14573 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14574 return JIM_ERR;
14576 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14577 != JIM_OK) {
14578 return JIM_ERR;
14581 /* Test for the most common commands first, just in case it makes a difference */
14582 switch (cmd) {
14583 case INFO_EXISTS:
14584 if (argc != 3) {
14585 Jim_WrongNumArgs(interp, 2, argv, "varName");
14586 return JIM_ERR;
14588 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14589 break;
14591 case INFO_ALIAS:{
14592 Jim_Cmd *cmdPtr;
14594 if (argc != 3) {
14595 Jim_WrongNumArgs(interp, 2, argv, "command");
14596 return JIM_ERR;
14598 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14599 return JIM_ERR;
14601 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14602 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14603 return JIM_ERR;
14605 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14606 return JIM_OK;
14609 case INFO_CHANNELS:
14610 mode++; /* JIM_CMDLIST_CHANNELS */
14611 #ifndef jim_ext_aio
14612 Jim_SetResultString(interp, "aio not enabled", -1);
14613 return JIM_ERR;
14614 #endif
14615 /* fall through */
14616 case INFO_PROCS:
14617 mode++; /* JIM_CMDLIST_PROCS */
14618 /* fall through */
14619 case INFO_COMMANDS:
14620 /* mode 0 => JIM_CMDLIST_COMMANDS */
14621 if (argc != 2 && argc != 3) {
14622 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14623 return JIM_ERR;
14625 #ifdef jim_ext_namespace
14626 if (!nons) {
14627 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14628 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14631 #endif
14632 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14633 break;
14635 case INFO_VARS:
14636 mode++; /* JIM_VARLIST_VARS */
14637 /* fall through */
14638 case INFO_LOCALS:
14639 mode++; /* JIM_VARLIST_LOCALS */
14640 /* fall through */
14641 case INFO_GLOBALS:
14642 /* mode 0 => JIM_VARLIST_GLOBALS */
14643 if (argc != 2 && argc != 3) {
14644 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14645 return JIM_ERR;
14647 #ifdef jim_ext_namespace
14648 if (!nons) {
14649 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14650 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14653 #endif
14654 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14655 break;
14657 case INFO_SCRIPT:
14658 if (argc != 2) {
14659 Jim_WrongNumArgs(interp, 2, argv, "");
14660 return JIM_ERR;
14662 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14663 break;
14665 case INFO_SOURCE:{
14666 jim_wide line;
14667 Jim_Obj *resObjPtr;
14668 Jim_Obj *fileNameObj;
14670 if (argc != 3 && argc != 5) {
14671 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14672 return JIM_ERR;
14674 if (argc == 5) {
14675 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14676 return JIM_ERR;
14678 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14679 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14681 else {
14682 if (argv[2]->typePtr == &sourceObjType) {
14683 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14684 line = argv[2]->internalRep.sourceValue.lineNumber;
14686 else if (argv[2]->typePtr == &scriptObjType) {
14687 ScriptObj *script = JimGetScript(interp, argv[2]);
14688 fileNameObj = script->fileNameObj;
14689 line = script->firstline;
14691 else {
14692 fileNameObj = interp->emptyObj;
14693 line = 1;
14695 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14696 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14697 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14699 Jim_SetResult(interp, resObjPtr);
14700 break;
14703 case INFO_STACKTRACE:
14704 Jim_SetResult(interp, interp->stackTrace);
14705 break;
14707 case INFO_LEVEL:
14708 case INFO_FRAME:
14709 switch (argc) {
14710 case 2:
14711 Jim_SetResultInt(interp, interp->framePtr->level);
14712 break;
14714 case 3:
14715 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14716 return JIM_ERR;
14718 Jim_SetResult(interp, objPtr);
14719 break;
14721 default:
14722 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14723 return JIM_ERR;
14725 break;
14727 case INFO_BODY:
14728 case INFO_STATICS:
14729 case INFO_ARGS:{
14730 Jim_Cmd *cmdPtr;
14732 if (argc != 3) {
14733 Jim_WrongNumArgs(interp, 2, argv, "procname");
14734 return JIM_ERR;
14736 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14737 return JIM_ERR;
14739 if (!cmdPtr->isproc) {
14740 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14741 return JIM_ERR;
14743 switch (cmd) {
14744 case INFO_BODY:
14745 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14746 break;
14747 case INFO_ARGS:
14748 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14749 break;
14750 case INFO_STATICS:
14751 if (cmdPtr->u.proc.staticVars) {
14752 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14753 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14755 break;
14757 break;
14760 case INFO_VERSION:
14761 case INFO_PATCHLEVEL:{
14762 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14764 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14765 Jim_SetResultString(interp, buf, -1);
14766 break;
14769 case INFO_COMPLETE:
14770 if (argc != 3 && argc != 4) {
14771 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14772 return JIM_ERR;
14774 else {
14775 char missing;
14777 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14778 if (missing != ' ' && argc == 4) {
14779 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14782 break;
14784 case INFO_HOSTNAME:
14785 /* Redirect to os.gethostname if it exists */
14786 return Jim_Eval(interp, "os.gethostname");
14788 case INFO_NAMEOFEXECUTABLE:
14789 /* Redirect to Tcl proc */
14790 return Jim_Eval(interp, "{info nameofexecutable}");
14792 case INFO_RETURNCODES:
14793 if (argc == 2) {
14794 int i;
14795 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14797 for (i = 0; jimReturnCodes[i]; i++) {
14798 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14799 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14800 jimReturnCodes[i], -1));
14803 Jim_SetResult(interp, listObjPtr);
14805 else if (argc == 3) {
14806 long code;
14807 const char *name;
14809 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14810 return JIM_ERR;
14812 name = Jim_ReturnCode(code);
14813 if (*name == '?') {
14814 Jim_SetResultInt(interp, code);
14816 else {
14817 Jim_SetResultString(interp, name, -1);
14820 else {
14821 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14822 return JIM_ERR;
14824 break;
14825 case INFO_REFERENCES:
14826 #ifdef JIM_REFERENCES
14827 return JimInfoReferences(interp, argc, argv);
14828 #else
14829 Jim_SetResultString(interp, "not supported", -1);
14830 return JIM_ERR;
14831 #endif
14833 return JIM_OK;
14836 /* [exists] */
14837 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14839 Jim_Obj *objPtr;
14840 int result = 0;
14842 static const char * const options[] = {
14843 "-command", "-proc", "-alias", "-var", NULL
14845 enum
14847 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14849 int option;
14851 if (argc == 2) {
14852 option = OPT_VAR;
14853 objPtr = argv[1];
14855 else if (argc == 3) {
14856 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14857 return JIM_ERR;
14859 objPtr = argv[2];
14861 else {
14862 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14863 return JIM_ERR;
14866 if (option == OPT_VAR) {
14867 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14869 else {
14870 /* Now different kinds of commands */
14871 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14873 if (cmd) {
14874 switch (option) {
14875 case OPT_COMMAND:
14876 result = 1;
14877 break;
14879 case OPT_ALIAS:
14880 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14881 break;
14883 case OPT_PROC:
14884 result = cmd->isproc;
14885 break;
14889 Jim_SetResultBool(interp, result);
14890 return JIM_OK;
14893 /* [split] */
14894 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14896 const char *str, *splitChars, *noMatchStart;
14897 int splitLen, strLen;
14898 Jim_Obj *resObjPtr;
14899 int c;
14900 int len;
14902 if (argc != 2 && argc != 3) {
14903 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14904 return JIM_ERR;
14907 str = Jim_GetString(argv[1], &len);
14908 if (len == 0) {
14909 return JIM_OK;
14911 strLen = Jim_Utf8Length(interp, argv[1]);
14913 /* Init */
14914 if (argc == 2) {
14915 splitChars = " \n\t\r";
14916 splitLen = 4;
14918 else {
14919 splitChars = Jim_String(argv[2]);
14920 splitLen = Jim_Utf8Length(interp, argv[2]);
14923 noMatchStart = str;
14924 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14926 /* Split */
14927 if (splitLen) {
14928 Jim_Obj *objPtr;
14929 while (strLen--) {
14930 const char *sc = splitChars;
14931 int scLen = splitLen;
14932 int sl = utf8_tounicode(str, &c);
14933 while (scLen--) {
14934 int pc;
14935 sc += utf8_tounicode(sc, &pc);
14936 if (c == pc) {
14937 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14938 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14939 noMatchStart = str + sl;
14940 break;
14943 str += sl;
14945 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14946 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14948 else {
14949 /* This handles the special case of splitchars eq {}
14950 * Optimise by sharing common (ASCII) characters
14952 Jim_Obj **commonObj = NULL;
14953 #define NUM_COMMON (128 - 9)
14954 while (strLen--) {
14955 int n = utf8_tounicode(str, &c);
14956 #ifdef JIM_OPTIMIZATION
14957 if (c >= 9 && c < 128) {
14958 /* Common ASCII char. Note that 9 is the tab character */
14959 c -= 9;
14960 if (!commonObj) {
14961 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14962 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14964 if (!commonObj[c]) {
14965 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14967 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14968 str++;
14969 continue;
14971 #endif
14972 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14973 str += n;
14975 Jim_Free(commonObj);
14978 Jim_SetResult(interp, resObjPtr);
14979 return JIM_OK;
14982 /* [join] */
14983 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14985 const char *joinStr;
14986 int joinStrLen;
14988 if (argc != 2 && argc != 3) {
14989 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14990 return JIM_ERR;
14992 /* Init */
14993 if (argc == 2) {
14994 joinStr = " ";
14995 joinStrLen = 1;
14997 else {
14998 joinStr = Jim_GetString(argv[2], &joinStrLen);
15000 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
15001 return JIM_OK;
15004 /* [format] */
15005 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15007 Jim_Obj *objPtr;
15009 if (argc < 2) {
15010 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
15011 return JIM_ERR;
15013 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
15014 if (objPtr == NULL)
15015 return JIM_ERR;
15016 Jim_SetResult(interp, objPtr);
15017 return JIM_OK;
15020 /* [scan] */
15021 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15023 Jim_Obj *listPtr, **outVec;
15024 int outc, i;
15026 if (argc < 3) {
15027 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
15028 return JIM_ERR;
15030 if (argv[2]->typePtr != &scanFmtStringObjType)
15031 SetScanFmtFromAny(interp, argv[2]);
15032 if (FormatGetError(argv[2]) != 0) {
15033 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
15034 return JIM_ERR;
15036 if (argc > 3) {
15037 int maxPos = FormatGetMaxPos(argv[2]);
15038 int count = FormatGetCnvCount(argv[2]);
15040 if (maxPos > argc - 3) {
15041 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
15042 return JIM_ERR;
15044 else if (count > argc - 3) {
15045 Jim_SetResultString(interp, "different numbers of variable names and "
15046 "field specifiers", -1);
15047 return JIM_ERR;
15049 else if (count < argc - 3) {
15050 Jim_SetResultString(interp, "variable is not assigned by any "
15051 "conversion specifiers", -1);
15052 return JIM_ERR;
15055 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
15056 if (listPtr == 0)
15057 return JIM_ERR;
15058 if (argc > 3) {
15059 int rc = JIM_OK;
15060 int count = 0;
15062 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
15063 int len = Jim_ListLength(interp, listPtr);
15065 if (len != 0) {
15066 JimListGetElements(interp, listPtr, &outc, &outVec);
15067 for (i = 0; i < outc; ++i) {
15068 if (Jim_Length(outVec[i]) > 0) {
15069 ++count;
15070 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
15071 rc = JIM_ERR;
15076 Jim_FreeNewObj(interp, listPtr);
15078 else {
15079 count = -1;
15081 if (rc == JIM_OK) {
15082 Jim_SetResultInt(interp, count);
15084 return rc;
15086 else {
15087 if (listPtr == (Jim_Obj *)EOF) {
15088 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
15089 return JIM_OK;
15091 Jim_SetResult(interp, listPtr);
15093 return JIM_OK;
15096 /* [error] */
15097 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15099 if (argc != 2 && argc != 3) {
15100 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
15101 return JIM_ERR;
15103 Jim_SetResult(interp, argv[1]);
15104 if (argc == 3) {
15105 JimSetStackTrace(interp, argv[2]);
15106 return JIM_ERR;
15108 interp->addStackTrace++;
15109 return JIM_ERR;
15112 /* [lrange] */
15113 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15115 Jim_Obj *objPtr;
15117 if (argc != 4) {
15118 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15119 return JIM_ERR;
15121 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15122 return JIM_ERR;
15123 Jim_SetResult(interp, objPtr);
15124 return JIM_OK;
15127 /* [lrepeat] */
15128 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15130 Jim_Obj *objPtr;
15131 long count;
15133 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15134 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15135 return JIM_ERR;
15138 if (count == 0 || argc == 2) {
15139 return JIM_OK;
15142 argc -= 2;
15143 argv += 2;
15145 objPtr = Jim_NewListObj(interp, argv, argc);
15146 while (--count) {
15147 ListInsertElements(objPtr, -1, argc, argv);
15150 Jim_SetResult(interp, objPtr);
15151 return JIM_OK;
15154 char **Jim_GetEnviron(void)
15156 #if defined(HAVE__NSGETENVIRON)
15157 return *_NSGetEnviron();
15158 #else
15159 #if !defined(NO_ENVIRON_EXTERN)
15160 extern char **environ;
15161 #endif
15163 return environ;
15164 #endif
15167 void Jim_SetEnviron(char **env)
15169 #if defined(HAVE__NSGETENVIRON)
15170 *_NSGetEnviron() = env;
15171 #else
15172 #if !defined(NO_ENVIRON_EXTERN)
15173 extern char **environ;
15174 #endif
15176 environ = env;
15177 #endif
15180 /* [env] */
15181 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15183 const char *key;
15184 const char *val;
15186 if (argc == 1) {
15187 char **e = Jim_GetEnviron();
15189 int i;
15190 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15192 for (i = 0; e[i]; i++) {
15193 const char *equals = strchr(e[i], '=');
15195 if (equals) {
15196 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15197 equals - e[i]));
15198 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15202 Jim_SetResult(interp, listObjPtr);
15203 return JIM_OK;
15206 if (argc < 2) {
15207 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15208 return JIM_ERR;
15210 key = Jim_String(argv[1]);
15211 val = getenv(key);
15212 if (val == NULL) {
15213 if (argc < 3) {
15214 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15215 return JIM_ERR;
15217 val = Jim_String(argv[2]);
15219 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15220 return JIM_OK;
15223 /* [source] */
15224 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15226 int retval;
15228 if (argc != 2) {
15229 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15230 return JIM_ERR;
15232 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15233 if (retval == JIM_RETURN)
15234 return JIM_OK;
15235 return retval;
15238 /* [lreverse] */
15239 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15241 Jim_Obj *revObjPtr, **ele;
15242 int len;
15244 if (argc != 2) {
15245 Jim_WrongNumArgs(interp, 1, argv, "list");
15246 return JIM_ERR;
15248 JimListGetElements(interp, argv[1], &len, &ele);
15249 len--;
15250 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15251 while (len >= 0)
15252 ListAppendElement(revObjPtr, ele[len--]);
15253 Jim_SetResult(interp, revObjPtr);
15254 return JIM_OK;
15257 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15259 jim_wide len;
15261 if (step == 0)
15262 return -1;
15263 if (start == end)
15264 return 0;
15265 else if (step > 0 && start > end)
15266 return -1;
15267 else if (step < 0 && end > start)
15268 return -1;
15269 len = end - start;
15270 if (len < 0)
15271 len = -len; /* abs(len) */
15272 if (step < 0)
15273 step = -step; /* abs(step) */
15274 len = 1 + ((len - 1) / step);
15275 /* We can truncate safely to INT_MAX, the range command
15276 * will always return an error for a such long range
15277 * because Tcl lists can't be so long. */
15278 if (len > INT_MAX)
15279 len = INT_MAX;
15280 return (int)((len < 0) ? -1 : len);
15283 /* [range] */
15284 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15286 jim_wide start = 0, end, step = 1;
15287 int len, i;
15288 Jim_Obj *objPtr;
15290 if (argc < 2 || argc > 4) {
15291 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15292 return JIM_ERR;
15294 if (argc == 2) {
15295 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15296 return JIM_ERR;
15298 else {
15299 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15300 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15301 return JIM_ERR;
15302 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15303 return JIM_ERR;
15305 if ((len = JimRangeLen(start, end, step)) == -1) {
15306 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15307 return JIM_ERR;
15309 objPtr = Jim_NewListObj(interp, NULL, 0);
15310 for (i = 0; i < len; i++)
15311 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15312 Jim_SetResult(interp, objPtr);
15313 return JIM_OK;
15316 /* [rand] */
15317 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15319 jim_wide min = 0, max = 0, len, maxMul;
15321 if (argc < 1 || argc > 3) {
15322 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15323 return JIM_ERR;
15325 if (argc == 1) {
15326 max = JIM_WIDE_MAX;
15327 } else if (argc == 2) {
15328 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15329 return JIM_ERR;
15330 } else if (argc == 3) {
15331 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15332 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15333 return JIM_ERR;
15335 len = max-min;
15336 if (len < 0) {
15337 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15338 return JIM_ERR;
15340 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15341 while (1) {
15342 jim_wide r;
15344 JimRandomBytes(interp, &r, sizeof(jim_wide));
15345 if (r < 0 || r >= maxMul) continue;
15346 r = (len == 0) ? 0 : r%len;
15347 Jim_SetResultInt(interp, min+r);
15348 return JIM_OK;
15352 static const struct {
15353 const char *name;
15354 Jim_CmdProc *cmdProc;
15355 } Jim_CoreCommandsTable[] = {
15356 {"alias", Jim_AliasCoreCommand},
15357 {"set", Jim_SetCoreCommand},
15358 {"unset", Jim_UnsetCoreCommand},
15359 {"puts", Jim_PutsCoreCommand},
15360 {"+", Jim_AddCoreCommand},
15361 {"*", Jim_MulCoreCommand},
15362 {"-", Jim_SubCoreCommand},
15363 {"/", Jim_DivCoreCommand},
15364 {"incr", Jim_IncrCoreCommand},
15365 {"while", Jim_WhileCoreCommand},
15366 {"loop", Jim_LoopCoreCommand},
15367 {"for", Jim_ForCoreCommand},
15368 {"foreach", Jim_ForeachCoreCommand},
15369 {"lmap", Jim_LmapCoreCommand},
15370 {"lassign", Jim_LassignCoreCommand},
15371 {"if", Jim_IfCoreCommand},
15372 {"switch", Jim_SwitchCoreCommand},
15373 {"list", Jim_ListCoreCommand},
15374 {"lindex", Jim_LindexCoreCommand},
15375 {"lset", Jim_LsetCoreCommand},
15376 {"lsearch", Jim_LsearchCoreCommand},
15377 {"llength", Jim_LlengthCoreCommand},
15378 {"lappend", Jim_LappendCoreCommand},
15379 {"linsert", Jim_LinsertCoreCommand},
15380 {"lreplace", Jim_LreplaceCoreCommand},
15381 {"lsort", Jim_LsortCoreCommand},
15382 {"append", Jim_AppendCoreCommand},
15383 {"debug", Jim_DebugCoreCommand},
15384 {"eval", Jim_EvalCoreCommand},
15385 {"uplevel", Jim_UplevelCoreCommand},
15386 {"expr", Jim_ExprCoreCommand},
15387 {"break", Jim_BreakCoreCommand},
15388 {"continue", Jim_ContinueCoreCommand},
15389 {"proc", Jim_ProcCoreCommand},
15390 {"concat", Jim_ConcatCoreCommand},
15391 {"return", Jim_ReturnCoreCommand},
15392 {"upvar", Jim_UpvarCoreCommand},
15393 {"global", Jim_GlobalCoreCommand},
15394 {"string", Jim_StringCoreCommand},
15395 {"time", Jim_TimeCoreCommand},
15396 {"exit", Jim_ExitCoreCommand},
15397 {"catch", Jim_CatchCoreCommand},
15398 #ifdef JIM_REFERENCES
15399 {"ref", Jim_RefCoreCommand},
15400 {"getref", Jim_GetrefCoreCommand},
15401 {"setref", Jim_SetrefCoreCommand},
15402 {"finalize", Jim_FinalizeCoreCommand},
15403 {"collect", Jim_CollectCoreCommand},
15404 #endif
15405 {"rename", Jim_RenameCoreCommand},
15406 {"dict", Jim_DictCoreCommand},
15407 {"subst", Jim_SubstCoreCommand},
15408 {"info", Jim_InfoCoreCommand},
15409 {"exists", Jim_ExistsCoreCommand},
15410 {"split", Jim_SplitCoreCommand},
15411 {"join", Jim_JoinCoreCommand},
15412 {"format", Jim_FormatCoreCommand},
15413 {"scan", Jim_ScanCoreCommand},
15414 {"error", Jim_ErrorCoreCommand},
15415 {"lrange", Jim_LrangeCoreCommand},
15416 {"lrepeat", Jim_LrepeatCoreCommand},
15417 {"env", Jim_EnvCoreCommand},
15418 {"source", Jim_SourceCoreCommand},
15419 {"lreverse", Jim_LreverseCoreCommand},
15420 {"range", Jim_RangeCoreCommand},
15421 {"rand", Jim_RandCoreCommand},
15422 {"tailcall", Jim_TailcallCoreCommand},
15423 {"local", Jim_LocalCoreCommand},
15424 {"upcall", Jim_UpcallCoreCommand},
15425 {"apply", Jim_ApplyCoreCommand},
15426 {NULL, NULL},
15429 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15431 int i = 0;
15433 while (Jim_CoreCommandsTable[i].name != NULL) {
15434 Jim_CreateCommand(interp,
15435 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15436 i++;
15440 /* -----------------------------------------------------------------------------
15441 * Interactive prompt
15442 * ---------------------------------------------------------------------------*/
15443 void Jim_MakeErrorMessage(Jim_Interp *interp)
15445 Jim_Obj *argv[2];
15447 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15448 argv[1] = interp->result;
15450 Jim_EvalObjVector(interp, 2, argv);
15453 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15454 const char *prefix, const char *const *tablePtr, const char *name)
15456 int count;
15457 char **tablePtrSorted;
15458 int i;
15460 for (count = 0; tablePtr[count]; count++) {
15463 if (name == NULL) {
15464 name = "option";
15467 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15468 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15469 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15470 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15471 for (i = 0; i < count; i++) {
15472 if (i + 1 == count && count > 1) {
15473 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15475 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15476 if (i + 1 != count) {
15477 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15480 Jim_Free(tablePtrSorted);
15483 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15484 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15486 const char *bad = "bad ";
15487 const char *const *entryPtr = NULL;
15488 int i;
15489 int match = -1;
15490 int arglen;
15491 const char *arg = Jim_GetString(objPtr, &arglen);
15493 *indexPtr = -1;
15495 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15496 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15497 /* Found an exact match */
15498 *indexPtr = i;
15499 return JIM_OK;
15501 if (flags & JIM_ENUM_ABBREV) {
15502 /* Accept an unambiguous abbreviation.
15503 * Note that '-' doesnt' consitute a valid abbreviation
15505 if (strncmp(arg, *entryPtr, arglen) == 0) {
15506 if (*arg == '-' && arglen == 1) {
15507 break;
15509 if (match >= 0) {
15510 bad = "ambiguous ";
15511 goto ambiguous;
15513 match = i;
15518 /* If we had an unambiguous partial match */
15519 if (match >= 0) {
15520 *indexPtr = match;
15521 return JIM_OK;
15524 ambiguous:
15525 if (flags & JIM_ERRMSG) {
15526 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15528 return JIM_ERR;
15531 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15533 int i;
15535 for (i = 0; i < (int)len; i++) {
15536 if (array[i] && strcmp(array[i], name) == 0) {
15537 return i;
15540 return -1;
15543 int Jim_IsDict(Jim_Obj *objPtr)
15545 return objPtr->typePtr == &dictObjType;
15548 int Jim_IsList(Jim_Obj *objPtr)
15550 return objPtr->typePtr == &listObjType;
15554 * Very simple printf-like formatting, designed for error messages.
15556 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15557 * The resulting string is created and set as the result.
15559 * Each '%s' should correspond to a regular string parameter.
15560 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15561 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15563 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15565 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15567 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15569 /* Initial space needed */
15570 int len = strlen(format);
15571 int extra = 0;
15572 int n = 0;
15573 const char *params[5];
15574 char *buf;
15575 va_list args;
15576 int i;
15578 va_start(args, format);
15580 for (i = 0; i < len && n < 5; i++) {
15581 int l;
15583 if (strncmp(format + i, "%s", 2) == 0) {
15584 params[n] = va_arg(args, char *);
15586 l = strlen(params[n]);
15588 else if (strncmp(format + i, "%#s", 3) == 0) {
15589 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15591 params[n] = Jim_GetString(objPtr, &l);
15593 else {
15594 if (format[i] == '%') {
15595 i++;
15597 continue;
15599 n++;
15600 extra += l;
15603 len += extra;
15604 buf = Jim_Alloc(len + 1);
15605 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15607 va_end(args);
15609 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15612 /* stubs */
15613 #ifndef jim_ext_package
15614 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15616 return JIM_OK;
15618 #endif
15619 #ifndef jim_ext_aio
15620 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15622 Jim_SetResultString(interp, "aio not enabled", -1);
15623 return NULL;
15625 #endif
15629 * Local Variables: ***
15630 * c-basic-offset: 4 ***
15631 * tab-width: 4 ***
15632 * End: ***