tcltest: do a better job of cleanup up after tests
[jimtcl.git] / jim.c
blob9dc2502a5e990b980aae48c9c775ea5c90d80500
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);
4995 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 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
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 Jim_HashTable marks;
5306 Jim_HashTableIterator htiter;
5307 Jim_HashEntry *he;
5308 Jim_Obj *objPtr;
5310 /* Avoid recursive calls */
5311 if (interp->lastCollectId == -1) {
5312 /* Jim_Collect() already running. Return just now. */
5313 return 0;
5315 interp->lastCollectId = -1;
5317 /* Mark all the references found into the 'mark' hash table.
5318 * The references are searched in every live object that
5319 * is of a type that can contain references. */
5320 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5321 objPtr = interp->liveList;
5322 while (objPtr) {
5323 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5324 const char *str, *p;
5325 int len;
5327 /* If the object is of type reference, to get the
5328 * Id is simple... */
5329 if (objPtr->typePtr == &referenceObjType) {
5330 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5331 #ifdef JIM_DEBUG_GC
5332 printf("MARK (reference): %d refcount: %d\n",
5333 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5334 #endif
5335 objPtr = objPtr->nextObjPtr;
5336 continue;
5338 /* Get the string repr of the object we want
5339 * to scan for references. */
5340 p = str = Jim_GetString(objPtr, &len);
5341 /* Skip objects too little to contain references. */
5342 if (len < JIM_REFERENCE_SPACE) {
5343 objPtr = objPtr->nextObjPtr;
5344 continue;
5346 /* Extract references from the object string repr. */
5347 while (1) {
5348 int i;
5349 unsigned long id;
5351 if ((p = strstr(p, "<reference.<")) == NULL)
5352 break;
5353 /* Check if it's a valid reference. */
5354 if (len - (p - str) < JIM_REFERENCE_SPACE)
5355 break;
5356 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5357 break;
5358 for (i = 21; i <= 40; i++)
5359 if (!isdigit(UCHAR(p[i])))
5360 break;
5361 /* Get the ID */
5362 id = strtoul(p + 21, NULL, 10);
5364 /* Ok, a reference for the given ID
5365 * was found. Mark it. */
5366 Jim_AddHashEntry(&marks, &id, NULL);
5367 #ifdef JIM_DEBUG_GC
5368 printf("MARK: %d\n", (int)id);
5369 #endif
5370 p += JIM_REFERENCE_SPACE;
5373 objPtr = objPtr->nextObjPtr;
5376 /* Run the references hash table to destroy every reference that
5377 * is not referenced outside (not present in the mark HT). */
5378 JimInitHashTableIterator(&interp->references, &htiter);
5379 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5380 const unsigned long *refId;
5381 Jim_Reference *refPtr;
5383 refId = he->key;
5384 /* Check if in the mark phase we encountered
5385 * this reference. */
5386 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5387 #ifdef JIM_DEBUG_GC
5388 printf("COLLECTING %d\n", (int)*refId);
5389 #endif
5390 collected++;
5391 /* Drop the reference, but call the
5392 * finalizer first if registered. */
5393 refPtr = Jim_GetHashEntryVal(he);
5394 if (refPtr->finalizerCmdNamePtr) {
5395 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5396 Jim_Obj *objv[3], *oldResult;
5398 JimFormatReference(refstr, refPtr, *refId);
5400 objv[0] = refPtr->finalizerCmdNamePtr;
5401 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5402 objv[2] = refPtr->objPtr;
5404 /* Drop the reference itself */
5405 /* Avoid the finaliser being freed here */
5406 Jim_IncrRefCount(objv[0]);
5407 /* Don't remove the reference from the hash table just yet
5408 * since that will free refPtr, and hence refPtr->objPtr
5411 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5412 oldResult = interp->result;
5413 Jim_IncrRefCount(oldResult);
5414 Jim_EvalObjVector(interp, 3, objv);
5415 Jim_SetResult(interp, oldResult);
5416 Jim_DecrRefCount(interp, oldResult);
5418 Jim_DecrRefCount(interp, objv[0]);
5420 Jim_DeleteHashEntry(&interp->references, refId);
5423 Jim_FreeHashTable(&marks);
5424 interp->lastCollectId = interp->referenceNextId;
5425 interp->lastCollectTime = time(NULL);
5426 return collected;
5429 #define JIM_COLLECT_ID_PERIOD 5000
5430 #define JIM_COLLECT_TIME_PERIOD 300
5432 void Jim_CollectIfNeeded(Jim_Interp *interp)
5434 unsigned long elapsedId;
5435 int elapsedTime;
5437 elapsedId = interp->referenceNextId - interp->lastCollectId;
5438 elapsedTime = time(NULL) - interp->lastCollectTime;
5441 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5442 Jim_Collect(interp);
5445 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5447 int Jim_IsBigEndian(void)
5449 union {
5450 unsigned short s;
5451 unsigned char c[2];
5452 } uval = {0x0102};
5454 return uval.c[0] == 1;
5457 /* -----------------------------------------------------------------------------
5458 * Interpreter related functions
5459 * ---------------------------------------------------------------------------*/
5461 Jim_Interp *Jim_CreateInterp(void)
5463 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5465 memset(i, 0, sizeof(*i));
5467 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5468 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5469 i->lastCollectTime = time(NULL);
5471 /* Note that we can create objects only after the
5472 * interpreter liveList and freeList pointers are
5473 * initialized to NULL. */
5474 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5475 #ifdef JIM_REFERENCES
5476 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5477 #endif
5478 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5479 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5480 i->emptyObj = Jim_NewEmptyStringObj(i);
5481 i->trueObj = Jim_NewIntObj(i, 1);
5482 i->falseObj = Jim_NewIntObj(i, 0);
5483 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5484 i->errorFileNameObj = i->emptyObj;
5485 i->result = i->emptyObj;
5486 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5487 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5488 i->errorProc = i->emptyObj;
5489 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5490 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5491 Jim_IncrRefCount(i->emptyObj);
5492 Jim_IncrRefCount(i->errorFileNameObj);
5493 Jim_IncrRefCount(i->result);
5494 Jim_IncrRefCount(i->stackTrace);
5495 Jim_IncrRefCount(i->unknown);
5496 Jim_IncrRefCount(i->currentScriptObj);
5497 Jim_IncrRefCount(i->nullScriptObj);
5498 Jim_IncrRefCount(i->errorProc);
5499 Jim_IncrRefCount(i->trueObj);
5500 Jim_IncrRefCount(i->falseObj);
5502 /* Initialize key variables every interpreter should contain */
5503 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5504 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5506 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5507 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5508 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5509 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5510 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5511 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5512 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5513 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5515 return i;
5518 void Jim_FreeInterp(Jim_Interp *i)
5520 Jim_CallFrame *cf, *cfx;
5522 Jim_Obj *objPtr, *nextObjPtr;
5524 /* Free the active call frames list - must be done before i->commands is destroyed */
5525 for (cf = i->framePtr; cf; cf = cfx) {
5526 cfx = cf->parent;
5527 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5530 Jim_DecrRefCount(i, i->emptyObj);
5531 Jim_DecrRefCount(i, i->trueObj);
5532 Jim_DecrRefCount(i, i->falseObj);
5533 Jim_DecrRefCount(i, i->result);
5534 Jim_DecrRefCount(i, i->stackTrace);
5535 Jim_DecrRefCount(i, i->errorProc);
5536 Jim_DecrRefCount(i, i->unknown);
5537 Jim_DecrRefCount(i, i->errorFileNameObj);
5538 Jim_DecrRefCount(i, i->currentScriptObj);
5539 Jim_DecrRefCount(i, i->nullScriptObj);
5540 Jim_FreeHashTable(&i->commands);
5541 #ifdef JIM_REFERENCES
5542 Jim_FreeHashTable(&i->references);
5543 #endif
5544 Jim_FreeHashTable(&i->packages);
5545 Jim_Free(i->prngState);
5546 Jim_FreeHashTable(&i->assocData);
5548 /* Check that the live object list is empty, otherwise
5549 * there is a memory leak. */
5550 #ifdef JIM_MAINTAINER
5551 if (i->liveList != NULL) {
5552 objPtr = i->liveList;
5554 printf("\n-------------------------------------\n");
5555 printf("Objects still in the free list:\n");
5556 while (objPtr) {
5557 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5559 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5560 printf("%p (%d) %-10s: '%.20s...'\n",
5561 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5563 else {
5564 printf("%p (%d) %-10s: '%s'\n",
5565 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5567 if (objPtr->typePtr == &sourceObjType) {
5568 printf("FILE %s LINE %d\n",
5569 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5570 objPtr->internalRep.sourceValue.lineNumber);
5572 objPtr = objPtr->nextObjPtr;
5574 printf("-------------------------------------\n\n");
5575 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5577 #endif
5579 /* Free all the freed objects. */
5580 objPtr = i->freeList;
5581 while (objPtr) {
5582 nextObjPtr = objPtr->nextObjPtr;
5583 Jim_Free(objPtr);
5584 objPtr = nextObjPtr;
5587 /* Free the free call frames list */
5588 for (cf = i->freeFramesList; cf; cf = cfx) {
5589 cfx = cf->next;
5590 if (cf->vars.table)
5591 Jim_FreeHashTable(&cf->vars);
5592 Jim_Free(cf);
5595 /* Free the interpreter structure. */
5596 Jim_Free(i);
5599 /* Returns the call frame relative to the level represented by
5600 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5602 * This function accepts the 'level' argument in the form
5603 * of the commands [uplevel] and [upvar].
5605 * Returns NULL on error.
5607 * Note: for a function accepting a relative integer as level suitable
5608 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5610 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5612 long level;
5613 const char *str;
5614 Jim_CallFrame *framePtr;
5616 if (levelObjPtr) {
5617 str = Jim_String(levelObjPtr);
5618 if (str[0] == '#') {
5619 char *endptr;
5621 level = jim_strtol(str + 1, &endptr);
5622 if (str[1] == '\0' || endptr[0] != '\0') {
5623 level = -1;
5626 else {
5627 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5628 level = -1;
5630 else {
5631 /* Convert from a relative to an absolute level */
5632 level = interp->framePtr->level - level;
5636 else {
5637 str = "1"; /* Needed to format the error message. */
5638 level = interp->framePtr->level - 1;
5641 if (level == 0) {
5642 return interp->topFramePtr;
5644 if (level > 0) {
5645 /* Lookup */
5646 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5647 if (framePtr->level == level) {
5648 return framePtr;
5653 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5654 return NULL;
5657 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5658 * as a relative integer like in the [info level ?level?] command.
5660 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5662 long level;
5663 Jim_CallFrame *framePtr;
5665 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5666 if (level <= 0) {
5667 /* Convert from a relative to an absolute level */
5668 level = interp->framePtr->level + level;
5671 if (level == 0) {
5672 return interp->topFramePtr;
5675 /* Lookup */
5676 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5677 if (framePtr->level == level) {
5678 return framePtr;
5683 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5684 return NULL;
5687 static void JimResetStackTrace(Jim_Interp *interp)
5689 Jim_DecrRefCount(interp, interp->stackTrace);
5690 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5691 Jim_IncrRefCount(interp->stackTrace);
5694 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5696 int len;
5698 /* Increment reference first in case these are the same object */
5699 Jim_IncrRefCount(stackTraceObj);
5700 Jim_DecrRefCount(interp, interp->stackTrace);
5701 interp->stackTrace = stackTraceObj;
5702 interp->errorFlag = 1;
5704 /* This is a bit ugly.
5705 * If the filename of the last entry of the stack trace is empty,
5706 * the next stack level should be added.
5708 len = Jim_ListLength(interp, interp->stackTrace);
5709 if (len >= 3) {
5710 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5711 interp->addStackTrace = 1;
5716 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5717 Jim_Obj *fileNameObj, int linenr)
5719 if (strcmp(procname, "unknown") == 0) {
5720 procname = "";
5722 if (!*procname && !Jim_Length(fileNameObj)) {
5723 /* No useful info here */
5724 return;
5727 if (Jim_IsShared(interp->stackTrace)) {
5728 Jim_DecrRefCount(interp, interp->stackTrace);
5729 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5730 Jim_IncrRefCount(interp->stackTrace);
5733 /* If we have no procname but the previous element did, merge with that frame */
5734 if (!*procname && Jim_Length(fileNameObj)) {
5735 /* Just a filename. Check the previous entry */
5736 int len = Jim_ListLength(interp, interp->stackTrace);
5738 if (len >= 3) {
5739 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5740 if (Jim_Length(objPtr)) {
5741 /* Yes, the previous level had procname */
5742 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5743 if (Jim_Length(objPtr) == 0) {
5744 /* But no filename, so merge the new info with that frame */
5745 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5746 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5747 return;
5753 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5754 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5755 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5758 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5759 void *data)
5761 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5763 assocEntryPtr->delProc = delProc;
5764 assocEntryPtr->data = data;
5765 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5768 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5770 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5772 if (entryPtr != NULL) {
5773 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5774 return assocEntryPtr->data;
5776 return NULL;
5779 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5781 return Jim_DeleteHashEntry(&interp->assocData, key);
5784 int Jim_GetExitCode(Jim_Interp *interp)
5786 return interp->exitCode;
5789 /* -----------------------------------------------------------------------------
5790 * Integer object
5791 * ---------------------------------------------------------------------------*/
5792 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5793 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5795 static const Jim_ObjType intObjType = {
5796 "int",
5797 NULL,
5798 NULL,
5799 UpdateStringOfInt,
5800 JIM_TYPE_NONE,
5803 /* A coerced double is closer to an int than a double.
5804 * It is an int value temporarily masquerading as a double value.
5805 * i.e. it has the same string value as an int and Jim_GetWide()
5806 * succeeds, but also Jim_GetDouble() returns the value directly.
5808 static const Jim_ObjType coercedDoubleObjType = {
5809 "coerced-double",
5810 NULL,
5811 NULL,
5812 UpdateStringOfInt,
5813 JIM_TYPE_NONE,
5817 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5819 char buf[JIM_INTEGER_SPACE + 1];
5820 jim_wide wideValue = JimWideValue(objPtr);
5821 int pos = 0;
5823 if (wideValue == 0) {
5824 buf[pos++] = '0';
5826 else {
5827 char tmp[JIM_INTEGER_SPACE];
5828 int num = 0;
5829 int i;
5831 if (wideValue < 0) {
5832 buf[pos++] = '-';
5833 i = wideValue % 10;
5834 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5835 * whereas C99 is always -6
5836 * coverity[dead_error_line]
5838 tmp[num++] = (i > 0) ? (10 - i) : -i;
5839 wideValue /= -10;
5842 while (wideValue) {
5843 tmp[num++] = wideValue % 10;
5844 wideValue /= 10;
5847 for (i = 0; i < num; i++) {
5848 buf[pos++] = '0' + tmp[num - i - 1];
5851 buf[pos] = 0;
5853 JimSetStringBytes(objPtr, buf);
5856 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5858 jim_wide wideValue;
5859 const char *str;
5861 if (objPtr->typePtr == &coercedDoubleObjType) {
5862 /* Simple switch */
5863 objPtr->typePtr = &intObjType;
5864 return JIM_OK;
5867 /* Get the string representation */
5868 str = Jim_String(objPtr);
5869 /* Try to convert into a jim_wide */
5870 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5871 if (flags & JIM_ERRMSG) {
5872 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5874 return JIM_ERR;
5876 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5877 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5878 return JIM_ERR;
5880 /* Free the old internal repr and set the new one. */
5881 Jim_FreeIntRep(interp, objPtr);
5882 objPtr->typePtr = &intObjType;
5883 objPtr->internalRep.wideValue = wideValue;
5884 return JIM_OK;
5887 #ifdef JIM_OPTIMIZATION
5888 static int JimIsWide(Jim_Obj *objPtr)
5890 return objPtr->typePtr == &intObjType;
5892 #endif
5894 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5896 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5897 return JIM_ERR;
5898 *widePtr = JimWideValue(objPtr);
5899 return JIM_OK;
5902 /* Get a wide but does not set an error if the format is bad. */
5903 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5905 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5906 return JIM_ERR;
5907 *widePtr = JimWideValue(objPtr);
5908 return JIM_OK;
5911 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5913 jim_wide wideValue;
5914 int retval;
5916 retval = Jim_GetWide(interp, objPtr, &wideValue);
5917 if (retval == JIM_OK) {
5918 *longPtr = (long)wideValue;
5919 return JIM_OK;
5921 return JIM_ERR;
5924 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5926 Jim_Obj *objPtr;
5928 objPtr = Jim_NewObj(interp);
5929 objPtr->typePtr = &intObjType;
5930 objPtr->bytes = NULL;
5931 objPtr->internalRep.wideValue = wideValue;
5932 return objPtr;
5935 /* -----------------------------------------------------------------------------
5936 * Double object
5937 * ---------------------------------------------------------------------------*/
5938 #define JIM_DOUBLE_SPACE 30
5940 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5941 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5943 static const Jim_ObjType doubleObjType = {
5944 "double",
5945 NULL,
5946 NULL,
5947 UpdateStringOfDouble,
5948 JIM_TYPE_NONE,
5951 #ifndef HAVE_ISNAN
5952 #undef isnan
5953 #define isnan(X) ((X) != (X))
5954 #endif
5955 #ifndef HAVE_ISINF
5956 #undef isinf
5957 #define isinf(X) (1.0 / (X) == 0.0)
5958 #endif
5960 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5962 double value = objPtr->internalRep.doubleValue;
5964 if (isnan(value)) {
5965 JimSetStringBytes(objPtr, "NaN");
5966 return;
5968 if (isinf(value)) {
5969 if (value < 0) {
5970 JimSetStringBytes(objPtr, "-Inf");
5972 else {
5973 JimSetStringBytes(objPtr, "Inf");
5975 return;
5978 char buf[JIM_DOUBLE_SPACE + 1];
5979 int i;
5980 int len = sprintf(buf, "%.12g", value);
5982 /* Add a final ".0" if necessary */
5983 for (i = 0; i < len; i++) {
5984 if (buf[i] == '.' || buf[i] == 'e') {
5985 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5986 /* If 'buf' ends in e-0nn or e+0nn, remove
5987 * the 0 after the + or - and reduce the length by 1
5989 char *e = strchr(buf, 'e');
5990 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5991 /* Move it up */
5992 e += 2;
5993 memmove(e, e + 1, len - (e - buf));
5995 #endif
5996 break;
5999 if (buf[i] == '\0') {
6000 buf[i++] = '.';
6001 buf[i++] = '0';
6002 buf[i] = '\0';
6004 JimSetStringBytes(objPtr, buf);
6008 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6010 double doubleValue;
6011 jim_wide wideValue;
6012 const char *str;
6014 /* Preserve the string representation.
6015 * Needed so we can convert back to int without loss
6017 str = Jim_String(objPtr);
6019 #ifdef HAVE_LONG_LONG
6020 /* Assume a 53 bit mantissa */
6021 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6022 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6024 if (objPtr->typePtr == &intObjType
6025 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6026 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6028 /* Direct conversion to coerced double */
6029 objPtr->typePtr = &coercedDoubleObjType;
6030 return JIM_OK;
6032 else
6033 #endif
6034 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6035 /* Managed to convert to an int, so we can use this as a cooerced double */
6036 Jim_FreeIntRep(interp, objPtr);
6037 objPtr->typePtr = &coercedDoubleObjType;
6038 objPtr->internalRep.wideValue = wideValue;
6039 return JIM_OK;
6041 else {
6042 /* Try to convert into a double */
6043 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6044 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6045 return JIM_ERR;
6047 /* Free the old internal repr and set the new one. */
6048 Jim_FreeIntRep(interp, objPtr);
6050 objPtr->typePtr = &doubleObjType;
6051 objPtr->internalRep.doubleValue = doubleValue;
6052 return JIM_OK;
6055 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6057 if (objPtr->typePtr == &coercedDoubleObjType) {
6058 *doublePtr = JimWideValue(objPtr);
6059 return JIM_OK;
6061 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6062 return JIM_ERR;
6064 if (objPtr->typePtr == &coercedDoubleObjType) {
6065 *doublePtr = JimWideValue(objPtr);
6067 else {
6068 *doublePtr = objPtr->internalRep.doubleValue;
6070 return JIM_OK;
6073 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6075 Jim_Obj *objPtr;
6077 objPtr = Jim_NewObj(interp);
6078 objPtr->typePtr = &doubleObjType;
6079 objPtr->bytes = NULL;
6080 objPtr->internalRep.doubleValue = doubleValue;
6081 return objPtr;
6084 /* -----------------------------------------------------------------------------
6085 * Boolean conversion
6086 * ---------------------------------------------------------------------------*/
6087 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6089 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6091 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6092 return JIM_ERR;
6093 *booleanPtr = (int) JimWideValue(objPtr);
6094 return JIM_OK;
6097 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6099 static const char * const falses[] = {
6100 "0", "false", "no", "off", NULL
6102 static const char * const trues[] = {
6103 "1", "true", "yes", "on", NULL
6106 int boolean;
6108 int index;
6109 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6110 boolean = 0;
6111 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6112 boolean = 1;
6113 } else {
6114 if (flags & JIM_ERRMSG) {
6115 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6117 return JIM_ERR;
6120 /* Free the old internal repr and set the new one. */
6121 Jim_FreeIntRep(interp, objPtr);
6122 objPtr->typePtr = &intObjType;
6123 objPtr->internalRep.wideValue = boolean;
6124 return JIM_OK;
6127 /* -----------------------------------------------------------------------------
6128 * List object
6129 * ---------------------------------------------------------------------------*/
6130 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6131 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6132 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6133 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6134 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6135 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6137 /* Note that while the elements of the list may contain references,
6138 * the list object itself can't. This basically means that the
6139 * list object string representation as a whole can't contain references
6140 * that are not presents in the single elements. */
6141 static const Jim_ObjType listObjType = {
6142 "list",
6143 FreeListInternalRep,
6144 DupListInternalRep,
6145 UpdateStringOfList,
6146 JIM_TYPE_NONE,
6149 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6151 int i;
6153 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6154 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6156 Jim_Free(objPtr->internalRep.listValue.ele);
6159 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6161 int i;
6163 JIM_NOTUSED(interp);
6165 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6166 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6167 dupPtr->internalRep.listValue.ele =
6168 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6169 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6170 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6171 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6172 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6174 dupPtr->typePtr = &listObjType;
6177 /* The following function checks if a given string can be encoded
6178 * into a list element without any kind of quoting, surrounded by braces,
6179 * or using escapes to quote. */
6180 #define JIM_ELESTR_SIMPLE 0
6181 #define JIM_ELESTR_BRACE 1
6182 #define JIM_ELESTR_QUOTE 2
6183 static unsigned char ListElementQuotingType(const char *s, int len)
6185 int i, level, blevel, trySimple = 1;
6187 /* Try with the SIMPLE case */
6188 if (len == 0)
6189 return JIM_ELESTR_BRACE;
6190 if (s[0] == '"' || s[0] == '{') {
6191 trySimple = 0;
6192 goto testbrace;
6194 for (i = 0; i < len; i++) {
6195 switch (s[i]) {
6196 case ' ':
6197 case '$':
6198 case '"':
6199 case '[':
6200 case ']':
6201 case ';':
6202 case '\\':
6203 case '\r':
6204 case '\n':
6205 case '\t':
6206 case '\f':
6207 case '\v':
6208 trySimple = 0;
6209 /* fall through */
6210 case '{':
6211 case '}':
6212 goto testbrace;
6215 return JIM_ELESTR_SIMPLE;
6217 testbrace:
6218 /* Test if it's possible to do with braces */
6219 if (s[len - 1] == '\\')
6220 return JIM_ELESTR_QUOTE;
6221 level = 0;
6222 blevel = 0;
6223 for (i = 0; i < len; i++) {
6224 switch (s[i]) {
6225 case '{':
6226 level++;
6227 break;
6228 case '}':
6229 level--;
6230 if (level < 0)
6231 return JIM_ELESTR_QUOTE;
6232 break;
6233 case '[':
6234 blevel++;
6235 break;
6236 case ']':
6237 blevel--;
6238 break;
6239 case '\\':
6240 if (s[i + 1] == '\n')
6241 return JIM_ELESTR_QUOTE;
6242 else if (s[i + 1] != '\0')
6243 i++;
6244 break;
6247 if (blevel < 0) {
6248 return JIM_ELESTR_QUOTE;
6251 if (level == 0) {
6252 if (!trySimple)
6253 return JIM_ELESTR_BRACE;
6254 for (i = 0; i < len; i++) {
6255 switch (s[i]) {
6256 case ' ':
6257 case '$':
6258 case '"':
6259 case '[':
6260 case ']':
6261 case ';':
6262 case '\\':
6263 case '\r':
6264 case '\n':
6265 case '\t':
6266 case '\f':
6267 case '\v':
6268 return JIM_ELESTR_BRACE;
6269 break;
6272 return JIM_ELESTR_SIMPLE;
6274 return JIM_ELESTR_QUOTE;
6277 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6278 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6279 * scenario.
6280 * Returns the length of the result.
6282 static int BackslashQuoteString(const char *s, int len, char *q)
6284 char *p = q;
6286 while (len--) {
6287 switch (*s) {
6288 case ' ':
6289 case '$':
6290 case '"':
6291 case '[':
6292 case ']':
6293 case '{':
6294 case '}':
6295 case ';':
6296 case '\\':
6297 *p++ = '\\';
6298 *p++ = *s++;
6299 break;
6300 case '\n':
6301 *p++ = '\\';
6302 *p++ = 'n';
6303 s++;
6304 break;
6305 case '\r':
6306 *p++ = '\\';
6307 *p++ = 'r';
6308 s++;
6309 break;
6310 case '\t':
6311 *p++ = '\\';
6312 *p++ = 't';
6313 s++;
6314 break;
6315 case '\f':
6316 *p++ = '\\';
6317 *p++ = 'f';
6318 s++;
6319 break;
6320 case '\v':
6321 *p++ = '\\';
6322 *p++ = 'v';
6323 s++;
6324 break;
6325 default:
6326 *p++ = *s++;
6327 break;
6330 *p = '\0';
6332 return p - q;
6335 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6337 #define STATIC_QUOTING_LEN 32
6338 int i, bufLen, realLength;
6339 const char *strRep;
6340 char *p;
6341 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6343 /* Estimate the space needed. */
6344 if (objc > STATIC_QUOTING_LEN) {
6345 quotingType = Jim_Alloc(objc);
6347 else {
6348 quotingType = staticQuoting;
6350 bufLen = 0;
6351 for (i = 0; i < objc; i++) {
6352 int len;
6354 strRep = Jim_GetString(objv[i], &len);
6355 quotingType[i] = ListElementQuotingType(strRep, len);
6356 switch (quotingType[i]) {
6357 case JIM_ELESTR_SIMPLE:
6358 if (i != 0 || strRep[0] != '#') {
6359 bufLen += len;
6360 break;
6362 /* Special case '#' on first element needs braces */
6363 quotingType[i] = JIM_ELESTR_BRACE;
6364 /* fall through */
6365 case JIM_ELESTR_BRACE:
6366 bufLen += len + 2;
6367 break;
6368 case JIM_ELESTR_QUOTE:
6369 bufLen += len * 2;
6370 break;
6372 bufLen++; /* elements separator. */
6374 bufLen++;
6376 /* Generate the string rep. */
6377 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6378 realLength = 0;
6379 for (i = 0; i < objc; i++) {
6380 int len, qlen;
6382 strRep = Jim_GetString(objv[i], &len);
6384 switch (quotingType[i]) {
6385 case JIM_ELESTR_SIMPLE:
6386 memcpy(p, strRep, len);
6387 p += len;
6388 realLength += len;
6389 break;
6390 case JIM_ELESTR_BRACE:
6391 *p++ = '{';
6392 memcpy(p, strRep, len);
6393 p += len;
6394 *p++ = '}';
6395 realLength += len + 2;
6396 break;
6397 case JIM_ELESTR_QUOTE:
6398 if (i == 0 && strRep[0] == '#') {
6399 *p++ = '\\';
6400 realLength++;
6402 qlen = BackslashQuoteString(strRep, len, p);
6403 p += qlen;
6404 realLength += qlen;
6405 break;
6407 /* Add a separating space */
6408 if (i + 1 != objc) {
6409 *p++ = ' ';
6410 realLength++;
6413 *p = '\0'; /* nul term. */
6414 objPtr->length = realLength;
6416 if (quotingType != staticQuoting) {
6417 Jim_Free(quotingType);
6421 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6423 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6426 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6428 struct JimParserCtx parser;
6429 const char *str;
6430 int strLen;
6431 Jim_Obj *fileNameObj;
6432 int linenr;
6434 if (objPtr->typePtr == &listObjType) {
6435 return JIM_OK;
6438 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6439 * it also preserves any source location of the dict elements
6440 * which can be very useful
6442 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6443 Jim_Obj **listObjPtrPtr;
6444 int len;
6445 int i;
6447 listObjPtrPtr = JimDictPairs(objPtr, &len);
6448 for (i = 0; i < len; i++) {
6449 Jim_IncrRefCount(listObjPtrPtr[i]);
6452 /* Now just switch the internal rep */
6453 Jim_FreeIntRep(interp, objPtr);
6454 objPtr->typePtr = &listObjType;
6455 objPtr->internalRep.listValue.len = len;
6456 objPtr->internalRep.listValue.maxLen = len;
6457 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6459 return JIM_OK;
6462 /* Try to preserve information about filename / line number */
6463 if (objPtr->typePtr == &sourceObjType) {
6464 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6465 linenr = objPtr->internalRep.sourceValue.lineNumber;
6467 else {
6468 fileNameObj = interp->emptyObj;
6469 linenr = 1;
6471 Jim_IncrRefCount(fileNameObj);
6473 /* Get the string representation */
6474 str = Jim_GetString(objPtr, &strLen);
6476 /* Free the old internal repr just now and initialize the
6477 * new one just now. The string->list conversion can't fail. */
6478 Jim_FreeIntRep(interp, objPtr);
6479 objPtr->typePtr = &listObjType;
6480 objPtr->internalRep.listValue.len = 0;
6481 objPtr->internalRep.listValue.maxLen = 0;
6482 objPtr->internalRep.listValue.ele = NULL;
6484 /* Convert into a list */
6485 if (strLen) {
6486 JimParserInit(&parser, str, strLen, linenr);
6487 while (!parser.eof) {
6488 Jim_Obj *elementPtr;
6490 JimParseList(&parser);
6491 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6492 continue;
6493 elementPtr = JimParserGetTokenObj(interp, &parser);
6494 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6495 ListAppendElement(objPtr, elementPtr);
6498 Jim_DecrRefCount(interp, fileNameObj);
6499 return JIM_OK;
6502 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6504 Jim_Obj *objPtr;
6506 objPtr = Jim_NewObj(interp);
6507 objPtr->typePtr = &listObjType;
6508 objPtr->bytes = NULL;
6509 objPtr->internalRep.listValue.ele = NULL;
6510 objPtr->internalRep.listValue.len = 0;
6511 objPtr->internalRep.listValue.maxLen = 0;
6513 if (len) {
6514 ListInsertElements(objPtr, 0, len, elements);
6517 return objPtr;
6520 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6521 * length of the vector. Note that the user of this function should make
6522 * sure that the list object can't shimmer while the vector returned
6523 * is in use, this vector is the one stored inside the internal representation
6524 * of the list object. This function is not exported, extensions should
6525 * always access to the List object elements using Jim_ListIndex(). */
6526 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6527 Jim_Obj ***listVec)
6529 *listLen = Jim_ListLength(interp, listObj);
6530 *listVec = listObj->internalRep.listValue.ele;
6533 /* Sorting uses ints, but commands may return wide */
6534 static int JimSign(jim_wide w)
6536 if (w == 0) {
6537 return 0;
6539 else if (w < 0) {
6540 return -1;
6542 return 1;
6545 /* ListSortElements type values */
6546 struct lsort_info {
6547 jmp_buf jmpbuf;
6548 Jim_Obj *command;
6549 Jim_Interp *interp;
6550 enum {
6551 JIM_LSORT_ASCII,
6552 JIM_LSORT_NOCASE,
6553 JIM_LSORT_INTEGER,
6554 JIM_LSORT_REAL,
6555 JIM_LSORT_COMMAND
6556 } type;
6557 int order;
6558 int index;
6559 int indexed;
6560 int unique;
6561 int (*subfn)(Jim_Obj **, Jim_Obj **);
6564 static struct lsort_info *sort_info;
6566 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6568 Jim_Obj *lObj, *rObj;
6570 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6571 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6572 longjmp(sort_info->jmpbuf, JIM_ERR);
6574 return sort_info->subfn(&lObj, &rObj);
6577 /* Sort the internal rep of a list. */
6578 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6580 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6583 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6585 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6588 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6590 jim_wide lhs = 0, rhs = 0;
6592 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6593 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6594 longjmp(sort_info->jmpbuf, JIM_ERR);
6597 return JimSign(lhs - rhs) * sort_info->order;
6600 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6602 double lhs = 0, rhs = 0;
6604 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6605 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6606 longjmp(sort_info->jmpbuf, JIM_ERR);
6608 if (lhs == rhs) {
6609 return 0;
6611 if (lhs > rhs) {
6612 return sort_info->order;
6614 return -sort_info->order;
6617 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6619 Jim_Obj *compare_script;
6620 int rc;
6622 jim_wide ret = 0;
6624 /* This must be a valid list */
6625 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6626 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6627 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6629 rc = Jim_EvalObj(sort_info->interp, compare_script);
6631 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6632 longjmp(sort_info->jmpbuf, rc);
6635 return JimSign(ret) * sort_info->order;
6638 /* Remove duplicate elements from the (sorted) list in-place, according to the
6639 * comparison function, comp.
6641 * Note that the last unique value is kept, not the first
6643 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6645 int src;
6646 int dst = 0;
6647 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6649 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6650 if (comp(&ele[dst], &ele[src]) == 0) {
6651 /* Match, so replace the dest with the current source */
6652 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6654 else {
6655 /* No match, so keep the current source and move to the next destination */
6656 dst++;
6658 ele[dst] = ele[src];
6660 /* At end of list, keep the final element */
6661 ele[++dst] = ele[src];
6663 /* Set the new length */
6664 listObjPtr->internalRep.listValue.len = dst;
6667 /* Sort a list *in place*. MUST be called with a non-shared list. */
6668 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6670 struct lsort_info *prev_info;
6672 typedef int (qsort_comparator) (const void *, const void *);
6673 int (*fn) (Jim_Obj **, Jim_Obj **);
6674 Jim_Obj **vector;
6675 int len;
6676 int rc;
6678 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6679 SetListFromAny(interp, listObjPtr);
6681 /* Allow lsort to be called reentrantly */
6682 prev_info = sort_info;
6683 sort_info = info;
6685 vector = listObjPtr->internalRep.listValue.ele;
6686 len = listObjPtr->internalRep.listValue.len;
6687 switch (info->type) {
6688 case JIM_LSORT_ASCII:
6689 fn = ListSortString;
6690 break;
6691 case JIM_LSORT_NOCASE:
6692 fn = ListSortStringNoCase;
6693 break;
6694 case JIM_LSORT_INTEGER:
6695 fn = ListSortInteger;
6696 break;
6697 case JIM_LSORT_REAL:
6698 fn = ListSortReal;
6699 break;
6700 case JIM_LSORT_COMMAND:
6701 fn = ListSortCommand;
6702 break;
6703 default:
6704 fn = NULL; /* avoid warning */
6705 JimPanic((1, "ListSort called with invalid sort type"));
6706 return -1; /* Should not be run but keeps static analysers happy */
6709 if (info->indexed) {
6710 /* Need to interpose a "list index" function */
6711 info->subfn = fn;
6712 fn = ListSortIndexHelper;
6715 if ((rc = setjmp(info->jmpbuf)) == 0) {
6716 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6718 if (info->unique && len > 1) {
6719 ListRemoveDuplicates(listObjPtr, fn);
6722 Jim_InvalidateStringRep(listObjPtr);
6724 sort_info = prev_info;
6726 return rc;
6729 /* This is the low-level function to insert elements into a list.
6730 * The higher-level Jim_ListInsertElements() performs shared object
6731 * check and invalidates the string repr. This version is used
6732 * in the internals of the List Object and is not exported.
6734 * NOTE: this function can be called only against objects
6735 * with internal type of List.
6737 * An insertion point (idx) of -1 means end-of-list.
6739 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6741 int currentLen = listPtr->internalRep.listValue.len;
6742 int requiredLen = currentLen + elemc;
6743 int i;
6744 Jim_Obj **point;
6746 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6747 if (requiredLen < 2) {
6748 /* Don't do allocations of under 4 pointers. */
6749 requiredLen = 4;
6751 else {
6752 requiredLen *= 2;
6755 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6756 sizeof(Jim_Obj *) * requiredLen);
6758 listPtr->internalRep.listValue.maxLen = requiredLen;
6760 if (idx < 0) {
6761 idx = currentLen;
6763 point = listPtr->internalRep.listValue.ele + idx;
6764 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6765 for (i = 0; i < elemc; ++i) {
6766 point[i] = elemVec[i];
6767 Jim_IncrRefCount(point[i]);
6769 listPtr->internalRep.listValue.len += elemc;
6772 /* Convenience call to ListInsertElements() to append a single element.
6774 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6776 ListInsertElements(listPtr, -1, 1, &objPtr);
6779 /* Appends every element of appendListPtr into listPtr.
6780 * Both have to be of the list type.
6781 * Convenience call to ListInsertElements()
6783 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6785 ListInsertElements(listPtr, -1,
6786 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6789 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6791 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6792 SetListFromAny(interp, listPtr);
6793 Jim_InvalidateStringRep(listPtr);
6794 ListAppendElement(listPtr, objPtr);
6797 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6799 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6800 SetListFromAny(interp, listPtr);
6801 SetListFromAny(interp, appendListPtr);
6802 Jim_InvalidateStringRep(listPtr);
6803 ListAppendList(listPtr, appendListPtr);
6806 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6808 SetListFromAny(interp, objPtr);
6809 return objPtr->internalRep.listValue.len;
6812 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6813 int objc, Jim_Obj *const *objVec)
6815 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6816 SetListFromAny(interp, listPtr);
6817 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6818 idx = listPtr->internalRep.listValue.len;
6819 else if (idx < 0)
6820 idx = 0;
6821 Jim_InvalidateStringRep(listPtr);
6822 ListInsertElements(listPtr, idx, objc, objVec);
6825 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6827 SetListFromAny(interp, listPtr);
6828 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6829 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6830 return NULL;
6832 if (idx < 0)
6833 idx = listPtr->internalRep.listValue.len + idx;
6834 return listPtr->internalRep.listValue.ele[idx];
6837 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6839 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6840 if (*objPtrPtr == NULL) {
6841 if (flags & JIM_ERRMSG) {
6842 Jim_SetResultString(interp, "list index out of range", -1);
6844 return JIM_ERR;
6846 return JIM_OK;
6849 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6850 Jim_Obj *newObjPtr, int flags)
6852 SetListFromAny(interp, listPtr);
6853 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6854 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6855 if (flags & JIM_ERRMSG) {
6856 Jim_SetResultString(interp, "list index out of range", -1);
6858 return JIM_ERR;
6860 if (idx < 0)
6861 idx = listPtr->internalRep.listValue.len + idx;
6862 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6863 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6864 Jim_IncrRefCount(newObjPtr);
6865 return JIM_OK;
6868 /* Modify the list stored in the variable named 'varNamePtr'
6869 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6870 * with the new element 'newObjptr'. (implements the [lset] command) */
6871 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6872 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6874 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6875 int shared, i, idx;
6877 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6878 if (objPtr == NULL)
6879 return JIM_ERR;
6880 if ((shared = Jim_IsShared(objPtr)))
6881 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6882 for (i = 0; i < indexc - 1; i++) {
6883 listObjPtr = objPtr;
6884 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6885 goto err;
6886 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6887 goto err;
6889 if (Jim_IsShared(objPtr)) {
6890 objPtr = Jim_DuplicateObj(interp, objPtr);
6891 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6893 Jim_InvalidateStringRep(listObjPtr);
6895 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6896 goto err;
6897 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6898 goto err;
6899 Jim_InvalidateStringRep(objPtr);
6900 Jim_InvalidateStringRep(varObjPtr);
6901 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6902 goto err;
6903 Jim_SetResult(interp, varObjPtr);
6904 return JIM_OK;
6905 err:
6906 if (shared) {
6907 Jim_FreeNewObj(interp, varObjPtr);
6909 return JIM_ERR;
6912 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6914 int i;
6915 int listLen = Jim_ListLength(interp, listObjPtr);
6916 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6918 for (i = 0; i < listLen; ) {
6919 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6920 if (++i != listLen) {
6921 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6924 return resObjPtr;
6927 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6929 int i;
6931 /* If all the objects in objv are lists,
6932 * it's possible to return a list as result, that's the
6933 * concatenation of all the lists. */
6934 for (i = 0; i < objc; i++) {
6935 if (!Jim_IsList(objv[i]))
6936 break;
6938 if (i == objc) {
6939 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6941 for (i = 0; i < objc; i++)
6942 ListAppendList(objPtr, objv[i]);
6943 return objPtr;
6945 else {
6946 /* Else... we have to glue strings together */
6947 int len = 0, objLen;
6948 char *bytes, *p;
6950 /* Compute the length */
6951 for (i = 0; i < objc; i++) {
6952 len += Jim_Length(objv[i]);
6954 if (objc)
6955 len += objc - 1;
6956 /* Create the string rep, and a string object holding it. */
6957 p = bytes = Jim_Alloc(len + 1);
6958 for (i = 0; i < objc; i++) {
6959 const char *s = Jim_GetString(objv[i], &objLen);
6961 /* Remove leading space */
6962 while (objLen && isspace(UCHAR(*s))) {
6963 s++;
6964 objLen--;
6965 len--;
6967 /* And trailing space */
6968 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6969 /* Handle trailing backslash-space case */
6970 if (objLen > 1 && s[objLen - 2] == '\\') {
6971 break;
6973 objLen--;
6974 len--;
6976 memcpy(p, s, objLen);
6977 p += objLen;
6978 if (i + 1 != objc) {
6979 if (objLen)
6980 *p++ = ' ';
6981 else {
6982 /* Drop the space calculated for this
6983 * element that is instead null. */
6984 len--;
6988 *p = '\0';
6989 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6993 /* Returns a list composed of the elements in the specified range.
6994 * first and start are directly accepted as Jim_Objects and
6995 * processed for the end?-index? case. */
6996 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6997 Jim_Obj *lastObjPtr)
6999 int first, last;
7000 int len, rangeLen;
7002 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7003 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7004 return NULL;
7005 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7006 first = JimRelToAbsIndex(len, first);
7007 last = JimRelToAbsIndex(len, last);
7008 JimRelToAbsRange(len, &first, &last, &rangeLen);
7009 if (first == 0 && last == len) {
7010 return listObjPtr;
7012 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7015 /* -----------------------------------------------------------------------------
7016 * Dict object
7017 * ---------------------------------------------------------------------------*/
7018 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7019 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7020 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7021 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7023 /* Dict HashTable Type.
7025 * Keys and Values are Jim objects. */
7027 static unsigned int JimObjectHTHashFunction(const void *key)
7029 int len;
7030 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7031 return Jim_GenHashFunction((const unsigned char *)str, len);
7034 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7036 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7039 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7041 Jim_IncrRefCount((Jim_Obj *)val);
7042 return (void *)val;
7045 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7047 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7050 static const Jim_HashTableType JimDictHashTableType = {
7051 JimObjectHTHashFunction, /* hash function */
7052 JimObjectHTKeyValDup, /* key dup */
7053 JimObjectHTKeyValDup, /* val dup */
7054 JimObjectHTKeyCompare, /* key compare */
7055 JimObjectHTKeyValDestructor, /* key destructor */
7056 JimObjectHTKeyValDestructor /* val destructor */
7059 /* Note that while the elements of the dict may contain references,
7060 * the list object itself can't. This basically means that the
7061 * dict object string representation as a whole can't contain references
7062 * that are not presents in the single elements. */
7063 static const Jim_ObjType dictObjType = {
7064 "dict",
7065 FreeDictInternalRep,
7066 DupDictInternalRep,
7067 UpdateStringOfDict,
7068 JIM_TYPE_NONE,
7071 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7073 JIM_NOTUSED(interp);
7075 Jim_FreeHashTable(objPtr->internalRep.ptr);
7076 Jim_Free(objPtr->internalRep.ptr);
7079 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7081 Jim_HashTable *ht, *dupHt;
7082 Jim_HashTableIterator htiter;
7083 Jim_HashEntry *he;
7085 /* Create a new hash table */
7086 ht = srcPtr->internalRep.ptr;
7087 dupHt = Jim_Alloc(sizeof(*dupHt));
7088 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7089 if (ht->size != 0)
7090 Jim_ExpandHashTable(dupHt, ht->size);
7091 /* Copy every element from the source to the dup hash table */
7092 JimInitHashTableIterator(ht, &htiter);
7093 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7094 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7097 dupPtr->internalRep.ptr = dupHt;
7098 dupPtr->typePtr = &dictObjType;
7101 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7103 Jim_HashTable *ht;
7104 Jim_HashTableIterator htiter;
7105 Jim_HashEntry *he;
7106 Jim_Obj **objv;
7107 int i;
7109 ht = dictPtr->internalRep.ptr;
7111 /* Turn the hash table into a flat vector of Jim_Objects. */
7112 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7113 JimInitHashTableIterator(ht, &htiter);
7114 i = 0;
7115 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7116 objv[i++] = Jim_GetHashEntryKey(he);
7117 objv[i++] = Jim_GetHashEntryVal(he);
7119 *len = i;
7120 return objv;
7123 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7125 /* Turn the hash table into a flat vector of Jim_Objects. */
7126 int len;
7127 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7129 /* And now generate the string rep as a list */
7130 JimMakeListStringRep(objPtr, objv, len);
7132 Jim_Free(objv);
7135 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7137 int listlen;
7139 if (objPtr->typePtr == &dictObjType) {
7140 return JIM_OK;
7143 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7144 /* A shared list, so get the string representation now to avoid
7145 * changing the order in case of fast conversion to dict.
7147 Jim_String(objPtr);
7150 /* For simplicity, convert a non-list object to a list and then to a dict */
7151 listlen = Jim_ListLength(interp, objPtr);
7152 if (listlen % 2) {
7153 Jim_SetResultString(interp, "missing value to go with key", -1);
7154 return JIM_ERR;
7156 else {
7157 /* Converting from a list to a dict can't fail */
7158 Jim_HashTable *ht;
7159 int i;
7161 ht = Jim_Alloc(sizeof(*ht));
7162 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7164 for (i = 0; i < listlen; i += 2) {
7165 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7166 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7168 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7171 Jim_FreeIntRep(interp, objPtr);
7172 objPtr->typePtr = &dictObjType;
7173 objPtr->internalRep.ptr = ht;
7175 return JIM_OK;
7179 /* Dict object API */
7181 /* Add an element to a dict. objPtr must be of the "dict" type.
7182 * The higher-level exported function is Jim_DictAddElement().
7183 * If an element with the specified key already exists, the value
7184 * associated is replaced with the new one.
7186 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7187 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7188 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7190 Jim_HashTable *ht = objPtr->internalRep.ptr;
7192 if (valueObjPtr == NULL) { /* unset */
7193 return Jim_DeleteHashEntry(ht, keyObjPtr);
7195 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7196 return JIM_OK;
7199 /* Add an element, higher-level interface for DictAddElement().
7200 * If valueObjPtr == NULL, the key is removed if it exists. */
7201 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7202 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7204 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7205 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7206 return JIM_ERR;
7208 Jim_InvalidateStringRep(objPtr);
7209 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7212 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7214 Jim_Obj *objPtr;
7215 int i;
7217 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7219 objPtr = Jim_NewObj(interp);
7220 objPtr->typePtr = &dictObjType;
7221 objPtr->bytes = NULL;
7222 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7223 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7224 for (i = 0; i < len; i += 2)
7225 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7226 return objPtr;
7229 /* Return the value associated to the specified dict key
7230 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7232 * Sets *objPtrPtr to non-NULL only upon success.
7234 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7235 Jim_Obj **objPtrPtr, int flags)
7237 Jim_HashEntry *he;
7238 Jim_HashTable *ht;
7240 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7241 return -1;
7243 ht = dictPtr->internalRep.ptr;
7244 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7245 if (flags & JIM_ERRMSG) {
7246 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7248 return JIM_ERR;
7250 *objPtrPtr = he->u.val;
7251 return JIM_OK;
7254 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7255 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7257 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7258 return JIM_ERR;
7260 *objPtrPtr = JimDictPairs(dictPtr, len);
7262 return JIM_OK;
7266 /* Return the value associated to the specified dict keys */
7267 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7268 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7270 int i;
7272 if (keyc == 0) {
7273 *objPtrPtr = dictPtr;
7274 return JIM_OK;
7277 for (i = 0; i < keyc; i++) {
7278 Jim_Obj *objPtr;
7280 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7281 if (rc != JIM_OK) {
7282 return rc;
7284 dictPtr = objPtr;
7286 *objPtrPtr = dictPtr;
7287 return JIM_OK;
7290 /* Modify the dict stored into the variable named 'varNamePtr'
7291 * setting the element specified by the 'keyc' keys objects in 'keyv',
7292 * with the new value of the element 'newObjPtr'.
7294 * If newObjPtr == NULL the operation is to remove the given key
7295 * from the dictionary.
7297 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7298 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7300 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7301 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7303 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7304 int shared, i;
7306 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7307 if (objPtr == NULL) {
7308 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7309 /* Cannot remove a key from non existing var */
7310 return JIM_ERR;
7312 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7313 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7314 Jim_FreeNewObj(interp, varObjPtr);
7315 return JIM_ERR;
7318 if ((shared = Jim_IsShared(objPtr)))
7319 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7320 for (i = 0; i < keyc; i++) {
7321 dictObjPtr = objPtr;
7323 /* Check if it's a valid dictionary */
7324 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7325 goto err;
7328 if (i == keyc - 1) {
7329 /* Last key: Note that error on unset with missing last key is OK */
7330 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7331 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7332 goto err;
7335 break;
7338 /* Check if the given key exists. */
7339 Jim_InvalidateStringRep(dictObjPtr);
7340 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7341 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7342 /* This key exists at the current level.
7343 * Make sure it's not shared!. */
7344 if (Jim_IsShared(objPtr)) {
7345 objPtr = Jim_DuplicateObj(interp, objPtr);
7346 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7349 else {
7350 /* Key not found. If it's an [unset] operation
7351 * this is an error. Only the last key may not
7352 * exist. */
7353 if (newObjPtr == NULL) {
7354 goto err;
7356 /* Otherwise set an empty dictionary
7357 * as key's value. */
7358 objPtr = Jim_NewDictObj(interp, NULL, 0);
7359 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7362 /* XXX: Is this necessary? */
7363 Jim_InvalidateStringRep(objPtr);
7364 Jim_InvalidateStringRep(varObjPtr);
7365 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7366 goto err;
7368 Jim_SetResult(interp, varObjPtr);
7369 return JIM_OK;
7370 err:
7371 if (shared) {
7372 Jim_FreeNewObj(interp, varObjPtr);
7374 return JIM_ERR;
7377 /* -----------------------------------------------------------------------------
7378 * Index object
7379 * ---------------------------------------------------------------------------*/
7380 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7381 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7383 static const Jim_ObjType indexObjType = {
7384 "index",
7385 NULL,
7386 NULL,
7387 UpdateStringOfIndex,
7388 JIM_TYPE_NONE,
7391 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7393 if (objPtr->internalRep.intValue == -1) {
7394 JimSetStringBytes(objPtr, "end");
7396 else {
7397 char buf[JIM_INTEGER_SPACE + 1];
7398 if (objPtr->internalRep.intValue >= 0) {
7399 sprintf(buf, "%d", objPtr->internalRep.intValue);
7401 else {
7402 /* Must be <= -2 */
7403 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7405 JimSetStringBytes(objPtr, buf);
7409 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7411 int idx, end = 0;
7412 const char *str;
7413 char *endptr;
7415 /* Get the string representation */
7416 str = Jim_String(objPtr);
7418 /* Try to convert into an index */
7419 if (strncmp(str, "end", 3) == 0) {
7420 end = 1;
7421 str += 3;
7422 idx = 0;
7424 else {
7425 idx = jim_strtol(str, &endptr);
7427 if (endptr == str) {
7428 goto badindex;
7430 str = endptr;
7433 /* Now str may include or +<num> or -<num> */
7434 if (*str == '+' || *str == '-') {
7435 int sign = (*str == '+' ? 1 : -1);
7437 idx += sign * jim_strtol(++str, &endptr);
7438 if (str == endptr || *endptr) {
7439 goto badindex;
7441 str = endptr;
7443 /* The only thing left should be spaces */
7444 while (isspace(UCHAR(*str))) {
7445 str++;
7447 if (*str) {
7448 goto badindex;
7450 if (end) {
7451 if (idx > 0) {
7452 idx = INT_MAX;
7454 else {
7455 /* end-1 is repesented as -2 */
7456 idx--;
7459 else if (idx < 0) {
7460 idx = -INT_MAX;
7463 /* Free the old internal repr and set the new one. */
7464 Jim_FreeIntRep(interp, objPtr);
7465 objPtr->typePtr = &indexObjType;
7466 objPtr->internalRep.intValue = idx;
7467 return JIM_OK;
7469 badindex:
7470 Jim_SetResultFormatted(interp,
7471 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7472 return JIM_ERR;
7475 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7477 /* Avoid shimmering if the object is an integer. */
7478 if (objPtr->typePtr == &intObjType) {
7479 jim_wide val = JimWideValue(objPtr);
7481 if (val < 0)
7482 *indexPtr = -INT_MAX;
7483 else if (val > INT_MAX)
7484 *indexPtr = INT_MAX;
7485 else
7486 *indexPtr = (int)val;
7487 return JIM_OK;
7489 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7490 return JIM_ERR;
7491 *indexPtr = objPtr->internalRep.intValue;
7492 return JIM_OK;
7495 /* -----------------------------------------------------------------------------
7496 * Return Code Object.
7497 * ---------------------------------------------------------------------------*/
7499 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7500 static const char * const jimReturnCodes[] = {
7501 "ok",
7502 "error",
7503 "return",
7504 "break",
7505 "continue",
7506 "signal",
7507 "exit",
7508 "eval",
7509 NULL
7512 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7514 static const Jim_ObjType returnCodeObjType = {
7515 "return-code",
7516 NULL,
7517 NULL,
7518 NULL,
7519 JIM_TYPE_NONE,
7522 /* Converts a (standard) return code to a string. Returns "?" for
7523 * non-standard return codes.
7525 const char *Jim_ReturnCode(int code)
7527 if (code < 0 || code >= (int)jimReturnCodesSize) {
7528 return "?";
7530 else {
7531 return jimReturnCodes[code];
7535 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7537 int returnCode;
7538 jim_wide wideValue;
7540 /* Try to convert into an integer */
7541 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7542 returnCode = (int)wideValue;
7543 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7544 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7545 return JIM_ERR;
7547 /* Free the old internal repr and set the new one. */
7548 Jim_FreeIntRep(interp, objPtr);
7549 objPtr->typePtr = &returnCodeObjType;
7550 objPtr->internalRep.intValue = returnCode;
7551 return JIM_OK;
7554 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7556 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7557 return JIM_ERR;
7558 *intPtr = objPtr->internalRep.intValue;
7559 return JIM_OK;
7562 /* -----------------------------------------------------------------------------
7563 * Expression Parsing
7564 * ---------------------------------------------------------------------------*/
7565 static int JimParseExprOperator(struct JimParserCtx *pc);
7566 static int JimParseExprNumber(struct JimParserCtx *pc);
7567 static int JimParseExprIrrational(struct JimParserCtx *pc);
7568 static int JimParseExprBoolean(struct JimParserCtx *pc);
7570 /* Exrp's Stack machine operators opcodes. */
7572 /* Binary operators (numbers) */
7573 enum
7575 /* Continues on from the JIM_TT_ space */
7576 /* Operations */
7577 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7578 JIM_EXPROP_DIV,
7579 JIM_EXPROP_MOD,
7580 JIM_EXPROP_SUB,
7581 JIM_EXPROP_ADD,
7582 JIM_EXPROP_LSHIFT,
7583 JIM_EXPROP_RSHIFT,
7584 JIM_EXPROP_ROTL,
7585 JIM_EXPROP_ROTR,
7586 JIM_EXPROP_LT,
7587 JIM_EXPROP_GT,
7588 JIM_EXPROP_LTE,
7589 JIM_EXPROP_GTE,
7590 JIM_EXPROP_NUMEQ,
7591 JIM_EXPROP_NUMNE,
7592 JIM_EXPROP_BITAND, /* 35 */
7593 JIM_EXPROP_BITXOR,
7594 JIM_EXPROP_BITOR,
7596 /* Note must keep these together */
7597 JIM_EXPROP_LOGICAND, /* 38 */
7598 JIM_EXPROP_LOGICAND_LEFT,
7599 JIM_EXPROP_LOGICAND_RIGHT,
7601 /* and these */
7602 JIM_EXPROP_LOGICOR, /* 41 */
7603 JIM_EXPROP_LOGICOR_LEFT,
7604 JIM_EXPROP_LOGICOR_RIGHT,
7606 /* and these */
7607 /* Ternary operators */
7608 JIM_EXPROP_TERNARY, /* 44 */
7609 JIM_EXPROP_TERNARY_LEFT,
7610 JIM_EXPROP_TERNARY_RIGHT,
7612 /* and these */
7613 JIM_EXPROP_COLON, /* 47 */
7614 JIM_EXPROP_COLON_LEFT,
7615 JIM_EXPROP_COLON_RIGHT,
7617 JIM_EXPROP_POW, /* 50 */
7619 /* Binary operators (strings) */
7620 JIM_EXPROP_STREQ, /* 51 */
7621 JIM_EXPROP_STRNE,
7622 JIM_EXPROP_STRIN,
7623 JIM_EXPROP_STRNI,
7625 /* Unary operators (numbers) */
7626 JIM_EXPROP_NOT, /* 55 */
7627 JIM_EXPROP_BITNOT,
7628 JIM_EXPROP_UNARYMINUS,
7629 JIM_EXPROP_UNARYPLUS,
7631 /* Functions */
7632 JIM_EXPROP_FUNC_FIRST, /* 59 */
7633 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7634 JIM_EXPROP_FUNC_WIDE,
7635 JIM_EXPROP_FUNC_ABS,
7636 JIM_EXPROP_FUNC_DOUBLE,
7637 JIM_EXPROP_FUNC_ROUND,
7638 JIM_EXPROP_FUNC_RAND,
7639 JIM_EXPROP_FUNC_SRAND,
7641 /* math functions from libm */
7642 JIM_EXPROP_FUNC_SIN, /* 65 */
7643 JIM_EXPROP_FUNC_COS,
7644 JIM_EXPROP_FUNC_TAN,
7645 JIM_EXPROP_FUNC_ASIN,
7646 JIM_EXPROP_FUNC_ACOS,
7647 JIM_EXPROP_FUNC_ATAN,
7648 JIM_EXPROP_FUNC_ATAN2,
7649 JIM_EXPROP_FUNC_SINH,
7650 JIM_EXPROP_FUNC_COSH,
7651 JIM_EXPROP_FUNC_TANH,
7652 JIM_EXPROP_FUNC_CEIL,
7653 JIM_EXPROP_FUNC_FLOOR,
7654 JIM_EXPROP_FUNC_EXP,
7655 JIM_EXPROP_FUNC_LOG,
7656 JIM_EXPROP_FUNC_LOG10,
7657 JIM_EXPROP_FUNC_SQRT,
7658 JIM_EXPROP_FUNC_POW,
7659 JIM_EXPROP_FUNC_HYPOT,
7660 JIM_EXPROP_FUNC_FMOD,
7663 struct JimExprState
7665 Jim_Obj **stack;
7666 int stacklen;
7667 int opcode;
7668 int skip;
7671 /* Operators table */
7672 typedef struct Jim_ExprOperator
7674 const char *name;
7675 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7676 unsigned char precedence;
7677 unsigned char arity;
7678 unsigned char lazy;
7679 unsigned char namelen;
7680 } Jim_ExprOperator;
7682 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7684 Jim_IncrRefCount(obj);
7685 e->stack[e->stacklen++] = obj;
7688 static Jim_Obj *ExprPop(struct JimExprState *e)
7690 return e->stack[--e->stacklen];
7693 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7695 int intresult = 1;
7696 int rc = JIM_OK;
7697 Jim_Obj *A = ExprPop(e);
7698 double dA, dC = 0;
7699 jim_wide wA, wC = 0;
7701 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7702 switch (e->opcode) {
7703 case JIM_EXPROP_FUNC_INT:
7704 case JIM_EXPROP_FUNC_WIDE:
7705 case JIM_EXPROP_FUNC_ROUND:
7706 case JIM_EXPROP_UNARYPLUS:
7707 wC = wA;
7708 break;
7709 case JIM_EXPROP_FUNC_DOUBLE:
7710 dC = wA;
7711 intresult = 0;
7712 break;
7713 case JIM_EXPROP_FUNC_ABS:
7714 wC = wA >= 0 ? wA : -wA;
7715 break;
7716 case JIM_EXPROP_UNARYMINUS:
7717 wC = -wA;
7718 break;
7719 case JIM_EXPROP_NOT:
7720 wC = !wA;
7721 break;
7722 default:
7723 abort();
7726 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7727 switch (e->opcode) {
7728 case JIM_EXPROP_FUNC_INT:
7729 case JIM_EXPROP_FUNC_WIDE:
7730 wC = dA;
7731 break;
7732 case JIM_EXPROP_FUNC_ROUND:
7733 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7734 break;
7735 case JIM_EXPROP_FUNC_DOUBLE:
7736 case JIM_EXPROP_UNARYPLUS:
7737 dC = dA;
7738 intresult = 0;
7739 break;
7740 case JIM_EXPROP_FUNC_ABS:
7741 #ifdef JIM_MATH_FUNCTIONS
7742 dC = fabs(dA);
7743 #else
7744 dC = dA >= 0 ? dA : -dA;
7745 #endif
7746 intresult = 0;
7747 break;
7748 case JIM_EXPROP_UNARYMINUS:
7749 dC = -dA;
7750 intresult = 0;
7751 break;
7752 case JIM_EXPROP_NOT:
7753 wC = !dA;
7754 break;
7755 default:
7756 abort();
7760 if (rc == JIM_OK) {
7761 if (intresult) {
7762 ExprPush(e, Jim_NewIntObj(interp, wC));
7764 else {
7765 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7769 Jim_DecrRefCount(interp, A);
7771 return rc;
7774 static double JimRandDouble(Jim_Interp *interp)
7776 unsigned long x;
7777 JimRandomBytes(interp, &x, sizeof(x));
7779 return (double)x / (unsigned long)~0;
7782 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7784 Jim_Obj *A = ExprPop(e);
7785 jim_wide wA;
7787 int rc = Jim_GetWide(interp, A, &wA);
7788 if (rc == JIM_OK) {
7789 switch (e->opcode) {
7790 case JIM_EXPROP_BITNOT:
7791 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7792 break;
7793 case JIM_EXPROP_FUNC_SRAND:
7794 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7795 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7796 break;
7797 default:
7798 abort();
7802 Jim_DecrRefCount(interp, A);
7804 return rc;
7807 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7809 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7811 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7813 return JIM_OK;
7816 #ifdef JIM_MATH_FUNCTIONS
7817 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7819 int rc;
7820 Jim_Obj *A = ExprPop(e);
7821 double dA, dC;
7823 rc = Jim_GetDouble(interp, A, &dA);
7824 if (rc == JIM_OK) {
7825 switch (e->opcode) {
7826 case JIM_EXPROP_FUNC_SIN:
7827 dC = sin(dA);
7828 break;
7829 case JIM_EXPROP_FUNC_COS:
7830 dC = cos(dA);
7831 break;
7832 case JIM_EXPROP_FUNC_TAN:
7833 dC = tan(dA);
7834 break;
7835 case JIM_EXPROP_FUNC_ASIN:
7836 dC = asin(dA);
7837 break;
7838 case JIM_EXPROP_FUNC_ACOS:
7839 dC = acos(dA);
7840 break;
7841 case JIM_EXPROP_FUNC_ATAN:
7842 dC = atan(dA);
7843 break;
7844 case JIM_EXPROP_FUNC_SINH:
7845 dC = sinh(dA);
7846 break;
7847 case JIM_EXPROP_FUNC_COSH:
7848 dC = cosh(dA);
7849 break;
7850 case JIM_EXPROP_FUNC_TANH:
7851 dC = tanh(dA);
7852 break;
7853 case JIM_EXPROP_FUNC_CEIL:
7854 dC = ceil(dA);
7855 break;
7856 case JIM_EXPROP_FUNC_FLOOR:
7857 dC = floor(dA);
7858 break;
7859 case JIM_EXPROP_FUNC_EXP:
7860 dC = exp(dA);
7861 break;
7862 case JIM_EXPROP_FUNC_LOG:
7863 dC = log(dA);
7864 break;
7865 case JIM_EXPROP_FUNC_LOG10:
7866 dC = log10(dA);
7867 break;
7868 case JIM_EXPROP_FUNC_SQRT:
7869 dC = sqrt(dA);
7870 break;
7871 default:
7872 abort();
7874 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7877 Jim_DecrRefCount(interp, A);
7879 return rc;
7881 #endif
7883 /* A binary operation on two ints */
7884 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7886 Jim_Obj *B = ExprPop(e);
7887 Jim_Obj *A = ExprPop(e);
7888 jim_wide wA, wB;
7889 int rc = JIM_ERR;
7891 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7892 jim_wide wC;
7894 rc = JIM_OK;
7896 switch (e->opcode) {
7897 case JIM_EXPROP_LSHIFT:
7898 wC = wA << wB;
7899 break;
7900 case JIM_EXPROP_RSHIFT:
7901 wC = wA >> wB;
7902 break;
7903 case JIM_EXPROP_BITAND:
7904 wC = wA & wB;
7905 break;
7906 case JIM_EXPROP_BITXOR:
7907 wC = wA ^ wB;
7908 break;
7909 case JIM_EXPROP_BITOR:
7910 wC = wA | wB;
7911 break;
7912 case JIM_EXPROP_MOD:
7913 if (wB == 0) {
7914 wC = 0;
7915 Jim_SetResultString(interp, "Division by zero", -1);
7916 rc = JIM_ERR;
7918 else {
7920 * From Tcl 8.x
7922 * This code is tricky: C doesn't guarantee much
7923 * about the quotient or remainder, but Tcl does.
7924 * The remainder always has the same sign as the
7925 * divisor and a smaller absolute value.
7927 int negative = 0;
7929 if (wB < 0) {
7930 wB = -wB;
7931 wA = -wA;
7932 negative = 1;
7934 wC = wA % wB;
7935 if (wC < 0) {
7936 wC += wB;
7938 if (negative) {
7939 wC = -wC;
7942 break;
7943 case JIM_EXPROP_ROTL:
7944 case JIM_EXPROP_ROTR:{
7945 /* uint32_t would be better. But not everyone has inttypes.h? */
7946 unsigned long uA = (unsigned long)wA;
7947 unsigned long uB = (unsigned long)wB;
7948 const unsigned int S = sizeof(unsigned long) * 8;
7950 /* Shift left by the word size or more is undefined. */
7951 uB %= S;
7953 if (e->opcode == JIM_EXPROP_ROTR) {
7954 uB = S - uB;
7956 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7957 break;
7959 default:
7960 abort();
7962 ExprPush(e, Jim_NewIntObj(interp, wC));
7966 Jim_DecrRefCount(interp, A);
7967 Jim_DecrRefCount(interp, B);
7969 return rc;
7973 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7974 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7976 int rc = JIM_OK;
7977 double dA, dB, dC = 0;
7978 jim_wide wA, wB, wC = 0;
7980 Jim_Obj *B = ExprPop(e);
7981 Jim_Obj *A = ExprPop(e);
7983 if ((A->typePtr != &doubleObjType || A->bytes) &&
7984 (B->typePtr != &doubleObjType || B->bytes) &&
7985 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7987 /* Both are ints */
7989 switch (e->opcode) {
7990 case JIM_EXPROP_POW:
7991 case JIM_EXPROP_FUNC_POW:
7992 if (wA == 0 && wB < 0) {
7993 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
7994 rc = JIM_ERR;
7995 goto done;
7997 wC = JimPowWide(wA, wB);
7998 goto intresult;
7999 case JIM_EXPROP_ADD:
8000 wC = wA + wB;
8001 goto intresult;
8002 case JIM_EXPROP_SUB:
8003 wC = wA - wB;
8004 goto intresult;
8005 case JIM_EXPROP_MUL:
8006 wC = wA * wB;
8007 goto intresult;
8008 case JIM_EXPROP_DIV:
8009 if (wB == 0) {
8010 Jim_SetResultString(interp, "Division by zero", -1);
8011 rc = JIM_ERR;
8012 goto done;
8014 else {
8016 * From Tcl 8.x
8018 * This code is tricky: C doesn't guarantee much
8019 * about the quotient or remainder, but Tcl does.
8020 * The remainder always has the same sign as the
8021 * divisor and a smaller absolute value.
8023 if (wB < 0) {
8024 wB = -wB;
8025 wA = -wA;
8027 wC = wA / wB;
8028 if (wA % wB < 0) {
8029 wC--;
8031 goto intresult;
8033 case JIM_EXPROP_LT:
8034 wC = wA < wB;
8035 goto intresult;
8036 case JIM_EXPROP_GT:
8037 wC = wA > wB;
8038 goto intresult;
8039 case JIM_EXPROP_LTE:
8040 wC = wA <= wB;
8041 goto intresult;
8042 case JIM_EXPROP_GTE:
8043 wC = wA >= wB;
8044 goto intresult;
8045 case JIM_EXPROP_NUMEQ:
8046 wC = wA == wB;
8047 goto intresult;
8048 case JIM_EXPROP_NUMNE:
8049 wC = wA != wB;
8050 goto intresult;
8053 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8054 switch (e->opcode) {
8055 #ifndef JIM_MATH_FUNCTIONS
8056 case JIM_EXPROP_POW:
8057 case JIM_EXPROP_FUNC_POW:
8058 case JIM_EXPROP_FUNC_ATAN2:
8059 case JIM_EXPROP_FUNC_HYPOT:
8060 case JIM_EXPROP_FUNC_FMOD:
8061 Jim_SetResultString(interp, "unsupported", -1);
8062 rc = JIM_ERR;
8063 goto done;
8064 #else
8065 case JIM_EXPROP_POW:
8066 case JIM_EXPROP_FUNC_POW:
8067 dC = pow(dA, dB);
8068 goto doubleresult;
8069 case JIM_EXPROP_FUNC_ATAN2:
8070 dC = atan2(dA, dB);
8071 goto doubleresult;
8072 case JIM_EXPROP_FUNC_HYPOT:
8073 dC = hypot(dA, dB);
8074 goto doubleresult;
8075 case JIM_EXPROP_FUNC_FMOD:
8076 dC = fmod(dA, dB);
8077 goto doubleresult;
8078 #endif
8079 case JIM_EXPROP_ADD:
8080 dC = dA + dB;
8081 goto doubleresult;
8082 case JIM_EXPROP_SUB:
8083 dC = dA - dB;
8084 goto doubleresult;
8085 case JIM_EXPROP_MUL:
8086 dC = dA * dB;
8087 goto doubleresult;
8088 case JIM_EXPROP_DIV:
8089 if (dB == 0) {
8090 #ifdef INFINITY
8091 dC = dA < 0 ? -INFINITY : INFINITY;
8092 #else
8093 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8094 #endif
8096 else {
8097 dC = dA / dB;
8099 goto doubleresult;
8100 case JIM_EXPROP_LT:
8101 wC = dA < dB;
8102 goto intresult;
8103 case JIM_EXPROP_GT:
8104 wC = dA > dB;
8105 goto intresult;
8106 case JIM_EXPROP_LTE:
8107 wC = dA <= dB;
8108 goto intresult;
8109 case JIM_EXPROP_GTE:
8110 wC = dA >= dB;
8111 goto intresult;
8112 case JIM_EXPROP_NUMEQ:
8113 wC = dA == dB;
8114 goto intresult;
8115 case JIM_EXPROP_NUMNE:
8116 wC = dA != dB;
8117 goto intresult;
8120 else {
8121 /* Handle the string case */
8123 /* XXX: Could optimise the eq/ne case by checking lengths */
8124 int i = Jim_StringCompareObj(interp, A, B, 0);
8126 switch (e->opcode) {
8127 case JIM_EXPROP_LT:
8128 wC = i < 0;
8129 goto intresult;
8130 case JIM_EXPROP_GT:
8131 wC = i > 0;
8132 goto intresult;
8133 case JIM_EXPROP_LTE:
8134 wC = i <= 0;
8135 goto intresult;
8136 case JIM_EXPROP_GTE:
8137 wC = i >= 0;
8138 goto intresult;
8139 case JIM_EXPROP_NUMEQ:
8140 wC = i == 0;
8141 goto intresult;
8142 case JIM_EXPROP_NUMNE:
8143 wC = i != 0;
8144 goto intresult;
8147 /* If we get here, it is an error */
8148 rc = JIM_ERR;
8149 done:
8150 Jim_DecrRefCount(interp, A);
8151 Jim_DecrRefCount(interp, B);
8152 return rc;
8153 intresult:
8154 ExprPush(e, Jim_NewIntObj(interp, wC));
8155 goto done;
8156 doubleresult:
8157 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8158 goto done;
8161 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8163 int listlen;
8164 int i;
8166 listlen = Jim_ListLength(interp, listObjPtr);
8167 for (i = 0; i < listlen; i++) {
8168 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8169 return 1;
8172 return 0;
8175 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8177 Jim_Obj *B = ExprPop(e);
8178 Jim_Obj *A = ExprPop(e);
8180 jim_wide wC;
8182 switch (e->opcode) {
8183 case JIM_EXPROP_STREQ:
8184 case JIM_EXPROP_STRNE:
8185 wC = Jim_StringEqObj(A, B);
8186 if (e->opcode == JIM_EXPROP_STRNE) {
8187 wC = !wC;
8189 break;
8190 case JIM_EXPROP_STRIN:
8191 wC = JimSearchList(interp, B, A);
8192 break;
8193 case JIM_EXPROP_STRNI:
8194 wC = !JimSearchList(interp, B, A);
8195 break;
8196 default:
8197 abort();
8199 ExprPush(e, Jim_NewIntObj(interp, wC));
8201 Jim_DecrRefCount(interp, A);
8202 Jim_DecrRefCount(interp, B);
8204 return JIM_OK;
8207 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8209 long l;
8210 double d;
8211 int b;
8213 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8214 return l != 0;
8216 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8217 return d != 0;
8219 if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8220 return b != 0;
8222 return -1;
8225 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8227 Jim_Obj *skip = ExprPop(e);
8228 Jim_Obj *A = ExprPop(e);
8229 int rc = JIM_OK;
8231 switch (ExprBool(interp, A)) {
8232 case 0:
8233 /* false, so skip RHS opcodes with a 0 result */
8234 e->skip = JimWideValue(skip);
8235 ExprPush(e, Jim_NewIntObj(interp, 0));
8236 break;
8238 case 1:
8239 /* true so continue */
8240 break;
8242 case -1:
8243 /* Invalid */
8244 rc = JIM_ERR;
8246 Jim_DecrRefCount(interp, A);
8247 Jim_DecrRefCount(interp, skip);
8249 return rc;
8252 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8254 Jim_Obj *skip = ExprPop(e);
8255 Jim_Obj *A = ExprPop(e);
8256 int rc = JIM_OK;
8258 switch (ExprBool(interp, A)) {
8259 case 0:
8260 /* false, so do nothing */
8261 break;
8263 case 1:
8264 /* true so skip RHS opcodes with a 1 result */
8265 e->skip = JimWideValue(skip);
8266 ExprPush(e, Jim_NewIntObj(interp, 1));
8267 break;
8269 case -1:
8270 /* Invalid */
8271 rc = JIM_ERR;
8272 break;
8274 Jim_DecrRefCount(interp, A);
8275 Jim_DecrRefCount(interp, skip);
8277 return rc;
8280 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8282 Jim_Obj *A = ExprPop(e);
8283 int rc = JIM_OK;
8285 switch (ExprBool(interp, A)) {
8286 case 0:
8287 ExprPush(e, Jim_NewIntObj(interp, 0));
8288 break;
8290 case 1:
8291 ExprPush(e, Jim_NewIntObj(interp, 1));
8292 break;
8294 case -1:
8295 /* Invalid */
8296 rc = JIM_ERR;
8297 break;
8299 Jim_DecrRefCount(interp, A);
8301 return rc;
8304 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8306 Jim_Obj *skip = ExprPop(e);
8307 Jim_Obj *A = ExprPop(e);
8308 int rc = JIM_OK;
8310 /* Repush A */
8311 ExprPush(e, A);
8313 switch (ExprBool(interp, A)) {
8314 case 0:
8315 /* false, skip RHS opcodes */
8316 e->skip = JimWideValue(skip);
8317 /* Push a dummy value */
8318 ExprPush(e, Jim_NewIntObj(interp, 0));
8319 break;
8321 case 1:
8322 /* true so do nothing */
8323 break;
8325 case -1:
8326 /* Invalid */
8327 rc = JIM_ERR;
8328 break;
8330 Jim_DecrRefCount(interp, A);
8331 Jim_DecrRefCount(interp, skip);
8333 return rc;
8336 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8338 Jim_Obj *skip = ExprPop(e);
8339 Jim_Obj *B = ExprPop(e);
8340 Jim_Obj *A = ExprPop(e);
8342 /* No need to check for A as non-boolean */
8343 if (ExprBool(interp, A)) {
8344 /* true, so skip RHS opcodes */
8345 e->skip = JimWideValue(skip);
8346 /* Repush B as the answer */
8347 ExprPush(e, B);
8350 Jim_DecrRefCount(interp, skip);
8351 Jim_DecrRefCount(interp, A);
8352 Jim_DecrRefCount(interp, B);
8353 return JIM_OK;
8356 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8358 return JIM_OK;
8361 enum
8363 LAZY_NONE,
8364 LAZY_OP,
8365 LAZY_LEFT,
8366 LAZY_RIGHT,
8367 RIGHT_ASSOC, /* reuse this field for right associativity too */
8370 /* name - precedence - arity - opcode
8372 * This array *must* be kept in sync with the JIM_EXPROP enum.
8374 * The following macros pre-compute the string length at compile time.
8376 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8377 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, LAZY_NONE)
8379 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8380 OPRINIT("*", 110, 2, JimExprOpBin),
8381 OPRINIT("/", 110, 2, JimExprOpBin),
8382 OPRINIT("%", 110, 2, JimExprOpIntBin),
8384 OPRINIT("-", 100, 2, JimExprOpBin),
8385 OPRINIT("+", 100, 2, JimExprOpBin),
8387 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8388 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8390 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8391 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8393 OPRINIT("<", 80, 2, JimExprOpBin),
8394 OPRINIT(">", 80, 2, JimExprOpBin),
8395 OPRINIT("<=", 80, 2, JimExprOpBin),
8396 OPRINIT(">=", 80, 2, JimExprOpBin),
8398 OPRINIT("==", 70, 2, JimExprOpBin),
8399 OPRINIT("!=", 70, 2, JimExprOpBin),
8401 OPRINIT("&", 50, 2, JimExprOpIntBin),
8402 OPRINIT("^", 49, 2, JimExprOpIntBin),
8403 OPRINIT("|", 48, 2, JimExprOpIntBin),
8405 OPRINIT_ATTR("&&", 10, 2, NULL, LAZY_OP),
8406 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8407 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8409 OPRINIT_ATTR("||", 9, 2, NULL, LAZY_OP),
8410 OPRINIT_ATTR(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8411 OPRINIT_ATTR(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8413 OPRINIT_ATTR("?", 5, 2, JimExprOpNull, LAZY_OP),
8414 OPRINIT_ATTR(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8415 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8417 OPRINIT_ATTR(":", 5, 2, JimExprOpNull, LAZY_OP),
8418 OPRINIT_ATTR(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8419 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8421 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8422 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, RIGHT_ASSOC),
8424 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8425 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8427 OPRINIT("in", 55, 2, JimExprOpStrBin),
8428 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8430 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8431 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8432 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8433 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8437 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8438 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8439 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8440 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8441 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8442 OPRINIT("rand", 200, 0, JimExprOpNone),
8443 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8445 #ifdef JIM_MATH_FUNCTIONS
8446 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8447 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8448 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8449 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8450 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8451 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8452 OPRINIT("atan2", 200, 2, JimExprOpBin),
8453 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8454 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8455 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8456 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8457 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8458 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8459 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8460 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8461 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8462 OPRINIT("pow", 200, 2, JimExprOpBin),
8463 OPRINIT("hypot", 200, 2, JimExprOpBin),
8464 OPRINIT("fmod", 200, 2, JimExprOpBin),
8465 #endif
8467 #undef OPRINIT
8468 #undef OPRINIT_LAZY
8470 #define JIM_EXPR_OPERATORS_NUM \
8471 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8473 static int JimParseExpression(struct JimParserCtx *pc)
8475 /* Discard spaces and quoted newline */
8476 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8477 if (*pc->p == '\n') {
8478 pc->linenr++;
8480 pc->p++;
8481 pc->len--;
8484 /* Common case */
8485 pc->tline = pc->linenr;
8486 pc->tstart = pc->p;
8488 if (pc->len == 0) {
8489 pc->tend = pc->p;
8490 pc->tt = JIM_TT_EOL;
8491 pc->eof = 1;
8492 return JIM_OK;
8494 switch (*(pc->p)) {
8495 case '(':
8496 pc->tt = JIM_TT_SUBEXPR_START;
8497 goto singlechar;
8498 case ')':
8499 pc->tt = JIM_TT_SUBEXPR_END;
8500 goto singlechar;
8501 case ',':
8502 pc->tt = JIM_TT_SUBEXPR_COMMA;
8503 singlechar:
8504 pc->tend = pc->p;
8505 pc->p++;
8506 pc->len--;
8507 break;
8508 case '[':
8509 return JimParseCmd(pc);
8510 case '$':
8511 if (JimParseVar(pc) == JIM_ERR)
8512 return JimParseExprOperator(pc);
8513 else {
8514 /* Don't allow expr sugar in expressions */
8515 if (pc->tt == JIM_TT_EXPRSUGAR) {
8516 return JIM_ERR;
8518 return JIM_OK;
8520 break;
8521 case '0':
8522 case '1':
8523 case '2':
8524 case '3':
8525 case '4':
8526 case '5':
8527 case '6':
8528 case '7':
8529 case '8':
8530 case '9':
8531 case '.':
8532 return JimParseExprNumber(pc);
8533 case '"':
8534 return JimParseQuote(pc);
8535 case '{':
8536 return JimParseBrace(pc);
8538 case 'N':
8539 case 'I':
8540 case 'n':
8541 case 'i':
8542 if (JimParseExprIrrational(pc) == JIM_ERR)
8543 if (JimParseExprBoolean(pc) == JIM_ERR)
8544 return JimParseExprOperator(pc);
8545 break;
8546 case 't':
8547 case 'f':
8548 case 'o':
8549 case 'y':
8550 if (JimParseExprBoolean(pc) == JIM_ERR)
8551 return JimParseExprOperator(pc);
8552 break;
8553 default:
8554 return JimParseExprOperator(pc);
8555 break;
8557 return JIM_OK;
8560 static int JimParseExprNumber(struct JimParserCtx *pc)
8562 char *end;
8564 /* Assume an integer for now */
8565 pc->tt = JIM_TT_EXPR_INT;
8567 jim_strtoull(pc->p, (char **)&pc->p);
8568 /* Tried as an integer, but perhaps it parses as a double */
8569 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8570 /* Some stupid compilers insist they are cleverer that
8571 * we are. Even a (void) cast doesn't prevent this warning!
8573 if (strtod(pc->tstart, &end)) { /* nothing */ }
8574 if (end == pc->tstart)
8575 return JIM_ERR;
8576 if (end > pc->p) {
8577 /* Yes, double captured more chars */
8578 pc->tt = JIM_TT_EXPR_DOUBLE;
8579 pc->p = end;
8582 pc->tend = pc->p - 1;
8583 pc->len -= (pc->p - pc->tstart);
8584 return JIM_OK;
8587 static int JimParseExprIrrational(struct JimParserCtx *pc)
8589 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8590 int i;
8592 for (i = 0; irrationals[i]; i++) {
8593 const char *irr = irrationals[i];
8595 if (strncmp(irr, pc->p, 3) == 0) {
8596 pc->p += 3;
8597 pc->len -= 3;
8598 pc->tend = pc->p - 1;
8599 pc->tt = JIM_TT_EXPR_DOUBLE;
8600 return JIM_OK;
8603 return JIM_ERR;
8606 static int JimParseExprBoolean(struct JimParserCtx *pc)
8608 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8609 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8610 int i;
8612 for (i = 0; booleans[i]; i++) {
8613 const char *boolean = booleans[i];
8614 int length = lengths[i];
8616 if (strncmp(boolean, pc->p, length) == 0) {
8617 pc->p += length;
8618 pc->len -= length;
8619 pc->tend = pc->p - 1;
8620 pc->tt = JIM_TT_EXPR_BOOLEAN;
8621 return JIM_OK;
8624 return JIM_ERR;
8627 static int JimParseExprOperator(struct JimParserCtx *pc)
8629 int i;
8630 int bestIdx = -1, bestLen = 0;
8632 /* Try to get the longest match. */
8633 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8634 const char * const opname = Jim_ExprOperators[i].name;
8635 const int oplen = Jim_ExprOperators[i].namelen;
8637 if (opname == NULL || opname[0] != pc->p[0]) {
8638 continue;
8641 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8642 bestIdx = i + JIM_TT_EXPR_OP;
8643 bestLen = oplen;
8646 if (bestIdx == -1) {
8647 return JIM_ERR;
8650 /* Validate paretheses around function arguments */
8651 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8652 const char *p = pc->p + bestLen;
8653 int len = pc->len - bestLen;
8655 while (len && isspace(UCHAR(*p))) {
8656 len--;
8657 p++;
8659 if (*p != '(') {
8660 return JIM_ERR;
8663 pc->tend = pc->p + bestLen - 1;
8664 pc->p += bestLen;
8665 pc->len -= bestLen;
8667 pc->tt = bestIdx;
8668 return JIM_OK;
8671 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8673 static Jim_ExprOperator dummy_op;
8674 if (opcode < JIM_TT_EXPR_OP) {
8675 return &dummy_op;
8677 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8680 const char *jim_tt_name(int type)
8682 static const char * const tt_names[JIM_TT_EXPR_OP] =
8683 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8684 "DBL", "BOO", "$()" };
8685 if (type < JIM_TT_EXPR_OP) {
8686 return tt_names[type];
8688 else if (type == JIM_EXPROP_UNARYMINUS) {
8689 return "-VE";
8691 else if (type == JIM_EXPROP_UNARYPLUS) {
8692 return "+VE";
8694 else {
8695 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8696 static char buf[20];
8698 if (op->name) {
8699 return op->name;
8701 sprintf(buf, "(%d)", type);
8702 return buf;
8706 /* -----------------------------------------------------------------------------
8707 * Expression Object
8708 * ---------------------------------------------------------------------------*/
8709 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8710 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8711 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8713 static const Jim_ObjType exprObjType = {
8714 "expression",
8715 FreeExprInternalRep,
8716 DupExprInternalRep,
8717 NULL,
8718 JIM_TYPE_REFERENCES,
8721 /* Expr bytecode structure */
8722 typedef struct ExprByteCode
8724 ScriptToken *token; /* Tokens array. */
8725 int len; /* Length as number of tokens. */
8726 int inUse; /* Used for sharing. */
8727 } ExprByteCode;
8729 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8731 int i;
8733 for (i = 0; i < expr->len; i++) {
8734 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8736 Jim_Free(expr->token);
8737 Jim_Free(expr);
8740 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8742 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8744 if (expr) {
8745 if (--expr->inUse != 0) {
8746 return;
8749 ExprFreeByteCode(interp, expr);
8753 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8755 JIM_NOTUSED(interp);
8756 JIM_NOTUSED(srcPtr);
8758 /* Just returns an simple string. */
8759 dupPtr->typePtr = NULL;
8762 /* Check if an expr program looks correct
8763 * Sets an error result on invalid
8765 static int ExprCheckCorrectness(Jim_Interp *interp, Jim_Obj *exprObjPtr, ExprByteCode * expr)
8767 int i;
8768 int stacklen = 0;
8769 int ternary = 0;
8770 int lasttt = JIM_TT_NONE;
8771 const char *errmsg;
8773 /* Try to check if there are stack underflows,
8774 * and make sure at the end of the program there is
8775 * a single result on the stack. */
8776 for (i = 0; i < expr->len; i++) {
8777 ScriptToken *t = &expr->token[i];
8778 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8779 lasttt = t->type;
8781 stacklen -= op->arity;
8783 if (stacklen < 0) {
8784 break;
8786 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8787 ternary++;
8789 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8790 ternary--;
8793 /* All operations and operands add one to the stack */
8794 stacklen++;
8796 if (stacklen == 1 && ternary == 0) {
8797 return JIM_OK;
8800 if (stacklen <= 0) {
8801 /* Too few args */
8802 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8803 errmsg = "too few arguments for math function";
8804 Jim_SetResultString(interp, "too few arguments for math function", -1);
8805 } else {
8806 errmsg = "premature end of expression";
8809 else if (stacklen > 1) {
8810 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8811 errmsg = "too many arguments for math function";
8812 } else {
8813 errmsg = "extra tokens at end of expression";
8816 else {
8817 errmsg = "invalid ternary expression";
8819 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": %s", exprObjPtr, errmsg);
8820 return JIM_ERR;
8823 /* This procedure converts every occurrence of || and && opereators
8824 * in lazy unary versions.
8826 * a b || is converted into:
8828 * a <offset> |L b |R
8830 * a b && is converted into:
8832 * a <offset> &L b &R
8834 * "|L" checks if 'a' is true:
8835 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8836 * the opcode just after |R.
8837 * 2) if it is false does nothing.
8838 * "|R" checks if 'b' is true:
8839 * 1) if it is true pushes 1, otherwise pushes 0.
8841 * "&L" checks if 'a' is true:
8842 * 1) if it is true does nothing.
8843 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8844 * the opcode just after &R
8845 * "&R" checks if 'a' is true:
8846 * if it is true pushes 1, otherwise pushes 0.
8848 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8850 int i;
8852 int leftindex, arity, offset;
8854 /* Search for the end of the first operator */
8855 leftindex = expr->len - 1;
8857 arity = 1;
8858 while (arity) {
8859 ScriptToken *tt = &expr->token[leftindex];
8861 if (tt->type >= JIM_TT_EXPR_OP) {
8862 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8864 arity--;
8865 if (--leftindex < 0) {
8866 return JIM_ERR;
8869 leftindex++;
8871 /* Move them up */
8872 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8873 sizeof(*expr->token) * (expr->len - leftindex));
8874 expr->len += 2;
8875 offset = (expr->len - leftindex) - 1;
8877 /* Now we rely on the fact that the left and right version have opcodes
8878 * 1 and 2 after the main opcode respectively
8880 expr->token[leftindex + 1].type = t->type + 1;
8881 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8883 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8884 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8886 /* Now add the 'R' operator */
8887 expr->token[expr->len].objPtr = interp->emptyObj;
8888 expr->token[expr->len].type = t->type + 2;
8889 expr->len++;
8891 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8892 for (i = leftindex - 1; i > 0; i--) {
8893 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8894 if (op->lazy == LAZY_LEFT) {
8895 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8896 JimWideValue(expr->token[i - 1].objPtr) += 2;
8900 return JIM_OK;
8903 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8905 struct ScriptToken *token = &expr->token[expr->len];
8906 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8908 if (op->lazy == LAZY_OP) {
8909 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8910 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8911 return JIM_ERR;
8914 else {
8915 token->objPtr = interp->emptyObj;
8916 token->type = t->type;
8917 expr->len++;
8919 return JIM_OK;
8923 * Returns the index of the COLON_LEFT to the left of 'right_index'
8924 * taking into account nesting.
8926 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8928 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8930 int ternary_count = 1;
8932 right_index--;
8934 while (right_index > 1) {
8935 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8936 ternary_count--;
8938 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8939 ternary_count++;
8941 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8942 return right_index;
8944 right_index--;
8947 /*notreached*/
8948 return -1;
8952 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8954 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8955 * Otherwise returns 0.
8957 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8959 int i = right_index - 1;
8960 int ternary_count = 1;
8962 while (i > 1) {
8963 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8964 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8965 *prev_right_index = i - 2;
8966 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8967 return 1;
8970 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8971 if (ternary_count == 0) {
8972 return 0;
8974 ternary_count++;
8976 i--;
8978 return 0;
8982 * ExprTernaryReorderExpression description
8983 * ========================================
8985 * ?: is right-to-left associative which doesn't work with the stack-based
8986 * expression engine. The fix is to reorder the bytecode.
8988 * The expression:
8990 * expr 1?2:0?3:4
8992 * Has initial bytecode:
8994 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8995 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8997 * The fix involves simulating this expression instead:
8999 * expr 1?2:(0?3:4)
9001 * With the following bytecode:
9003 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
9004 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
9006 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
9007 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
9008 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
9009 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
9011 * ExprTernaryReorderExpression works thus as follows :
9012 * - start from the end of the stack
9013 * - while walking towards the beginning of the stack
9014 * if token=JIM_EXPROP_COLON_RIGHT then
9015 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
9016 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
9017 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
9018 * if all found then
9019 * perform the rotation
9020 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
9021 * end if
9022 * end if
9024 * Note: care has to be taken for nested ternary constructs!!!
9026 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
9028 int i;
9030 for (i = expr->len - 1; i > 1; i--) {
9031 int prev_right_index;
9032 int prev_left_index;
9033 int j;
9034 ScriptToken tmp;
9036 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
9037 continue;
9040 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
9041 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
9042 continue;
9046 ** rotate tokens down
9048 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
9049 ** | | |
9050 ** | V V
9051 ** | [...] : ...
9052 ** | | |
9053 ** | V V
9054 ** | [...] : ...
9055 ** | | |
9056 ** | V V
9057 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
9059 tmp = expr->token[prev_right_index];
9060 for (j = prev_right_index; j < i; j++) {
9061 expr->token[j] = expr->token[j + 1];
9063 expr->token[i] = tmp;
9065 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
9067 * This is 'colon left increment' = i - prev_right_index
9069 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
9070 * [prev_left_index-1] : skip_count
9073 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
9075 /* Adjust for i-- in the loop */
9076 i++;
9080 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9082 Jim_Stack stack;
9083 ExprByteCode *expr;
9084 int ok = 1;
9085 int i;
9086 int prevtt = JIM_TT_NONE;
9087 int have_ternary = 0;
9089 /* -1 for EOL */
9090 int count = tokenlist->count - 1;
9092 expr = Jim_Alloc(sizeof(*expr));
9093 expr->inUse = 1;
9094 expr->len = 0;
9096 Jim_InitStack(&stack);
9098 /* Need extra bytecodes for lazy operators.
9099 * Also check for the ternary operator
9101 for (i = 0; i < tokenlist->count; i++) {
9102 ParseToken *t = &tokenlist->list[i];
9103 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
9105 if (op->lazy == LAZY_OP) {
9106 count += 2;
9107 /* Ternary is a lazy op but also needs reordering */
9108 if (t->type == JIM_EXPROP_TERNARY) {
9109 have_ternary = 1;
9114 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
9116 for (i = 0; i < tokenlist->count && ok; i++) {
9117 ParseToken *t = &tokenlist->list[i];
9119 /* Next token will be stored here */
9120 struct ScriptToken *token = &expr->token[expr->len];
9122 if (t->type == JIM_TT_EOL) {
9123 break;
9126 if (TOKEN_IS_EXPR_OP(t->type)) {
9127 const struct Jim_ExprOperator *op;
9128 ParseToken *tt;
9130 /* Convert -/+ to unary minus or unary plus if necessary */
9131 if (prevtt == JIM_TT_NONE || prevtt == JIM_TT_SUBEXPR_START || prevtt == JIM_TT_SUBEXPR_COMMA || prevtt >= JIM_TT_EXPR_OP) {
9132 if (t->type == JIM_EXPROP_SUB) {
9133 t->type = JIM_EXPROP_UNARYMINUS;
9135 else if (t->type == JIM_EXPROP_ADD) {
9136 t->type = JIM_EXPROP_UNARYPLUS;
9140 op = JimExprOperatorInfoByOpcode(t->type);
9142 /* Handle precedence */
9143 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9144 const struct Jim_ExprOperator *tt_op =
9145 JimExprOperatorInfoByOpcode(tt->type);
9147 /* Note that right-to-left associativity of ?: operator is handled later.
9150 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9151 /* Don't reduce if right associative with equal precedence? */
9152 if (tt_op->precedence == op->precedence && tt_op->lazy == RIGHT_ASSOC) {
9153 break;
9155 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9156 ok = 0;
9157 goto err;
9159 Jim_StackPop(&stack);
9161 else {
9162 break;
9165 Jim_StackPush(&stack, t);
9167 else if (t->type == JIM_TT_SUBEXPR_START) {
9168 Jim_StackPush(&stack, t);
9170 else if (t->type == JIM_TT_SUBEXPR_END || t->type == JIM_TT_SUBEXPR_COMMA) {
9171 /* Reduce the expression back to the previous ( or , */
9172 ok = 0;
9173 while (Jim_StackLen(&stack)) {
9174 ParseToken *tt = Jim_StackPop(&stack);
9176 if (tt->type == JIM_TT_SUBEXPR_START || tt->type == JIM_TT_SUBEXPR_COMMA) {
9177 if (t->type == JIM_TT_SUBEXPR_COMMA) {
9178 /* Need to push back the previous START or COMMA in the case of comma */
9179 Jim_StackPush(&stack, tt);
9181 ok = 1;
9182 break;
9184 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9185 goto err;
9188 if (!ok) {
9189 Jim_SetResultFormatted(interp, "Unexpected close parenthesis in expression: \"%#s\"", exprObjPtr);
9190 goto err;
9193 else {
9194 Jim_Obj *objPtr = NULL;
9196 /* This is a simple non-operator term, so create and push the appropriate object */
9197 token->type = t->type;
9199 /* Two consecutive terms without an operator is invalid */
9200 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9201 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", exprObjPtr);
9202 ok = 0;
9203 goto err;
9206 /* Immediately create a double or int object? */
9207 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9208 char *endptr;
9209 if (t->type == JIM_TT_EXPR_INT) {
9210 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9212 else {
9213 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9215 if (endptr != t->token + t->len) {
9216 /* Conversion failed, so just store it as a string */
9217 Jim_FreeNewObj(interp, objPtr);
9218 objPtr = NULL;
9222 if (objPtr) {
9223 token->objPtr = objPtr;
9225 else {
9226 /* Everything else is stored a simple string term */
9227 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
9228 if (t->type == JIM_TT_CMD) {
9229 /* Only commands need source info */
9230 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
9233 expr->len++;
9235 prevtt = t->type;
9238 /* Reduce any remaining subexpr */
9239 while (Jim_StackLen(&stack)) {
9240 ParseToken *tt = Jim_StackPop(&stack);
9242 if (tt->type == JIM_TT_SUBEXPR_START) {
9243 ok = 0;
9244 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9245 goto err;
9247 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9248 ok = 0;
9249 goto err;
9253 if (have_ternary) {
9254 ExprTernaryReorderExpression(interp, expr);
9257 err:
9258 /* Free the stack used for the compilation. */
9259 Jim_FreeStack(&stack);
9261 for (i = 0; i < expr->len; i++) {
9262 Jim_IncrRefCount(expr->token[i].objPtr);
9265 if (!ok) {
9266 ExprFreeByteCode(interp, expr);
9267 return NULL;
9270 return expr;
9274 /* This method takes the string representation of an expression
9275 * and generates a program for the Expr's stack-based VM. */
9276 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9278 int exprTextLen;
9279 const char *exprText;
9280 struct JimParserCtx parser;
9281 struct ExprByteCode *expr;
9282 ParseTokenList tokenlist;
9283 int line;
9284 Jim_Obj *fileNameObj;
9285 int rc = JIM_ERR;
9287 /* Try to get information about filename / line number */
9288 if (objPtr->typePtr == &sourceObjType) {
9289 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9290 line = objPtr->internalRep.sourceValue.lineNumber;
9292 else {
9293 fileNameObj = interp->emptyObj;
9294 line = 1;
9296 Jim_IncrRefCount(fileNameObj);
9298 exprText = Jim_GetString(objPtr, &exprTextLen);
9300 /* Initially tokenise the expression into tokenlist */
9301 ScriptTokenListInit(&tokenlist);
9303 JimParserInit(&parser, exprText, exprTextLen, line);
9304 while (!parser.eof) {
9305 if (JimParseExpression(&parser) != JIM_OK) {
9306 ScriptTokenListFree(&tokenlist);
9307 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9308 expr = NULL;
9309 goto err;
9312 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9313 parser.tline);
9316 #ifdef DEBUG_SHOW_EXPR_TOKENS
9318 int i;
9319 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9320 for (i = 0; i < tokenlist.count; i++) {
9321 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9322 tokenlist.list[i].len, tokenlist.list[i].token);
9325 #endif
9327 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9328 ScriptTokenListFree(&tokenlist);
9329 Jim_DecrRefCount(interp, fileNameObj);
9330 return JIM_ERR;
9333 /* Now create the expression bytecode from the tokenlist */
9334 expr = ExprCreateByteCode(interp, &tokenlist, objPtr, fileNameObj);
9336 /* No longer need the token list */
9337 ScriptTokenListFree(&tokenlist);
9339 if (!expr) {
9340 goto err;
9343 #ifdef DEBUG_SHOW_EXPR
9345 int i;
9347 printf("==== Expr ====\n");
9348 for (i = 0; i < expr->len; i++) {
9349 ScriptToken *t = &expr->token[i];
9351 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9354 #endif
9356 /* Check program correctness. */
9357 if (ExprCheckCorrectness(interp, objPtr, expr) != JIM_OK) {
9358 /* ExprCheckCorrectness set an error in this case */
9359 ExprFreeByteCode(interp, expr);
9360 expr = NULL;
9361 goto err;
9364 rc = JIM_OK;
9366 err:
9367 /* Free the old internal rep and set the new one. */
9368 Jim_DecrRefCount(interp, fileNameObj);
9369 Jim_FreeIntRep(interp, objPtr);
9370 Jim_SetIntRepPtr(objPtr, expr);
9371 objPtr->typePtr = &exprObjType;
9372 return rc;
9375 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9377 if (objPtr->typePtr != &exprObjType) {
9378 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9379 return NULL;
9382 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9385 #ifdef JIM_OPTIMIZATION
9386 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9388 if (token->type == JIM_TT_EXPR_INT)
9389 return token->objPtr;
9390 else if (token->type == JIM_TT_VAR)
9391 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9392 else if (token->type == JIM_TT_DICTSUGAR)
9393 return JimExpandDictSugar(interp, token->objPtr);
9394 else
9395 return NULL;
9397 #endif
9399 /* -----------------------------------------------------------------------------
9400 * Expressions evaluation.
9401 * Jim uses a specialized stack-based virtual machine for expressions,
9402 * that takes advantage of the fact that expr's operators
9403 * can't be redefined.
9405 * Jim_EvalExpression() uses the bytecode compiled by
9406 * SetExprFromAny() method of the "expression" object.
9408 * On success a Tcl Object containing the result of the evaluation
9409 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9410 * returned.
9411 * On error the function returns a retcode != to JIM_OK and set a suitable
9412 * error on the interp.
9413 * ---------------------------------------------------------------------------*/
9414 #define JIM_EE_STATICSTACK_LEN 10
9416 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9418 ExprByteCode *expr;
9419 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9420 int i;
9421 int retcode = JIM_OK;
9422 struct JimExprState e;
9424 expr = JimGetExpression(interp, exprObjPtr);
9425 if (!expr) {
9426 return JIM_ERR; /* error in expression. */
9429 #ifdef JIM_OPTIMIZATION
9430 /* Check for one of the following common expressions used by while/for
9432 * CONST
9433 * $a
9434 * !$a
9435 * $a < CONST, $a < $b
9436 * $a <= CONST, $a <= $b
9437 * $a > CONST, $a > $b
9438 * $a >= CONST, $a >= $b
9439 * $a != CONST, $a != $b
9440 * $a == CONST, $a == $b
9443 Jim_Obj *objPtr;
9445 /* STEP 1 -- Check if there are the conditions to run the specialized
9446 * version of while */
9448 switch (expr->len) {
9449 case 1:
9450 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9451 if (objPtr) {
9452 Jim_IncrRefCount(objPtr);
9453 *exprResultPtrPtr = objPtr;
9454 return JIM_OK;
9456 break;
9458 case 2:
9459 if (expr->token[1].type == JIM_EXPROP_NOT) {
9460 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9462 if (objPtr && JimIsWide(objPtr)) {
9463 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9464 Jim_IncrRefCount(*exprResultPtrPtr);
9465 return JIM_OK;
9468 break;
9470 case 3:
9471 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9472 if (objPtr && JimIsWide(objPtr)) {
9473 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9474 if (objPtr2 && JimIsWide(objPtr2)) {
9475 jim_wide wideValueA = JimWideValue(objPtr);
9476 jim_wide wideValueB = JimWideValue(objPtr2);
9477 int cmpRes;
9478 switch (expr->token[2].type) {
9479 case JIM_EXPROP_LT:
9480 cmpRes = wideValueA < wideValueB;
9481 break;
9482 case JIM_EXPROP_LTE:
9483 cmpRes = wideValueA <= wideValueB;
9484 break;
9485 case JIM_EXPROP_GT:
9486 cmpRes = wideValueA > wideValueB;
9487 break;
9488 case JIM_EXPROP_GTE:
9489 cmpRes = wideValueA >= wideValueB;
9490 break;
9491 case JIM_EXPROP_NUMEQ:
9492 cmpRes = wideValueA == wideValueB;
9493 break;
9494 case JIM_EXPROP_NUMNE:
9495 cmpRes = wideValueA != wideValueB;
9496 break;
9497 default:
9498 goto noopt;
9500 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9501 Jim_IncrRefCount(*exprResultPtrPtr);
9502 return JIM_OK;
9505 break;
9508 noopt:
9509 #endif
9511 /* In order to avoid that the internal repr gets freed due to
9512 * shimmering of the exprObjPtr's object, we make the internal rep
9513 * shared. */
9514 expr->inUse++;
9516 /* The stack-based expr VM itself */
9518 /* Stack allocation. Expr programs have the feature that
9519 * a program of length N can't require a stack longer than
9520 * N. */
9521 if (expr->len > JIM_EE_STATICSTACK_LEN)
9522 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9523 else
9524 e.stack = staticStack;
9526 e.stacklen = 0;
9528 /* Execute every instruction */
9529 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9530 Jim_Obj *objPtr;
9532 switch (expr->token[i].type) {
9533 case JIM_TT_EXPR_INT:
9534 case JIM_TT_EXPR_DOUBLE:
9535 case JIM_TT_EXPR_BOOLEAN:
9536 case JIM_TT_STR:
9537 ExprPush(&e, expr->token[i].objPtr);
9538 break;
9540 case JIM_TT_VAR:
9541 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9542 if (objPtr) {
9543 ExprPush(&e, objPtr);
9545 else {
9546 retcode = JIM_ERR;
9548 break;
9550 case JIM_TT_DICTSUGAR:
9551 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9552 if (objPtr) {
9553 ExprPush(&e, objPtr);
9555 else {
9556 retcode = JIM_ERR;
9558 break;
9560 case JIM_TT_ESC:
9561 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9562 if (retcode == JIM_OK) {
9563 ExprPush(&e, objPtr);
9565 break;
9567 case JIM_TT_CMD:
9568 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9569 if (retcode == JIM_OK) {
9570 ExprPush(&e, Jim_GetResult(interp));
9572 break;
9574 default:{
9575 /* Find and execute the operation */
9576 e.skip = 0;
9577 e.opcode = expr->token[i].type;
9579 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9580 /* Skip some opcodes if necessary */
9581 i += e.skip;
9582 continue;
9587 expr->inUse--;
9589 if (retcode == JIM_OK) {
9590 *exprResultPtrPtr = ExprPop(&e);
9592 else {
9593 for (i = 0; i < e.stacklen; i++) {
9594 Jim_DecrRefCount(interp, e.stack[i]);
9597 if (e.stack != staticStack) {
9598 Jim_Free(e.stack);
9600 return retcode;
9603 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9605 int retcode;
9606 jim_wide wideValue;
9607 double doubleValue;
9608 int booleanValue;
9609 Jim_Obj *exprResultPtr;
9611 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9612 if (retcode != JIM_OK)
9613 return retcode;
9615 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9616 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9617 if (Jim_GetBoolean(interp, exprResultPtr, &booleanValue) != JIM_OK) {
9618 Jim_DecrRefCount(interp, exprResultPtr);
9619 return JIM_ERR;
9620 } else {
9621 Jim_DecrRefCount(interp, exprResultPtr);
9622 *boolPtr = booleanValue;
9623 return JIM_OK;
9626 else {
9627 Jim_DecrRefCount(interp, exprResultPtr);
9628 *boolPtr = doubleValue != 0;
9629 return JIM_OK;
9632 *boolPtr = wideValue != 0;
9634 Jim_DecrRefCount(interp, exprResultPtr);
9635 return JIM_OK;
9638 /* -----------------------------------------------------------------------------
9639 * ScanFormat String Object
9640 * ---------------------------------------------------------------------------*/
9642 /* This Jim_Obj will held a parsed representation of a format string passed to
9643 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9644 * to be parsed in its entirely first and then, if correct, can be used for
9645 * scanning. To avoid endless re-parsing, the parsed representation will be
9646 * stored in an internal representation and re-used for performance reason. */
9648 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9649 * scanformat string. This part will later be used to extract information
9650 * out from the string to be parsed by Jim_ScanString */
9652 typedef struct ScanFmtPartDescr
9654 char *arg; /* Specification of a CHARSET conversion */
9655 char *prefix; /* Prefix to be scanned literally before conversion */
9656 size_t width; /* Maximal width of input to be converted */
9657 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9658 char type; /* Type of conversion (e.g. c, d, f) */
9659 char modifier; /* Modify type (e.g. l - long, h - short */
9660 } ScanFmtPartDescr;
9662 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9663 * string parsed and separated in part descriptions. Furthermore it contains
9664 * the original string representation of the scanformat string to allow for
9665 * fast update of the Jim_Obj's string representation part.
9667 * As an add-on the internal object representation adds some scratch pad area
9668 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9669 * memory for purpose of string scanning.
9671 * The error member points to a static allocated string in case of a mal-
9672 * formed scanformat string or it contains '0' (NULL) in case of a valid
9673 * parse representation.
9675 * The whole memory of the internal representation is allocated as a single
9676 * area of memory that will be internally separated. So freeing and duplicating
9677 * of such an object is cheap */
9679 typedef struct ScanFmtStringObj
9681 jim_wide size; /* Size of internal repr in bytes */
9682 char *stringRep; /* Original string representation */
9683 size_t count; /* Number of ScanFmtPartDescr contained */
9684 size_t convCount; /* Number of conversions that will assign */
9685 size_t maxPos; /* Max position index if XPG3 is used */
9686 const char *error; /* Ptr to error text (NULL if no error */
9687 char *scratch; /* Some scratch pad used by Jim_ScanString */
9688 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9689 } ScanFmtStringObj;
9692 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9693 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9694 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9696 static const Jim_ObjType scanFmtStringObjType = {
9697 "scanformatstring",
9698 FreeScanFmtInternalRep,
9699 DupScanFmtInternalRep,
9700 UpdateStringOfScanFmt,
9701 JIM_TYPE_NONE,
9704 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9706 JIM_NOTUSED(interp);
9707 Jim_Free((char *)objPtr->internalRep.ptr);
9708 objPtr->internalRep.ptr = 0;
9711 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9713 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9714 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9716 JIM_NOTUSED(interp);
9717 memcpy(newVec, srcPtr->internalRep.ptr, size);
9718 dupPtr->internalRep.ptr = newVec;
9719 dupPtr->typePtr = &scanFmtStringObjType;
9722 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9724 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9727 /* SetScanFmtFromAny will parse a given string and create the internal
9728 * representation of the format specification. In case of an error
9729 * the error data member of the internal representation will be set
9730 * to an descriptive error text and the function will be left with
9731 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9732 * specification */
9734 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9736 ScanFmtStringObj *fmtObj;
9737 char *buffer;
9738 int maxCount, i, approxSize, lastPos = -1;
9739 const char *fmt = objPtr->bytes;
9740 int maxFmtLen = objPtr->length;
9741 const char *fmtEnd = fmt + maxFmtLen;
9742 int curr;
9744 Jim_FreeIntRep(interp, objPtr);
9745 /* Count how many conversions could take place maximally */
9746 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9747 if (fmt[i] == '%')
9748 ++maxCount;
9749 /* Calculate an approximation of the memory necessary */
9750 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9751 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9752 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9753 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9754 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9755 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9756 +1; /* safety byte */
9757 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9758 memset(fmtObj, 0, approxSize);
9759 fmtObj->size = approxSize;
9760 fmtObj->maxPos = 0;
9761 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9762 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9763 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9764 buffer = fmtObj->stringRep + maxFmtLen + 1;
9765 objPtr->internalRep.ptr = fmtObj;
9766 objPtr->typePtr = &scanFmtStringObjType;
9767 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9768 int width = 0, skip;
9769 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9771 fmtObj->count++;
9772 descr->width = 0; /* Assume width unspecified */
9773 /* Overread and store any "literal" prefix */
9774 if (*fmt != '%' || fmt[1] == '%') {
9775 descr->type = 0;
9776 descr->prefix = &buffer[i];
9777 for (; fmt < fmtEnd; ++fmt) {
9778 if (*fmt == '%') {
9779 if (fmt[1] != '%')
9780 break;
9781 ++fmt;
9783 buffer[i++] = *fmt;
9785 buffer[i++] = 0;
9787 /* Skip the conversion introducing '%' sign */
9788 ++fmt;
9789 /* End reached due to non-conversion literal only? */
9790 if (fmt >= fmtEnd)
9791 goto done;
9792 descr->pos = 0; /* Assume "natural" positioning */
9793 if (*fmt == '*') {
9794 descr->pos = -1; /* Okay, conversion will not be assigned */
9795 ++fmt;
9797 else
9798 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9799 /* Check if next token is a number (could be width or pos */
9800 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9801 fmt += skip;
9802 /* Was the number a XPG3 position specifier? */
9803 if (descr->pos != -1 && *fmt == '$') {
9804 int prev;
9806 ++fmt;
9807 descr->pos = width;
9808 width = 0;
9809 /* Look if "natural" postioning and XPG3 one was mixed */
9810 if ((lastPos == 0 && descr->pos > 0)
9811 || (lastPos > 0 && descr->pos == 0)) {
9812 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9813 return JIM_ERR;
9815 /* Look if this position was already used */
9816 for (prev = 0; prev < curr; ++prev) {
9817 if (fmtObj->descr[prev].pos == -1)
9818 continue;
9819 if (fmtObj->descr[prev].pos == descr->pos) {
9820 fmtObj->error =
9821 "variable is assigned by multiple \"%n$\" conversion specifiers";
9822 return JIM_ERR;
9825 /* Try to find a width after the XPG3 specifier */
9826 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9827 descr->width = width;
9828 fmt += skip;
9830 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9831 fmtObj->maxPos = descr->pos;
9833 else {
9834 /* Number was not a XPG3, so it has to be a width */
9835 descr->width = width;
9838 /* If positioning mode was undetermined yet, fix this */
9839 if (lastPos == -1)
9840 lastPos = descr->pos;
9841 /* Handle CHARSET conversion type ... */
9842 if (*fmt == '[') {
9843 int swapped = 1, beg = i, end, j;
9845 descr->type = '[';
9846 descr->arg = &buffer[i];
9847 ++fmt;
9848 if (*fmt == '^')
9849 buffer[i++] = *fmt++;
9850 if (*fmt == ']')
9851 buffer[i++] = *fmt++;
9852 while (*fmt && *fmt != ']')
9853 buffer[i++] = *fmt++;
9854 if (*fmt != ']') {
9855 fmtObj->error = "unmatched [ in format string";
9856 return JIM_ERR;
9858 end = i;
9859 buffer[i++] = 0;
9860 /* In case a range fence was given "backwards", swap it */
9861 while (swapped) {
9862 swapped = 0;
9863 for (j = beg + 1; j < end - 1; ++j) {
9864 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9865 char tmp = buffer[j - 1];
9867 buffer[j - 1] = buffer[j + 1];
9868 buffer[j + 1] = tmp;
9869 swapped = 1;
9874 else {
9875 /* Remember any valid modifier if given */
9876 if (strchr("hlL", *fmt) != 0)
9877 descr->modifier = tolower((int)*fmt++);
9879 descr->type = *fmt;
9880 if (strchr("efgcsndoxui", *fmt) == 0) {
9881 fmtObj->error = "bad scan conversion character";
9882 return JIM_ERR;
9884 else if (*fmt == 'c' && descr->width != 0) {
9885 fmtObj->error = "field width may not be specified in %c " "conversion";
9886 return JIM_ERR;
9888 else if (*fmt == 'u' && descr->modifier == 'l') {
9889 fmtObj->error = "unsigned wide not supported";
9890 return JIM_ERR;
9893 curr++;
9895 done:
9896 return JIM_OK;
9899 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9901 #define FormatGetCnvCount(_fo_) \
9902 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9903 #define FormatGetMaxPos(_fo_) \
9904 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9905 #define FormatGetError(_fo_) \
9906 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9908 /* JimScanAString is used to scan an unspecified string that ends with
9909 * next WS, or a string that is specified via a charset.
9912 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9914 char *buffer = Jim_StrDup(str);
9915 char *p = buffer;
9917 while (*str) {
9918 int c;
9919 int n;
9921 if (!sdescr && isspace(UCHAR(*str)))
9922 break; /* EOS via WS if unspecified */
9924 n = utf8_tounicode(str, &c);
9925 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9926 break;
9927 while (n--)
9928 *p++ = *str++;
9930 *p = 0;
9931 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9934 /* ScanOneEntry will scan one entry out of the string passed as argument.
9935 * It use the sscanf() function for this task. After extracting and
9936 * converting of the value, the count of scanned characters will be
9937 * returned of -1 in case of no conversion tool place and string was
9938 * already scanned thru */
9940 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9941 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9943 const char *tok;
9944 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9945 size_t scanned = 0;
9946 size_t anchor = pos;
9947 int i;
9948 Jim_Obj *tmpObj = NULL;
9950 /* First pessimistically assume, we will not scan anything :-) */
9951 *valObjPtr = 0;
9952 if (descr->prefix) {
9953 /* There was a prefix given before the conversion, skip it and adjust
9954 * the string-to-be-parsed accordingly */
9955 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9956 /* If prefix require, skip WS */
9957 if (isspace(UCHAR(descr->prefix[i])))
9958 while (pos < strLen && isspace(UCHAR(str[pos])))
9959 ++pos;
9960 else if (descr->prefix[i] != str[pos])
9961 break; /* Prefix do not match here, leave the loop */
9962 else
9963 ++pos; /* Prefix matched so far, next round */
9965 if (pos >= strLen) {
9966 return -1; /* All of str consumed: EOF condition */
9968 else if (descr->prefix[i] != 0)
9969 return 0; /* Not whole prefix consumed, no conversion possible */
9971 /* For all but following conversion, skip leading WS */
9972 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9973 while (isspace(UCHAR(str[pos])))
9974 ++pos;
9975 /* Determine how much skipped/scanned so far */
9976 scanned = pos - anchor;
9978 /* %c is a special, simple case. no width */
9979 if (descr->type == 'n') {
9980 /* Return pseudo conversion means: how much scanned so far? */
9981 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9983 else if (pos >= strLen) {
9984 /* Cannot scan anything, as str is totally consumed */
9985 return -1;
9987 else if (descr->type == 'c') {
9988 int c;
9989 scanned += utf8_tounicode(&str[pos], &c);
9990 *valObjPtr = Jim_NewIntObj(interp, c);
9991 return scanned;
9993 else {
9994 /* Processing of conversions follows ... */
9995 if (descr->width > 0) {
9996 /* Do not try to scan as fas as possible but only the given width.
9997 * To ensure this, we copy the part that should be scanned. */
9998 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9999 size_t tLen = descr->width > sLen ? sLen : descr->width;
10001 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
10002 tok = tmpObj->bytes;
10004 else {
10005 /* As no width was given, simply refer to the original string */
10006 tok = &str[pos];
10008 switch (descr->type) {
10009 case 'd':
10010 case 'o':
10011 case 'x':
10012 case 'u':
10013 case 'i':{
10014 char *endp; /* Position where the number finished */
10015 jim_wide w;
10017 int base = descr->type == 'o' ? 8
10018 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
10020 /* Try to scan a number with the given base */
10021 if (base == 0) {
10022 w = jim_strtoull(tok, &endp);
10024 else {
10025 w = strtoull(tok, &endp, base);
10028 if (endp != tok) {
10029 /* There was some number sucessfully scanned! */
10030 *valObjPtr = Jim_NewIntObj(interp, w);
10032 /* Adjust the number-of-chars scanned so far */
10033 scanned += endp - tok;
10035 else {
10036 /* Nothing was scanned. We have to determine if this
10037 * happened due to e.g. prefix mismatch or input str
10038 * exhausted */
10039 scanned = *tok ? 0 : -1;
10041 break;
10043 case 's':
10044 case '[':{
10045 *valObjPtr = JimScanAString(interp, descr->arg, tok);
10046 scanned += Jim_Length(*valObjPtr);
10047 break;
10049 case 'e':
10050 case 'f':
10051 case 'g':{
10052 char *endp;
10053 double value = strtod(tok, &endp);
10055 if (endp != tok) {
10056 /* There was some number sucessfully scanned! */
10057 *valObjPtr = Jim_NewDoubleObj(interp, value);
10058 /* Adjust the number-of-chars scanned so far */
10059 scanned += endp - tok;
10061 else {
10062 /* Nothing was scanned. We have to determine if this
10063 * happened due to e.g. prefix mismatch or input str
10064 * exhausted */
10065 scanned = *tok ? 0 : -1;
10067 break;
10070 /* If a substring was allocated (due to pre-defined width) do not
10071 * forget to free it */
10072 if (tmpObj) {
10073 Jim_FreeNewObj(interp, tmpObj);
10076 return scanned;
10079 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
10080 * string and returns all converted (and not ignored) values in a list back
10081 * to the caller. If an error occured, a NULL pointer will be returned */
10083 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
10085 size_t i, pos;
10086 int scanned = 1;
10087 const char *str = Jim_String(strObjPtr);
10088 int strLen = Jim_Utf8Length(interp, strObjPtr);
10089 Jim_Obj *resultList = 0;
10090 Jim_Obj **resultVec = 0;
10091 int resultc;
10092 Jim_Obj *emptyStr = 0;
10093 ScanFmtStringObj *fmtObj;
10095 /* This should never happen. The format object should already be of the correct type */
10096 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
10098 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
10099 /* Check if format specification was valid */
10100 if (fmtObj->error != 0) {
10101 if (flags & JIM_ERRMSG)
10102 Jim_SetResultString(interp, fmtObj->error, -1);
10103 return 0;
10105 /* Allocate a new "shared" empty string for all unassigned conversions */
10106 emptyStr = Jim_NewEmptyStringObj(interp);
10107 Jim_IncrRefCount(emptyStr);
10108 /* Create a list and fill it with empty strings up to max specified XPG3 */
10109 resultList = Jim_NewListObj(interp, NULL, 0);
10110 if (fmtObj->maxPos > 0) {
10111 for (i = 0; i < fmtObj->maxPos; ++i)
10112 Jim_ListAppendElement(interp, resultList, emptyStr);
10113 JimListGetElements(interp, resultList, &resultc, &resultVec);
10115 /* Now handle every partial format description */
10116 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
10117 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
10118 Jim_Obj *value = 0;
10120 /* Only last type may be "literal" w/o conversion - skip it! */
10121 if (descr->type == 0)
10122 continue;
10123 /* As long as any conversion could be done, we will proceed */
10124 if (scanned > 0)
10125 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
10126 /* In case our first try results in EOF, we will leave */
10127 if (scanned == -1 && i == 0)
10128 goto eof;
10129 /* Advance next pos-to-be-scanned for the amount scanned already */
10130 pos += scanned;
10132 /* value == 0 means no conversion took place so take empty string */
10133 if (value == 0)
10134 value = Jim_NewEmptyStringObj(interp);
10135 /* If value is a non-assignable one, skip it */
10136 if (descr->pos == -1) {
10137 Jim_FreeNewObj(interp, value);
10139 else if (descr->pos == 0)
10140 /* Otherwise append it to the result list if no XPG3 was given */
10141 Jim_ListAppendElement(interp, resultList, value);
10142 else if (resultVec[descr->pos - 1] == emptyStr) {
10143 /* But due to given XPG3, put the value into the corr. slot */
10144 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
10145 Jim_IncrRefCount(value);
10146 resultVec[descr->pos - 1] = value;
10148 else {
10149 /* Otherwise, the slot was already used - free obj and ERROR */
10150 Jim_FreeNewObj(interp, value);
10151 goto err;
10154 Jim_DecrRefCount(interp, emptyStr);
10155 return resultList;
10156 eof:
10157 Jim_DecrRefCount(interp, emptyStr);
10158 Jim_FreeNewObj(interp, resultList);
10159 return (Jim_Obj *)EOF;
10160 err:
10161 Jim_DecrRefCount(interp, emptyStr);
10162 Jim_FreeNewObj(interp, resultList);
10163 return 0;
10166 /* -----------------------------------------------------------------------------
10167 * Pseudo Random Number Generation
10168 * ---------------------------------------------------------------------------*/
10169 /* Initialize the sbox with the numbers from 0 to 255 */
10170 static void JimPrngInit(Jim_Interp *interp)
10172 #define PRNG_SEED_SIZE 256
10173 int i;
10174 unsigned int *seed;
10175 time_t t = time(NULL);
10177 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10179 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10180 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10181 seed[i] = (rand() ^ t ^ clock());
10183 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10184 Jim_Free(seed);
10187 /* Generates N bytes of random data */
10188 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10190 Jim_PrngState *prng;
10191 unsigned char *destByte = (unsigned char *)dest;
10192 unsigned int si, sj, x;
10194 /* initialization, only needed the first time */
10195 if (interp->prngState == NULL)
10196 JimPrngInit(interp);
10197 prng = interp->prngState;
10198 /* generates 'len' bytes of pseudo-random numbers */
10199 for (x = 0; x < len; x++) {
10200 prng->i = (prng->i + 1) & 0xff;
10201 si = prng->sbox[prng->i];
10202 prng->j = (prng->j + si) & 0xff;
10203 sj = prng->sbox[prng->j];
10204 prng->sbox[prng->i] = sj;
10205 prng->sbox[prng->j] = si;
10206 *destByte++ = prng->sbox[(si + sj) & 0xff];
10210 /* Re-seed the generator with user-provided bytes */
10211 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10213 int i;
10214 Jim_PrngState *prng;
10216 /* initialization, only needed the first time */
10217 if (interp->prngState == NULL)
10218 JimPrngInit(interp);
10219 prng = interp->prngState;
10221 /* Set the sbox[i] with i */
10222 for (i = 0; i < 256; i++)
10223 prng->sbox[i] = i;
10224 /* Now use the seed to perform a random permutation of the sbox */
10225 for (i = 0; i < seedLen; i++) {
10226 unsigned char t;
10228 t = prng->sbox[i & 0xFF];
10229 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10230 prng->sbox[seed[i]] = t;
10232 prng->i = prng->j = 0;
10234 /* discard at least the first 256 bytes of stream.
10235 * borrow the seed buffer for this
10237 for (i = 0; i < 256; i += seedLen) {
10238 JimRandomBytes(interp, seed, seedLen);
10242 /* [incr] */
10243 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10245 jim_wide wideValue, increment = 1;
10246 Jim_Obj *intObjPtr;
10248 if (argc != 2 && argc != 3) {
10249 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10250 return JIM_ERR;
10252 if (argc == 3) {
10253 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10254 return JIM_ERR;
10256 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10257 if (!intObjPtr) {
10258 /* Set missing variable to 0 */
10259 wideValue = 0;
10261 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10262 return JIM_ERR;
10264 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10265 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10266 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10267 Jim_FreeNewObj(interp, intObjPtr);
10268 return JIM_ERR;
10271 else {
10272 /* Can do it the quick way */
10273 Jim_InvalidateStringRep(intObjPtr);
10274 JimWideValue(intObjPtr) = wideValue + increment;
10276 /* The following step is required in order to invalidate the
10277 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10278 if (argv[1]->typePtr != &variableObjType) {
10279 /* Note that this can't fail since GetVariable already succeeded */
10280 Jim_SetVariable(interp, argv[1], intObjPtr);
10283 Jim_SetResult(interp, intObjPtr);
10284 return JIM_OK;
10288 /* -----------------------------------------------------------------------------
10289 * Eval
10290 * ---------------------------------------------------------------------------*/
10291 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10292 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10294 /* Handle calls to the [unknown] command */
10295 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10297 int retcode;
10299 /* If JimUnknown() is recursively called too many times...
10300 * done here
10302 if (interp->unknown_called > 50) {
10303 return JIM_ERR;
10306 /* The object interp->unknown just contains
10307 * the "unknown" string, it is used in order to
10308 * avoid to lookup the unknown command every time
10309 * but instead to cache the result. */
10311 /* If the [unknown] command does not exist ... */
10312 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10313 return JIM_ERR;
10315 interp->unknown_called++;
10316 /* XXX: Are we losing fileNameObj and linenr? */
10317 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10318 interp->unknown_called--;
10320 return retcode;
10323 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10325 int retcode;
10326 Jim_Cmd *cmdPtr;
10328 #if 0
10329 printf("invoke");
10330 int j;
10331 for (j = 0; j < objc; j++) {
10332 printf(" '%s'", Jim_String(objv[j]));
10334 printf("\n");
10335 #endif
10337 if (interp->framePtr->tailcallCmd) {
10338 /* Special tailcall command was pre-resolved */
10339 cmdPtr = interp->framePtr->tailcallCmd;
10340 interp->framePtr->tailcallCmd = NULL;
10342 else {
10343 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10344 if (cmdPtr == NULL) {
10345 return JimUnknown(interp, objc, objv);
10347 JimIncrCmdRefCount(cmdPtr);
10350 if (interp->evalDepth == interp->maxEvalDepth) {
10351 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10352 retcode = JIM_ERR;
10353 goto out;
10355 interp->evalDepth++;
10357 /* Call it -- Make sure result is an empty object. */
10358 Jim_SetEmptyResult(interp);
10359 if (cmdPtr->isproc) {
10360 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10362 else {
10363 interp->cmdPrivData = cmdPtr->u.native.privData;
10364 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10366 interp->evalDepth--;
10368 out:
10369 JimDecrCmdRefCount(interp, cmdPtr);
10371 return retcode;
10374 /* Eval the object vector 'objv' composed of 'objc' elements.
10375 * Every element is used as single argument.
10376 * Jim_EvalObj() will call this function every time its object
10377 * argument is of "list" type, with no string representation.
10379 * This is possible because the string representation of a
10380 * list object generated by the UpdateStringOfList is made
10381 * in a way that ensures that every list element is a different
10382 * command argument. */
10383 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10385 int i, retcode;
10387 /* Incr refcount of arguments. */
10388 for (i = 0; i < objc; i++)
10389 Jim_IncrRefCount(objv[i]);
10391 retcode = JimInvokeCommand(interp, objc, objv);
10393 /* Decr refcount of arguments and return the retcode */
10394 for (i = 0; i < objc; i++)
10395 Jim_DecrRefCount(interp, objv[i]);
10397 return retcode;
10401 * Invokes 'prefix' as a command with the objv array as arguments.
10403 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10405 int ret;
10406 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10408 nargv[0] = prefix;
10409 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10410 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10411 Jim_Free(nargv);
10412 return ret;
10415 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10417 if (!interp->errorFlag) {
10418 /* This is the first error, so save the file/line information and reset the stack */
10419 interp->errorFlag = 1;
10420 Jim_IncrRefCount(script->fileNameObj);
10421 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10422 interp->errorFileNameObj = script->fileNameObj;
10423 interp->errorLine = script->linenr;
10425 JimResetStackTrace(interp);
10426 /* Always add a level where the error first occurs */
10427 interp->addStackTrace++;
10430 /* Now if this is an "interesting" level, add it to the stack trace */
10431 if (interp->addStackTrace > 0) {
10432 /* Add the stack info for the current level */
10434 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10436 /* Note: if we didn't have a filename for this level,
10437 * don't clear the addStackTrace flag
10438 * so we can pick it up at the next level
10440 if (Jim_Length(script->fileNameObj)) {
10441 interp->addStackTrace = 0;
10444 Jim_DecrRefCount(interp, interp->errorProc);
10445 interp->errorProc = interp->emptyObj;
10446 Jim_IncrRefCount(interp->errorProc);
10450 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10452 Jim_Obj *objPtr;
10454 switch (token->type) {
10455 case JIM_TT_STR:
10456 case JIM_TT_ESC:
10457 objPtr = token->objPtr;
10458 break;
10459 case JIM_TT_VAR:
10460 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10461 break;
10462 case JIM_TT_DICTSUGAR:
10463 objPtr = JimExpandDictSugar(interp, token->objPtr);
10464 break;
10465 case JIM_TT_EXPRSUGAR:
10466 objPtr = JimExpandExprSugar(interp, token->objPtr);
10467 break;
10468 case JIM_TT_CMD:
10469 switch (Jim_EvalObj(interp, token->objPtr)) {
10470 case JIM_OK:
10471 case JIM_RETURN:
10472 objPtr = interp->result;
10473 break;
10474 case JIM_BREAK:
10475 /* Stop substituting */
10476 return JIM_BREAK;
10477 case JIM_CONTINUE:
10478 /* just skip this one */
10479 return JIM_CONTINUE;
10480 default:
10481 return JIM_ERR;
10483 break;
10484 default:
10485 JimPanic((1,
10486 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10487 objPtr = NULL;
10488 break;
10490 if (objPtr) {
10491 *objPtrPtr = objPtr;
10492 return JIM_OK;
10494 return JIM_ERR;
10497 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10498 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10499 * The returned object has refcount = 0.
10501 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10503 int totlen = 0, i;
10504 Jim_Obj **intv;
10505 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10506 Jim_Obj *objPtr;
10507 char *s;
10509 if (tokens <= JIM_EVAL_SINTV_LEN)
10510 intv = sintv;
10511 else
10512 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10514 /* Compute every token forming the argument
10515 * in the intv objects vector. */
10516 for (i = 0; i < tokens; i++) {
10517 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10518 case JIM_OK:
10519 case JIM_RETURN:
10520 break;
10521 case JIM_BREAK:
10522 if (flags & JIM_SUBST_FLAG) {
10523 /* Stop here */
10524 tokens = i;
10525 continue;
10527 /* XXX: Should probably set an error about break outside loop */
10528 /* fall through to error */
10529 case JIM_CONTINUE:
10530 if (flags & JIM_SUBST_FLAG) {
10531 intv[i] = NULL;
10532 continue;
10534 /* XXX: Ditto continue outside loop */
10535 /* fall through to error */
10536 default:
10537 while (i--) {
10538 Jim_DecrRefCount(interp, intv[i]);
10540 if (intv != sintv) {
10541 Jim_Free(intv);
10543 return NULL;
10545 Jim_IncrRefCount(intv[i]);
10546 Jim_String(intv[i]);
10547 totlen += intv[i]->length;
10550 /* Fast path return for a single token */
10551 if (tokens == 1 && intv[0] && intv == sintv) {
10552 Jim_DecrRefCount(interp, intv[0]);
10553 return intv[0];
10556 /* Concatenate every token in an unique
10557 * object. */
10558 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10560 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10561 && token[2].type == JIM_TT_VAR) {
10562 /* May be able to do fast interpolated object -> dictSubst */
10563 objPtr->typePtr = &interpolatedObjType;
10564 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10565 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10566 Jim_IncrRefCount(intv[2]);
10568 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10569 /* The first interpolated token is source, so preserve the source info */
10570 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10574 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10575 objPtr->length = totlen;
10576 for (i = 0; i < tokens; i++) {
10577 if (intv[i]) {
10578 memcpy(s, intv[i]->bytes, intv[i]->length);
10579 s += intv[i]->length;
10580 Jim_DecrRefCount(interp, intv[i]);
10583 objPtr->bytes[totlen] = '\0';
10584 /* Free the intv vector if not static. */
10585 if (intv != sintv) {
10586 Jim_Free(intv);
10589 return objPtr;
10593 /* listPtr *must* be a list.
10594 * The contents of the list is evaluated with the first element as the command and
10595 * the remaining elements as the arguments.
10597 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10599 int retcode = JIM_OK;
10601 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10603 if (listPtr->internalRep.listValue.len) {
10604 Jim_IncrRefCount(listPtr);
10605 retcode = JimInvokeCommand(interp,
10606 listPtr->internalRep.listValue.len,
10607 listPtr->internalRep.listValue.ele);
10608 Jim_DecrRefCount(interp, listPtr);
10610 return retcode;
10613 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10615 SetListFromAny(interp, listPtr);
10616 return JimEvalObjList(interp, listPtr);
10619 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10621 int i;
10622 ScriptObj *script;
10623 ScriptToken *token;
10624 int retcode = JIM_OK;
10625 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10626 Jim_Obj *prevScriptObj;
10628 /* If the object is of type "list", with no string rep we can call
10629 * a specialized version of Jim_EvalObj() */
10630 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10631 return JimEvalObjList(interp, scriptObjPtr);
10634 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10635 script = JimGetScript(interp, scriptObjPtr);
10636 if (!JimScriptValid(interp, script)) {
10637 Jim_DecrRefCount(interp, scriptObjPtr);
10638 return JIM_ERR;
10641 /* Reset the interpreter result. This is useful to
10642 * return the empty result in the case of empty program. */
10643 Jim_SetEmptyResult(interp);
10645 token = script->token;
10647 #ifdef JIM_OPTIMIZATION
10648 /* Check for one of the following common scripts used by for, while
10650 * {}
10651 * incr a
10653 if (script->len == 0) {
10654 Jim_DecrRefCount(interp, scriptObjPtr);
10655 return JIM_OK;
10657 if (script->len == 3
10658 && token[1].objPtr->typePtr == &commandObjType
10659 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10660 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10661 && token[2].objPtr->typePtr == &variableObjType) {
10663 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10665 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10666 JimWideValue(objPtr)++;
10667 Jim_InvalidateStringRep(objPtr);
10668 Jim_DecrRefCount(interp, scriptObjPtr);
10669 Jim_SetResult(interp, objPtr);
10670 return JIM_OK;
10673 #endif
10675 /* Now we have to make sure the internal repr will not be
10676 * freed on shimmering.
10678 * Think for example to this:
10680 * set x {llength $x; ... some more code ...}; eval $x
10682 * In order to preserve the internal rep, we increment the
10683 * inUse field of the script internal rep structure. */
10684 script->inUse++;
10686 /* Stash the current script */
10687 prevScriptObj = interp->currentScriptObj;
10688 interp->currentScriptObj = scriptObjPtr;
10690 interp->errorFlag = 0;
10691 argv = sargv;
10693 /* Execute every command sequentially until the end of the script
10694 * or an error occurs.
10696 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10697 int argc;
10698 int j;
10700 /* First token of the line is always JIM_TT_LINE */
10701 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10702 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10704 /* Allocate the arguments vector if required */
10705 if (argc > JIM_EVAL_SARGV_LEN)
10706 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10708 /* Skip the JIM_TT_LINE token */
10709 i++;
10711 /* Populate the arguments objects.
10712 * If an error occurs, retcode will be set and
10713 * 'j' will be set to the number of args expanded
10715 for (j = 0; j < argc; j++) {
10716 long wordtokens = 1;
10717 int expand = 0;
10718 Jim_Obj *wordObjPtr = NULL;
10720 if (token[i].type == JIM_TT_WORD) {
10721 wordtokens = JimWideValue(token[i++].objPtr);
10722 if (wordtokens < 0) {
10723 expand = 1;
10724 wordtokens = -wordtokens;
10728 if (wordtokens == 1) {
10729 /* Fast path if the token does not
10730 * need interpolation */
10732 switch (token[i].type) {
10733 case JIM_TT_ESC:
10734 case JIM_TT_STR:
10735 wordObjPtr = token[i].objPtr;
10736 break;
10737 case JIM_TT_VAR:
10738 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10739 break;
10740 case JIM_TT_EXPRSUGAR:
10741 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10742 break;
10743 case JIM_TT_DICTSUGAR:
10744 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10745 break;
10746 case JIM_TT_CMD:
10747 retcode = Jim_EvalObj(interp, token[i].objPtr);
10748 if (retcode == JIM_OK) {
10749 wordObjPtr = Jim_GetResult(interp);
10751 break;
10752 default:
10753 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10756 else {
10757 /* For interpolation we call a helper
10758 * function to do the work for us. */
10759 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10762 if (!wordObjPtr) {
10763 if (retcode == JIM_OK) {
10764 retcode = JIM_ERR;
10766 break;
10769 Jim_IncrRefCount(wordObjPtr);
10770 i += wordtokens;
10772 if (!expand) {
10773 argv[j] = wordObjPtr;
10775 else {
10776 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10777 int len = Jim_ListLength(interp, wordObjPtr);
10778 int newargc = argc + len - 1;
10779 int k;
10781 if (len > 1) {
10782 if (argv == sargv) {
10783 if (newargc > JIM_EVAL_SARGV_LEN) {
10784 argv = Jim_Alloc(sizeof(*argv) * newargc);
10785 memcpy(argv, sargv, sizeof(*argv) * j);
10788 else {
10789 /* Need to realloc to make room for (len - 1) more entries */
10790 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10794 /* Now copy in the expanded version */
10795 for (k = 0; k < len; k++) {
10796 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10797 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10800 /* The original object reference is no longer needed,
10801 * after the expansion it is no longer present on
10802 * the argument vector, but the single elements are
10803 * in its place. */
10804 Jim_DecrRefCount(interp, wordObjPtr);
10806 /* And update the indexes */
10807 j--;
10808 argc += len - 1;
10812 if (retcode == JIM_OK && argc) {
10813 /* Invoke the command */
10814 retcode = JimInvokeCommand(interp, argc, argv);
10815 /* Check for a signal after each command */
10816 if (Jim_CheckSignal(interp)) {
10817 retcode = JIM_SIGNAL;
10821 /* Finished with the command, so decrement ref counts of each argument */
10822 while (j-- > 0) {
10823 Jim_DecrRefCount(interp, argv[j]);
10826 if (argv != sargv) {
10827 Jim_Free(argv);
10828 argv = sargv;
10832 /* Possibly add to the error stack trace */
10833 if (retcode == JIM_ERR) {
10834 JimAddErrorToStack(interp, script);
10836 /* Propagate the addStackTrace value through 'return -code error' */
10837 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10838 /* No need to add stack trace */
10839 interp->addStackTrace = 0;
10842 /* Restore the current script */
10843 interp->currentScriptObj = prevScriptObj;
10845 /* Note that we don't have to decrement inUse, because the
10846 * following code transfers our use of the reference again to
10847 * the script object. */
10848 Jim_FreeIntRep(interp, scriptObjPtr);
10849 scriptObjPtr->typePtr = &scriptObjType;
10850 Jim_SetIntRepPtr(scriptObjPtr, script);
10851 Jim_DecrRefCount(interp, scriptObjPtr);
10853 return retcode;
10856 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10858 int retcode;
10859 /* If argObjPtr begins with '&', do an automatic upvar */
10860 const char *varname = Jim_String(argNameObj);
10861 if (*varname == '&') {
10862 /* First check that the target variable exists */
10863 Jim_Obj *objPtr;
10864 Jim_CallFrame *savedCallFrame = interp->framePtr;
10866 interp->framePtr = interp->framePtr->parent;
10867 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10868 interp->framePtr = savedCallFrame;
10869 if (!objPtr) {
10870 return JIM_ERR;
10873 /* It exists, so perform the binding. */
10874 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10875 Jim_IncrRefCount(objPtr);
10876 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10877 Jim_DecrRefCount(interp, objPtr);
10879 else {
10880 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10882 return retcode;
10886 * Sets the interp result to be an error message indicating the required proc args.
10888 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10890 /* Create a nice error message, consistent with Tcl 8.5 */
10891 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10892 int i;
10894 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10895 Jim_AppendString(interp, argmsg, " ", 1);
10897 if (i == cmd->u.proc.argsPos) {
10898 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10899 /* Renamed args */
10900 Jim_AppendString(interp, argmsg, "?", 1);
10901 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10902 Jim_AppendString(interp, argmsg, " ...?", -1);
10904 else {
10905 /* We have plain args */
10906 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10909 else {
10910 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10911 Jim_AppendString(interp, argmsg, "?", 1);
10912 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10913 Jim_AppendString(interp, argmsg, "?", 1);
10915 else {
10916 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10917 if (*arg == '&') {
10918 arg++;
10920 Jim_AppendString(interp, argmsg, arg, -1);
10924 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10925 Jim_FreeNewObj(interp, argmsg);
10928 #ifdef jim_ext_namespace
10930 * [namespace eval]
10932 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10934 Jim_CallFrame *callFramePtr;
10935 int retcode;
10937 /* Create a new callframe */
10938 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10939 callFramePtr->argv = &interp->emptyObj;
10940 callFramePtr->argc = 0;
10941 callFramePtr->procArgsObjPtr = NULL;
10942 callFramePtr->procBodyObjPtr = scriptObj;
10943 callFramePtr->staticVars = NULL;
10944 callFramePtr->fileNameObj = interp->emptyObj;
10945 callFramePtr->line = 0;
10946 Jim_IncrRefCount(scriptObj);
10947 interp->framePtr = callFramePtr;
10949 /* Check if there are too nested calls */
10950 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10951 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10952 retcode = JIM_ERR;
10954 else {
10955 /* Eval the body */
10956 retcode = Jim_EvalObj(interp, scriptObj);
10959 /* Destroy the callframe */
10960 interp->framePtr = interp->framePtr->parent;
10961 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10963 return retcode;
10965 #endif
10967 /* Call a procedure implemented in Tcl.
10968 * It's possible to speed-up a lot this function, currently
10969 * the callframes are not cached, but allocated and
10970 * destroied every time. What is expecially costly is
10971 * to create/destroy the local vars hash table every time.
10973 * This can be fixed just implementing callframes caching
10974 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10975 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10977 Jim_CallFrame *callFramePtr;
10978 int i, d, retcode, optargs;
10979 ScriptObj *script;
10981 /* Check arity */
10982 if (argc - 1 < cmd->u.proc.reqArity ||
10983 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10984 JimSetProcWrongArgs(interp, argv[0], cmd);
10985 return JIM_ERR;
10988 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10989 /* Optimise for procedure with no body - useful for optional debugging */
10990 return JIM_OK;
10993 /* Check if there are too nested calls */
10994 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10995 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10996 return JIM_ERR;
10999 /* Create a new callframe */
11000 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
11001 callFramePtr->argv = argv;
11002 callFramePtr->argc = argc;
11003 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
11004 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
11005 callFramePtr->staticVars = cmd->u.proc.staticVars;
11007 /* Remember where we were called from. */
11008 script = JimGetScript(interp, interp->currentScriptObj);
11009 callFramePtr->fileNameObj = script->fileNameObj;
11010 callFramePtr->line = script->linenr;
11012 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
11013 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
11014 interp->framePtr = callFramePtr;
11016 /* How many optional args are available */
11017 optargs = (argc - 1 - cmd->u.proc.reqArity);
11019 /* Step 'i' along the actual args, and step 'd' along the formal args */
11020 i = 1;
11021 for (d = 0; d < cmd->u.proc.argListLen; d++) {
11022 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
11023 if (d == cmd->u.proc.argsPos) {
11024 /* assign $args */
11025 Jim_Obj *listObjPtr;
11026 int argsLen = 0;
11027 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
11028 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
11030 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
11032 /* It is possible to rename args. */
11033 if (cmd->u.proc.arglist[d].defaultObjPtr) {
11034 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
11036 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
11037 if (retcode != JIM_OK) {
11038 goto badargset;
11041 i += argsLen;
11042 continue;
11045 /* Optional or required? */
11046 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
11047 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
11049 else {
11050 /* Ran out, so use the default */
11051 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
11053 if (retcode != JIM_OK) {
11054 goto badargset;
11058 /* Eval the body */
11059 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
11061 badargset:
11063 /* Free the callframe */
11064 interp->framePtr = interp->framePtr->parent;
11065 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
11067 /* Now chain any tailcalls in the parent frame */
11068 if (interp->framePtr->tailcallObj) {
11069 do {
11070 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
11072 interp->framePtr->tailcallObj = NULL;
11074 if (retcode == JIM_EVAL) {
11075 retcode = Jim_EvalObjList(interp, tailcallObj);
11076 if (retcode == JIM_RETURN) {
11077 /* If the result of the tailcall is 'return', push
11078 * it up to the caller
11080 interp->returnLevel++;
11083 Jim_DecrRefCount(interp, tailcallObj);
11084 } while (interp->framePtr->tailcallObj);
11086 /* If the tailcall chain finished early, may need to manually discard the command */
11087 if (interp->framePtr->tailcallCmd) {
11088 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
11089 interp->framePtr->tailcallCmd = NULL;
11093 /* Handle the JIM_RETURN return code */
11094 if (retcode == JIM_RETURN) {
11095 if (--interp->returnLevel <= 0) {
11096 retcode = interp->returnCode;
11097 interp->returnCode = JIM_OK;
11098 interp->returnLevel = 0;
11101 else if (retcode == JIM_ERR) {
11102 interp->addStackTrace++;
11103 Jim_DecrRefCount(interp, interp->errorProc);
11104 interp->errorProc = argv[0];
11105 Jim_IncrRefCount(interp->errorProc);
11108 return retcode;
11111 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
11113 int retval;
11114 Jim_Obj *scriptObjPtr;
11116 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
11117 Jim_IncrRefCount(scriptObjPtr);
11119 if (filename) {
11120 Jim_Obj *prevScriptObj;
11122 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
11124 prevScriptObj = interp->currentScriptObj;
11125 interp->currentScriptObj = scriptObjPtr;
11127 retval = Jim_EvalObj(interp, scriptObjPtr);
11129 interp->currentScriptObj = prevScriptObj;
11131 else {
11132 retval = Jim_EvalObj(interp, scriptObjPtr);
11134 Jim_DecrRefCount(interp, scriptObjPtr);
11135 return retval;
11138 int Jim_Eval(Jim_Interp *interp, const char *script)
11140 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
11143 /* Execute script in the scope of the global level */
11144 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
11146 int retval;
11147 Jim_CallFrame *savedFramePtr = interp->framePtr;
11149 interp->framePtr = interp->topFramePtr;
11150 retval = Jim_Eval(interp, script);
11151 interp->framePtr = savedFramePtr;
11153 return retval;
11156 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
11158 int retval;
11159 Jim_CallFrame *savedFramePtr = interp->framePtr;
11161 interp->framePtr = interp->topFramePtr;
11162 retval = Jim_EvalFile(interp, filename);
11163 interp->framePtr = savedFramePtr;
11165 return retval;
11168 #include <sys/stat.h>
11170 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11172 FILE *fp;
11173 char *buf;
11174 Jim_Obj *scriptObjPtr;
11175 Jim_Obj *prevScriptObj;
11176 struct stat sb;
11177 int retcode;
11178 int readlen;
11180 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11181 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11182 return JIM_ERR;
11184 if (sb.st_size == 0) {
11185 fclose(fp);
11186 return JIM_OK;
11189 buf = Jim_Alloc(sb.st_size + 1);
11190 readlen = fread(buf, 1, sb.st_size, fp);
11191 if (ferror(fp)) {
11192 fclose(fp);
11193 Jim_Free(buf);
11194 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11195 return JIM_ERR;
11197 fclose(fp);
11198 buf[readlen] = 0;
11200 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11201 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11202 Jim_IncrRefCount(scriptObjPtr);
11204 prevScriptObj = interp->currentScriptObj;
11205 interp->currentScriptObj = scriptObjPtr;
11207 retcode = Jim_EvalObj(interp, scriptObjPtr);
11209 /* Handle the JIM_RETURN return code */
11210 if (retcode == JIM_RETURN) {
11211 if (--interp->returnLevel <= 0) {
11212 retcode = interp->returnCode;
11213 interp->returnCode = JIM_OK;
11214 interp->returnLevel = 0;
11217 if (retcode == JIM_ERR) {
11218 /* EvalFile changes context, so add a stack frame here */
11219 interp->addStackTrace++;
11222 interp->currentScriptObj = prevScriptObj;
11224 Jim_DecrRefCount(interp, scriptObjPtr);
11226 return retcode;
11229 /* -----------------------------------------------------------------------------
11230 * Subst
11231 * ---------------------------------------------------------------------------*/
11232 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11234 pc->tstart = pc->p;
11235 pc->tline = pc->linenr;
11237 if (pc->len == 0) {
11238 pc->tend = pc->p;
11239 pc->tt = JIM_TT_EOL;
11240 pc->eof = 1;
11241 return;
11243 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11244 JimParseCmd(pc);
11245 return;
11247 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11248 if (JimParseVar(pc) == JIM_OK) {
11249 return;
11251 /* Not a var, so treat as a string */
11252 pc->tstart = pc->p;
11253 flags |= JIM_SUBST_NOVAR;
11255 while (pc->len) {
11256 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11257 break;
11259 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11260 break;
11262 if (*pc->p == '\\' && pc->len > 1) {
11263 pc->p++;
11264 pc->len--;
11266 pc->p++;
11267 pc->len--;
11269 pc->tend = pc->p - 1;
11270 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11273 /* The subst object type reuses most of the data structures and functions
11274 * of the script object. Script's data structures are a bit more complex
11275 * for what is needed for [subst]itution tasks, but the reuse helps to
11276 * deal with a single data structure at the cost of some more memory
11277 * usage for substitutions. */
11279 /* This method takes the string representation of an object
11280 * as a Tcl string where to perform [subst]itution, and generates
11281 * the pre-parsed internal representation. */
11282 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11284 int scriptTextLen;
11285 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11286 struct JimParserCtx parser;
11287 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11288 ParseTokenList tokenlist;
11290 /* Initially parse the subst into tokens (in tokenlist) */
11291 ScriptTokenListInit(&tokenlist);
11293 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11294 while (1) {
11295 JimParseSubst(&parser, flags);
11296 if (parser.eof) {
11297 /* Note that subst doesn't need the EOL token */
11298 break;
11300 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11301 parser.tline);
11304 /* Create the "real" subst/script tokens from the initial token list */
11305 script->inUse = 1;
11306 script->substFlags = flags;
11307 script->fileNameObj = interp->emptyObj;
11308 Jim_IncrRefCount(script->fileNameObj);
11309 SubstObjAddTokens(interp, script, &tokenlist);
11311 /* No longer need the token list */
11312 ScriptTokenListFree(&tokenlist);
11314 #ifdef DEBUG_SHOW_SUBST
11316 int i;
11318 printf("==== Subst ====\n");
11319 for (i = 0; i < script->len; i++) {
11320 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11321 Jim_String(script->token[i].objPtr));
11324 #endif
11326 /* Free the old internal rep and set the new one. */
11327 Jim_FreeIntRep(interp, objPtr);
11328 Jim_SetIntRepPtr(objPtr, script);
11329 objPtr->typePtr = &scriptObjType;
11330 return JIM_OK;
11333 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11335 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11336 SetSubstFromAny(interp, objPtr, flags);
11337 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11340 /* Performs commands,variables,blackslashes substitution,
11341 * storing the result object (with refcount 0) into
11342 * resObjPtrPtr. */
11343 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11345 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11347 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11348 /* In order to preserve the internal rep, we increment the
11349 * inUse field of the script internal rep structure. */
11350 script->inUse++;
11352 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11354 script->inUse--;
11355 Jim_DecrRefCount(interp, substObjPtr);
11356 if (*resObjPtrPtr == NULL) {
11357 return JIM_ERR;
11359 return JIM_OK;
11362 /* -----------------------------------------------------------------------------
11363 * Core commands utility functions
11364 * ---------------------------------------------------------------------------*/
11365 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11367 Jim_Obj *objPtr;
11368 Jim_Obj *listObjPtr;
11370 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11372 listObjPtr = Jim_NewListObj(interp, argv, argc);
11374 if (*msg) {
11375 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11377 Jim_IncrRefCount(listObjPtr);
11378 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11379 Jim_DecrRefCount(interp, listObjPtr);
11381 Jim_IncrRefCount(objPtr);
11382 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11383 Jim_DecrRefCount(interp, objPtr);
11387 * May add the key and/or value to the list.
11389 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11390 Jim_HashEntry *he, int type);
11392 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11395 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11396 * invoke the callback to add entries to a list.
11397 * Returns the list.
11399 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11400 JimHashtableIteratorCallbackType *callback, int type)
11402 Jim_HashEntry *he;
11403 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11405 /* Check for the non-pattern case. We can do this much more efficiently. */
11406 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11407 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11408 if (he) {
11409 callback(interp, listObjPtr, he, type);
11412 else {
11413 Jim_HashTableIterator htiter;
11414 JimInitHashTableIterator(ht, &htiter);
11415 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11416 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11417 callback(interp, listObjPtr, he, type);
11421 return listObjPtr;
11424 /* Keep these in order */
11425 #define JIM_CMDLIST_COMMANDS 0
11426 #define JIM_CMDLIST_PROCS 1
11427 #define JIM_CMDLIST_CHANNELS 2
11430 * Adds matching command names (procs, channels) to the list.
11432 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11433 Jim_HashEntry *he, int type)
11435 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11436 Jim_Obj *objPtr;
11438 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11439 /* not a proc */
11440 return;
11443 objPtr = Jim_NewStringObj(interp, he->key, -1);
11444 Jim_IncrRefCount(objPtr);
11446 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11447 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11449 Jim_DecrRefCount(interp, objPtr);
11452 /* type is JIM_CMDLIST_xxx */
11453 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11455 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11458 /* Keep these in order */
11459 #define JIM_VARLIST_GLOBALS 0
11460 #define JIM_VARLIST_LOCALS 1
11461 #define JIM_VARLIST_VARS 2
11463 #define JIM_VARLIST_VALUES 0x1000
11466 * Adds matching variable names to the list.
11468 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11469 Jim_HashEntry *he, int type)
11471 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11473 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11474 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11475 if (type & JIM_VARLIST_VALUES) {
11476 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11481 /* mode is JIM_VARLIST_xxx */
11482 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11484 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11485 /* For [info locals], if we are at top level an emtpy list
11486 * is returned. I don't agree, but we aim at compatibility (SS) */
11487 return interp->emptyObj;
11489 else {
11490 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11491 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11495 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11496 Jim_Obj **objPtrPtr, int info_level_cmd)
11498 Jim_CallFrame *targetCallFrame;
11500 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11501 if (targetCallFrame == NULL) {
11502 return JIM_ERR;
11504 /* No proc call at toplevel callframe */
11505 if (targetCallFrame == interp->topFramePtr) {
11506 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11507 return JIM_ERR;
11509 if (info_level_cmd) {
11510 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11512 else {
11513 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11515 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11516 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11517 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11518 *objPtrPtr = listObj;
11520 return JIM_OK;
11523 /* -----------------------------------------------------------------------------
11524 * Core commands
11525 * ---------------------------------------------------------------------------*/
11527 /* fake [puts] -- not the real puts, just for debugging. */
11528 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11530 if (argc != 2 && argc != 3) {
11531 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11532 return JIM_ERR;
11534 if (argc == 3) {
11535 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11536 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11537 return JIM_ERR;
11539 else {
11540 fputs(Jim_String(argv[2]), stdout);
11543 else {
11544 puts(Jim_String(argv[1]));
11546 return JIM_OK;
11549 /* Helper for [+] and [*] */
11550 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11552 jim_wide wideValue, res;
11553 double doubleValue, doubleRes;
11554 int i;
11556 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11558 for (i = 1; i < argc; i++) {
11559 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11560 goto trydouble;
11561 if (op == JIM_EXPROP_ADD)
11562 res += wideValue;
11563 else
11564 res *= wideValue;
11566 Jim_SetResultInt(interp, res);
11567 return JIM_OK;
11568 trydouble:
11569 doubleRes = (double)res;
11570 for (; i < argc; i++) {
11571 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11572 return JIM_ERR;
11573 if (op == JIM_EXPROP_ADD)
11574 doubleRes += doubleValue;
11575 else
11576 doubleRes *= doubleValue;
11578 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11579 return JIM_OK;
11582 /* Helper for [-] and [/] */
11583 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11585 jim_wide wideValue, res = 0;
11586 double doubleValue, doubleRes = 0;
11587 int i = 2;
11589 if (argc < 2) {
11590 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11591 return JIM_ERR;
11593 else if (argc == 2) {
11594 /* The arity = 2 case is different. For [- x] returns -x,
11595 * while [/ x] returns 1/x. */
11596 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11597 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11598 return JIM_ERR;
11600 else {
11601 if (op == JIM_EXPROP_SUB)
11602 doubleRes = -doubleValue;
11603 else
11604 doubleRes = 1.0 / doubleValue;
11605 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11606 return JIM_OK;
11609 if (op == JIM_EXPROP_SUB) {
11610 res = -wideValue;
11611 Jim_SetResultInt(interp, res);
11613 else {
11614 doubleRes = 1.0 / wideValue;
11615 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11617 return JIM_OK;
11619 else {
11620 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11621 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11622 != JIM_OK) {
11623 return JIM_ERR;
11625 else {
11626 goto trydouble;
11630 for (i = 2; i < argc; i++) {
11631 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11632 doubleRes = (double)res;
11633 goto trydouble;
11635 if (op == JIM_EXPROP_SUB)
11636 res -= wideValue;
11637 else
11638 res /= wideValue;
11640 Jim_SetResultInt(interp, res);
11641 return JIM_OK;
11642 trydouble:
11643 for (; i < argc; i++) {
11644 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11645 return JIM_ERR;
11646 if (op == JIM_EXPROP_SUB)
11647 doubleRes -= doubleValue;
11648 else
11649 doubleRes /= doubleValue;
11651 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11652 return JIM_OK;
11656 /* [+] */
11657 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11659 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11662 /* [*] */
11663 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11665 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11668 /* [-] */
11669 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11671 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11674 /* [/] */
11675 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11677 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11680 /* [set] */
11681 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11683 if (argc != 2 && argc != 3) {
11684 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11685 return JIM_ERR;
11687 if (argc == 2) {
11688 Jim_Obj *objPtr;
11690 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11691 if (!objPtr)
11692 return JIM_ERR;
11693 Jim_SetResult(interp, objPtr);
11694 return JIM_OK;
11696 /* argc == 3 case. */
11697 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11698 return JIM_ERR;
11699 Jim_SetResult(interp, argv[2]);
11700 return JIM_OK;
11703 /* [unset]
11705 * unset ?-nocomplain? ?--? ?varName ...?
11707 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11709 int i = 1;
11710 int complain = 1;
11712 while (i < argc) {
11713 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11714 i++;
11715 break;
11717 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11718 complain = 0;
11719 i++;
11720 continue;
11722 break;
11725 while (i < argc) {
11726 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11727 && complain) {
11728 return JIM_ERR;
11730 i++;
11732 return JIM_OK;
11735 /* [while] */
11736 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11738 if (argc != 3) {
11739 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11740 return JIM_ERR;
11743 /* The general purpose implementation of while starts here */
11744 while (1) {
11745 int boolean, retval;
11747 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11748 return retval;
11749 if (!boolean)
11750 break;
11752 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11753 switch (retval) {
11754 case JIM_BREAK:
11755 goto out;
11756 break;
11757 case JIM_CONTINUE:
11758 continue;
11759 break;
11760 default:
11761 return retval;
11765 out:
11766 Jim_SetEmptyResult(interp);
11767 return JIM_OK;
11770 /* [for] */
11771 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11773 int retval;
11774 int boolean = 1;
11775 Jim_Obj *varNamePtr = NULL;
11776 Jim_Obj *stopVarNamePtr = NULL;
11778 if (argc != 5) {
11779 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11780 return JIM_ERR;
11783 /* Do the initialisation */
11784 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11785 return retval;
11788 /* And do the first test now. Better for optimisation
11789 * if we can do next/test at the bottom of the loop
11791 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11793 /* Ready to do the body as follows:
11794 * while (1) {
11795 * body // check retcode
11796 * next // check retcode
11797 * test // check retcode/test bool
11801 #ifdef JIM_OPTIMIZATION
11802 /* Check if the for is on the form:
11803 * for ... {$i < CONST} {incr i}
11804 * for ... {$i < $j} {incr i}
11806 if (retval == JIM_OK && boolean) {
11807 ScriptObj *incrScript;
11808 ExprByteCode *expr;
11809 jim_wide stop, currentVal;
11810 Jim_Obj *objPtr;
11811 int cmpOffset;
11813 /* Do it only if there aren't shared arguments */
11814 expr = JimGetExpression(interp, argv[2]);
11815 incrScript = JimGetScript(interp, argv[3]);
11817 /* Ensure proper lengths to start */
11818 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11819 goto evalstart;
11821 /* Ensure proper token types. */
11822 if (incrScript->token[1].type != JIM_TT_ESC ||
11823 expr->token[0].type != JIM_TT_VAR ||
11824 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11825 goto evalstart;
11828 if (expr->token[2].type == JIM_EXPROP_LT) {
11829 cmpOffset = 0;
11831 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11832 cmpOffset = 1;
11834 else {
11835 goto evalstart;
11838 /* Update command must be incr */
11839 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11840 goto evalstart;
11843 /* incr, expression must be about the same variable */
11844 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11845 goto evalstart;
11848 /* Get the stop condition (must be a variable or integer) */
11849 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11850 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11851 goto evalstart;
11854 else {
11855 stopVarNamePtr = expr->token[1].objPtr;
11856 Jim_IncrRefCount(stopVarNamePtr);
11857 /* Keep the compiler happy */
11858 stop = 0;
11861 /* Initialization */
11862 varNamePtr = expr->token[0].objPtr;
11863 Jim_IncrRefCount(varNamePtr);
11865 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11866 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11867 goto testcond;
11870 /* --- OPTIMIZED FOR --- */
11871 while (retval == JIM_OK) {
11872 /* === Check condition === */
11873 /* Note that currentVal is already set here */
11875 /* Immediate or Variable? get the 'stop' value if the latter. */
11876 if (stopVarNamePtr) {
11877 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11878 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11879 goto testcond;
11883 if (currentVal >= stop + cmpOffset) {
11884 break;
11887 /* Eval body */
11888 retval = Jim_EvalObj(interp, argv[4]);
11889 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11890 retval = JIM_OK;
11892 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11894 /* Increment */
11895 if (objPtr == NULL) {
11896 retval = JIM_ERR;
11897 goto out;
11899 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11900 currentVal = ++JimWideValue(objPtr);
11901 Jim_InvalidateStringRep(objPtr);
11903 else {
11904 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11905 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11906 ++currentVal)) != JIM_OK) {
11907 goto evalnext;
11912 goto out;
11914 evalstart:
11915 #endif
11917 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11918 /* Body */
11919 retval = Jim_EvalObj(interp, argv[4]);
11921 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11922 /* increment */
11923 JIM_IF_OPTIM(evalnext:)
11924 retval = Jim_EvalObj(interp, argv[3]);
11925 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11926 /* test */
11927 JIM_IF_OPTIM(testcond:)
11928 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11932 JIM_IF_OPTIM(out:)
11933 if (stopVarNamePtr) {
11934 Jim_DecrRefCount(interp, stopVarNamePtr);
11936 if (varNamePtr) {
11937 Jim_DecrRefCount(interp, varNamePtr);
11940 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11941 Jim_SetEmptyResult(interp);
11942 return JIM_OK;
11945 return retval;
11948 /* [loop] */
11949 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11951 int retval;
11952 jim_wide i;
11953 jim_wide limit;
11954 jim_wide incr = 1;
11955 Jim_Obj *bodyObjPtr;
11957 if (argc != 5 && argc != 6) {
11958 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11959 return JIM_ERR;
11962 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11963 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11964 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11965 return JIM_ERR;
11967 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11969 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11971 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11972 retval = Jim_EvalObj(interp, bodyObjPtr);
11973 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11974 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11976 retval = JIM_OK;
11978 /* Increment */
11979 i += incr;
11981 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11982 if (argv[1]->typePtr != &variableObjType) {
11983 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11984 return JIM_ERR;
11987 JimWideValue(objPtr) = i;
11988 Jim_InvalidateStringRep(objPtr);
11990 /* The following step is required in order to invalidate the
11991 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11992 if (argv[1]->typePtr != &variableObjType) {
11993 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11994 retval = JIM_ERR;
11995 break;
11999 else {
12000 objPtr = Jim_NewIntObj(interp, i);
12001 retval = Jim_SetVariable(interp, argv[1], objPtr);
12002 if (retval != JIM_OK) {
12003 Jim_FreeNewObj(interp, objPtr);
12009 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
12010 Jim_SetEmptyResult(interp);
12011 return JIM_OK;
12013 return retval;
12016 /* List iterators make it easy to iterate over a list.
12017 * At some point iterators will be expanded to support generators.
12019 typedef struct {
12020 Jim_Obj *objPtr;
12021 int idx;
12022 } Jim_ListIter;
12025 * Initialise the iterator at the start of the list.
12027 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
12029 iter->objPtr = objPtr;
12030 iter->idx = 0;
12034 * Returns the next object from the list, or NULL on end-of-list.
12036 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
12038 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
12039 return NULL;
12041 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
12045 * Returns 1 if end-of-list has been reached.
12047 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
12049 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
12052 /* foreach + lmap implementation. */
12053 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
12055 int result = JIM_OK;
12056 int i, numargs;
12057 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
12058 Jim_ListIter *iters;
12059 Jim_Obj *script;
12060 Jim_Obj *resultObj;
12062 if (argc < 4 || argc % 2 != 0) {
12063 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
12064 return JIM_ERR;
12066 script = argv[argc - 1]; /* Last argument is a script */
12067 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
12069 if (numargs == 2) {
12070 iters = twoiters;
12072 else {
12073 iters = Jim_Alloc(numargs * sizeof(*iters));
12075 for (i = 0; i < numargs; i++) {
12076 JimListIterInit(&iters[i], argv[i + 1]);
12077 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
12078 result = JIM_ERR;
12081 if (result != JIM_OK) {
12082 Jim_SetResultString(interp, "foreach varlist is empty", -1);
12083 return result;
12086 if (doMap) {
12087 resultObj = Jim_NewListObj(interp, NULL, 0);
12089 else {
12090 resultObj = interp->emptyObj;
12092 Jim_IncrRefCount(resultObj);
12094 while (1) {
12095 /* Have we expired all lists? */
12096 for (i = 0; i < numargs; i += 2) {
12097 if (!JimListIterDone(interp, &iters[i + 1])) {
12098 break;
12101 if (i == numargs) {
12102 /* All done */
12103 break;
12106 /* For each list */
12107 for (i = 0; i < numargs; i += 2) {
12108 Jim_Obj *varName;
12110 /* foreach var */
12111 JimListIterInit(&iters[i], argv[i + 1]);
12112 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
12113 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
12114 if (!valObj) {
12115 /* Ran out, so store the empty string */
12116 valObj = interp->emptyObj;
12118 /* Avoid shimmering */
12119 Jim_IncrRefCount(valObj);
12120 result = Jim_SetVariable(interp, varName, valObj);
12121 Jim_DecrRefCount(interp, valObj);
12122 if (result != JIM_OK) {
12123 goto err;
12127 switch (result = Jim_EvalObj(interp, script)) {
12128 case JIM_OK:
12129 if (doMap) {
12130 Jim_ListAppendElement(interp, resultObj, interp->result);
12132 break;
12133 case JIM_CONTINUE:
12134 break;
12135 case JIM_BREAK:
12136 goto out;
12137 default:
12138 goto err;
12141 out:
12142 result = JIM_OK;
12143 Jim_SetResult(interp, resultObj);
12144 err:
12145 Jim_DecrRefCount(interp, resultObj);
12146 if (numargs > 2) {
12147 Jim_Free(iters);
12149 return result;
12152 /* [foreach] */
12153 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12155 return JimForeachMapHelper(interp, argc, argv, 0);
12158 /* [lmap] */
12159 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12161 return JimForeachMapHelper(interp, argc, argv, 1);
12164 /* [lassign] */
12165 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12167 int result = JIM_ERR;
12168 int i;
12169 Jim_ListIter iter;
12170 Jim_Obj *resultObj;
12172 if (argc < 2) {
12173 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12174 return JIM_ERR;
12177 JimListIterInit(&iter, argv[1]);
12179 for (i = 2; i < argc; i++) {
12180 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12181 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12182 if (result != JIM_OK) {
12183 return result;
12187 resultObj = Jim_NewListObj(interp, NULL, 0);
12188 while (!JimListIterDone(interp, &iter)) {
12189 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12192 Jim_SetResult(interp, resultObj);
12194 return JIM_OK;
12197 /* [if] */
12198 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12200 int boolean, retval, current = 1, falsebody = 0;
12202 if (argc >= 3) {
12203 while (1) {
12204 /* Far not enough arguments given! */
12205 if (current >= argc)
12206 goto err;
12207 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12208 != JIM_OK)
12209 return retval;
12210 /* There lacks something, isn't it? */
12211 if (current >= argc)
12212 goto err;
12213 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12214 current++;
12215 /* Tsk tsk, no then-clause? */
12216 if (current >= argc)
12217 goto err;
12218 if (boolean)
12219 return Jim_EvalObj(interp, argv[current]);
12220 /* Ok: no else-clause follows */
12221 if (++current >= argc) {
12222 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12223 return JIM_OK;
12225 falsebody = current++;
12226 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12227 /* IIICKS - else-clause isn't last cmd? */
12228 if (current != argc - 1)
12229 goto err;
12230 return Jim_EvalObj(interp, argv[current]);
12232 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12233 /* Ok: elseif follows meaning all the stuff
12234 * again (how boring...) */
12235 continue;
12236 /* OOPS - else-clause is not last cmd? */
12237 else if (falsebody != argc - 1)
12238 goto err;
12239 return Jim_EvalObj(interp, argv[falsebody]);
12241 return JIM_OK;
12243 err:
12244 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12245 return JIM_ERR;
12249 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12250 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12251 Jim_Obj *stringObj, int nocase)
12253 Jim_Obj *parms[4];
12254 int argc = 0;
12255 long eq;
12256 int rc;
12258 parms[argc++] = commandObj;
12259 if (nocase) {
12260 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12262 parms[argc++] = patternObj;
12263 parms[argc++] = stringObj;
12265 rc = Jim_EvalObjVector(interp, argc, parms);
12267 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12268 eq = -rc;
12271 return eq;
12274 enum
12275 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12277 /* [switch] */
12278 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12280 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12281 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12282 Jim_Obj *script = 0;
12284 if (argc < 3) {
12285 wrongnumargs:
12286 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12287 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12288 return JIM_ERR;
12290 for (opt = 1; opt < argc; ++opt) {
12291 const char *option = Jim_String(argv[opt]);
12293 if (*option != '-')
12294 break;
12295 else if (strncmp(option, "--", 2) == 0) {
12296 ++opt;
12297 break;
12299 else if (strncmp(option, "-exact", 2) == 0)
12300 matchOpt = SWITCH_EXACT;
12301 else if (strncmp(option, "-glob", 2) == 0)
12302 matchOpt = SWITCH_GLOB;
12303 else if (strncmp(option, "-regexp", 2) == 0)
12304 matchOpt = SWITCH_RE;
12305 else if (strncmp(option, "-command", 2) == 0) {
12306 matchOpt = SWITCH_CMD;
12307 if ((argc - opt) < 2)
12308 goto wrongnumargs;
12309 command = argv[++opt];
12311 else {
12312 Jim_SetResultFormatted(interp,
12313 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12314 argv[opt]);
12315 return JIM_ERR;
12317 if ((argc - opt) < 2)
12318 goto wrongnumargs;
12320 strObj = argv[opt++];
12321 patCount = argc - opt;
12322 if (patCount == 1) {
12323 Jim_Obj **vector;
12325 JimListGetElements(interp, argv[opt], &patCount, &vector);
12326 caseList = vector;
12328 else
12329 caseList = &argv[opt];
12330 if (patCount == 0 || patCount % 2 != 0)
12331 goto wrongnumargs;
12332 for (i = 0; script == 0 && i < patCount; i += 2) {
12333 Jim_Obj *patObj = caseList[i];
12335 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12336 || i < (patCount - 2)) {
12337 switch (matchOpt) {
12338 case SWITCH_EXACT:
12339 if (Jim_StringEqObj(strObj, patObj))
12340 script = caseList[i + 1];
12341 break;
12342 case SWITCH_GLOB:
12343 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12344 script = caseList[i + 1];
12345 break;
12346 case SWITCH_RE:
12347 command = Jim_NewStringObj(interp, "regexp", -1);
12348 /* Fall thru intentionally */
12349 case SWITCH_CMD:{
12350 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12352 /* After the execution of a command we need to
12353 * make sure to reconvert the object into a list
12354 * again. Only for the single-list style [switch]. */
12355 if (argc - opt == 1) {
12356 Jim_Obj **vector;
12358 JimListGetElements(interp, argv[opt], &patCount, &vector);
12359 caseList = vector;
12361 /* command is here already decref'd */
12362 if (rc < 0) {
12363 return -rc;
12365 if (rc)
12366 script = caseList[i + 1];
12367 break;
12371 else {
12372 script = caseList[i + 1];
12375 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12376 script = caseList[i + 1];
12377 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12378 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12379 return JIM_ERR;
12381 Jim_SetEmptyResult(interp);
12382 if (script) {
12383 return Jim_EvalObj(interp, script);
12385 return JIM_OK;
12388 /* [list] */
12389 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12391 Jim_Obj *listObjPtr;
12393 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12394 Jim_SetResult(interp, listObjPtr);
12395 return JIM_OK;
12398 /* [lindex] */
12399 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12401 Jim_Obj *objPtr, *listObjPtr;
12402 int i;
12403 int idx;
12405 if (argc < 2) {
12406 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12407 return JIM_ERR;
12409 objPtr = argv[1];
12410 Jim_IncrRefCount(objPtr);
12411 for (i = 2; i < argc; i++) {
12412 listObjPtr = objPtr;
12413 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12414 Jim_DecrRefCount(interp, listObjPtr);
12415 return JIM_ERR;
12417 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12418 /* Returns an empty object if the index
12419 * is out of range. */
12420 Jim_DecrRefCount(interp, listObjPtr);
12421 Jim_SetEmptyResult(interp);
12422 return JIM_OK;
12424 Jim_IncrRefCount(objPtr);
12425 Jim_DecrRefCount(interp, listObjPtr);
12427 Jim_SetResult(interp, objPtr);
12428 Jim_DecrRefCount(interp, objPtr);
12429 return JIM_OK;
12432 /* [llength] */
12433 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12435 if (argc != 2) {
12436 Jim_WrongNumArgs(interp, 1, argv, "list");
12437 return JIM_ERR;
12439 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12440 return JIM_OK;
12443 /* [lsearch] */
12444 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12446 static const char * const options[] = {
12447 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12448 NULL
12450 enum
12451 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12452 OPT_COMMAND };
12453 int i;
12454 int opt_bool = 0;
12455 int opt_not = 0;
12456 int opt_nocase = 0;
12457 int opt_all = 0;
12458 int opt_inline = 0;
12459 int opt_match = OPT_EXACT;
12460 int listlen;
12461 int rc = JIM_OK;
12462 Jim_Obj *listObjPtr = NULL;
12463 Jim_Obj *commandObj = NULL;
12465 if (argc < 3) {
12466 wrongargs:
12467 Jim_WrongNumArgs(interp, 1, argv,
12468 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12469 return JIM_ERR;
12472 for (i = 1; i < argc - 2; i++) {
12473 int option;
12475 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12476 return JIM_ERR;
12478 switch (option) {
12479 case OPT_BOOL:
12480 opt_bool = 1;
12481 opt_inline = 0;
12482 break;
12483 case OPT_NOT:
12484 opt_not = 1;
12485 break;
12486 case OPT_NOCASE:
12487 opt_nocase = 1;
12488 break;
12489 case OPT_INLINE:
12490 opt_inline = 1;
12491 opt_bool = 0;
12492 break;
12493 case OPT_ALL:
12494 opt_all = 1;
12495 break;
12496 case OPT_COMMAND:
12497 if (i >= argc - 2) {
12498 goto wrongargs;
12500 commandObj = argv[++i];
12501 /* fallthru */
12502 case OPT_EXACT:
12503 case OPT_GLOB:
12504 case OPT_REGEXP:
12505 opt_match = option;
12506 break;
12510 argv += i;
12512 if (opt_all) {
12513 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12515 if (opt_match == OPT_REGEXP) {
12516 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12518 if (commandObj) {
12519 Jim_IncrRefCount(commandObj);
12522 listlen = Jim_ListLength(interp, argv[0]);
12523 for (i = 0; i < listlen; i++) {
12524 int eq = 0;
12525 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12527 switch (opt_match) {
12528 case OPT_EXACT:
12529 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12530 break;
12532 case OPT_GLOB:
12533 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12534 break;
12536 case OPT_REGEXP:
12537 case OPT_COMMAND:
12538 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12539 if (eq < 0) {
12540 if (listObjPtr) {
12541 Jim_FreeNewObj(interp, listObjPtr);
12543 rc = JIM_ERR;
12544 goto done;
12546 break;
12549 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12550 if (!eq && opt_bool && opt_not && !opt_all) {
12551 continue;
12554 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12555 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12556 Jim_Obj *resultObj;
12558 if (opt_bool) {
12559 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12561 else if (!opt_inline) {
12562 resultObj = Jim_NewIntObj(interp, i);
12564 else {
12565 resultObj = objPtr;
12568 if (opt_all) {
12569 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12571 else {
12572 Jim_SetResult(interp, resultObj);
12573 goto done;
12578 if (opt_all) {
12579 Jim_SetResult(interp, listObjPtr);
12581 else {
12582 /* No match */
12583 if (opt_bool) {
12584 Jim_SetResultBool(interp, opt_not);
12586 else if (!opt_inline) {
12587 Jim_SetResultInt(interp, -1);
12591 done:
12592 if (commandObj) {
12593 Jim_DecrRefCount(interp, commandObj);
12595 return rc;
12598 /* [lappend] */
12599 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12601 Jim_Obj *listObjPtr;
12602 int new_obj = 0;
12603 int i;
12605 if (argc < 2) {
12606 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12607 return JIM_ERR;
12609 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12610 if (!listObjPtr) {
12611 /* Create the list if it does not exist */
12612 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12613 new_obj = 1;
12615 else if (Jim_IsShared(listObjPtr)) {
12616 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12617 new_obj = 1;
12619 for (i = 2; i < argc; i++)
12620 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12621 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12622 if (new_obj)
12623 Jim_FreeNewObj(interp, listObjPtr);
12624 return JIM_ERR;
12626 Jim_SetResult(interp, listObjPtr);
12627 return JIM_OK;
12630 /* [linsert] */
12631 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12633 int idx, len;
12634 Jim_Obj *listPtr;
12636 if (argc < 3) {
12637 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12638 return JIM_ERR;
12640 listPtr = argv[1];
12641 if (Jim_IsShared(listPtr))
12642 listPtr = Jim_DuplicateObj(interp, listPtr);
12643 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12644 goto err;
12645 len = Jim_ListLength(interp, listPtr);
12646 if (idx >= len)
12647 idx = len;
12648 else if (idx < 0)
12649 idx = len + idx + 1;
12650 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12651 Jim_SetResult(interp, listPtr);
12652 return JIM_OK;
12653 err:
12654 if (listPtr != argv[1]) {
12655 Jim_FreeNewObj(interp, listPtr);
12657 return JIM_ERR;
12660 /* [lreplace] */
12661 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12663 int first, last, len, rangeLen;
12664 Jim_Obj *listObj;
12665 Jim_Obj *newListObj;
12667 if (argc < 4) {
12668 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12669 return JIM_ERR;
12671 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12672 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12673 return JIM_ERR;
12676 listObj = argv[1];
12677 len = Jim_ListLength(interp, listObj);
12679 first = JimRelToAbsIndex(len, first);
12680 last = JimRelToAbsIndex(len, last);
12681 JimRelToAbsRange(len, &first, &last, &rangeLen);
12683 /* Now construct a new list which consists of:
12684 * <elements before first> <supplied elements> <elements after last>
12687 /* Check to see if trying to replace past the end of the list */
12688 if (first < len) {
12689 /* OK. Not past the end */
12691 else if (len == 0) {
12692 /* Special for empty list, adjust first to 0 */
12693 first = 0;
12695 else {
12696 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12697 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12698 return JIM_ERR;
12701 /* Add the first set of elements */
12702 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12704 /* Add supplied elements */
12705 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12707 /* Add the remaining elements */
12708 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12710 Jim_SetResult(interp, newListObj);
12711 return JIM_OK;
12714 /* [lset] */
12715 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12717 if (argc < 3) {
12718 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12719 return JIM_ERR;
12721 else if (argc == 3) {
12722 /* With no indexes, simply implements [set] */
12723 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12724 return JIM_ERR;
12725 Jim_SetResult(interp, argv[2]);
12726 return JIM_OK;
12728 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12731 /* [lsort] */
12732 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12734 static const char * const options[] = {
12735 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12737 enum
12738 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12739 Jim_Obj *resObj;
12740 int i;
12741 int retCode;
12743 struct lsort_info info;
12745 if (argc < 2) {
12746 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12747 return JIM_ERR;
12750 info.type = JIM_LSORT_ASCII;
12751 info.order = 1;
12752 info.indexed = 0;
12753 info.unique = 0;
12754 info.command = NULL;
12755 info.interp = interp;
12757 for (i = 1; i < (argc - 1); i++) {
12758 int option;
12760 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12761 != JIM_OK)
12762 return JIM_ERR;
12763 switch (option) {
12764 case OPT_ASCII:
12765 info.type = JIM_LSORT_ASCII;
12766 break;
12767 case OPT_NOCASE:
12768 info.type = JIM_LSORT_NOCASE;
12769 break;
12770 case OPT_INTEGER:
12771 info.type = JIM_LSORT_INTEGER;
12772 break;
12773 case OPT_REAL:
12774 info.type = JIM_LSORT_REAL;
12775 break;
12776 case OPT_INCREASING:
12777 info.order = 1;
12778 break;
12779 case OPT_DECREASING:
12780 info.order = -1;
12781 break;
12782 case OPT_UNIQUE:
12783 info.unique = 1;
12784 break;
12785 case OPT_COMMAND:
12786 if (i >= (argc - 2)) {
12787 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12788 return JIM_ERR;
12790 info.type = JIM_LSORT_COMMAND;
12791 info.command = argv[i + 1];
12792 i++;
12793 break;
12794 case OPT_INDEX:
12795 if (i >= (argc - 2)) {
12796 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12797 return JIM_ERR;
12799 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12800 return JIM_ERR;
12802 info.indexed = 1;
12803 i++;
12804 break;
12807 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12808 retCode = ListSortElements(interp, resObj, &info);
12809 if (retCode == JIM_OK) {
12810 Jim_SetResult(interp, resObj);
12812 else {
12813 Jim_FreeNewObj(interp, resObj);
12815 return retCode;
12818 /* [append] */
12819 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12821 Jim_Obj *stringObjPtr;
12822 int i;
12824 if (argc < 2) {
12825 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12826 return JIM_ERR;
12828 if (argc == 2) {
12829 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12830 if (!stringObjPtr)
12831 return JIM_ERR;
12833 else {
12834 int new_obj = 0;
12835 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12836 if (!stringObjPtr) {
12837 /* Create the string if it doesn't exist */
12838 stringObjPtr = Jim_NewEmptyStringObj(interp);
12839 new_obj = 1;
12841 else if (Jim_IsShared(stringObjPtr)) {
12842 new_obj = 1;
12843 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12845 for (i = 2; i < argc; i++) {
12846 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12848 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12849 if (new_obj) {
12850 Jim_FreeNewObj(interp, stringObjPtr);
12852 return JIM_ERR;
12855 Jim_SetResult(interp, stringObjPtr);
12856 return JIM_OK;
12859 /* [debug] */
12860 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12862 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12863 static const char * const options[] = {
12864 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12865 "exprbc", "show",
12866 NULL
12868 enum
12870 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12871 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12873 int option;
12875 if (argc < 2) {
12876 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12877 return JIM_ERR;
12879 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12880 return JIM_ERR;
12881 if (option == OPT_REFCOUNT) {
12882 if (argc != 3) {
12883 Jim_WrongNumArgs(interp, 2, argv, "object");
12884 return JIM_ERR;
12886 Jim_SetResultInt(interp, argv[2]->refCount);
12887 return JIM_OK;
12889 else if (option == OPT_OBJCOUNT) {
12890 int freeobj = 0, liveobj = 0;
12891 char buf[256];
12892 Jim_Obj *objPtr;
12894 if (argc != 2) {
12895 Jim_WrongNumArgs(interp, 2, argv, "");
12896 return JIM_ERR;
12898 /* Count the number of free objects. */
12899 objPtr = interp->freeList;
12900 while (objPtr) {
12901 freeobj++;
12902 objPtr = objPtr->nextObjPtr;
12904 /* Count the number of live objects. */
12905 objPtr = interp->liveList;
12906 while (objPtr) {
12907 liveobj++;
12908 objPtr = objPtr->nextObjPtr;
12910 /* Set the result string and return. */
12911 sprintf(buf, "free %d used %d", freeobj, liveobj);
12912 Jim_SetResultString(interp, buf, -1);
12913 return JIM_OK;
12915 else if (option == OPT_OBJECTS) {
12916 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12918 /* Count the number of live objects. */
12919 objPtr = interp->liveList;
12920 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12921 while (objPtr) {
12922 char buf[128];
12923 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12925 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12926 sprintf(buf, "%p", objPtr);
12927 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12928 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12929 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12930 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12931 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12932 objPtr = objPtr->nextObjPtr;
12934 Jim_SetResult(interp, listObjPtr);
12935 return JIM_OK;
12937 else if (option == OPT_INVSTR) {
12938 Jim_Obj *objPtr;
12940 if (argc != 3) {
12941 Jim_WrongNumArgs(interp, 2, argv, "object");
12942 return JIM_ERR;
12944 objPtr = argv[2];
12945 if (objPtr->typePtr != NULL)
12946 Jim_InvalidateStringRep(objPtr);
12947 Jim_SetEmptyResult(interp);
12948 return JIM_OK;
12950 else if (option == OPT_SHOW) {
12951 const char *s;
12952 int len, charlen;
12954 if (argc != 3) {
12955 Jim_WrongNumArgs(interp, 2, argv, "object");
12956 return JIM_ERR;
12958 s = Jim_GetString(argv[2], &len);
12959 #ifdef JIM_UTF8
12960 charlen = utf8_strlen(s, len);
12961 #else
12962 charlen = len;
12963 #endif
12964 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12965 printf("chars (%d): <<%s>>\n", charlen, s);
12966 printf("bytes (%d):", len);
12967 while (len--) {
12968 printf(" %02x", (unsigned char)*s++);
12970 printf("\n");
12971 return JIM_OK;
12973 else if (option == OPT_SCRIPTLEN) {
12974 ScriptObj *script;
12976 if (argc != 3) {
12977 Jim_WrongNumArgs(interp, 2, argv, "script");
12978 return JIM_ERR;
12980 script = JimGetScript(interp, argv[2]);
12981 if (script == NULL)
12982 return JIM_ERR;
12983 Jim_SetResultInt(interp, script->len);
12984 return JIM_OK;
12986 else if (option == OPT_EXPRLEN) {
12987 ExprByteCode *expr;
12989 if (argc != 3) {
12990 Jim_WrongNumArgs(interp, 2, argv, "expression");
12991 return JIM_ERR;
12993 expr = JimGetExpression(interp, argv[2]);
12994 if (expr == NULL)
12995 return JIM_ERR;
12996 Jim_SetResultInt(interp, expr->len);
12997 return JIM_OK;
12999 else if (option == OPT_EXPRBC) {
13000 Jim_Obj *objPtr;
13001 ExprByteCode *expr;
13002 int i;
13004 if (argc != 3) {
13005 Jim_WrongNumArgs(interp, 2, argv, "expression");
13006 return JIM_ERR;
13008 expr = JimGetExpression(interp, argv[2]);
13009 if (expr == NULL)
13010 return JIM_ERR;
13011 objPtr = Jim_NewListObj(interp, NULL, 0);
13012 for (i = 0; i < expr->len; i++) {
13013 const char *type;
13014 const Jim_ExprOperator *op;
13015 Jim_Obj *obj = expr->token[i].objPtr;
13017 switch (expr->token[i].type) {
13018 case JIM_TT_EXPR_INT:
13019 type = "int";
13020 break;
13021 case JIM_TT_EXPR_DOUBLE:
13022 type = "double";
13023 break;
13024 case JIM_TT_EXPR_BOOLEAN:
13025 type = "boolean";
13026 break;
13027 case JIM_TT_CMD:
13028 type = "command";
13029 break;
13030 case JIM_TT_VAR:
13031 type = "variable";
13032 break;
13033 case JIM_TT_DICTSUGAR:
13034 type = "dictsugar";
13035 break;
13036 case JIM_TT_EXPRSUGAR:
13037 type = "exprsugar";
13038 break;
13039 case JIM_TT_ESC:
13040 type = "subst";
13041 break;
13042 case JIM_TT_STR:
13043 type = "string";
13044 break;
13045 default:
13046 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
13047 if (op == NULL) {
13048 type = "private";
13050 else {
13051 type = "operator";
13053 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
13054 break;
13056 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
13057 Jim_ListAppendElement(interp, objPtr, obj);
13059 Jim_SetResult(interp, objPtr);
13060 return JIM_OK;
13062 else {
13063 Jim_SetResultString(interp,
13064 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
13065 return JIM_ERR;
13067 /* unreached */
13068 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
13069 #if !defined(JIM_DEBUG_COMMAND)
13070 Jim_SetResultString(interp, "unsupported", -1);
13071 return JIM_ERR;
13072 #endif
13075 /* [eval] */
13076 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13078 int rc;
13080 if (argc < 2) {
13081 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
13082 return JIM_ERR;
13085 if (argc == 2) {
13086 rc = Jim_EvalObj(interp, argv[1]);
13088 else {
13089 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13092 if (rc == JIM_ERR) {
13093 /* eval is "interesting", so add a stack frame here */
13094 interp->addStackTrace++;
13096 return rc;
13099 /* [uplevel] */
13100 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13102 if (argc >= 2) {
13103 int retcode;
13104 Jim_CallFrame *savedCallFrame, *targetCallFrame;
13105 const char *str;
13107 /* Save the old callframe pointer */
13108 savedCallFrame = interp->framePtr;
13110 /* Lookup the target frame pointer */
13111 str = Jim_String(argv[1]);
13112 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
13113 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13114 argc--;
13115 argv++;
13117 else {
13118 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13120 if (targetCallFrame == NULL) {
13121 return JIM_ERR;
13123 if (argc < 2) {
13124 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
13125 return JIM_ERR;
13127 /* Eval the code in the target callframe. */
13128 interp->framePtr = targetCallFrame;
13129 if (argc == 2) {
13130 retcode = Jim_EvalObj(interp, argv[1]);
13132 else {
13133 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13135 interp->framePtr = savedCallFrame;
13136 return retcode;
13138 else {
13139 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
13140 return JIM_ERR;
13144 /* [expr] */
13145 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13147 Jim_Obj *exprResultPtr;
13148 int retcode;
13150 if (argc == 2) {
13151 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
13153 else if (argc > 2) {
13154 Jim_Obj *objPtr;
13156 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13157 Jim_IncrRefCount(objPtr);
13158 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
13159 Jim_DecrRefCount(interp, objPtr);
13161 else {
13162 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13163 return JIM_ERR;
13165 if (retcode != JIM_OK)
13166 return retcode;
13167 Jim_SetResult(interp, exprResultPtr);
13168 Jim_DecrRefCount(interp, exprResultPtr);
13169 return JIM_OK;
13172 /* [break] */
13173 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13175 if (argc != 1) {
13176 Jim_WrongNumArgs(interp, 1, argv, "");
13177 return JIM_ERR;
13179 return JIM_BREAK;
13182 /* [continue] */
13183 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13185 if (argc != 1) {
13186 Jim_WrongNumArgs(interp, 1, argv, "");
13187 return JIM_ERR;
13189 return JIM_CONTINUE;
13192 /* [return] */
13193 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13195 int i;
13196 Jim_Obj *stackTraceObj = NULL;
13197 Jim_Obj *errorCodeObj = NULL;
13198 int returnCode = JIM_OK;
13199 long level = 1;
13201 for (i = 1; i < argc - 1; i += 2) {
13202 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13203 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13204 return JIM_ERR;
13207 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13208 stackTraceObj = argv[i + 1];
13210 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13211 errorCodeObj = argv[i + 1];
13213 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13214 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13215 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13216 return JIM_ERR;
13219 else {
13220 break;
13224 if (i != argc - 1 && i != argc) {
13225 Jim_WrongNumArgs(interp, 1, argv,
13226 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13229 /* If a stack trace is supplied and code is error, set the stack trace */
13230 if (stackTraceObj && returnCode == JIM_ERR) {
13231 JimSetStackTrace(interp, stackTraceObj);
13233 /* If an error code list is supplied, set the global $errorCode */
13234 if (errorCodeObj && returnCode == JIM_ERR) {
13235 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13237 interp->returnCode = returnCode;
13238 interp->returnLevel = level;
13240 if (i == argc - 1) {
13241 Jim_SetResult(interp, argv[i]);
13243 return JIM_RETURN;
13246 /* [tailcall] */
13247 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13249 if (interp->framePtr->level == 0) {
13250 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13251 return JIM_ERR;
13253 else if (argc >= 2) {
13254 /* Need to resolve the tailcall command in the current context */
13255 Jim_CallFrame *cf = interp->framePtr->parent;
13257 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13258 if (cmdPtr == NULL) {
13259 return JIM_ERR;
13262 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13264 /* And stash this pre-resolved command */
13265 JimIncrCmdRefCount(cmdPtr);
13266 cf->tailcallCmd = cmdPtr;
13268 /* And stash the command list */
13269 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13271 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13272 Jim_IncrRefCount(cf->tailcallObj);
13274 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13275 return JIM_EVAL;
13277 return JIM_OK;
13280 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13282 Jim_Obj *cmdList;
13283 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13285 /* prefixListObj is a list to which the args need to be appended */
13286 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13287 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13289 return JimEvalObjList(interp, cmdList);
13292 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13294 Jim_Obj *prefixListObj = privData;
13295 Jim_DecrRefCount(interp, prefixListObj);
13298 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13300 Jim_Obj *prefixListObj;
13301 const char *newname;
13303 if (argc < 3) {
13304 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13305 return JIM_ERR;
13308 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13309 Jim_IncrRefCount(prefixListObj);
13310 newname = Jim_String(argv[1]);
13311 if (newname[0] == ':' && newname[1] == ':') {
13312 while (*++newname == ':') {
13316 Jim_SetResult(interp, argv[1]);
13318 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13321 /* [proc] */
13322 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13324 Jim_Cmd *cmd;
13326 if (argc != 4 && argc != 5) {
13327 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13328 return JIM_ERR;
13331 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13332 return JIM_ERR;
13335 if (argc == 4) {
13336 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13338 else {
13339 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13342 if (cmd) {
13343 /* Add the new command */
13344 Jim_Obj *qualifiedCmdNameObj;
13345 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13347 JimCreateCommand(interp, cmdname, cmd);
13349 /* Calculate and set the namespace for this proc */
13350 JimUpdateProcNamespace(interp, cmd, cmdname);
13352 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13354 /* Unlike Tcl, set the name of the proc as the result */
13355 Jim_SetResult(interp, argv[1]);
13356 return JIM_OK;
13358 return JIM_ERR;
13361 /* [local] */
13362 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13364 int retcode;
13366 if (argc < 2) {
13367 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13368 return JIM_ERR;
13371 /* Evaluate the arguments with 'local' in force */
13372 interp->local++;
13373 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13374 interp->local--;
13377 /* If OK, and the result is a proc, add it to the list of local procs */
13378 if (retcode == 0) {
13379 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13381 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13382 return JIM_ERR;
13384 if (interp->framePtr->localCommands == NULL) {
13385 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13386 Jim_InitStack(interp->framePtr->localCommands);
13388 Jim_IncrRefCount(cmdNameObj);
13389 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13392 return retcode;
13395 /* [upcall] */
13396 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13398 if (argc < 2) {
13399 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13400 return JIM_ERR;
13402 else {
13403 int retcode;
13405 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13406 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13407 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13408 return JIM_ERR;
13410 /* OK. Mark this command as being in an upcall */
13411 cmdPtr->u.proc.upcall++;
13412 JimIncrCmdRefCount(cmdPtr);
13414 /* Invoke the command as normal */
13415 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13417 /* No longer in an upcall */
13418 cmdPtr->u.proc.upcall--;
13419 JimDecrCmdRefCount(interp, cmdPtr);
13421 return retcode;
13425 /* [apply] */
13426 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13428 if (argc < 2) {
13429 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13430 return JIM_ERR;
13432 else {
13433 int ret;
13434 Jim_Cmd *cmd;
13435 Jim_Obj *argListObjPtr;
13436 Jim_Obj *bodyObjPtr;
13437 Jim_Obj *nsObj = NULL;
13438 Jim_Obj **nargv;
13440 int len = Jim_ListLength(interp, argv[1]);
13441 if (len != 2 && len != 3) {
13442 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13443 return JIM_ERR;
13446 if (len == 3) {
13447 #ifdef jim_ext_namespace
13448 /* Need to canonicalise the given namespace. */
13449 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13450 #else
13451 Jim_SetResultString(interp, "namespaces not enabled", -1);
13452 return JIM_ERR;
13453 #endif
13455 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13456 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13458 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13460 if (cmd) {
13461 /* Create a new argv array with a dummy argv[0], for error messages */
13462 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13463 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13464 Jim_IncrRefCount(nargv[0]);
13465 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13466 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13467 Jim_DecrRefCount(interp, nargv[0]);
13468 Jim_Free(nargv);
13470 JimDecrCmdRefCount(interp, cmd);
13471 return ret;
13473 return JIM_ERR;
13478 /* [concat] */
13479 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13481 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13482 return JIM_OK;
13485 /* [upvar] */
13486 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13488 int i;
13489 Jim_CallFrame *targetCallFrame;
13491 /* Lookup the target frame pointer */
13492 if (argc > 3 && (argc % 2 == 0)) {
13493 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13494 argc--;
13495 argv++;
13497 else {
13498 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13500 if (targetCallFrame == NULL) {
13501 return JIM_ERR;
13504 /* Check for arity */
13505 if (argc < 3) {
13506 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13507 return JIM_ERR;
13510 /* Now... for every other/local couple: */
13511 for (i = 1; i < argc; i += 2) {
13512 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13513 return JIM_ERR;
13515 return JIM_OK;
13518 /* [global] */
13519 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13521 int i;
13523 if (argc < 2) {
13524 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13525 return JIM_ERR;
13527 /* Link every var to the toplevel having the same name */
13528 if (interp->framePtr->level == 0)
13529 return JIM_OK; /* global at toplevel... */
13530 for (i = 1; i < argc; i++) {
13531 /* global ::blah does nothing */
13532 const char *name = Jim_String(argv[i]);
13533 if (name[0] != ':' || name[1] != ':') {
13534 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13535 return JIM_ERR;
13538 return JIM_OK;
13541 /* does the [string map] operation. On error NULL is returned,
13542 * otherwise a new string object with the result, having refcount = 0,
13543 * is returned. */
13544 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13545 Jim_Obj *objPtr, int nocase)
13547 int numMaps;
13548 const char *str, *noMatchStart = NULL;
13549 int strLen, i;
13550 Jim_Obj *resultObjPtr;
13552 numMaps = Jim_ListLength(interp, mapListObjPtr);
13553 if (numMaps % 2) {
13554 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13555 return NULL;
13558 str = Jim_String(objPtr);
13559 strLen = Jim_Utf8Length(interp, objPtr);
13561 /* Map it */
13562 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13563 while (strLen) {
13564 for (i = 0; i < numMaps; i += 2) {
13565 Jim_Obj *eachObjPtr;
13566 const char *k;
13567 int kl;
13569 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13570 k = Jim_String(eachObjPtr);
13571 kl = Jim_Utf8Length(interp, eachObjPtr);
13573 if (strLen >= kl && kl) {
13574 int rc;
13575 rc = JimStringCompareLen(str, k, kl, nocase);
13576 if (rc == 0) {
13577 if (noMatchStart) {
13578 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13579 noMatchStart = NULL;
13581 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13582 str += utf8_index(str, kl);
13583 strLen -= kl;
13584 break;
13588 if (i == numMaps) { /* no match */
13589 int c;
13590 if (noMatchStart == NULL)
13591 noMatchStart = str;
13592 str += utf8_tounicode(str, &c);
13593 strLen--;
13596 if (noMatchStart) {
13597 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13599 return resultObjPtr;
13602 /* [string] */
13603 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13605 int len;
13606 int opt_case = 1;
13607 int option;
13608 static const char * const options[] = {
13609 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13610 "map", "repeat", "reverse", "index", "first", "last", "cat",
13611 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13613 enum
13615 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13616 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13617 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13619 static const char * const nocase_options[] = {
13620 "-nocase", NULL
13622 static const char * const nocase_length_options[] = {
13623 "-nocase", "-length", NULL
13626 if (argc < 2) {
13627 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13628 return JIM_ERR;
13630 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13631 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13632 return JIM_ERR;
13634 switch (option) {
13635 case OPT_LENGTH:
13636 case OPT_BYTELENGTH:
13637 if (argc != 3) {
13638 Jim_WrongNumArgs(interp, 2, argv, "string");
13639 return JIM_ERR;
13641 if (option == OPT_LENGTH) {
13642 len = Jim_Utf8Length(interp, argv[2]);
13644 else {
13645 len = Jim_Length(argv[2]);
13647 Jim_SetResultInt(interp, len);
13648 return JIM_OK;
13650 case OPT_CAT:{
13651 Jim_Obj *objPtr;
13652 if (argc == 3) {
13653 /* optimise the one-arg case */
13654 objPtr = argv[2];
13656 else {
13657 int i;
13659 objPtr = Jim_NewStringObj(interp, "", 0);
13661 for (i = 2; i < argc; i++) {
13662 Jim_AppendObj(interp, objPtr, argv[i]);
13665 Jim_SetResult(interp, objPtr);
13666 return JIM_OK;
13669 case OPT_COMPARE:
13670 case OPT_EQUAL:
13672 /* n is the number of remaining option args */
13673 long opt_length = -1;
13674 int n = argc - 4;
13675 int i = 2;
13676 while (n > 0) {
13677 int subopt;
13678 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13679 JIM_ENUM_ABBREV) != JIM_OK) {
13680 badcompareargs:
13681 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13682 return JIM_ERR;
13684 if (subopt == 0) {
13685 /* -nocase */
13686 opt_case = 0;
13687 n--;
13689 else {
13690 /* -length */
13691 if (n < 2) {
13692 goto badcompareargs;
13694 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13695 return JIM_ERR;
13697 n -= 2;
13700 if (n) {
13701 goto badcompareargs;
13703 argv += argc - 2;
13704 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13705 /* Fast version - [string equal], case sensitive, no length */
13706 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13708 else {
13709 if (opt_length >= 0) {
13710 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13712 else {
13713 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13715 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13717 return JIM_OK;
13720 case OPT_MATCH:
13721 if (argc != 4 &&
13722 (argc != 5 ||
13723 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13724 JIM_ENUM_ABBREV) != JIM_OK)) {
13725 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13726 return JIM_ERR;
13728 if (opt_case == 0) {
13729 argv++;
13731 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13732 return JIM_OK;
13734 case OPT_MAP:{
13735 Jim_Obj *objPtr;
13737 if (argc != 4 &&
13738 (argc != 5 ||
13739 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13740 JIM_ENUM_ABBREV) != JIM_OK)) {
13741 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13742 return JIM_ERR;
13745 if (opt_case == 0) {
13746 argv++;
13748 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13749 if (objPtr == NULL) {
13750 return JIM_ERR;
13752 Jim_SetResult(interp, objPtr);
13753 return JIM_OK;
13756 case OPT_RANGE:
13757 case OPT_BYTERANGE:{
13758 Jim_Obj *objPtr;
13760 if (argc != 5) {
13761 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13762 return JIM_ERR;
13764 if (option == OPT_RANGE) {
13765 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13767 else
13769 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13772 if (objPtr == NULL) {
13773 return JIM_ERR;
13775 Jim_SetResult(interp, objPtr);
13776 return JIM_OK;
13779 case OPT_REPLACE:{
13780 Jim_Obj *objPtr;
13782 if (argc != 5 && argc != 6) {
13783 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13784 return JIM_ERR;
13786 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13787 if (objPtr == NULL) {
13788 return JIM_ERR;
13790 Jim_SetResult(interp, objPtr);
13791 return JIM_OK;
13795 case OPT_REPEAT:{
13796 Jim_Obj *objPtr;
13797 jim_wide count;
13799 if (argc != 4) {
13800 Jim_WrongNumArgs(interp, 2, argv, "string count");
13801 return JIM_ERR;
13803 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13804 return JIM_ERR;
13806 objPtr = Jim_NewStringObj(interp, "", 0);
13807 if (count > 0) {
13808 while (count--) {
13809 Jim_AppendObj(interp, objPtr, argv[2]);
13812 Jim_SetResult(interp, objPtr);
13813 return JIM_OK;
13816 case OPT_REVERSE:{
13817 char *buf, *p;
13818 const char *str;
13819 int i;
13821 if (argc != 3) {
13822 Jim_WrongNumArgs(interp, 2, argv, "string");
13823 return JIM_ERR;
13826 str = Jim_GetString(argv[2], &len);
13827 buf = Jim_Alloc(len + 1);
13828 p = buf + len;
13829 *p = 0;
13830 for (i = 0; i < len; ) {
13831 int c;
13832 int l = utf8_tounicode(str, &c);
13833 memcpy(p - l, str, l);
13834 p -= l;
13835 i += l;
13836 str += l;
13838 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13839 return JIM_OK;
13842 case OPT_INDEX:{
13843 int idx;
13844 const char *str;
13846 if (argc != 4) {
13847 Jim_WrongNumArgs(interp, 2, argv, "string index");
13848 return JIM_ERR;
13850 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13851 return JIM_ERR;
13853 str = Jim_String(argv[2]);
13854 len = Jim_Utf8Length(interp, argv[2]);
13855 if (idx != INT_MIN && idx != INT_MAX) {
13856 idx = JimRelToAbsIndex(len, idx);
13858 if (idx < 0 || idx >= len || str == NULL) {
13859 Jim_SetResultString(interp, "", 0);
13861 else if (len == Jim_Length(argv[2])) {
13862 /* ASCII optimisation */
13863 Jim_SetResultString(interp, str + idx, 1);
13865 else {
13866 int c;
13867 int i = utf8_index(str, idx);
13868 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13870 return JIM_OK;
13873 case OPT_FIRST:
13874 case OPT_LAST:{
13875 int idx = 0, l1, l2;
13876 const char *s1, *s2;
13878 if (argc != 4 && argc != 5) {
13879 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13880 return JIM_ERR;
13882 s1 = Jim_String(argv[2]);
13883 s2 = Jim_String(argv[3]);
13884 l1 = Jim_Utf8Length(interp, argv[2]);
13885 l2 = Jim_Utf8Length(interp, argv[3]);
13886 if (argc == 5) {
13887 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13888 return JIM_ERR;
13890 idx = JimRelToAbsIndex(l2, idx);
13892 else if (option == OPT_LAST) {
13893 idx = l2;
13895 if (option == OPT_FIRST) {
13896 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13898 else {
13899 #ifdef JIM_UTF8
13900 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13901 #else
13902 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13903 #endif
13905 return JIM_OK;
13908 case OPT_TRIM:
13909 case OPT_TRIMLEFT:
13910 case OPT_TRIMRIGHT:{
13911 Jim_Obj *trimchars;
13913 if (argc != 3 && argc != 4) {
13914 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13915 return JIM_ERR;
13917 trimchars = (argc == 4 ? argv[3] : NULL);
13918 if (option == OPT_TRIM) {
13919 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13921 else if (option == OPT_TRIMLEFT) {
13922 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13924 else if (option == OPT_TRIMRIGHT) {
13925 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13927 return JIM_OK;
13930 case OPT_TOLOWER:
13931 case OPT_TOUPPER:
13932 case OPT_TOTITLE:
13933 if (argc != 3) {
13934 Jim_WrongNumArgs(interp, 2, argv, "string");
13935 return JIM_ERR;
13937 if (option == OPT_TOLOWER) {
13938 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13940 else if (option == OPT_TOUPPER) {
13941 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13943 else {
13944 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13946 return JIM_OK;
13948 case OPT_IS:
13949 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13950 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13952 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13953 return JIM_ERR;
13955 return JIM_OK;
13958 /* [time] */
13959 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13961 long i, count = 1;
13962 jim_wide start, elapsed;
13963 char buf[60];
13964 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13966 if (argc < 2) {
13967 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13968 return JIM_ERR;
13970 if (argc == 3) {
13971 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13972 return JIM_ERR;
13974 if (count < 0)
13975 return JIM_OK;
13976 i = count;
13977 start = JimClock();
13978 while (i-- > 0) {
13979 int retval;
13981 retval = Jim_EvalObj(interp, argv[1]);
13982 if (retval != JIM_OK) {
13983 return retval;
13986 elapsed = JimClock() - start;
13987 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13988 Jim_SetResultString(interp, buf, -1);
13989 return JIM_OK;
13992 /* [exit] */
13993 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13995 long exitCode = 0;
13997 if (argc > 2) {
13998 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13999 return JIM_ERR;
14001 if (argc == 2) {
14002 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
14003 return JIM_ERR;
14005 interp->exitCode = exitCode;
14006 return JIM_EXIT;
14009 /* [catch] */
14010 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14012 int exitCode = 0;
14013 int i;
14014 int sig = 0;
14016 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
14017 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
14018 static const int max_ignore_code = sizeof(ignore_mask) * 8;
14020 /* Reset the error code before catch.
14021 * Note that this is not strictly correct.
14023 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
14025 for (i = 1; i < argc - 1; i++) {
14026 const char *arg = Jim_String(argv[i]);
14027 jim_wide option;
14028 int ignore;
14030 /* It's a pity we can't use Jim_GetEnum here :-( */
14031 if (strcmp(arg, "--") == 0) {
14032 i++;
14033 break;
14035 if (*arg != '-') {
14036 break;
14039 if (strncmp(arg, "-no", 3) == 0) {
14040 arg += 3;
14041 ignore = 1;
14043 else {
14044 arg++;
14045 ignore = 0;
14048 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
14049 option = -1;
14051 if (option < 0) {
14052 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
14054 if (option < 0) {
14055 goto wrongargs;
14058 if (ignore) {
14059 ignore_mask |= ((jim_wide)1 << option);
14061 else {
14062 ignore_mask &= (~((jim_wide)1 << option));
14066 argc -= i;
14067 if (argc < 1 || argc > 3) {
14068 wrongargs:
14069 Jim_WrongNumArgs(interp, 1, argv,
14070 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
14071 return JIM_ERR;
14073 argv += i;
14075 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
14076 sig++;
14079 interp->signal_level += sig;
14080 if (Jim_CheckSignal(interp)) {
14081 /* If a signal is set, don't even try to execute the body */
14082 exitCode = JIM_SIGNAL;
14084 else {
14085 exitCode = Jim_EvalObj(interp, argv[0]);
14086 /* Don't want any caught error included in a later stack trace */
14087 interp->errorFlag = 0;
14089 interp->signal_level -= sig;
14091 /* Catch or pass through? Only the first 32/64 codes can be passed through */
14092 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
14093 /* Not caught, pass it up */
14094 return exitCode;
14097 if (sig && exitCode == JIM_SIGNAL) {
14098 /* Catch the signal at this level */
14099 if (interp->signal_set_result) {
14100 interp->signal_set_result(interp, interp->sigmask);
14102 else {
14103 Jim_SetResultInt(interp, interp->sigmask);
14105 interp->sigmask = 0;
14108 if (argc >= 2) {
14109 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
14110 return JIM_ERR;
14112 if (argc == 3) {
14113 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
14115 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
14116 Jim_ListAppendElement(interp, optListObj,
14117 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
14118 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
14119 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
14120 if (exitCode == JIM_ERR) {
14121 Jim_Obj *errorCode;
14122 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
14123 -1));
14124 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
14126 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
14127 if (errorCode) {
14128 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
14129 Jim_ListAppendElement(interp, optListObj, errorCode);
14132 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
14133 return JIM_ERR;
14137 Jim_SetResultInt(interp, exitCode);
14138 return JIM_OK;
14141 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
14143 /* [ref] */
14144 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14146 if (argc != 3 && argc != 4) {
14147 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
14148 return JIM_ERR;
14150 if (argc == 3) {
14151 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
14153 else {
14154 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
14156 return JIM_OK;
14159 /* [getref] */
14160 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14162 Jim_Reference *refPtr;
14164 if (argc != 2) {
14165 Jim_WrongNumArgs(interp, 1, argv, "reference");
14166 return JIM_ERR;
14168 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14169 return JIM_ERR;
14170 Jim_SetResult(interp, refPtr->objPtr);
14171 return JIM_OK;
14174 /* [setref] */
14175 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14177 Jim_Reference *refPtr;
14179 if (argc != 3) {
14180 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14181 return JIM_ERR;
14183 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14184 return JIM_ERR;
14185 Jim_IncrRefCount(argv[2]);
14186 Jim_DecrRefCount(interp, refPtr->objPtr);
14187 refPtr->objPtr = argv[2];
14188 Jim_SetResult(interp, argv[2]);
14189 return JIM_OK;
14192 /* [collect] */
14193 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14195 if (argc != 1) {
14196 Jim_WrongNumArgs(interp, 1, argv, "");
14197 return JIM_ERR;
14199 Jim_SetResultInt(interp, Jim_Collect(interp));
14201 /* Free all the freed objects. */
14202 while (interp->freeList) {
14203 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14204 Jim_Free(interp->freeList);
14205 interp->freeList = nextObjPtr;
14208 return JIM_OK;
14211 /* [finalize] reference ?newValue? */
14212 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14214 if (argc != 2 && argc != 3) {
14215 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14216 return JIM_ERR;
14218 if (argc == 2) {
14219 Jim_Obj *cmdNamePtr;
14221 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14222 return JIM_ERR;
14223 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14224 Jim_SetResult(interp, cmdNamePtr);
14226 else {
14227 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14228 return JIM_ERR;
14229 Jim_SetResult(interp, argv[2]);
14231 return JIM_OK;
14234 /* [info references] */
14235 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14237 Jim_Obj *listObjPtr;
14238 Jim_HashTableIterator htiter;
14239 Jim_HashEntry *he;
14241 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14243 JimInitHashTableIterator(&interp->references, &htiter);
14244 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14245 char buf[JIM_REFERENCE_SPACE + 1];
14246 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14247 const unsigned long *refId = he->key;
14249 JimFormatReference(buf, refPtr, *refId);
14250 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14252 Jim_SetResult(interp, listObjPtr);
14253 return JIM_OK;
14255 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14257 /* [rename] */
14258 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14260 if (argc != 3) {
14261 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14262 return JIM_ERR;
14265 if (JimValidName(interp, "new procedure", argv[2])) {
14266 return JIM_ERR;
14269 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14272 #define JIM_DICTMATCH_VALUES 0x0001
14274 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14276 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14278 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14279 if (type & JIM_DICTMATCH_VALUES) {
14280 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14285 * Like JimHashtablePatternMatch, but for dictionaries.
14287 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14288 JimDictMatchCallbackType *callback, int type)
14290 Jim_HashEntry *he;
14291 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14293 /* Check for the non-pattern case. We can do this much more efficiently. */
14294 Jim_HashTableIterator htiter;
14295 JimInitHashTableIterator(ht, &htiter);
14296 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14297 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14298 callback(interp, listObjPtr, he, type);
14302 return listObjPtr;
14306 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14308 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14309 return JIM_ERR;
14311 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14312 return JIM_OK;
14315 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14317 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14318 return JIM_ERR;
14320 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14321 return JIM_OK;
14324 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14326 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14327 return -1;
14329 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14332 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14334 Jim_HashTable *ht;
14335 unsigned int i;
14337 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14338 return JIM_ERR;
14341 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14343 /* Note that this uses internal knowledge of the hash table */
14344 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14346 for (i = 0; i < ht->size; i++) {
14347 Jim_HashEntry *he = ht->table[i];
14349 if (he) {
14350 printf("%d: ", i);
14352 while (he) {
14353 printf(" %s", Jim_String(he->key));
14354 he = he->next;
14356 printf("\n");
14359 return JIM_OK;
14362 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14364 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14366 Jim_AppendString(interp, prefixObj, " ", 1);
14367 Jim_AppendString(interp, prefixObj, subcmd, -1);
14369 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14372 /* [dict] */
14373 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14375 Jim_Obj *objPtr;
14376 int option;
14377 static const char * const options[] = {
14378 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14379 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14380 "replace", "update", NULL
14382 enum
14384 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14385 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14386 OPT_REPLACE, OPT_UPDATE,
14389 if (argc < 2) {
14390 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14391 return JIM_ERR;
14394 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14395 return JIM_ERR;
14398 switch (option) {
14399 case OPT_GET:
14400 if (argc < 3) {
14401 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14402 return JIM_ERR;
14404 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14405 JIM_ERRMSG) != JIM_OK) {
14406 return JIM_ERR;
14408 Jim_SetResult(interp, objPtr);
14409 return JIM_OK;
14411 case OPT_SET:
14412 if (argc < 5) {
14413 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14414 return JIM_ERR;
14416 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14418 case OPT_EXISTS:
14419 if (argc < 4) {
14420 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14421 return JIM_ERR;
14423 else {
14424 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14425 if (rc < 0) {
14426 return JIM_ERR;
14428 Jim_SetResultBool(interp, rc == JIM_OK);
14429 return JIM_OK;
14432 case OPT_UNSET:
14433 if (argc < 4) {
14434 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14435 return JIM_ERR;
14437 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14438 return JIM_ERR;
14440 return JIM_OK;
14442 case OPT_KEYS:
14443 if (argc != 3 && argc != 4) {
14444 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14445 return JIM_ERR;
14447 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14449 case OPT_SIZE:
14450 if (argc != 3) {
14451 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14452 return JIM_ERR;
14454 else if (Jim_DictSize(interp, argv[2]) < 0) {
14455 return JIM_ERR;
14457 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14458 return JIM_OK;
14460 case OPT_MERGE:
14461 if (argc == 2) {
14462 return JIM_OK;
14464 if (Jim_DictSize(interp, argv[2]) < 0) {
14465 return JIM_ERR;
14467 /* Handle as ensemble */
14468 break;
14470 case OPT_UPDATE:
14471 if (argc < 6 || argc % 2) {
14472 /* Better error message */
14473 argc = 2;
14475 break;
14477 case OPT_CREATE:
14478 if (argc % 2) {
14479 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14480 return JIM_ERR;
14482 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14483 Jim_SetResult(interp, objPtr);
14484 return JIM_OK;
14486 case OPT_INFO:
14487 if (argc != 3) {
14488 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14489 return JIM_ERR;
14491 return Jim_DictInfo(interp, argv[2]);
14493 /* Handle command as an ensemble */
14494 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14497 /* [subst] */
14498 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14500 static const char * const options[] = {
14501 "-nobackslashes", "-nocommands", "-novariables", NULL
14503 enum
14504 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14505 int i;
14506 int flags = JIM_SUBST_FLAG;
14507 Jim_Obj *objPtr;
14509 if (argc < 2) {
14510 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14511 return JIM_ERR;
14513 for (i = 1; i < (argc - 1); i++) {
14514 int option;
14516 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14517 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14518 return JIM_ERR;
14520 switch (option) {
14521 case OPT_NOBACKSLASHES:
14522 flags |= JIM_SUBST_NOESC;
14523 break;
14524 case OPT_NOCOMMANDS:
14525 flags |= JIM_SUBST_NOCMD;
14526 break;
14527 case OPT_NOVARIABLES:
14528 flags |= JIM_SUBST_NOVAR;
14529 break;
14532 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14533 return JIM_ERR;
14535 Jim_SetResult(interp, objPtr);
14536 return JIM_OK;
14539 /* [info] */
14540 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14542 int cmd;
14543 Jim_Obj *objPtr;
14544 int mode = 0;
14546 static const char * const commands[] = {
14547 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14548 "vars", "version", "patchlevel", "complete", "args", "hostname",
14549 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14550 "references", "alias", NULL
14552 enum
14553 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14554 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14555 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14556 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14559 #ifdef jim_ext_namespace
14560 int nons = 0;
14562 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14563 /* This is for internal use only */
14564 argc--;
14565 argv++;
14566 nons = 1;
14568 #endif
14570 if (argc < 2) {
14571 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14572 return JIM_ERR;
14574 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14575 != JIM_OK) {
14576 return JIM_ERR;
14579 /* Test for the most common commands first, just in case it makes a difference */
14580 switch (cmd) {
14581 case INFO_EXISTS:
14582 if (argc != 3) {
14583 Jim_WrongNumArgs(interp, 2, argv, "varName");
14584 return JIM_ERR;
14586 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14587 break;
14589 case INFO_ALIAS:{
14590 Jim_Cmd *cmdPtr;
14592 if (argc != 3) {
14593 Jim_WrongNumArgs(interp, 2, argv, "command");
14594 return JIM_ERR;
14596 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14597 return JIM_ERR;
14599 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14600 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14601 return JIM_ERR;
14603 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14604 return JIM_OK;
14607 case INFO_CHANNELS:
14608 mode++; /* JIM_CMDLIST_CHANNELS */
14609 #ifndef jim_ext_aio
14610 Jim_SetResultString(interp, "aio not enabled", -1);
14611 return JIM_ERR;
14612 #endif
14613 /* fall through */
14614 case INFO_PROCS:
14615 mode++; /* JIM_CMDLIST_PROCS */
14616 /* fall through */
14617 case INFO_COMMANDS:
14618 /* mode 0 => JIM_CMDLIST_COMMANDS */
14619 if (argc != 2 && argc != 3) {
14620 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14621 return JIM_ERR;
14623 #ifdef jim_ext_namespace
14624 if (!nons) {
14625 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14626 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14629 #endif
14630 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14631 break;
14633 case INFO_VARS:
14634 mode++; /* JIM_VARLIST_VARS */
14635 /* fall through */
14636 case INFO_LOCALS:
14637 mode++; /* JIM_VARLIST_LOCALS */
14638 /* fall through */
14639 case INFO_GLOBALS:
14640 /* mode 0 => JIM_VARLIST_GLOBALS */
14641 if (argc != 2 && argc != 3) {
14642 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14643 return JIM_ERR;
14645 #ifdef jim_ext_namespace
14646 if (!nons) {
14647 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14648 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14651 #endif
14652 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14653 break;
14655 case INFO_SCRIPT:
14656 if (argc != 2) {
14657 Jim_WrongNumArgs(interp, 2, argv, "");
14658 return JIM_ERR;
14660 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14661 break;
14663 case INFO_SOURCE:{
14664 jim_wide line;
14665 Jim_Obj *resObjPtr;
14666 Jim_Obj *fileNameObj;
14668 if (argc != 3 && argc != 5) {
14669 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14670 return JIM_ERR;
14672 if (argc == 5) {
14673 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14674 return JIM_ERR;
14676 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14677 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14679 else {
14680 if (argv[2]->typePtr == &sourceObjType) {
14681 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14682 line = argv[2]->internalRep.sourceValue.lineNumber;
14684 else if (argv[2]->typePtr == &scriptObjType) {
14685 ScriptObj *script = JimGetScript(interp, argv[2]);
14686 fileNameObj = script->fileNameObj;
14687 line = script->firstline;
14689 else {
14690 fileNameObj = interp->emptyObj;
14691 line = 1;
14693 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14694 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14695 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14697 Jim_SetResult(interp, resObjPtr);
14698 break;
14701 case INFO_STACKTRACE:
14702 Jim_SetResult(interp, interp->stackTrace);
14703 break;
14705 case INFO_LEVEL:
14706 case INFO_FRAME:
14707 switch (argc) {
14708 case 2:
14709 Jim_SetResultInt(interp, interp->framePtr->level);
14710 break;
14712 case 3:
14713 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14714 return JIM_ERR;
14716 Jim_SetResult(interp, objPtr);
14717 break;
14719 default:
14720 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14721 return JIM_ERR;
14723 break;
14725 case INFO_BODY:
14726 case INFO_STATICS:
14727 case INFO_ARGS:{
14728 Jim_Cmd *cmdPtr;
14730 if (argc != 3) {
14731 Jim_WrongNumArgs(interp, 2, argv, "procname");
14732 return JIM_ERR;
14734 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14735 return JIM_ERR;
14737 if (!cmdPtr->isproc) {
14738 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14739 return JIM_ERR;
14741 switch (cmd) {
14742 case INFO_BODY:
14743 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14744 break;
14745 case INFO_ARGS:
14746 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14747 break;
14748 case INFO_STATICS:
14749 if (cmdPtr->u.proc.staticVars) {
14750 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14751 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14753 break;
14755 break;
14758 case INFO_VERSION:
14759 case INFO_PATCHLEVEL:{
14760 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14762 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14763 Jim_SetResultString(interp, buf, -1);
14764 break;
14767 case INFO_COMPLETE:
14768 if (argc != 3 && argc != 4) {
14769 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14770 return JIM_ERR;
14772 else {
14773 char missing;
14775 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14776 if (missing != ' ' && argc == 4) {
14777 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14780 break;
14782 case INFO_HOSTNAME:
14783 /* Redirect to os.gethostname if it exists */
14784 return Jim_Eval(interp, "os.gethostname");
14786 case INFO_NAMEOFEXECUTABLE:
14787 /* Redirect to Tcl proc */
14788 return Jim_Eval(interp, "{info nameofexecutable}");
14790 case INFO_RETURNCODES:
14791 if (argc == 2) {
14792 int i;
14793 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14795 for (i = 0; jimReturnCodes[i]; i++) {
14796 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14797 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14798 jimReturnCodes[i], -1));
14801 Jim_SetResult(interp, listObjPtr);
14803 else if (argc == 3) {
14804 long code;
14805 const char *name;
14807 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14808 return JIM_ERR;
14810 name = Jim_ReturnCode(code);
14811 if (*name == '?') {
14812 Jim_SetResultInt(interp, code);
14814 else {
14815 Jim_SetResultString(interp, name, -1);
14818 else {
14819 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14820 return JIM_ERR;
14822 break;
14823 case INFO_REFERENCES:
14824 #ifdef JIM_REFERENCES
14825 return JimInfoReferences(interp, argc, argv);
14826 #else
14827 Jim_SetResultString(interp, "not supported", -1);
14828 return JIM_ERR;
14829 #endif
14831 return JIM_OK;
14834 /* [exists] */
14835 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14837 Jim_Obj *objPtr;
14838 int result = 0;
14840 static const char * const options[] = {
14841 "-command", "-proc", "-alias", "-var", NULL
14843 enum
14845 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14847 int option;
14849 if (argc == 2) {
14850 option = OPT_VAR;
14851 objPtr = argv[1];
14853 else if (argc == 3) {
14854 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14855 return JIM_ERR;
14857 objPtr = argv[2];
14859 else {
14860 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14861 return JIM_ERR;
14864 if (option == OPT_VAR) {
14865 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14867 else {
14868 /* Now different kinds of commands */
14869 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14871 if (cmd) {
14872 switch (option) {
14873 case OPT_COMMAND:
14874 result = 1;
14875 break;
14877 case OPT_ALIAS:
14878 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14879 break;
14881 case OPT_PROC:
14882 result = cmd->isproc;
14883 break;
14887 Jim_SetResultBool(interp, result);
14888 return JIM_OK;
14891 /* [split] */
14892 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14894 const char *str, *splitChars, *noMatchStart;
14895 int splitLen, strLen;
14896 Jim_Obj *resObjPtr;
14897 int c;
14898 int len;
14900 if (argc != 2 && argc != 3) {
14901 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14902 return JIM_ERR;
14905 str = Jim_GetString(argv[1], &len);
14906 if (len == 0) {
14907 return JIM_OK;
14909 strLen = Jim_Utf8Length(interp, argv[1]);
14911 /* Init */
14912 if (argc == 2) {
14913 splitChars = " \n\t\r";
14914 splitLen = 4;
14916 else {
14917 splitChars = Jim_String(argv[2]);
14918 splitLen = Jim_Utf8Length(interp, argv[2]);
14921 noMatchStart = str;
14922 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14924 /* Split */
14925 if (splitLen) {
14926 Jim_Obj *objPtr;
14927 while (strLen--) {
14928 const char *sc = splitChars;
14929 int scLen = splitLen;
14930 int sl = utf8_tounicode(str, &c);
14931 while (scLen--) {
14932 int pc;
14933 sc += utf8_tounicode(sc, &pc);
14934 if (c == pc) {
14935 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14936 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14937 noMatchStart = str + sl;
14938 break;
14941 str += sl;
14943 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14944 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14946 else {
14947 /* This handles the special case of splitchars eq {}
14948 * Optimise by sharing common (ASCII) characters
14950 Jim_Obj **commonObj = NULL;
14951 #define NUM_COMMON (128 - 9)
14952 while (strLen--) {
14953 int n = utf8_tounicode(str, &c);
14954 #ifdef JIM_OPTIMIZATION
14955 if (c >= 9 && c < 128) {
14956 /* Common ASCII char. Note that 9 is the tab character */
14957 c -= 9;
14958 if (!commonObj) {
14959 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14960 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14962 if (!commonObj[c]) {
14963 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14965 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14966 str++;
14967 continue;
14969 #endif
14970 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14971 str += n;
14973 Jim_Free(commonObj);
14976 Jim_SetResult(interp, resObjPtr);
14977 return JIM_OK;
14980 /* [join] */
14981 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14983 const char *joinStr;
14984 int joinStrLen;
14986 if (argc != 2 && argc != 3) {
14987 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14988 return JIM_ERR;
14990 /* Init */
14991 if (argc == 2) {
14992 joinStr = " ";
14993 joinStrLen = 1;
14995 else {
14996 joinStr = Jim_GetString(argv[2], &joinStrLen);
14998 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14999 return JIM_OK;
15002 /* [format] */
15003 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15005 Jim_Obj *objPtr;
15007 if (argc < 2) {
15008 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
15009 return JIM_ERR;
15011 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
15012 if (objPtr == NULL)
15013 return JIM_ERR;
15014 Jim_SetResult(interp, objPtr);
15015 return JIM_OK;
15018 /* [scan] */
15019 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15021 Jim_Obj *listPtr, **outVec;
15022 int outc, i;
15024 if (argc < 3) {
15025 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
15026 return JIM_ERR;
15028 if (argv[2]->typePtr != &scanFmtStringObjType)
15029 SetScanFmtFromAny(interp, argv[2]);
15030 if (FormatGetError(argv[2]) != 0) {
15031 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
15032 return JIM_ERR;
15034 if (argc > 3) {
15035 int maxPos = FormatGetMaxPos(argv[2]);
15036 int count = FormatGetCnvCount(argv[2]);
15038 if (maxPos > argc - 3) {
15039 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
15040 return JIM_ERR;
15042 else if (count > argc - 3) {
15043 Jim_SetResultString(interp, "different numbers of variable names and "
15044 "field specifiers", -1);
15045 return JIM_ERR;
15047 else if (count < argc - 3) {
15048 Jim_SetResultString(interp, "variable is not assigned by any "
15049 "conversion specifiers", -1);
15050 return JIM_ERR;
15053 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
15054 if (listPtr == 0)
15055 return JIM_ERR;
15056 if (argc > 3) {
15057 int rc = JIM_OK;
15058 int count = 0;
15060 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
15061 int len = Jim_ListLength(interp, listPtr);
15063 if (len != 0) {
15064 JimListGetElements(interp, listPtr, &outc, &outVec);
15065 for (i = 0; i < outc; ++i) {
15066 if (Jim_Length(outVec[i]) > 0) {
15067 ++count;
15068 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
15069 rc = JIM_ERR;
15074 Jim_FreeNewObj(interp, listPtr);
15076 else {
15077 count = -1;
15079 if (rc == JIM_OK) {
15080 Jim_SetResultInt(interp, count);
15082 return rc;
15084 else {
15085 if (listPtr == (Jim_Obj *)EOF) {
15086 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
15087 return JIM_OK;
15089 Jim_SetResult(interp, listPtr);
15091 return JIM_OK;
15094 /* [error] */
15095 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15097 if (argc != 2 && argc != 3) {
15098 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
15099 return JIM_ERR;
15101 Jim_SetResult(interp, argv[1]);
15102 if (argc == 3) {
15103 JimSetStackTrace(interp, argv[2]);
15104 return JIM_ERR;
15106 interp->addStackTrace++;
15107 return JIM_ERR;
15110 /* [lrange] */
15111 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15113 Jim_Obj *objPtr;
15115 if (argc != 4) {
15116 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15117 return JIM_ERR;
15119 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15120 return JIM_ERR;
15121 Jim_SetResult(interp, objPtr);
15122 return JIM_OK;
15125 /* [lrepeat] */
15126 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15128 Jim_Obj *objPtr;
15129 long count;
15131 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15132 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15133 return JIM_ERR;
15136 if (count == 0 || argc == 2) {
15137 return JIM_OK;
15140 argc -= 2;
15141 argv += 2;
15143 objPtr = Jim_NewListObj(interp, argv, argc);
15144 while (--count) {
15145 ListInsertElements(objPtr, -1, argc, argv);
15148 Jim_SetResult(interp, objPtr);
15149 return JIM_OK;
15152 char **Jim_GetEnviron(void)
15154 #if defined(HAVE__NSGETENVIRON)
15155 return *_NSGetEnviron();
15156 #else
15157 #if !defined(NO_ENVIRON_EXTERN)
15158 extern char **environ;
15159 #endif
15161 return environ;
15162 #endif
15165 void Jim_SetEnviron(char **env)
15167 #if defined(HAVE__NSGETENVIRON)
15168 *_NSGetEnviron() = env;
15169 #else
15170 #if !defined(NO_ENVIRON_EXTERN)
15171 extern char **environ;
15172 #endif
15174 environ = env;
15175 #endif
15178 /* [env] */
15179 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15181 const char *key;
15182 const char *val;
15184 if (argc == 1) {
15185 char **e = Jim_GetEnviron();
15187 int i;
15188 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15190 for (i = 0; e[i]; i++) {
15191 const char *equals = strchr(e[i], '=');
15193 if (equals) {
15194 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15195 equals - e[i]));
15196 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15200 Jim_SetResult(interp, listObjPtr);
15201 return JIM_OK;
15204 if (argc < 2) {
15205 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15206 return JIM_ERR;
15208 key = Jim_String(argv[1]);
15209 val = getenv(key);
15210 if (val == NULL) {
15211 if (argc < 3) {
15212 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15213 return JIM_ERR;
15215 val = Jim_String(argv[2]);
15217 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15218 return JIM_OK;
15221 /* [source] */
15222 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15224 int retval;
15226 if (argc != 2) {
15227 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15228 return JIM_ERR;
15230 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15231 if (retval == JIM_RETURN)
15232 return JIM_OK;
15233 return retval;
15236 /* [lreverse] */
15237 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15239 Jim_Obj *revObjPtr, **ele;
15240 int len;
15242 if (argc != 2) {
15243 Jim_WrongNumArgs(interp, 1, argv, "list");
15244 return JIM_ERR;
15246 JimListGetElements(interp, argv[1], &len, &ele);
15247 len--;
15248 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15249 while (len >= 0)
15250 ListAppendElement(revObjPtr, ele[len--]);
15251 Jim_SetResult(interp, revObjPtr);
15252 return JIM_OK;
15255 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15257 jim_wide len;
15259 if (step == 0)
15260 return -1;
15261 if (start == end)
15262 return 0;
15263 else if (step > 0 && start > end)
15264 return -1;
15265 else if (step < 0 && end > start)
15266 return -1;
15267 len = end - start;
15268 if (len < 0)
15269 len = -len; /* abs(len) */
15270 if (step < 0)
15271 step = -step; /* abs(step) */
15272 len = 1 + ((len - 1) / step);
15273 /* We can truncate safely to INT_MAX, the range command
15274 * will always return an error for a such long range
15275 * because Tcl lists can't be so long. */
15276 if (len > INT_MAX)
15277 len = INT_MAX;
15278 return (int)((len < 0) ? -1 : len);
15281 /* [range] */
15282 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15284 jim_wide start = 0, end, step = 1;
15285 int len, i;
15286 Jim_Obj *objPtr;
15288 if (argc < 2 || argc > 4) {
15289 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15290 return JIM_ERR;
15292 if (argc == 2) {
15293 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15294 return JIM_ERR;
15296 else {
15297 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15298 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15299 return JIM_ERR;
15300 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15301 return JIM_ERR;
15303 if ((len = JimRangeLen(start, end, step)) == -1) {
15304 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15305 return JIM_ERR;
15307 objPtr = Jim_NewListObj(interp, NULL, 0);
15308 for (i = 0; i < len; i++)
15309 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15310 Jim_SetResult(interp, objPtr);
15311 return JIM_OK;
15314 /* [rand] */
15315 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15317 jim_wide min = 0, max = 0, len, maxMul;
15319 if (argc < 1 || argc > 3) {
15320 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15321 return JIM_ERR;
15323 if (argc == 1) {
15324 max = JIM_WIDE_MAX;
15325 } else if (argc == 2) {
15326 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15327 return JIM_ERR;
15328 } else if (argc == 3) {
15329 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15330 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15331 return JIM_ERR;
15333 len = max-min;
15334 if (len < 0) {
15335 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15336 return JIM_ERR;
15338 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15339 while (1) {
15340 jim_wide r;
15342 JimRandomBytes(interp, &r, sizeof(jim_wide));
15343 if (r < 0 || r >= maxMul) continue;
15344 r = (len == 0) ? 0 : r%len;
15345 Jim_SetResultInt(interp, min+r);
15346 return JIM_OK;
15350 static const struct {
15351 const char *name;
15352 Jim_CmdProc *cmdProc;
15353 } Jim_CoreCommandsTable[] = {
15354 {"alias", Jim_AliasCoreCommand},
15355 {"set", Jim_SetCoreCommand},
15356 {"unset", Jim_UnsetCoreCommand},
15357 {"puts", Jim_PutsCoreCommand},
15358 {"+", Jim_AddCoreCommand},
15359 {"*", Jim_MulCoreCommand},
15360 {"-", Jim_SubCoreCommand},
15361 {"/", Jim_DivCoreCommand},
15362 {"incr", Jim_IncrCoreCommand},
15363 {"while", Jim_WhileCoreCommand},
15364 {"loop", Jim_LoopCoreCommand},
15365 {"for", Jim_ForCoreCommand},
15366 {"foreach", Jim_ForeachCoreCommand},
15367 {"lmap", Jim_LmapCoreCommand},
15368 {"lassign", Jim_LassignCoreCommand},
15369 {"if", Jim_IfCoreCommand},
15370 {"switch", Jim_SwitchCoreCommand},
15371 {"list", Jim_ListCoreCommand},
15372 {"lindex", Jim_LindexCoreCommand},
15373 {"lset", Jim_LsetCoreCommand},
15374 {"lsearch", Jim_LsearchCoreCommand},
15375 {"llength", Jim_LlengthCoreCommand},
15376 {"lappend", Jim_LappendCoreCommand},
15377 {"linsert", Jim_LinsertCoreCommand},
15378 {"lreplace", Jim_LreplaceCoreCommand},
15379 {"lsort", Jim_LsortCoreCommand},
15380 {"append", Jim_AppendCoreCommand},
15381 {"debug", Jim_DebugCoreCommand},
15382 {"eval", Jim_EvalCoreCommand},
15383 {"uplevel", Jim_UplevelCoreCommand},
15384 {"expr", Jim_ExprCoreCommand},
15385 {"break", Jim_BreakCoreCommand},
15386 {"continue", Jim_ContinueCoreCommand},
15387 {"proc", Jim_ProcCoreCommand},
15388 {"concat", Jim_ConcatCoreCommand},
15389 {"return", Jim_ReturnCoreCommand},
15390 {"upvar", Jim_UpvarCoreCommand},
15391 {"global", Jim_GlobalCoreCommand},
15392 {"string", Jim_StringCoreCommand},
15393 {"time", Jim_TimeCoreCommand},
15394 {"exit", Jim_ExitCoreCommand},
15395 {"catch", Jim_CatchCoreCommand},
15396 #ifdef JIM_REFERENCES
15397 {"ref", Jim_RefCoreCommand},
15398 {"getref", Jim_GetrefCoreCommand},
15399 {"setref", Jim_SetrefCoreCommand},
15400 {"finalize", Jim_FinalizeCoreCommand},
15401 {"collect", Jim_CollectCoreCommand},
15402 #endif
15403 {"rename", Jim_RenameCoreCommand},
15404 {"dict", Jim_DictCoreCommand},
15405 {"subst", Jim_SubstCoreCommand},
15406 {"info", Jim_InfoCoreCommand},
15407 {"exists", Jim_ExistsCoreCommand},
15408 {"split", Jim_SplitCoreCommand},
15409 {"join", Jim_JoinCoreCommand},
15410 {"format", Jim_FormatCoreCommand},
15411 {"scan", Jim_ScanCoreCommand},
15412 {"error", Jim_ErrorCoreCommand},
15413 {"lrange", Jim_LrangeCoreCommand},
15414 {"lrepeat", Jim_LrepeatCoreCommand},
15415 {"env", Jim_EnvCoreCommand},
15416 {"source", Jim_SourceCoreCommand},
15417 {"lreverse", Jim_LreverseCoreCommand},
15418 {"range", Jim_RangeCoreCommand},
15419 {"rand", Jim_RandCoreCommand},
15420 {"tailcall", Jim_TailcallCoreCommand},
15421 {"local", Jim_LocalCoreCommand},
15422 {"upcall", Jim_UpcallCoreCommand},
15423 {"apply", Jim_ApplyCoreCommand},
15424 {NULL, NULL},
15427 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15429 int i = 0;
15431 while (Jim_CoreCommandsTable[i].name != NULL) {
15432 Jim_CreateCommand(interp,
15433 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15434 i++;
15438 /* -----------------------------------------------------------------------------
15439 * Interactive prompt
15440 * ---------------------------------------------------------------------------*/
15441 void Jim_MakeErrorMessage(Jim_Interp *interp)
15443 Jim_Obj *argv[2];
15445 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15446 argv[1] = interp->result;
15448 Jim_EvalObjVector(interp, 2, argv);
15451 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15452 const char *prefix, const char *const *tablePtr, const char *name)
15454 int count;
15455 char **tablePtrSorted;
15456 int i;
15458 for (count = 0; tablePtr[count]; count++) {
15461 if (name == NULL) {
15462 name = "option";
15465 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15466 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15467 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15468 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15469 for (i = 0; i < count; i++) {
15470 if (i + 1 == count && count > 1) {
15471 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15473 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15474 if (i + 1 != count) {
15475 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15478 Jim_Free(tablePtrSorted);
15481 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15482 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15484 const char *bad = "bad ";
15485 const char *const *entryPtr = NULL;
15486 int i;
15487 int match = -1;
15488 int arglen;
15489 const char *arg = Jim_GetString(objPtr, &arglen);
15491 *indexPtr = -1;
15493 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15494 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15495 /* Found an exact match */
15496 *indexPtr = i;
15497 return JIM_OK;
15499 if (flags & JIM_ENUM_ABBREV) {
15500 /* Accept an unambiguous abbreviation.
15501 * Note that '-' doesnt' consitute a valid abbreviation
15503 if (strncmp(arg, *entryPtr, arglen) == 0) {
15504 if (*arg == '-' && arglen == 1) {
15505 break;
15507 if (match >= 0) {
15508 bad = "ambiguous ";
15509 goto ambiguous;
15511 match = i;
15516 /* If we had an unambiguous partial match */
15517 if (match >= 0) {
15518 *indexPtr = match;
15519 return JIM_OK;
15522 ambiguous:
15523 if (flags & JIM_ERRMSG) {
15524 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15526 return JIM_ERR;
15529 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15531 int i;
15533 for (i = 0; i < (int)len; i++) {
15534 if (array[i] && strcmp(array[i], name) == 0) {
15535 return i;
15538 return -1;
15541 int Jim_IsDict(Jim_Obj *objPtr)
15543 return objPtr->typePtr == &dictObjType;
15546 int Jim_IsList(Jim_Obj *objPtr)
15548 return objPtr->typePtr == &listObjType;
15552 * Very simple printf-like formatting, designed for error messages.
15554 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15555 * The resulting string is created and set as the result.
15557 * Each '%s' should correspond to a regular string parameter.
15558 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15559 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15561 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15563 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15565 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15567 /* Initial space needed */
15568 int len = strlen(format);
15569 int extra = 0;
15570 int n = 0;
15571 const char *params[5];
15572 char *buf;
15573 va_list args;
15574 int i;
15576 va_start(args, format);
15578 for (i = 0; i < len && n < 5; i++) {
15579 int l;
15581 if (strncmp(format + i, "%s", 2) == 0) {
15582 params[n] = va_arg(args, char *);
15584 l = strlen(params[n]);
15586 else if (strncmp(format + i, "%#s", 3) == 0) {
15587 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15589 params[n] = Jim_GetString(objPtr, &l);
15591 else {
15592 if (format[i] == '%') {
15593 i++;
15595 continue;
15597 n++;
15598 extra += l;
15601 len += extra;
15602 buf = Jim_Alloc(len + 1);
15603 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15605 va_end(args);
15607 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15610 /* stubs */
15611 #ifndef jim_ext_package
15612 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15614 return JIM_OK;
15616 #endif
15617 #ifndef jim_ext_aio
15618 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15620 Jim_SetResultString(interp, "aio not enabled", -1);
15621 return NULL;
15623 #endif
15627 * Local Variables: ***
15628 * c-basic-offset: 4 ***
15629 * tab-width: 4 ***
15630 * End: ***