zlib: Don't use PASTE for INTMAX error messages
[jimtcl.git] / jim.c
blob00c6c0c1ddbd2d561a912815496ed4f70d699e50
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44 #define _GNU_SOURCE /* Mostly just for environ */
46 #include <stdio.h>
47 #include <stdlib.h>
49 #include <string.h>
50 #include <stdarg.h>
51 #include <ctype.h>
52 #include <limits.h>
53 #include <assert.h>
54 #include <errno.h>
55 #include <time.h>
56 #include <setjmp.h>
58 #include "jim.h"
59 #include "jimautoconf.h"
60 #include "utf8.h"
62 #ifdef HAVE_SYS_TIME_H
63 #include <sys/time.h>
64 #endif
65 #ifdef HAVE_BACKTRACE
66 #include <execinfo.h>
67 #endif
68 #ifdef HAVE_CRT_EXTERNS_H
69 #include <crt_externs.h>
70 #endif
72 /* For INFINITY, even if math functions are not enabled */
73 #include <math.h>
75 /* We may decide to switch to using $[...] after all, so leave it as an option */
76 /*#define EXPRSUGAR_BRACKET*/
78 /* For the no-autoconf case */
79 #ifndef TCL_LIBRARY
80 #define TCL_LIBRARY "."
81 #endif
82 #ifndef TCL_PLATFORM_OS
83 #define TCL_PLATFORM_OS "unknown"
84 #endif
85 #ifndef TCL_PLATFORM_PLATFORM
86 #define TCL_PLATFORM_PLATFORM "unknown"
87 #endif
88 #ifndef TCL_PLATFORM_PATH_SEPARATOR
89 #define TCL_PLATFORM_PATH_SEPARATOR ":"
90 #endif
92 /*#define DEBUG_SHOW_SCRIPT*/
93 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
94 /*#define DEBUG_SHOW_SUBST*/
95 /*#define DEBUG_SHOW_EXPR*/
96 /*#define DEBUG_SHOW_EXPR_TOKENS*/
97 /*#define JIM_DEBUG_GC*/
98 #ifdef JIM_MAINTAINER
99 #define JIM_DEBUG_COMMAND
100 #define JIM_DEBUG_PANIC
101 #endif
102 /* Enable this (in conjunction with valgrind) to help debug
103 * reference counting issues
105 /*#define JIM_DISABLE_OBJECT_POOL*/
107 /* Maximum size of an integer */
108 #define JIM_INTEGER_SPACE 24
110 const char *jim_tt_name(int type);
112 #ifdef JIM_DEBUG_PANIC
113 static void JimPanicDump(int fail_condition, const char *fmt, ...);
114 #define JimPanic(X) JimPanicDump X
115 #else
116 #define JimPanic(X)
117 #endif
119 #ifdef JIM_OPTIMIZATION
120 #define JIM_IF_OPTIM(X) X
121 #else
122 #define JIM_IF_OPTIM(X)
123 #endif
125 /* -----------------------------------------------------------------------------
126 * Global variables
127 * ---------------------------------------------------------------------------*/
129 /* A shared empty string for the objects string representation.
130 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
131 static char JimEmptyStringRep[] = "";
133 /* -----------------------------------------------------------------------------
134 * Required prototypes of not exported functions
135 * ---------------------------------------------------------------------------*/
136 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
137 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
138 int flags);
139 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
140 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
141 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
142 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
143 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
144 const char *prefix, const char *const *tablePtr, const char *name);
145 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
146 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
147 static int JimSign(jim_wide w);
148 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
149 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
150 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
153 /* Fast access to the int (wide) value of an object which is known to be of int type */
154 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
156 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
158 static int utf8_tounicode_case(const char *s, int *uc, int upper)
160 int l = utf8_tounicode(s, uc);
161 if (upper) {
162 *uc = utf8_upper(*uc);
164 return l;
167 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
168 #define JIM_CHARSET_SCAN 2
169 #define JIM_CHARSET_GLOB 0
172 * pattern points to a string like "[^a-z\ub5]"
174 * The pattern may contain trailing chars, which are ignored.
176 * The pattern is matched against unicode char 'c'.
178 * If (flags & JIM_NOCASE), case is ignored when matching.
179 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
180 * of the charset, per scan, rather than glob/string match.
182 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
183 * or the null character if the ']' is missing.
185 * Returns NULL on no match.
187 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
189 int not = 0;
190 int pchar;
191 int match = 0;
192 int nocase = 0;
194 if (flags & JIM_NOCASE) {
195 nocase++;
196 c = utf8_upper(c);
199 if (flags & JIM_CHARSET_SCAN) {
200 if (*pattern == '^') {
201 not++;
202 pattern++;
205 /* Special case. If the first char is ']', it is part of the set */
206 if (*pattern == ']') {
207 goto first;
211 while (*pattern && *pattern != ']') {
212 /* Exact match */
213 if (pattern[0] == '\\') {
214 first:
215 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
217 else {
218 /* Is this a range? a-z */
219 int start;
220 int end;
222 pattern += utf8_tounicode_case(pattern, &start, nocase);
223 if (pattern[0] == '-' && pattern[1]) {
224 /* skip '-' */
225 pattern += utf8_tounicode(pattern, &pchar);
226 pattern += utf8_tounicode_case(pattern, &end, nocase);
228 /* Handle reversed range too */
229 if ((c >= start && c <= end) || (c >= end && c <= start)) {
230 match = 1;
232 continue;
234 pchar = start;
237 if (pchar == c) {
238 match = 1;
241 if (not) {
242 match = !match;
245 return match ? pattern : NULL;
248 /* Glob-style pattern matching. */
250 /* Note: string *must* be valid UTF-8 sequences
252 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
254 int c;
255 int pchar;
256 while (*pattern) {
257 switch (pattern[0]) {
258 case '*':
259 while (pattern[1] == '*') {
260 pattern++;
262 pattern++;
263 if (!pattern[0]) {
264 return 1; /* match */
266 while (*string) {
267 /* Recursive call - Does the remaining pattern match anywhere? */
268 if (JimGlobMatch(pattern, string, nocase))
269 return 1; /* match */
270 string += utf8_tounicode(string, &c);
272 return 0; /* no match */
274 case '?':
275 string += utf8_tounicode(string, &c);
276 break;
278 case '[': {
279 string += utf8_tounicode(string, &c);
280 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
281 if (!pattern) {
282 return 0;
284 if (!*pattern) {
285 /* Ran out of pattern (no ']') */
286 continue;
288 break;
290 case '\\':
291 if (pattern[1]) {
292 pattern++;
294 /* fall through */
295 default:
296 string += utf8_tounicode_case(string, &c, nocase);
297 utf8_tounicode_case(pattern, &pchar, nocase);
298 if (pchar != c) {
299 return 0;
301 break;
303 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
304 if (!*string) {
305 while (*pattern == '*') {
306 pattern++;
308 break;
311 if (!*pattern && !*string) {
312 return 1;
314 return 0;
318 * string comparison. Works on binary data.
320 * Returns -1, 0 or 1
322 * Note that the lengths are byte lengths, not char lengths.
324 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
326 if (l1 < l2) {
327 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
329 else if (l2 < l1) {
330 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
332 else {
333 return JimSign(memcmp(s1, s2, l1));
338 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
339 * (or end of string if 'maxchars' is -1).
341 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
343 * Note: does not support embedded nulls.
345 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
347 while (*s1 && *s2 && maxchars) {
348 int c1, c2;
349 s1 += utf8_tounicode_case(s1, &c1, nocase);
350 s2 += utf8_tounicode_case(s2, &c2, nocase);
351 if (c1 != c2) {
352 return JimSign(c1 - c2);
354 maxchars--;
356 if (!maxchars) {
357 return 0;
359 /* One string or both terminated */
360 if (*s1) {
361 return 1;
363 if (*s2) {
364 return -1;
366 return 0;
369 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
370 * The index of the first occurrence of s1 in s2 is returned.
371 * If s1 is not found inside s2, -1 is returned. */
372 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
374 int i;
375 int l1bytelen;
377 if (!l1 || !l2 || l1 > l2) {
378 return -1;
380 if (idx < 0)
381 idx = 0;
382 s2 += utf8_index(s2, idx);
384 l1bytelen = utf8_index(s1, l1);
386 for (i = idx; i <= l2 - l1; i++) {
387 int c;
388 if (memcmp(s2, s1, l1bytelen) == 0) {
389 return i;
391 s2 += utf8_tounicode(s2, &c);
393 return -1;
397 * Note: Lengths and return value are in bytes, not chars.
399 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
401 const char *p;
403 if (!l1 || !l2 || l1 > l2)
404 return -1;
406 /* Now search for the needle */
407 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
408 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
409 return p - s2;
412 return -1;
415 #ifdef JIM_UTF8
417 * Note: Lengths and return value are in chars.
419 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
421 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
422 if (n > 0) {
423 n = utf8_strlen(s2, n);
425 return n;
427 #endif
430 * After an strtol()/strtod()-like conversion,
431 * check whether something was converted and that
432 * the only thing left is white space.
434 * Returns JIM_OK or JIM_ERR.
436 static int JimCheckConversion(const char *str, const char *endptr)
438 if (str[0] == '\0' || str == endptr) {
439 return JIM_ERR;
442 if (endptr[0] != '\0') {
443 while (*endptr) {
444 if (!isspace(UCHAR(*endptr))) {
445 return JIM_ERR;
447 endptr++;
450 return JIM_OK;
453 /* Parses the front of a number to determine it's sign and base
454 * Returns the index to start parsing according to the given base
456 static int JimNumberBase(const char *str, int *base, int *sign)
458 int i = 0;
460 *base = 10;
462 while (isspace(UCHAR(str[i]))) {
463 i++;
466 if (str[i] == '-') {
467 *sign = -1;
468 i++;
470 else {
471 if (str[i] == '+') {
472 i++;
474 *sign = 1;
477 if (str[i] != '0') {
478 /* base 10 */
479 return 0;
482 /* We have 0<x>, so see if we can convert it */
483 switch (str[i + 1]) {
484 case 'x': case 'X': *base = 16; break;
485 case 'o': case 'O': *base = 8; break;
486 case 'b': case 'B': *base = 2; break;
487 default: return 0;
489 i += 2;
490 /* Ensure that (e.g.) 0x-5 fails to parse */
491 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
492 /* Parse according to this base */
493 return i;
495 /* Parse as base 10 */
496 *base = 10;
497 return 0;
500 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
501 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
503 static long jim_strtol(const char *str, char **endptr)
505 int sign;
506 int base;
507 int i = JimNumberBase(str, &base, &sign);
509 if (base != 10) {
510 long value = strtol(str + i, endptr, base);
511 if (endptr == NULL || *endptr != str + i) {
512 return value * sign;
516 /* Can just do a regular base-10 conversion */
517 return strtol(str, endptr, 10);
521 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
522 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
524 static jim_wide jim_strtoull(const char *str, char **endptr)
526 #ifdef HAVE_LONG_LONG
527 int sign;
528 int base;
529 int i = JimNumberBase(str, &base, &sign);
531 if (base != 10) {
532 jim_wide value = strtoull(str + i, endptr, base);
533 if (endptr == NULL || *endptr != str + i) {
534 return value * sign;
538 /* Can just do a regular base-10 conversion */
539 return strtoull(str, endptr, 10);
540 #else
541 return (unsigned long)jim_strtol(str, endptr);
542 #endif
545 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
547 char *endptr;
549 if (base) {
550 *widePtr = strtoull(str, &endptr, base);
552 else {
553 *widePtr = jim_strtoull(str, &endptr);
556 return JimCheckConversion(str, endptr);
559 int Jim_StringToDouble(const char *str, double *doublePtr)
561 char *endptr;
563 /* Callers can check for underflow via ERANGE */
564 errno = 0;
566 *doublePtr = strtod(str, &endptr);
568 return JimCheckConversion(str, endptr);
571 static jim_wide JimPowWide(jim_wide b, jim_wide e)
573 jim_wide res = 1;
575 /* Special cases */
576 if (b == 1) {
577 /* 1 ^ any = 1 */
578 return 1;
580 if (e < 0) {
581 if (b != -1) {
582 return 0;
584 /* Only special case is -1 ^ -n
585 * -1^-1 = -1
586 * -1^-2 = 1
587 * i.e. same as +ve n
589 e = -e;
591 while (e)
593 if (e & 1) {
594 res *= b;
596 e >>= 1;
597 b *= b;
599 return res;
602 /* -----------------------------------------------------------------------------
603 * Special functions
604 * ---------------------------------------------------------------------------*/
605 #ifdef JIM_DEBUG_PANIC
606 static void JimPanicDump(int condition, const char *fmt, ...)
608 va_list ap;
610 if (!condition) {
611 return;
614 va_start(ap, fmt);
616 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
617 vfprintf(stderr, fmt, ap);
618 fprintf(stderr, "\n\n");
619 va_end(ap);
621 #ifdef HAVE_BACKTRACE
623 void *array[40];
624 int size, i;
625 char **strings;
627 size = backtrace(array, 40);
628 strings = backtrace_symbols(array, size);
629 for (i = 0; i < size; i++)
630 fprintf(stderr, "[backtrace] %s\n", strings[i]);
631 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
632 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
634 #endif
636 exit(1);
638 #endif
640 /* -----------------------------------------------------------------------------
641 * Memory allocation
642 * ---------------------------------------------------------------------------*/
644 void *Jim_Alloc(int size)
646 return size ? malloc(size) : NULL;
649 void Jim_Free(void *ptr)
651 free(ptr);
654 void *Jim_Realloc(void *ptr, int size)
656 return realloc(ptr, size);
659 char *Jim_StrDup(const char *s)
661 return strdup(s);
664 char *Jim_StrDupLen(const char *s, int l)
666 char *copy = Jim_Alloc(l + 1);
668 memcpy(copy, s, l + 1);
669 copy[l] = 0; /* Just to be sure, original could be substring */
670 return copy;
673 /* -----------------------------------------------------------------------------
674 * Time related functions
675 * ---------------------------------------------------------------------------*/
677 /* Returns current time in microseconds */
678 static jim_wide JimClock(void)
680 struct timeval tv;
682 gettimeofday(&tv, NULL);
683 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
686 /* -----------------------------------------------------------------------------
687 * Hash Tables
688 * ---------------------------------------------------------------------------*/
690 /* -------------------------- private prototypes ---------------------------- */
691 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
692 static unsigned int JimHashTableNextPower(unsigned int size);
693 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
695 /* -------------------------- hash functions -------------------------------- */
697 /* Thomas Wang's 32 bit Mix Function */
698 unsigned int Jim_IntHashFunction(unsigned int key)
700 key += ~(key << 15);
701 key ^= (key >> 10);
702 key += (key << 3);
703 key ^= (key >> 6);
704 key += ~(key << 11);
705 key ^= (key >> 16);
706 return key;
709 /* Generic hash function (we are using to multiply by 9 and add the byte
710 * as Tcl) */
711 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
713 unsigned int h = 0;
715 while (len--)
716 h += (h << 3) + *buf++;
717 return h;
720 /* ----------------------------- API implementation ------------------------- */
722 /* reset a hashtable already initialized */
723 static void JimResetHashTable(Jim_HashTable *ht)
725 ht->table = NULL;
726 ht->size = 0;
727 ht->sizemask = 0;
728 ht->used = 0;
729 ht->collisions = 0;
730 #ifdef JIM_RANDOMISE_HASH
731 /* This is initialised to a random value to avoid a hash collision attack.
732 * See: n.runs-SA-2011.004
734 ht->uniq = (rand() ^ time(NULL) ^ clock());
735 #else
736 ht->uniq = 0;
737 #endif
740 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
742 iter->ht = ht;
743 iter->index = -1;
744 iter->entry = NULL;
745 iter->nextEntry = NULL;
748 /* Initialize the hash table */
749 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
751 JimResetHashTable(ht);
752 ht->type = type;
753 ht->privdata = privDataPtr;
754 return JIM_OK;
757 /* Resize the table to the minimal size that contains all the elements,
758 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
759 void Jim_ResizeHashTable(Jim_HashTable *ht)
761 int minimal = ht->used;
763 if (minimal < JIM_HT_INITIAL_SIZE)
764 minimal = JIM_HT_INITIAL_SIZE;
765 Jim_ExpandHashTable(ht, minimal);
768 /* Expand or create the hashtable */
769 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
771 Jim_HashTable n; /* the new hashtable */
772 unsigned int realsize = JimHashTableNextPower(size), i;
774 /* the size is invalid if it is smaller than the number of
775 * elements already inside the hashtable */
776 if (size <= ht->used)
777 return;
779 Jim_InitHashTable(&n, ht->type, ht->privdata);
780 n.size = realsize;
781 n.sizemask = realsize - 1;
782 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
783 /* Keep the same 'uniq' as the original */
784 n.uniq = ht->uniq;
786 /* Initialize all the pointers to NULL */
787 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
789 /* Copy all the elements from the old to the new table:
790 * note that if the old hash table is empty ht->used is zero,
791 * so Jim_ExpandHashTable just creates an empty hash table. */
792 n.used = ht->used;
793 for (i = 0; ht->used > 0; i++) {
794 Jim_HashEntry *he, *nextHe;
796 if (ht->table[i] == NULL)
797 continue;
799 /* For each hash entry on this slot... */
800 he = ht->table[i];
801 while (he) {
802 unsigned int h;
804 nextHe = he->next;
805 /* Get the new element index */
806 h = Jim_HashKey(ht, he->key) & n.sizemask;
807 he->next = n.table[h];
808 n.table[h] = he;
809 ht->used--;
810 /* Pass to the next element */
811 he = nextHe;
814 assert(ht->used == 0);
815 Jim_Free(ht->table);
817 /* Remap the new hashtable in the old */
818 *ht = n;
821 /* Add an element to the target hash table */
822 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
824 Jim_HashEntry *entry;
826 /* Get the index of the new element, or -1 if
827 * the element already exists. */
828 entry = JimInsertHashEntry(ht, key, 0);
829 if (entry == NULL)
830 return JIM_ERR;
832 /* Set the hash entry fields. */
833 Jim_SetHashKey(ht, entry, key);
834 Jim_SetHashVal(ht, entry, val);
835 return JIM_OK;
838 /* Add an element, discarding the old if the key already exists */
839 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
841 int existed;
842 Jim_HashEntry *entry;
844 /* Get the index of the new element, or -1 if
845 * the element already exists. */
846 entry = JimInsertHashEntry(ht, key, 1);
847 if (entry->key) {
848 /* It already exists, so only replace the value.
849 * Note if both a destructor and a duplicate function exist,
850 * need to dup before destroy. perhaps they are the same
851 * reference counted object
853 if (ht->type->valDestructor && ht->type->valDup) {
854 void *newval = ht->type->valDup(ht->privdata, val);
855 ht->type->valDestructor(ht->privdata, entry->u.val);
856 entry->u.val = newval;
858 else {
859 Jim_FreeEntryVal(ht, entry);
860 Jim_SetHashVal(ht, entry, val);
862 existed = 1;
864 else {
865 /* Doesn't exist, so set the key */
866 Jim_SetHashKey(ht, entry, key);
867 Jim_SetHashVal(ht, entry, val);
868 existed = 0;
871 return existed;
874 /* Search and remove an element */
875 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
877 unsigned int h;
878 Jim_HashEntry *he, *prevHe;
880 if (ht->used == 0)
881 return JIM_ERR;
882 h = Jim_HashKey(ht, key) & ht->sizemask;
883 he = ht->table[h];
885 prevHe = NULL;
886 while (he) {
887 if (Jim_CompareHashKeys(ht, key, he->key)) {
888 /* Unlink the element from the list */
889 if (prevHe)
890 prevHe->next = he->next;
891 else
892 ht->table[h] = he->next;
893 Jim_FreeEntryKey(ht, he);
894 Jim_FreeEntryVal(ht, he);
895 Jim_Free(he);
896 ht->used--;
897 return JIM_OK;
899 prevHe = he;
900 he = he->next;
902 return JIM_ERR; /* not found */
905 /* Destroy an entire hash table and leave it ready for reuse */
906 int Jim_FreeHashTable(Jim_HashTable *ht)
908 unsigned int i;
910 /* Free all the elements */
911 for (i = 0; ht->used > 0; i++) {
912 Jim_HashEntry *he, *nextHe;
914 if ((he = ht->table[i]) == NULL)
915 continue;
916 while (he) {
917 nextHe = he->next;
918 Jim_FreeEntryKey(ht, he);
919 Jim_FreeEntryVal(ht, he);
920 Jim_Free(he);
921 ht->used--;
922 he = nextHe;
925 /* Free the table and the allocated cache structure */
926 Jim_Free(ht->table);
927 /* Re-initialize the table */
928 JimResetHashTable(ht);
929 return JIM_OK; /* never fails */
932 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
934 Jim_HashEntry *he;
935 unsigned int h;
937 if (ht->used == 0)
938 return NULL;
939 h = Jim_HashKey(ht, key) & ht->sizemask;
940 he = ht->table[h];
941 while (he) {
942 if (Jim_CompareHashKeys(ht, key, he->key))
943 return he;
944 he = he->next;
946 return NULL;
949 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
951 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
952 JimInitHashTableIterator(ht, iter);
953 return iter;
956 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
958 while (1) {
959 if (iter->entry == NULL) {
960 iter->index++;
961 if (iter->index >= (signed)iter->ht->size)
962 break;
963 iter->entry = iter->ht->table[iter->index];
965 else {
966 iter->entry = iter->nextEntry;
968 if (iter->entry) {
969 /* We need to save the 'next' here, the iterator user
970 * may delete the entry we are returning. */
971 iter->nextEntry = iter->entry->next;
972 return iter->entry;
975 return NULL;
978 /* ------------------------- private functions ------------------------------ */
980 /* Expand the hash table if needed */
981 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
983 /* If the hash table is empty expand it to the intial size,
984 * if the table is "full" dobule its size. */
985 if (ht->size == 0)
986 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
987 if (ht->size == ht->used)
988 Jim_ExpandHashTable(ht, ht->size * 2);
991 /* Our hash table capability is a power of two */
992 static unsigned int JimHashTableNextPower(unsigned int size)
994 unsigned int i = JIM_HT_INITIAL_SIZE;
996 if (size >= 2147483648U)
997 return 2147483648U;
998 while (1) {
999 if (i >= size)
1000 return i;
1001 i *= 2;
1005 /* Returns the index of a free slot that can be populated with
1006 * a hash entry for the given 'key'.
1007 * If the key already exists, -1 is returned. */
1008 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1010 unsigned int h;
1011 Jim_HashEntry *he;
1013 /* Expand the hashtable if needed */
1014 JimExpandHashTableIfNeeded(ht);
1016 /* Compute the key hash value */
1017 h = Jim_HashKey(ht, key) & ht->sizemask;
1018 /* Search if this slot does not already contain the given key */
1019 he = ht->table[h];
1020 while (he) {
1021 if (Jim_CompareHashKeys(ht, key, he->key))
1022 return replace ? he : NULL;
1023 he = he->next;
1026 /* Allocates the memory and stores key */
1027 he = Jim_Alloc(sizeof(*he));
1028 he->next = ht->table[h];
1029 ht->table[h] = he;
1030 ht->used++;
1031 he->key = NULL;
1033 return he;
1036 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1038 static unsigned int JimStringCopyHTHashFunction(const void *key)
1040 return Jim_GenHashFunction(key, strlen(key));
1043 static void *JimStringCopyHTDup(void *privdata, const void *key)
1045 return Jim_StrDup(key);
1048 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1050 return strcmp(key1, key2) == 0;
1053 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1055 Jim_Free(key);
1058 static const Jim_HashTableType JimPackageHashTableType = {
1059 JimStringCopyHTHashFunction, /* hash function */
1060 JimStringCopyHTDup, /* key dup */
1061 NULL, /* val dup */
1062 JimStringCopyHTKeyCompare, /* key compare */
1063 JimStringCopyHTKeyDestructor, /* key destructor */
1064 NULL /* val destructor */
1067 typedef struct AssocDataValue
1069 Jim_InterpDeleteProc *delProc;
1070 void *data;
1071 } AssocDataValue;
1073 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1075 AssocDataValue *assocPtr = (AssocDataValue *) data;
1077 if (assocPtr->delProc != NULL)
1078 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1079 Jim_Free(data);
1082 static const Jim_HashTableType JimAssocDataHashTableType = {
1083 JimStringCopyHTHashFunction, /* hash function */
1084 JimStringCopyHTDup, /* key dup */
1085 NULL, /* val dup */
1086 JimStringCopyHTKeyCompare, /* key compare */
1087 JimStringCopyHTKeyDestructor, /* key destructor */
1088 JimAssocDataHashTableValueDestructor /* val destructor */
1091 /* -----------------------------------------------------------------------------
1092 * Stack - This is a simple generic stack implementation. It is used for
1093 * example in the 'expr' expression compiler.
1094 * ---------------------------------------------------------------------------*/
1095 void Jim_InitStack(Jim_Stack *stack)
1097 stack->len = 0;
1098 stack->maxlen = 0;
1099 stack->vector = NULL;
1102 void Jim_FreeStack(Jim_Stack *stack)
1104 Jim_Free(stack->vector);
1107 int Jim_StackLen(Jim_Stack *stack)
1109 return stack->len;
1112 void Jim_StackPush(Jim_Stack *stack, void *element)
1114 int neededLen = stack->len + 1;
1116 if (neededLen > stack->maxlen) {
1117 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1118 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1120 stack->vector[stack->len] = element;
1121 stack->len++;
1124 void *Jim_StackPop(Jim_Stack *stack)
1126 if (stack->len == 0)
1127 return NULL;
1128 stack->len--;
1129 return stack->vector[stack->len];
1132 void *Jim_StackPeek(Jim_Stack *stack)
1134 if (stack->len == 0)
1135 return NULL;
1136 return stack->vector[stack->len - 1];
1139 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1141 int i;
1143 for (i = 0; i < stack->len; i++)
1144 freeFunc(stack->vector[i]);
1147 /* -----------------------------------------------------------------------------
1148 * Tcl Parser
1149 * ---------------------------------------------------------------------------*/
1151 /* Token types */
1152 #define JIM_TT_NONE 0 /* No token returned */
1153 #define JIM_TT_STR 1 /* simple string */
1154 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1155 #define JIM_TT_VAR 3 /* var substitution */
1156 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1157 #define JIM_TT_CMD 5 /* command substitution */
1158 /* Note: Keep these three together for TOKEN_IS_SEP() */
1159 #define JIM_TT_SEP 6 /* word separator (white space) */
1160 #define JIM_TT_EOL 7 /* line separator */
1161 #define JIM_TT_EOF 8 /* end of script */
1163 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1164 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1166 /* Additional token types needed for expressions */
1167 #define JIM_TT_SUBEXPR_START 11
1168 #define JIM_TT_SUBEXPR_END 12
1169 #define JIM_TT_SUBEXPR_COMMA 13
1170 #define JIM_TT_EXPR_INT 14
1171 #define JIM_TT_EXPR_DOUBLE 15
1172 #define JIM_TT_EXPR_BOOLEAN 16
1174 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1176 /* Operator token types start here */
1177 #define JIM_TT_EXPR_OP 20
1179 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1180 /* Can this token start an expression? */
1181 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1182 /* Is this token an expression operator? */
1183 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1186 * Results of missing quotes, braces, etc. from parsing.
1188 struct JimParseMissing {
1189 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1190 int line; /* Line number starting the missing token */
1193 /* Parser context structure. The same context is used both to parse
1194 * Tcl scripts and lists. */
1195 struct JimParserCtx
1197 const char *p; /* Pointer to the point of the program we are parsing */
1198 int len; /* Remaining length */
1199 int linenr; /* Current line number */
1200 const char *tstart;
1201 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1202 int tline; /* Line number of the returned token */
1203 int tt; /* Token type */
1204 int eof; /* Non zero if EOF condition is true. */
1205 int inquote; /* Parsing a quoted string */
1206 int comment; /* Non zero if the next chars may be a comment. */
1207 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1210 static int JimParseScript(struct JimParserCtx *pc);
1211 static int JimParseSep(struct JimParserCtx *pc);
1212 static int JimParseEol(struct JimParserCtx *pc);
1213 static int JimParseCmd(struct JimParserCtx *pc);
1214 static int JimParseQuote(struct JimParserCtx *pc);
1215 static int JimParseVar(struct JimParserCtx *pc);
1216 static int JimParseBrace(struct JimParserCtx *pc);
1217 static int JimParseStr(struct JimParserCtx *pc);
1218 static int JimParseComment(struct JimParserCtx *pc);
1219 static void JimParseSubCmd(struct JimParserCtx *pc);
1220 static int JimParseSubQuote(struct JimParserCtx *pc);
1221 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1223 /* Initialize a parser context.
1224 * 'prg' is a pointer to the program text, linenr is the line
1225 * number of the first line contained in the program. */
1226 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1228 pc->p = prg;
1229 pc->len = len;
1230 pc->tstart = NULL;
1231 pc->tend = NULL;
1232 pc->tline = 0;
1233 pc->tt = JIM_TT_NONE;
1234 pc->eof = 0;
1235 pc->inquote = 0;
1236 pc->linenr = linenr;
1237 pc->comment = 1;
1238 pc->missing.ch = ' ';
1239 pc->missing.line = linenr;
1242 static int JimParseScript(struct JimParserCtx *pc)
1244 while (1) { /* the while is used to reiterate with continue if needed */
1245 if (!pc->len) {
1246 pc->tstart = pc->p;
1247 pc->tend = pc->p - 1;
1248 pc->tline = pc->linenr;
1249 pc->tt = JIM_TT_EOL;
1250 pc->eof = 1;
1251 return JIM_OK;
1253 switch (*(pc->p)) {
1254 case '\\':
1255 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1256 return JimParseSep(pc);
1258 pc->comment = 0;
1259 return JimParseStr(pc);
1260 case ' ':
1261 case '\t':
1262 case '\r':
1263 case '\f':
1264 if (!pc->inquote)
1265 return JimParseSep(pc);
1266 pc->comment = 0;
1267 return JimParseStr(pc);
1268 case '\n':
1269 case ';':
1270 pc->comment = 1;
1271 if (!pc->inquote)
1272 return JimParseEol(pc);
1273 return JimParseStr(pc);
1274 case '[':
1275 pc->comment = 0;
1276 return JimParseCmd(pc);
1277 case '$':
1278 pc->comment = 0;
1279 if (JimParseVar(pc) == JIM_ERR) {
1280 /* An orphan $. Create as a separate token */
1281 pc->tstart = pc->tend = pc->p++;
1282 pc->len--;
1283 pc->tt = JIM_TT_ESC;
1285 return JIM_OK;
1286 case '#':
1287 if (pc->comment) {
1288 JimParseComment(pc);
1289 continue;
1291 return JimParseStr(pc);
1292 default:
1293 pc->comment = 0;
1294 return JimParseStr(pc);
1296 return JIM_OK;
1300 static int JimParseSep(struct JimParserCtx *pc)
1302 pc->tstart = pc->p;
1303 pc->tline = pc->linenr;
1304 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1305 if (*pc->p == '\n') {
1306 break;
1308 if (*pc->p == '\\') {
1309 pc->p++;
1310 pc->len--;
1311 pc->linenr++;
1313 pc->p++;
1314 pc->len--;
1316 pc->tend = pc->p - 1;
1317 pc->tt = JIM_TT_SEP;
1318 return JIM_OK;
1321 static int JimParseEol(struct JimParserCtx *pc)
1323 pc->tstart = pc->p;
1324 pc->tline = pc->linenr;
1325 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1326 if (*pc->p == '\n')
1327 pc->linenr++;
1328 pc->p++;
1329 pc->len--;
1331 pc->tend = pc->p - 1;
1332 pc->tt = JIM_TT_EOL;
1333 return JIM_OK;
1337 ** Here are the rules for parsing:
1338 ** {braced expression}
1339 ** - Count open and closing braces
1340 ** - Backslash escapes meaning of braces
1342 ** "quoted expression"
1343 ** - First double quote at start of word terminates the expression
1344 ** - Backslash escapes quote and bracket
1345 ** - [commands brackets] are counted/nested
1346 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1348 ** [command expression]
1349 ** - Count open and closing brackets
1350 ** - Backslash escapes quote, bracket and brace
1351 ** - [commands brackets] are counted/nested
1352 ** - "quoted expressions" are parsed according to quoting rules
1353 ** - {braced expressions} are parsed according to brace rules
1355 ** For everything, backslash escapes the next char, newline increments current line
1359 * Parses a braced expression starting at pc->p.
1361 * Positions the parser at the end of the braced expression,
1362 * sets pc->tend and possibly pc->missing.
1364 static void JimParseSubBrace(struct JimParserCtx *pc)
1366 int level = 1;
1368 /* Skip the brace */
1369 pc->p++;
1370 pc->len--;
1371 while (pc->len) {
1372 switch (*pc->p) {
1373 case '\\':
1374 if (pc->len > 1) {
1375 if (*++pc->p == '\n') {
1376 pc->linenr++;
1378 pc->len--;
1380 break;
1382 case '{':
1383 level++;
1384 break;
1386 case '}':
1387 if (--level == 0) {
1388 pc->tend = pc->p - 1;
1389 pc->p++;
1390 pc->len--;
1391 return;
1393 break;
1395 case '\n':
1396 pc->linenr++;
1397 break;
1399 pc->p++;
1400 pc->len--;
1402 pc->missing.ch = '{';
1403 pc->missing.line = pc->tline;
1404 pc->tend = pc->p - 1;
1408 * Parses a quoted expression starting at pc->p.
1410 * Positions the parser at the end of the quoted expression,
1411 * sets pc->tend and possibly pc->missing.
1413 * Returns the type of the token of the string,
1414 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1415 * or JIM_TT_STR.
1417 static int JimParseSubQuote(struct JimParserCtx *pc)
1419 int tt = JIM_TT_STR;
1420 int line = pc->tline;
1422 /* Skip the quote */
1423 pc->p++;
1424 pc->len--;
1425 while (pc->len) {
1426 switch (*pc->p) {
1427 case '\\':
1428 if (pc->len > 1) {
1429 if (*++pc->p == '\n') {
1430 pc->linenr++;
1432 pc->len--;
1433 tt = JIM_TT_ESC;
1435 break;
1437 case '"':
1438 pc->tend = pc->p - 1;
1439 pc->p++;
1440 pc->len--;
1441 return tt;
1443 case '[':
1444 JimParseSubCmd(pc);
1445 tt = JIM_TT_ESC;
1446 continue;
1448 case '\n':
1449 pc->linenr++;
1450 break;
1452 case '$':
1453 tt = JIM_TT_ESC;
1454 break;
1456 pc->p++;
1457 pc->len--;
1459 pc->missing.ch = '"';
1460 pc->missing.line = line;
1461 pc->tend = pc->p - 1;
1462 return tt;
1466 * Parses a [command] expression starting at pc->p.
1468 * Positions the parser at the end of the command expression,
1469 * sets pc->tend and possibly pc->missing.
1471 static void JimParseSubCmd(struct JimParserCtx *pc)
1473 int level = 1;
1474 int startofword = 1;
1475 int line = pc->tline;
1477 /* Skip the bracket */
1478 pc->p++;
1479 pc->len--;
1480 while (pc->len) {
1481 switch (*pc->p) {
1482 case '\\':
1483 if (pc->len > 1) {
1484 if (*++pc->p == '\n') {
1485 pc->linenr++;
1487 pc->len--;
1489 break;
1491 case '[':
1492 level++;
1493 break;
1495 case ']':
1496 if (--level == 0) {
1497 pc->tend = pc->p - 1;
1498 pc->p++;
1499 pc->len--;
1500 return;
1502 break;
1504 case '"':
1505 if (startofword) {
1506 JimParseSubQuote(pc);
1507 continue;
1509 break;
1511 case '{':
1512 JimParseSubBrace(pc);
1513 startofword = 0;
1514 continue;
1516 case '\n':
1517 pc->linenr++;
1518 break;
1520 startofword = isspace(UCHAR(*pc->p));
1521 pc->p++;
1522 pc->len--;
1524 pc->missing.ch = '[';
1525 pc->missing.line = line;
1526 pc->tend = pc->p - 1;
1529 static int JimParseBrace(struct JimParserCtx *pc)
1531 pc->tstart = pc->p + 1;
1532 pc->tline = pc->linenr;
1533 pc->tt = JIM_TT_STR;
1534 JimParseSubBrace(pc);
1535 return JIM_OK;
1538 static int JimParseCmd(struct JimParserCtx *pc)
1540 pc->tstart = pc->p + 1;
1541 pc->tline = pc->linenr;
1542 pc->tt = JIM_TT_CMD;
1543 JimParseSubCmd(pc);
1544 return JIM_OK;
1547 static int JimParseQuote(struct JimParserCtx *pc)
1549 pc->tstart = pc->p + 1;
1550 pc->tline = pc->linenr;
1551 pc->tt = JimParseSubQuote(pc);
1552 return JIM_OK;
1555 static int JimParseVar(struct JimParserCtx *pc)
1557 /* skip the $ */
1558 pc->p++;
1559 pc->len--;
1561 #ifdef EXPRSUGAR_BRACKET
1562 if (*pc->p == '[') {
1563 /* Parse $[...] expr shorthand syntax */
1564 JimParseCmd(pc);
1565 pc->tt = JIM_TT_EXPRSUGAR;
1566 return JIM_OK;
1568 #endif
1570 pc->tstart = pc->p;
1571 pc->tt = JIM_TT_VAR;
1572 pc->tline = pc->linenr;
1574 if (*pc->p == '{') {
1575 pc->tstart = ++pc->p;
1576 pc->len--;
1578 while (pc->len && *pc->p != '}') {
1579 if (*pc->p == '\n') {
1580 pc->linenr++;
1582 pc->p++;
1583 pc->len--;
1585 pc->tend = pc->p - 1;
1586 if (pc->len) {
1587 pc->p++;
1588 pc->len--;
1591 else {
1592 while (1) {
1593 /* Skip double colon, but not single colon! */
1594 if (pc->p[0] == ':' && pc->p[1] == ':') {
1595 while (*pc->p == ':') {
1596 pc->p++;
1597 pc->len--;
1599 continue;
1601 /* Note that any char >= 0x80 must be part of a utf-8 char.
1602 * We consider all unicode points outside of ASCII as letters
1604 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1605 pc->p++;
1606 pc->len--;
1607 continue;
1609 break;
1611 /* Parse [dict get] syntax sugar. */
1612 if (*pc->p == '(') {
1613 int count = 1;
1614 const char *paren = NULL;
1616 pc->tt = JIM_TT_DICTSUGAR;
1618 while (count && pc->len) {
1619 pc->p++;
1620 pc->len--;
1621 if (*pc->p == '\\' && pc->len >= 1) {
1622 pc->p++;
1623 pc->len--;
1625 else if (*pc->p == '(') {
1626 count++;
1628 else if (*pc->p == ')') {
1629 paren = pc->p;
1630 count--;
1633 if (count == 0) {
1634 pc->p++;
1635 pc->len--;
1637 else if (paren) {
1638 /* Did not find a matching paren. Back up */
1639 paren++;
1640 pc->len += (pc->p - paren);
1641 pc->p = paren;
1643 #ifndef EXPRSUGAR_BRACKET
1644 if (*pc->tstart == '(') {
1645 pc->tt = JIM_TT_EXPRSUGAR;
1647 #endif
1649 pc->tend = pc->p - 1;
1651 /* Check if we parsed just the '$' character.
1652 * That's not a variable so an error is returned
1653 * to tell the state machine to consider this '$' just
1654 * a string. */
1655 if (pc->tstart == pc->p) {
1656 pc->p--;
1657 pc->len++;
1658 return JIM_ERR;
1660 return JIM_OK;
1663 static int JimParseStr(struct JimParserCtx *pc)
1665 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1666 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1667 /* Starting a new word */
1668 if (*pc->p == '{') {
1669 return JimParseBrace(pc);
1671 if (*pc->p == '"') {
1672 pc->inquote = 1;
1673 pc->p++;
1674 pc->len--;
1675 /* In case the end quote is missing */
1676 pc->missing.line = pc->tline;
1679 pc->tstart = pc->p;
1680 pc->tline = pc->linenr;
1681 while (1) {
1682 if (pc->len == 0) {
1683 if (pc->inquote) {
1684 pc->missing.ch = '"';
1686 pc->tend = pc->p - 1;
1687 pc->tt = JIM_TT_ESC;
1688 return JIM_OK;
1690 switch (*pc->p) {
1691 case '\\':
1692 if (!pc->inquote && *(pc->p + 1) == '\n') {
1693 pc->tend = pc->p - 1;
1694 pc->tt = JIM_TT_ESC;
1695 return JIM_OK;
1697 if (pc->len >= 2) {
1698 if (*(pc->p + 1) == '\n') {
1699 pc->linenr++;
1701 pc->p++;
1702 pc->len--;
1704 else if (pc->len == 1) {
1705 /* End of script with trailing backslash */
1706 pc->missing.ch = '\\';
1708 break;
1709 case '(':
1710 /* If the following token is not '$' just keep going */
1711 if (pc->len > 1 && pc->p[1] != '$') {
1712 break;
1714 /* fall through */
1715 case ')':
1716 /* Only need a separate ')' token if the previous was a var */
1717 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1718 if (pc->p == pc->tstart) {
1719 /* At the start of the token, so just return this char */
1720 pc->p++;
1721 pc->len--;
1723 pc->tend = pc->p - 1;
1724 pc->tt = JIM_TT_ESC;
1725 return JIM_OK;
1727 break;
1729 case '$':
1730 case '[':
1731 pc->tend = pc->p - 1;
1732 pc->tt = JIM_TT_ESC;
1733 return JIM_OK;
1734 case ' ':
1735 case '\t':
1736 case '\n':
1737 case '\r':
1738 case '\f':
1739 case ';':
1740 if (!pc->inquote) {
1741 pc->tend = pc->p - 1;
1742 pc->tt = JIM_TT_ESC;
1743 return JIM_OK;
1745 else if (*pc->p == '\n') {
1746 pc->linenr++;
1748 break;
1749 case '"':
1750 if (pc->inquote) {
1751 pc->tend = pc->p - 1;
1752 pc->tt = JIM_TT_ESC;
1753 pc->p++;
1754 pc->len--;
1755 pc->inquote = 0;
1756 return JIM_OK;
1758 break;
1760 pc->p++;
1761 pc->len--;
1763 return JIM_OK; /* unreached */
1766 static int JimParseComment(struct JimParserCtx *pc)
1768 while (*pc->p) {
1769 if (*pc->p == '\\') {
1770 pc->p++;
1771 pc->len--;
1772 if (pc->len == 0) {
1773 pc->missing.ch = '\\';
1774 return JIM_OK;
1776 if (*pc->p == '\n') {
1777 pc->linenr++;
1780 else if (*pc->p == '\n') {
1781 pc->p++;
1782 pc->len--;
1783 pc->linenr++;
1784 break;
1786 pc->p++;
1787 pc->len--;
1789 return JIM_OK;
1792 /* xdigitval and odigitval are helper functions for JimEscape() */
1793 static int xdigitval(int c)
1795 if (c >= '0' && c <= '9')
1796 return c - '0';
1797 if (c >= 'a' && c <= 'f')
1798 return c - 'a' + 10;
1799 if (c >= 'A' && c <= 'F')
1800 return c - 'A' + 10;
1801 return -1;
1804 static int odigitval(int c)
1806 if (c >= '0' && c <= '7')
1807 return c - '0';
1808 return -1;
1811 /* Perform Tcl escape substitution of 's', storing the result
1812 * string into 'dest'. The escaped string is guaranteed to
1813 * be the same length or shorted than the source string.
1814 * Slen is the length of the string at 's'.
1816 * The function returns the length of the resulting string. */
1817 static int JimEscape(char *dest, const char *s, int slen)
1819 char *p = dest;
1820 int i, len;
1822 for (i = 0; i < slen; i++) {
1823 switch (s[i]) {
1824 case '\\':
1825 switch (s[i + 1]) {
1826 case 'a':
1827 *p++ = 0x7;
1828 i++;
1829 break;
1830 case 'b':
1831 *p++ = 0x8;
1832 i++;
1833 break;
1834 case 'f':
1835 *p++ = 0xc;
1836 i++;
1837 break;
1838 case 'n':
1839 *p++ = 0xa;
1840 i++;
1841 break;
1842 case 'r':
1843 *p++ = 0xd;
1844 i++;
1845 break;
1846 case 't':
1847 *p++ = 0x9;
1848 i++;
1849 break;
1850 case 'u':
1851 case 'U':
1852 case 'x':
1853 /* A unicode or hex sequence.
1854 * \x Expect 1-2 hex chars and convert to hex.
1855 * \u Expect 1-4 hex chars and convert to utf-8.
1856 * \U Expect 1-8 hex chars and convert to utf-8.
1857 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1858 * An invalid sequence means simply the escaped char.
1861 unsigned val = 0;
1862 int k;
1863 int maxchars = 2;
1865 i++;
1867 if (s[i] == 'U') {
1868 maxchars = 8;
1870 else if (s[i] == 'u') {
1871 if (s[i + 1] == '{') {
1872 maxchars = 6;
1873 i++;
1875 else {
1876 maxchars = 4;
1880 for (k = 0; k < maxchars; k++) {
1881 int c = xdigitval(s[i + k + 1]);
1882 if (c == -1) {
1883 break;
1885 val = (val << 4) | c;
1887 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1888 if (s[i] == '{') {
1889 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1890 /* Back up */
1891 i--;
1892 k = 0;
1894 else {
1895 /* Skip the closing brace */
1896 k++;
1899 if (k) {
1900 /* Got a valid sequence, so convert */
1901 if (s[i] == 'x') {
1902 *p++ = val;
1904 else {
1905 p += utf8_fromunicode(p, val);
1907 i += k;
1908 break;
1910 /* Not a valid codepoint, just an escaped char */
1911 *p++ = s[i];
1913 break;
1914 case 'v':
1915 *p++ = 0xb;
1916 i++;
1917 break;
1918 case '\0':
1919 *p++ = '\\';
1920 i++;
1921 break;
1922 case '\n':
1923 /* Replace all spaces and tabs after backslash newline with a single space*/
1924 *p++ = ' ';
1925 do {
1926 i++;
1927 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1928 break;
1929 case '0':
1930 case '1':
1931 case '2':
1932 case '3':
1933 case '4':
1934 case '5':
1935 case '6':
1936 case '7':
1937 /* octal escape */
1939 int val = 0;
1940 int c = odigitval(s[i + 1]);
1942 val = c;
1943 c = odigitval(s[i + 2]);
1944 if (c == -1) {
1945 *p++ = val;
1946 i++;
1947 break;
1949 val = (val * 8) + c;
1950 c = odigitval(s[i + 3]);
1951 if (c == -1) {
1952 *p++ = val;
1953 i += 2;
1954 break;
1956 val = (val * 8) + c;
1957 *p++ = val;
1958 i += 3;
1960 break;
1961 default:
1962 *p++ = s[i + 1];
1963 i++;
1964 break;
1966 break;
1967 default:
1968 *p++ = s[i];
1969 break;
1972 len = p - dest;
1973 *p = '\0';
1974 return len;
1977 /* Returns a dynamically allocated copy of the current token in the
1978 * parser context. The function performs conversion of escapes if
1979 * the token is of type JIM_TT_ESC.
1981 * Note that after the conversion, tokens that are grouped with
1982 * braces in the source code, are always recognizable from the
1983 * identical string obtained in a different way from the type.
1985 * For example the string:
1987 * {*}$a
1989 * will return as first token "*", of type JIM_TT_STR
1991 * While the string:
1993 * *$a
1995 * will return as first token "*", of type JIM_TT_ESC
1997 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1999 const char *start, *end;
2000 char *token;
2001 int len;
2003 start = pc->tstart;
2004 end = pc->tend;
2005 if (start > end) {
2006 len = 0;
2007 token = Jim_Alloc(1);
2008 token[0] = '\0';
2010 else {
2011 len = (end - start) + 1;
2012 token = Jim_Alloc(len + 1);
2013 if (pc->tt != JIM_TT_ESC) {
2014 /* No escape conversion needed? Just copy it. */
2015 memcpy(token, start, len);
2016 token[len] = '\0';
2018 else {
2019 /* Else convert the escape chars. */
2020 len = JimEscape(token, start, len);
2024 return Jim_NewStringObjNoAlloc(interp, token, len);
2027 /* -----------------------------------------------------------------------------
2028 * Tcl Lists parsing
2029 * ---------------------------------------------------------------------------*/
2030 static int JimParseListSep(struct JimParserCtx *pc);
2031 static int JimParseListStr(struct JimParserCtx *pc);
2032 static int JimParseListQuote(struct JimParserCtx *pc);
2034 static int JimParseList(struct JimParserCtx *pc)
2036 if (isspace(UCHAR(*pc->p))) {
2037 return JimParseListSep(pc);
2039 switch (*pc->p) {
2040 case '"':
2041 return JimParseListQuote(pc);
2043 case '{':
2044 return JimParseBrace(pc);
2046 default:
2047 if (pc->len) {
2048 return JimParseListStr(pc);
2050 break;
2053 pc->tstart = pc->tend = pc->p;
2054 pc->tline = pc->linenr;
2055 pc->tt = JIM_TT_EOL;
2056 pc->eof = 1;
2057 return JIM_OK;
2060 static int JimParseListSep(struct JimParserCtx *pc)
2062 pc->tstart = pc->p;
2063 pc->tline = pc->linenr;
2064 while (isspace(UCHAR(*pc->p))) {
2065 if (*pc->p == '\n') {
2066 pc->linenr++;
2068 pc->p++;
2069 pc->len--;
2071 pc->tend = pc->p - 1;
2072 pc->tt = JIM_TT_SEP;
2073 return JIM_OK;
2076 static int JimParseListQuote(struct JimParserCtx *pc)
2078 pc->p++;
2079 pc->len--;
2081 pc->tstart = pc->p;
2082 pc->tline = pc->linenr;
2083 pc->tt = JIM_TT_STR;
2085 while (pc->len) {
2086 switch (*pc->p) {
2087 case '\\':
2088 pc->tt = JIM_TT_ESC;
2089 if (--pc->len == 0) {
2090 /* Trailing backslash */
2091 pc->tend = pc->p;
2092 return JIM_OK;
2094 pc->p++;
2095 break;
2096 case '\n':
2097 pc->linenr++;
2098 break;
2099 case '"':
2100 pc->tend = pc->p - 1;
2101 pc->p++;
2102 pc->len--;
2103 return JIM_OK;
2105 pc->p++;
2106 pc->len--;
2109 pc->tend = pc->p - 1;
2110 return JIM_OK;
2113 static int JimParseListStr(struct JimParserCtx *pc)
2115 pc->tstart = pc->p;
2116 pc->tline = pc->linenr;
2117 pc->tt = JIM_TT_STR;
2119 while (pc->len) {
2120 if (isspace(UCHAR(*pc->p))) {
2121 pc->tend = pc->p - 1;
2122 return JIM_OK;
2124 if (*pc->p == '\\') {
2125 if (--pc->len == 0) {
2126 /* Trailing backslash */
2127 pc->tend = pc->p;
2128 return JIM_OK;
2130 pc->tt = JIM_TT_ESC;
2131 pc->p++;
2133 pc->p++;
2134 pc->len--;
2136 pc->tend = pc->p - 1;
2137 return JIM_OK;
2140 /* -----------------------------------------------------------------------------
2141 * Jim_Obj related functions
2142 * ---------------------------------------------------------------------------*/
2144 /* Return a new initialized object. */
2145 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2147 Jim_Obj *objPtr;
2149 /* -- Check if there are objects in the free list -- */
2150 if (interp->freeList != NULL) {
2151 /* -- Unlink the object from the free list -- */
2152 objPtr = interp->freeList;
2153 interp->freeList = objPtr->nextObjPtr;
2155 else {
2156 /* -- No ready to use objects: allocate a new one -- */
2157 objPtr = Jim_Alloc(sizeof(*objPtr));
2160 /* Object is returned with refCount of 0. Every
2161 * kind of GC implemented should take care to don't try
2162 * to scan objects with refCount == 0. */
2163 objPtr->refCount = 0;
2164 /* All the other fields are left not initialized to save time.
2165 * The caller will probably want to set them to the right
2166 * value anyway. */
2168 /* -- Put the object into the live list -- */
2169 objPtr->prevObjPtr = NULL;
2170 objPtr->nextObjPtr = interp->liveList;
2171 if (interp->liveList)
2172 interp->liveList->prevObjPtr = objPtr;
2173 interp->liveList = objPtr;
2175 return objPtr;
2178 /* Free an object. Actually objects are never freed, but
2179 * just moved to the free objects list, where they will be
2180 * reused by Jim_NewObj(). */
2181 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2183 /* Check if the object was already freed, panic. */
2184 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2185 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2187 /* Free the internal representation */
2188 Jim_FreeIntRep(interp, objPtr);
2189 /* Free the string representation */
2190 if (objPtr->bytes != NULL) {
2191 if (objPtr->bytes != JimEmptyStringRep)
2192 Jim_Free(objPtr->bytes);
2194 /* Unlink the object from the live objects list */
2195 if (objPtr->prevObjPtr)
2196 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2197 if (objPtr->nextObjPtr)
2198 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2199 if (interp->liveList == objPtr)
2200 interp->liveList = objPtr->nextObjPtr;
2201 #ifdef JIM_DISABLE_OBJECT_POOL
2202 Jim_Free(objPtr);
2203 #else
2204 /* Link the object into the free objects list */
2205 objPtr->prevObjPtr = NULL;
2206 objPtr->nextObjPtr = interp->freeList;
2207 if (interp->freeList)
2208 interp->freeList->prevObjPtr = objPtr;
2209 interp->freeList = objPtr;
2210 objPtr->refCount = -1;
2211 #endif
2214 /* Invalidate the string representation of an object. */
2215 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2217 if (objPtr->bytes != NULL) {
2218 if (objPtr->bytes != JimEmptyStringRep)
2219 Jim_Free(objPtr->bytes);
2221 objPtr->bytes = NULL;
2224 /* Duplicate an object. The returned object has refcount = 0. */
2225 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2227 Jim_Obj *dupPtr;
2229 dupPtr = Jim_NewObj(interp);
2230 if (objPtr->bytes == NULL) {
2231 /* Object does not have a valid string representation. */
2232 dupPtr->bytes = NULL;
2234 else if (objPtr->length == 0) {
2235 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2236 dupPtr->bytes = JimEmptyStringRep;
2237 dupPtr->length = 0;
2238 dupPtr->typePtr = NULL;
2239 return dupPtr;
2241 else {
2242 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2243 dupPtr->length = objPtr->length;
2244 /* Copy the null byte too */
2245 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2248 /* By default, the new object has the same type as the old object */
2249 dupPtr->typePtr = objPtr->typePtr;
2250 if (objPtr->typePtr != NULL) {
2251 if (objPtr->typePtr->dupIntRepProc == NULL) {
2252 dupPtr->internalRep = objPtr->internalRep;
2254 else {
2255 /* The dup proc may set a different type, e.g. NULL */
2256 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2259 return dupPtr;
2262 /* Return the string representation for objPtr. If the object's
2263 * string representation is invalid, calls the updateStringProc method to create
2264 * a new one from the internal representation of the object.
2266 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2268 if (objPtr->bytes == NULL) {
2269 /* Invalid string repr. Generate it. */
2270 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2271 objPtr->typePtr->updateStringProc(objPtr);
2273 if (lenPtr)
2274 *lenPtr = objPtr->length;
2275 return objPtr->bytes;
2278 /* Just returns the length of the object's string rep */
2279 int Jim_Length(Jim_Obj *objPtr)
2281 if (objPtr->bytes == NULL) {
2282 /* Invalid string repr. Generate it. */
2283 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2284 objPtr->typePtr->updateStringProc(objPtr);
2286 return objPtr->length;
2289 /* Just returns object's string rep */
2290 const char *Jim_String(Jim_Obj *objPtr)
2292 if (objPtr->bytes == NULL) {
2293 /* Invalid string repr. Generate it. */
2294 JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value."));
2295 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2296 objPtr->typePtr->updateStringProc(objPtr);
2298 return objPtr->bytes;
2301 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2303 objPtr->bytes = Jim_StrDup(str);
2304 objPtr->length = strlen(str);
2307 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2308 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2310 static const Jim_ObjType dictSubstObjType = {
2311 "dict-substitution",
2312 FreeDictSubstInternalRep,
2313 DupDictSubstInternalRep,
2314 NULL,
2315 JIM_TYPE_NONE,
2318 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2320 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2323 static const Jim_ObjType interpolatedObjType = {
2324 "interpolated",
2325 FreeInterpolatedInternalRep,
2326 NULL,
2327 NULL,
2328 JIM_TYPE_NONE,
2331 /* -----------------------------------------------------------------------------
2332 * String Object
2333 * ---------------------------------------------------------------------------*/
2334 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2335 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2337 static const Jim_ObjType stringObjType = {
2338 "string",
2339 NULL,
2340 DupStringInternalRep,
2341 NULL,
2342 JIM_TYPE_REFERENCES,
2345 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2347 JIM_NOTUSED(interp);
2349 /* This is a bit subtle: the only caller of this function
2350 * should be Jim_DuplicateObj(), that will copy the
2351 * string representaion. After the copy, the duplicated
2352 * object will not have more room in the buffer than
2353 * srcPtr->length bytes. So we just set it to length. */
2354 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2355 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2358 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2360 if (objPtr->typePtr != &stringObjType) {
2361 /* Get a fresh string representation. */
2362 if (objPtr->bytes == NULL) {
2363 /* Invalid string repr. Generate it. */
2364 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2365 objPtr->typePtr->updateStringProc(objPtr);
2367 /* Free any other internal representation. */
2368 Jim_FreeIntRep(interp, objPtr);
2369 /* Set it as string, i.e. just set the maxLength field. */
2370 objPtr->typePtr = &stringObjType;
2371 objPtr->internalRep.strValue.maxLength = objPtr->length;
2372 /* Don't know the utf-8 length yet */
2373 objPtr->internalRep.strValue.charLength = -1;
2375 return JIM_OK;
2379 * Returns the length of the object string in chars, not bytes.
2381 * These may be different for a utf-8 string.
2383 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2385 #ifdef JIM_UTF8
2386 SetStringFromAny(interp, objPtr);
2388 if (objPtr->internalRep.strValue.charLength < 0) {
2389 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2391 return objPtr->internalRep.strValue.charLength;
2392 #else
2393 return Jim_Length(objPtr);
2394 #endif
2397 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2398 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2400 Jim_Obj *objPtr = Jim_NewObj(interp);
2402 /* Need to find out how many bytes the string requires */
2403 if (len == -1)
2404 len = strlen(s);
2405 /* Alloc/Set the string rep. */
2406 if (len == 0) {
2407 objPtr->bytes = JimEmptyStringRep;
2409 else {
2410 objPtr->bytes = Jim_Alloc(len + 1);
2411 memcpy(objPtr->bytes, s, len);
2412 objPtr->bytes[len] = '\0';
2414 objPtr->length = len;
2416 /* No typePtr field for the vanilla string object. */
2417 objPtr->typePtr = NULL;
2418 return objPtr;
2421 /* charlen is in characters -- see also Jim_NewStringObj() */
2422 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2424 #ifdef JIM_UTF8
2425 /* Need to find out how many bytes the string requires */
2426 int bytelen = utf8_index(s, charlen);
2428 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2430 /* Remember the utf8 length, so set the type */
2431 objPtr->typePtr = &stringObjType;
2432 objPtr->internalRep.strValue.maxLength = bytelen;
2433 objPtr->internalRep.strValue.charLength = charlen;
2435 return objPtr;
2436 #else
2437 return Jim_NewStringObj(interp, s, charlen);
2438 #endif
2441 /* This version does not try to duplicate the 's' pointer, but
2442 * use it directly. */
2443 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2445 Jim_Obj *objPtr = Jim_NewObj(interp);
2447 objPtr->bytes = s;
2448 objPtr->length = (len == -1) ? strlen(s) : len;
2449 objPtr->typePtr = NULL;
2450 return objPtr;
2453 /* Low-level string append. Use it only against unshared objects
2454 * of type "string". */
2455 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2457 int needlen;
2459 if (len == -1)
2460 len = strlen(str);
2461 needlen = objPtr->length + len;
2462 if (objPtr->internalRep.strValue.maxLength < needlen ||
2463 objPtr->internalRep.strValue.maxLength == 0) {
2464 needlen *= 2;
2465 /* Inefficient to malloc() for less than 8 bytes */
2466 if (needlen < 7) {
2467 needlen = 7;
2469 if (objPtr->bytes == JimEmptyStringRep) {
2470 objPtr->bytes = Jim_Alloc(needlen + 1);
2472 else {
2473 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2475 objPtr->internalRep.strValue.maxLength = needlen;
2477 memcpy(objPtr->bytes + objPtr->length, str, len);
2478 objPtr->bytes[objPtr->length + len] = '\0';
2480 if (objPtr->internalRep.strValue.charLength >= 0) {
2481 /* Update the utf-8 char length */
2482 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2484 objPtr->length += len;
2487 /* Higher level API to append strings to objects.
2488 * Object must not be unshared for each of these.
2490 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2492 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2493 SetStringFromAny(interp, objPtr);
2494 StringAppendString(objPtr, str, len);
2497 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2499 int len;
2500 const char *str = Jim_GetString(appendObjPtr, &len);
2501 Jim_AppendString(interp, objPtr, str, len);
2504 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2506 va_list ap;
2508 SetStringFromAny(interp, objPtr);
2509 va_start(ap, objPtr);
2510 while (1) {
2511 const char *s = va_arg(ap, const char *);
2513 if (s == NULL)
2514 break;
2515 Jim_AppendString(interp, objPtr, s, -1);
2517 va_end(ap);
2520 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2522 if (aObjPtr == bObjPtr) {
2523 return 1;
2525 else {
2526 int Alen, Blen;
2527 const char *sA = Jim_GetString(aObjPtr, &Alen);
2528 const char *sB = Jim_GetString(bObjPtr, &Blen);
2530 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2535 * Note. Does not support embedded nulls in either the pattern or the object.
2537 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2539 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2543 * Note: does not support embedded nulls for the nocase option.
2545 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2547 int l1, l2;
2548 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2549 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2551 if (nocase) {
2552 /* Do a character compare for nocase */
2553 return JimStringCompareLen(s1, s2, -1, nocase);
2555 return JimStringCompare(s1, l1, s2, l2);
2559 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2561 * Note: does not support embedded nulls
2563 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2565 const char *s1 = Jim_String(firstObjPtr);
2566 const char *s2 = Jim_String(secondObjPtr);
2568 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2571 /* Convert a range, as returned by Jim_GetRange(), into
2572 * an absolute index into an object of the specified length.
2573 * This function may return negative values, or values
2574 * greater than or equal to the length of the list if the index
2575 * is out of range. */
2576 static int JimRelToAbsIndex(int len, int idx)
2578 if (idx < 0)
2579 return len + idx;
2580 return idx;
2583 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2584 * into a form suitable for implementation of commands like [string range] and [lrange].
2586 * The resulting range is guaranteed to address valid elements of
2587 * the structure.
2589 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2591 int rangeLen;
2593 if (*firstPtr > *lastPtr) {
2594 rangeLen = 0;
2596 else {
2597 rangeLen = *lastPtr - *firstPtr + 1;
2598 if (rangeLen) {
2599 if (*firstPtr < 0) {
2600 rangeLen += *firstPtr;
2601 *firstPtr = 0;
2603 if (*lastPtr >= len) {
2604 rangeLen -= (*lastPtr - (len - 1));
2605 *lastPtr = len - 1;
2609 if (rangeLen < 0)
2610 rangeLen = 0;
2612 *rangeLenPtr = rangeLen;
2615 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2616 int len, int *first, int *last, int *range)
2618 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2619 return JIM_ERR;
2621 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2622 return JIM_ERR;
2624 *first = JimRelToAbsIndex(len, *first);
2625 *last = JimRelToAbsIndex(len, *last);
2626 JimRelToAbsRange(len, first, last, range);
2627 return JIM_OK;
2630 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2631 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2633 int first, last;
2634 const char *str;
2635 int rangeLen;
2636 int bytelen;
2638 str = Jim_GetString(strObjPtr, &bytelen);
2640 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2641 return NULL;
2644 if (first == 0 && rangeLen == bytelen) {
2645 return strObjPtr;
2647 return Jim_NewStringObj(interp, str + first, rangeLen);
2650 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2651 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2653 #ifdef JIM_UTF8
2654 int first, last;
2655 const char *str;
2656 int len, rangeLen;
2657 int bytelen;
2659 str = Jim_GetString(strObjPtr, &bytelen);
2660 len = Jim_Utf8Length(interp, strObjPtr);
2662 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2663 return NULL;
2666 if (first == 0 && rangeLen == len) {
2667 return strObjPtr;
2669 if (len == bytelen) {
2670 /* ASCII optimisation */
2671 return Jim_NewStringObj(interp, str + first, rangeLen);
2673 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2674 #else
2675 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2676 #endif
2679 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2680 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2682 int first, last;
2683 const char *str;
2684 int len, rangeLen;
2685 Jim_Obj *objPtr;
2687 len = Jim_Utf8Length(interp, strObjPtr);
2689 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2690 return NULL;
2693 if (last < first) {
2694 return strObjPtr;
2697 str = Jim_String(strObjPtr);
2699 /* Before part */
2700 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2702 /* Replacement */
2703 if (newStrObj) {
2704 Jim_AppendObj(interp, objPtr, newStrObj);
2707 /* After part */
2708 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2710 return objPtr;
2714 * Note: does not support embedded nulls.
2716 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2718 while (*str) {
2719 int c;
2720 str += utf8_tounicode(str, &c);
2721 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2723 *dest = 0;
2727 * Note: does not support embedded nulls.
2729 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2731 char *buf;
2732 int len;
2733 const char *str;
2735 SetStringFromAny(interp, strObjPtr);
2737 str = Jim_GetString(strObjPtr, &len);
2739 #ifdef JIM_UTF8
2740 /* Case mapping can change the utf-8 length of the string.
2741 * But at worst it will be by one extra byte per char
2743 len *= 2;
2744 #endif
2745 buf = Jim_Alloc(len + 1);
2746 JimStrCopyUpperLower(buf, str, 0);
2747 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2751 * Note: does not support embedded nulls.
2753 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2755 char *buf;
2756 const char *str;
2757 int len;
2759 if (strObjPtr->typePtr != &stringObjType) {
2760 SetStringFromAny(interp, strObjPtr);
2763 str = Jim_GetString(strObjPtr, &len);
2765 #ifdef JIM_UTF8
2766 /* Case mapping can change the utf-8 length of the string.
2767 * But at worst it will be by one extra byte per char
2769 len *= 2;
2770 #endif
2771 buf = Jim_Alloc(len + 1);
2772 JimStrCopyUpperLower(buf, str, 1);
2773 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2777 * Note: does not support embedded nulls.
2779 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2781 char *buf, *p;
2782 int len;
2783 int c;
2784 const char *str;
2786 str = Jim_GetString(strObjPtr, &len);
2787 if (len == 0) {
2788 return strObjPtr;
2790 #ifdef JIM_UTF8
2791 /* Case mapping can change the utf-8 length of the string.
2792 * But at worst it will be by one extra byte per char
2794 len *= 2;
2795 #endif
2796 buf = p = Jim_Alloc(len + 1);
2798 str += utf8_tounicode(str, &c);
2799 p += utf8_getchars(p, utf8_title(c));
2801 JimStrCopyUpperLower(p, str, 0);
2803 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2806 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2807 * for unicode character 'c'.
2808 * Returns the position if found or NULL if not
2810 static const char *utf8_memchr(const char *str, int len, int c)
2812 #ifdef JIM_UTF8
2813 while (len) {
2814 int sc;
2815 int n = utf8_tounicode(str, &sc);
2816 if (sc == c) {
2817 return str;
2819 str += n;
2820 len -= n;
2822 return NULL;
2823 #else
2824 return memchr(str, c, len);
2825 #endif
2829 * Searches for the first non-trim char in string (str, len)
2831 * If none is found, returns just past the last char.
2833 * Lengths are in bytes.
2835 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2837 while (len) {
2838 int c;
2839 int n = utf8_tounicode(str, &c);
2841 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2842 /* Not a trim char, so stop */
2843 break;
2845 str += n;
2846 len -= n;
2848 return str;
2852 * Searches backwards for a non-trim char in string (str, len).
2854 * Returns a pointer to just after the non-trim char, or NULL if not found.
2856 * Lengths are in bytes.
2858 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2860 str += len;
2862 while (len) {
2863 int c;
2864 int n = utf8_prev_len(str, len);
2866 len -= n;
2867 str -= n;
2869 n = utf8_tounicode(str, &c);
2871 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2872 return str + n;
2876 return NULL;
2879 static const char default_trim_chars[] = " \t\n\r";
2880 /* sizeof() here includes the null byte */
2881 static int default_trim_chars_len = sizeof(default_trim_chars);
2883 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2885 int len;
2886 const char *str = Jim_GetString(strObjPtr, &len);
2887 const char *trimchars = default_trim_chars;
2888 int trimcharslen = default_trim_chars_len;
2889 const char *newstr;
2891 if (trimcharsObjPtr) {
2892 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2895 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2896 if (newstr == str) {
2897 return strObjPtr;
2900 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2903 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2905 int len;
2906 const char *trimchars = default_trim_chars;
2907 int trimcharslen = default_trim_chars_len;
2908 const char *nontrim;
2910 if (trimcharsObjPtr) {
2911 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2914 SetStringFromAny(interp, strObjPtr);
2916 len = Jim_Length(strObjPtr);
2917 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2919 if (nontrim == NULL) {
2920 /* All trim, so return a zero-length string */
2921 return Jim_NewEmptyStringObj(interp);
2923 if (nontrim == strObjPtr->bytes + len) {
2924 /* All non-trim, so return the original object */
2925 return strObjPtr;
2928 if (Jim_IsShared(strObjPtr)) {
2929 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2931 else {
2932 /* Can modify this string in place */
2933 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2934 strObjPtr->length = (nontrim - strObjPtr->bytes);
2937 return strObjPtr;
2940 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2942 /* First trim left. */
2943 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2945 /* Now trim right */
2946 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2948 /* Note: refCount check is needed since objPtr may be emptyObj */
2949 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2950 /* We don't want this object to be leaked */
2951 Jim_FreeNewObj(interp, objPtr);
2954 return strObjPtr;
2957 /* Some platforms don't have isascii - need a non-macro version */
2958 #ifdef HAVE_ISASCII
2959 #define jim_isascii isascii
2960 #else
2961 static int jim_isascii(int c)
2963 return !(c & ~0x7f);
2965 #endif
2967 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2969 static const char * const strclassnames[] = {
2970 "integer", "alpha", "alnum", "ascii", "digit",
2971 "double", "lower", "upper", "space", "xdigit",
2972 "control", "print", "graph", "punct", "boolean",
2973 NULL
2975 enum {
2976 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2977 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2978 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2980 int strclass;
2981 int len;
2982 int i;
2983 const char *str;
2984 int (*isclassfunc)(int c) = NULL;
2986 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2987 return JIM_ERR;
2990 str = Jim_GetString(strObjPtr, &len);
2991 if (len == 0) {
2992 Jim_SetResultBool(interp, !strict);
2993 return JIM_OK;
2996 switch (strclass) {
2997 case STR_IS_INTEGER:
2999 jim_wide w;
3000 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3001 return JIM_OK;
3004 case STR_IS_DOUBLE:
3006 double d;
3007 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3008 return JIM_OK;
3011 case STR_IS_BOOLEAN:
3013 int b;
3014 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3015 return JIM_OK;
3018 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3019 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3020 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3021 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3022 case STR_IS_LOWER: isclassfunc = islower; break;
3023 case STR_IS_UPPER: isclassfunc = isupper; break;
3024 case STR_IS_SPACE: isclassfunc = isspace; break;
3025 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3026 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3027 case STR_IS_PRINT: isclassfunc = isprint; break;
3028 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3029 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3030 default:
3031 return JIM_ERR;
3034 for (i = 0; i < len; i++) {
3035 if (!isclassfunc(str[i])) {
3036 Jim_SetResultBool(interp, 0);
3037 return JIM_OK;
3040 Jim_SetResultBool(interp, 1);
3041 return JIM_OK;
3044 /* -----------------------------------------------------------------------------
3045 * Compared String Object
3046 * ---------------------------------------------------------------------------*/
3048 /* This is strange object that allows comparison of a C literal string
3049 * with a Jim object in a very short time if the same comparison is done
3050 * multiple times. For example every time the [if] command is executed,
3051 * Jim has to check if a given argument is "else".
3052 * If the code has no errors, this comparison is true most of the time,
3053 * so we can cache the pointer of the string of the last matching
3054 * comparison inside the object. Because most C compilers perform literal sharing,
3055 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3056 * this works pretty well even if comparisons are at different places
3057 * inside the C code. */
3059 static const Jim_ObjType comparedStringObjType = {
3060 "compared-string",
3061 NULL,
3062 NULL,
3063 NULL,
3064 JIM_TYPE_REFERENCES,
3067 /* The only way this object is exposed to the API is via the following
3068 * function. Returns true if the string and the object string repr.
3069 * are the same, otherwise zero is returned.
3071 * Note: this isn't binary safe, but it hardly needs to be.*/
3072 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3074 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3075 return 1;
3077 else {
3078 const char *objStr = Jim_String(objPtr);
3080 if (strcmp(str, objStr) != 0)
3081 return 0;
3083 if (objPtr->typePtr != &comparedStringObjType) {
3084 Jim_FreeIntRep(interp, objPtr);
3085 objPtr->typePtr = &comparedStringObjType;
3087 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3088 return 1;
3092 static int qsortCompareStringPointers(const void *a, const void *b)
3094 char *const *sa = (char *const *)a;
3095 char *const *sb = (char *const *)b;
3097 return strcmp(*sa, *sb);
3101 /* -----------------------------------------------------------------------------
3102 * Source Object
3104 * This object is just a string from the language point of view, but
3105 * the internal representation contains the filename and line number
3106 * where this token was read. This information is used by
3107 * Jim_EvalObj() if the object passed happens to be of type "source".
3109 * This allows propagation of the information about line numbers and file
3110 * names and gives error messages with absolute line numbers.
3112 * Note that this object uses the internal representation of the Jim_Object,
3113 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3115 * Also the object will be converted to something else if the given
3116 * token it represents in the source file is not something to be
3117 * evaluated (not a script), and will be specialized in some other way,
3118 * so the time overhead is also almost zero.
3119 * ---------------------------------------------------------------------------*/
3121 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3122 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3124 static const Jim_ObjType sourceObjType = {
3125 "source",
3126 FreeSourceInternalRep,
3127 DupSourceInternalRep,
3128 NULL,
3129 JIM_TYPE_REFERENCES,
3132 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3134 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3137 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3139 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3140 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3143 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3144 Jim_Obj *fileNameObj, int lineNumber)
3146 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3147 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3148 Jim_IncrRefCount(fileNameObj);
3149 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3150 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3151 objPtr->typePtr = &sourceObjType;
3154 /* -----------------------------------------------------------------------------
3155 * ScriptLine Object
3157 * This object is used only in the Script internal represenation.
3158 * For each line of the script, it holds the number of tokens on the line
3159 * and the source line number.
3161 static const Jim_ObjType scriptLineObjType = {
3162 "scriptline",
3163 NULL,
3164 NULL,
3165 NULL,
3166 JIM_NONE,
3169 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3171 Jim_Obj *objPtr;
3173 #ifdef DEBUG_SHOW_SCRIPT
3174 char buf[100];
3175 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3176 objPtr = Jim_NewStringObj(interp, buf, -1);
3177 #else
3178 objPtr = Jim_NewEmptyStringObj(interp);
3179 #endif
3180 objPtr->typePtr = &scriptLineObjType;
3181 objPtr->internalRep.scriptLineValue.argc = argc;
3182 objPtr->internalRep.scriptLineValue.line = line;
3184 return objPtr;
3187 /* -----------------------------------------------------------------------------
3188 * Script Object
3190 * This object holds the parsed internal representation of a script.
3191 * This representation is help within an allocated ScriptObj (see below)
3193 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3194 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3196 static const Jim_ObjType scriptObjType = {
3197 "script",
3198 FreeScriptInternalRep,
3199 DupScriptInternalRep,
3200 NULL,
3201 JIM_TYPE_REFERENCES,
3204 /* Each token of a script is represented by a ScriptToken.
3205 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3206 * can be specialized by commands operating on it.
3208 typedef struct ScriptToken
3210 Jim_Obj *objPtr;
3211 int type;
3212 } ScriptToken;
3214 /* This is the script object internal representation. An array of
3215 * ScriptToken structures, including a pre-computed representation of the
3216 * command length and arguments.
3218 * For example the script:
3220 * puts hello
3221 * set $i $x$y [foo]BAR
3223 * will produce a ScriptObj with the following ScriptToken's:
3225 * LIN 2
3226 * ESC puts
3227 * ESC hello
3228 * LIN 4
3229 * ESC set
3230 * VAR i
3231 * WRD 2
3232 * VAR x
3233 * VAR y
3234 * WRD 2
3235 * CMD foo
3236 * ESC BAR
3238 * "puts hello" has two args (LIN 2), composed of single tokens.
3239 * (Note that the WRD token is omitted for the common case of a single token.)
3241 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3242 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3244 * The precomputation of the command structure makes Jim_Eval() faster,
3245 * and simpler because there aren't dynamic lengths / allocations.
3247 * -- {expand}/{*} handling --
3249 * Expand is handled in a special way.
3251 * If a "word" begins with {*}, the word token count is -ve.
3253 * For example the command:
3255 * list {*}{a b}
3257 * Will produce the following cmdstruct array:
3259 * LIN 2
3260 * ESC list
3261 * WRD -1
3262 * STR a b
3264 * Note that the 'LIN' token also contains the source information for the
3265 * first word of the line for error reporting purposes
3267 * -- the substFlags field of the structure --
3269 * The scriptObj structure is used to represent both "script" objects
3270 * and "subst" objects. In the second case, there are no LIN and WRD
3271 * tokens. Instead SEP and EOL tokens are added as-is.
3272 * In addition, the field 'substFlags' is used to represent the flags used to turn
3273 * the string into the internal representation.
3274 * If these flags do not match what the application requires,
3275 * the scriptObj is created again. For example the script:
3277 * subst -nocommands $string
3278 * subst -novariables $string
3280 * Will (re)create the internal representation of the $string object
3281 * two times.
3283 typedef struct ScriptObj
3285 ScriptToken *token; /* Tokens array. */
3286 Jim_Obj *fileNameObj; /* Filename */
3287 int len; /* Length of token[] */
3288 int substFlags; /* flags used for the compilation of "subst" objects */
3289 int inUse; /* Used to share a ScriptObj. Currently
3290 only used by Jim_EvalObj() as protection against
3291 shimmering of the currently evaluated object. */
3292 int firstline; /* Line number of the first line */
3293 int linenr; /* Error line number, if any */
3294 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3295 } ScriptObj;
3297 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3298 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3299 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3301 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3303 int i;
3304 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3306 if (--script->inUse != 0)
3307 return;
3308 for (i = 0; i < script->len; i++) {
3309 Jim_DecrRefCount(interp, script->token[i].objPtr);
3311 Jim_Free(script->token);
3312 Jim_DecrRefCount(interp, script->fileNameObj);
3313 Jim_Free(script);
3316 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3318 JIM_NOTUSED(interp);
3319 JIM_NOTUSED(srcPtr);
3321 /* Just return a simple string. We don't try to preserve the source info
3322 * since in practice scripts are never duplicated
3324 dupPtr->typePtr = NULL;
3327 /* A simple parse token.
3328 * As the script is parsed, the created tokens point into the script string rep.
3330 typedef struct
3332 const char *token; /* Pointer to the start of the token */
3333 int len; /* Length of this token */
3334 int type; /* Token type */
3335 int line; /* Line number */
3336 } ParseToken;
3338 /* A list of parsed tokens representing a script.
3339 * Tokens are added to this list as the script is parsed.
3340 * It grows as needed.
3342 typedef struct
3344 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3345 ParseToken *list; /* Array of tokens */
3346 int size; /* Current size of the list */
3347 int count; /* Number of entries used */
3348 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3349 } ParseTokenList;
3351 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3353 tokenlist->list = tokenlist->static_list;
3354 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3355 tokenlist->count = 0;
3358 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3360 if (tokenlist->list != tokenlist->static_list) {
3361 Jim_Free(tokenlist->list);
3366 * Adds the new token to the tokenlist.
3367 * The token has the given length, type and line number.
3368 * The token list is resized as necessary.
3370 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3371 int line)
3373 ParseToken *t;
3375 if (tokenlist->count == tokenlist->size) {
3376 /* Resize the list */
3377 tokenlist->size *= 2;
3378 if (tokenlist->list != tokenlist->static_list) {
3379 tokenlist->list =
3380 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3382 else {
3383 /* The list needs to become allocated */
3384 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3385 memcpy(tokenlist->list, tokenlist->static_list,
3386 tokenlist->count * sizeof(*tokenlist->list));
3389 t = &tokenlist->list[tokenlist->count++];
3390 t->token = token;
3391 t->len = len;
3392 t->type = type;
3393 t->line = line;
3396 /* Counts the number of adjoining non-separator tokens.
3398 * Returns -ve if the first token is the expansion
3399 * operator (in which case the count doesn't include
3400 * that token).
3402 static int JimCountWordTokens(ParseToken *t)
3404 int expand = 1;
3405 int count = 0;
3407 /* Is the first word {*} or {expand}? */
3408 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3409 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3410 /* Create an expand token */
3411 expand = -1;
3412 t++;
3416 /* Now count non-separator words */
3417 while (!TOKEN_IS_SEP(t->type)) {
3418 t++;
3419 count++;
3422 return count * expand;
3426 * Create a script/subst object from the given token.
3428 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3430 Jim_Obj *objPtr;
3432 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3433 /* Convert backlash escapes. The result will never be longer than the original */
3434 int len = t->len;
3435 char *str = Jim_Alloc(len + 1);
3436 len = JimEscape(str, t->token, len);
3437 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3439 else {
3440 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3441 * with a single space.
3443 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3445 return objPtr;
3449 * Takes a tokenlist and creates the allocated list of script tokens
3450 * in script->token, of length script->len.
3452 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3453 * as required.
3455 * Also sets script->line to the line number of the first token
3457 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3458 ParseTokenList *tokenlist)
3460 int i;
3461 struct ScriptToken *token;
3462 /* Number of tokens so far for the current command */
3463 int lineargs = 0;
3464 /* This is the first token for the current command */
3465 ScriptToken *linefirst;
3466 int count;
3467 int linenr;
3469 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3470 printf("==== Tokens ====\n");
3471 for (i = 0; i < tokenlist->count; i++) {
3472 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3473 tokenlist->list[i].len, tokenlist->list[i].token);
3475 #endif
3477 /* May need up to one extra script token for each EOL in the worst case */
3478 count = tokenlist->count;
3479 for (i = 0; i < tokenlist->count; i++) {
3480 if (tokenlist->list[i].type == JIM_TT_EOL) {
3481 count++;
3484 linenr = script->firstline = tokenlist->list[0].line;
3486 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3488 /* This is the first token for the current command */
3489 linefirst = token++;
3491 for (i = 0; i < tokenlist->count; ) {
3492 /* Look ahead to find out how many tokens make up the next word */
3493 int wordtokens;
3495 /* Skip any leading separators */
3496 while (tokenlist->list[i].type == JIM_TT_SEP) {
3497 i++;
3500 wordtokens = JimCountWordTokens(tokenlist->list + i);
3502 if (wordtokens == 0) {
3503 /* None, so at end of line */
3504 if (lineargs) {
3505 linefirst->type = JIM_TT_LINE;
3506 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3507 Jim_IncrRefCount(linefirst->objPtr);
3509 /* Reset for new line */
3510 lineargs = 0;
3511 linefirst = token++;
3513 i++;
3514 continue;
3516 else if (wordtokens != 1) {
3517 /* More than 1, or {*}, so insert a WORD token */
3518 token->type = JIM_TT_WORD;
3519 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3520 Jim_IncrRefCount(token->objPtr);
3521 token++;
3522 if (wordtokens < 0) {
3523 /* Skip the expand token */
3524 i++;
3525 wordtokens = -wordtokens - 1;
3526 lineargs--;
3530 if (lineargs == 0) {
3531 /* First real token on the line, so record the line number */
3532 linenr = tokenlist->list[i].line;
3534 lineargs++;
3536 /* Add each non-separator word token to the line */
3537 while (wordtokens--) {
3538 const ParseToken *t = &tokenlist->list[i++];
3540 token->type = t->type;
3541 token->objPtr = JimMakeScriptObj(interp, t);
3542 Jim_IncrRefCount(token->objPtr);
3544 /* Every object is initially a string of type 'source', but the
3545 * internal type may be specialized during execution of the
3546 * script. */
3547 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3548 token++;
3552 if (lineargs == 0) {
3553 token--;
3556 script->len = token - script->token;
3558 JimPanic((script->len >= count, "allocated script array is too short"));
3560 #ifdef DEBUG_SHOW_SCRIPT
3561 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3562 for (i = 0; i < script->len; i++) {
3563 const ScriptToken *t = &script->token[i];
3564 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3566 #endif
3570 /* Parses the given string object to determine if it represents a complete script.
3572 * This is useful for interactive shells implementation, for [info complete].
3574 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3575 * '{' on scripts incomplete missing one or more '}' to be balanced.
3576 * '[' on scripts incomplete missing one or more ']' to be balanced.
3577 * '"' on scripts incomplete missing a '"' char.
3578 * '\\' on scripts with a trailing backslash.
3580 * If the script is complete, 1 is returned, otherwise 0.
3582 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3584 ScriptObj *script = JimGetScript(interp, scriptObj);
3585 if (stateCharPtr) {
3586 *stateCharPtr = script->missing;
3588 return (script->missing == ' ');
3592 * Sets an appropriate error message for a missing script/expression terminator.
3594 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3596 * Note that a trailing backslash is not considered to be an error.
3598 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3600 const char *msg;
3602 switch (ch) {
3603 case '\\':
3604 case ' ':
3605 return JIM_OK;
3607 case '[':
3608 msg = "unmatched \"[\"";
3609 break;
3610 case '{':
3611 msg = "missing close-brace";
3612 break;
3613 case '"':
3614 default:
3615 msg = "missing quote";
3616 break;
3619 Jim_SetResultString(interp, msg, -1);
3620 return JIM_ERR;
3624 * Similar to ScriptObjAddTokens(), but for subst objects.
3626 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3627 ParseTokenList *tokenlist)
3629 int i;
3630 struct ScriptToken *token;
3632 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3634 for (i = 0; i < tokenlist->count; i++) {
3635 const ParseToken *t = &tokenlist->list[i];
3637 /* Create a token for 't' */
3638 token->type = t->type;
3639 token->objPtr = JimMakeScriptObj(interp, t);
3640 Jim_IncrRefCount(token->objPtr);
3641 token++;
3644 script->len = i;
3647 /* This method takes the string representation of an object
3648 * as a Tcl script, and generates the pre-parsed internal representation
3649 * of the script.
3651 * On parse error, sets an error message and returns JIM_ERR
3652 * (Note: the object is still converted to a script, even if an error occurs)
3654 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3656 int scriptTextLen;
3657 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3658 struct JimParserCtx parser;
3659 struct ScriptObj *script;
3660 ParseTokenList tokenlist;
3661 int line = 1;
3663 /* Try to get information about filename / line number */
3664 if (objPtr->typePtr == &sourceObjType) {
3665 line = objPtr->internalRep.sourceValue.lineNumber;
3668 /* Initially parse the script into tokens (in tokenlist) */
3669 ScriptTokenListInit(&tokenlist);
3671 JimParserInit(&parser, scriptText, scriptTextLen, line);
3672 while (!parser.eof) {
3673 JimParseScript(&parser);
3674 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3675 parser.tline);
3678 /* Add a final EOF token */
3679 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3681 /* Create the "real" script tokens from the parsed tokens */
3682 script = Jim_Alloc(sizeof(*script));
3683 memset(script, 0, sizeof(*script));
3684 script->inUse = 1;
3685 if (objPtr->typePtr == &sourceObjType) {
3686 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3688 else {
3689 script->fileNameObj = interp->emptyObj;
3691 Jim_IncrRefCount(script->fileNameObj);
3692 script->missing = parser.missing.ch;
3693 script->linenr = parser.missing.line;
3695 ScriptObjAddTokens(interp, script, &tokenlist);
3697 /* No longer need the token list */
3698 ScriptTokenListFree(&tokenlist);
3700 /* Free the old internal rep and set the new one. */
3701 Jim_FreeIntRep(interp, objPtr);
3702 Jim_SetIntRepPtr(objPtr, script);
3703 objPtr->typePtr = &scriptObjType;
3706 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3709 * Returns the parsed script.
3710 * Note that if there is any possibility that the script is not valid,
3711 * call JimScriptValid() to check
3713 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3715 if (objPtr == interp->emptyObj) {
3716 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3717 objPtr = interp->nullScriptObj;
3720 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3721 JimSetScriptFromAny(interp, objPtr);
3724 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3728 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3729 * and leaves an error message in the interp result.
3732 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3734 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3735 JimAddErrorToStack(interp, script);
3736 return 0;
3738 return 1;
3742 /* -----------------------------------------------------------------------------
3743 * Commands
3744 * ---------------------------------------------------------------------------*/
3745 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3747 cmdPtr->inUse++;
3750 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3752 if (--cmdPtr->inUse == 0) {
3753 if (cmdPtr->isproc) {
3754 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3755 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3756 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3757 if (cmdPtr->u.proc.staticVars) {
3758 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3759 Jim_Free(cmdPtr->u.proc.staticVars);
3762 else {
3763 /* native (C) */
3764 if (cmdPtr->u.native.delProc) {
3765 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3768 if (cmdPtr->prevCmd) {
3769 /* Delete any pushed command too */
3770 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3772 Jim_Free(cmdPtr);
3776 /* Variables HashTable Type.
3778 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3781 /* Variables HashTable Type.
3783 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3784 static void JimVariablesHTValDestructor(void *interp, void *val)
3786 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3787 Jim_Free(val);
3790 static const Jim_HashTableType JimVariablesHashTableType = {
3791 JimStringCopyHTHashFunction, /* hash function */
3792 JimStringCopyHTDup, /* key dup */
3793 NULL, /* val dup */
3794 JimStringCopyHTKeyCompare, /* key compare */
3795 JimStringCopyHTKeyDestructor, /* key destructor */
3796 JimVariablesHTValDestructor /* val destructor */
3799 /* Commands HashTable Type.
3801 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3803 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3805 JimDecrCmdRefCount(interp, val);
3808 static const Jim_HashTableType JimCommandsHashTableType = {
3809 JimStringCopyHTHashFunction, /* hash function */
3810 JimStringCopyHTDup, /* key dup */
3811 NULL, /* val dup */
3812 JimStringCopyHTKeyCompare, /* key compare */
3813 JimStringCopyHTKeyDestructor, /* key destructor */
3814 JimCommandsHT_ValDestructor /* val destructor */
3817 /* ------------------------- Commands related functions --------------------- */
3819 #ifdef jim_ext_namespace
3821 * Returns the "unscoped" version of the given namespace.
3822 * That is, the fully qualified name without the leading ::
3823 * The returned value is either nsObj, or an object with a zero ref count.
3825 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3827 const char *name = Jim_String(nsObj);
3828 if (name[0] == ':' && name[1] == ':') {
3829 /* This command is being defined in the global namespace */
3830 while (*++name == ':') {
3832 nsObj = Jim_NewStringObj(interp, name, -1);
3834 else if (Jim_Length(interp->framePtr->nsObj)) {
3835 /* This command is being defined in a non-global namespace */
3836 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3837 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3839 return nsObj;
3842 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3844 Jim_Obj *resultObj;
3846 const char *name = Jim_String(nameObjPtr);
3847 if (name[0] == ':' && name[1] == ':') {
3848 return nameObjPtr;
3850 Jim_IncrRefCount(nameObjPtr);
3851 resultObj = Jim_NewStringObj(interp, "::", -1);
3852 Jim_AppendObj(interp, resultObj, nameObjPtr);
3853 Jim_DecrRefCount(interp, nameObjPtr);
3855 return resultObj;
3859 * An efficient version of JimQualifyNameObj() where the name is
3860 * available (and needed) as a 'const char *'.
3861 * Avoids creating an object if not necessary.
3862 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3864 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3866 Jim_Obj *objPtr = interp->emptyObj;
3868 if (name[0] == ':' && name[1] == ':') {
3869 /* This command is being defined in the global namespace */
3870 while (*++name == ':') {
3873 else if (Jim_Length(interp->framePtr->nsObj)) {
3874 /* This command is being defined in a non-global namespace */
3875 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3876 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3877 name = Jim_String(objPtr);
3879 Jim_IncrRefCount(objPtr);
3880 *objPtrPtr = objPtr;
3881 return name;
3884 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3886 #else
3887 /* We can be more efficient in the no-namespace case */
3888 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3889 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3891 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3893 return nameObjPtr;
3895 #endif
3897 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3899 /* It may already exist, so we try to delete the old one.
3900 * Note that reference count means that it won't be deleted yet if
3901 * it exists in the call stack.
3903 * BUT, if 'local' is in force, instead of deleting the existing
3904 * proc, we stash a reference to the old proc here.
3906 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3907 if (he) {
3908 /* There was an old cmd with the same name,
3909 * so this requires a 'proc epoch' update. */
3911 /* If a procedure with the same name didn't exist there is no need
3912 * to increment the 'proc epoch' because creation of a new procedure
3913 * can never affect existing cached commands. We don't do
3914 * negative caching. */
3915 Jim_InterpIncrProcEpoch(interp);
3918 if (he && interp->local) {
3919 /* Push this command over the top of the previous one */
3920 cmd->prevCmd = Jim_GetHashEntryVal(he);
3921 Jim_SetHashVal(&interp->commands, he, cmd);
3923 else {
3924 if (he) {
3925 /* Replace the existing command */
3926 Jim_DeleteHashEntry(&interp->commands, name);
3929 Jim_AddHashEntry(&interp->commands, name, cmd);
3931 return JIM_OK;
3935 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3936 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3938 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3940 /* Store the new details for this command */
3941 memset(cmdPtr, 0, sizeof(*cmdPtr));
3942 cmdPtr->inUse = 1;
3943 cmdPtr->u.native.delProc = delProc;
3944 cmdPtr->u.native.cmdProc = cmdProc;
3945 cmdPtr->u.native.privData = privData;
3947 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3949 return JIM_OK;
3952 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3954 int len, i;
3956 len = Jim_ListLength(interp, staticsListObjPtr);
3957 if (len == 0) {
3958 return JIM_OK;
3961 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3962 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3963 for (i = 0; i < len; i++) {
3964 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3965 Jim_Var *varPtr;
3966 int subLen;
3968 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3969 /* Check if it's composed of two elements. */
3970 subLen = Jim_ListLength(interp, objPtr);
3971 if (subLen == 1 || subLen == 2) {
3972 /* Try to get the variable value from the current
3973 * environment. */
3974 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3975 if (subLen == 1) {
3976 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3977 if (initObjPtr == NULL) {
3978 Jim_SetResultFormatted(interp,
3979 "variable for initialization of static \"%#s\" not found in the local context",
3980 nameObjPtr);
3981 return JIM_ERR;
3984 else {
3985 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3987 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3988 return JIM_ERR;
3991 varPtr = Jim_Alloc(sizeof(*varPtr));
3992 varPtr->objPtr = initObjPtr;
3993 Jim_IncrRefCount(initObjPtr);
3994 varPtr->linkFramePtr = NULL;
3995 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3996 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3997 Jim_SetResultFormatted(interp,
3998 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3999 Jim_DecrRefCount(interp, initObjPtr);
4000 Jim_Free(varPtr);
4001 return JIM_ERR;
4004 else {
4005 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4006 objPtr);
4007 return JIM_ERR;
4010 return JIM_OK;
4013 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4015 #ifdef jim_ext_namespace
4016 if (cmdPtr->isproc) {
4017 /* XXX: Really need JimNamespaceSplit() */
4018 const char *pt = strrchr(cmdname, ':');
4019 if (pt && pt != cmdname && pt[-1] == ':') {
4020 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4021 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4022 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4024 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4025 /* This commands shadows a global command, so a proc epoch update is required */
4026 Jim_InterpIncrProcEpoch(interp);
4030 #endif
4033 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4034 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4036 Jim_Cmd *cmdPtr;
4037 int argListLen;
4038 int i;
4040 argListLen = Jim_ListLength(interp, argListObjPtr);
4042 /* Allocate space for both the command pointer and the arg list */
4043 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4044 memset(cmdPtr, 0, sizeof(*cmdPtr));
4045 cmdPtr->inUse = 1;
4046 cmdPtr->isproc = 1;
4047 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4048 cmdPtr->u.proc.argListLen = argListLen;
4049 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4050 cmdPtr->u.proc.argsPos = -1;
4051 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4052 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4053 Jim_IncrRefCount(argListObjPtr);
4054 Jim_IncrRefCount(bodyObjPtr);
4055 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4057 /* Create the statics hash table. */
4058 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4059 goto err;
4062 /* Parse the args out into arglist, validating as we go */
4063 /* Examine the argument list for default parameters and 'args' */
4064 for (i = 0; i < argListLen; i++) {
4065 Jim_Obj *argPtr;
4066 Jim_Obj *nameObjPtr;
4067 Jim_Obj *defaultObjPtr;
4068 int len;
4070 /* Examine a parameter */
4071 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4072 len = Jim_ListLength(interp, argPtr);
4073 if (len == 0) {
4074 Jim_SetResultString(interp, "argument with no name", -1);
4075 err:
4076 JimDecrCmdRefCount(interp, cmdPtr);
4077 return NULL;
4079 if (len > 2) {
4080 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4081 goto err;
4084 if (len == 2) {
4085 /* Optional parameter */
4086 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4087 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4089 else {
4090 /* Required parameter */
4091 nameObjPtr = argPtr;
4092 defaultObjPtr = NULL;
4096 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4097 if (cmdPtr->u.proc.argsPos >= 0) {
4098 Jim_SetResultString(interp, "'args' specified more than once", -1);
4099 goto err;
4101 cmdPtr->u.proc.argsPos = i;
4103 else {
4104 if (len == 2) {
4105 cmdPtr->u.proc.optArity++;
4107 else {
4108 cmdPtr->u.proc.reqArity++;
4112 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4113 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4116 return cmdPtr;
4119 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4121 int ret = JIM_OK;
4122 Jim_Obj *qualifiedNameObj;
4123 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4125 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4126 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4127 ret = JIM_ERR;
4129 else {
4130 Jim_InterpIncrProcEpoch(interp);
4133 JimFreeQualifiedName(interp, qualifiedNameObj);
4135 return ret;
4138 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4140 int ret = JIM_ERR;
4141 Jim_HashEntry *he;
4142 Jim_Cmd *cmdPtr;
4143 Jim_Obj *qualifiedOldNameObj;
4144 Jim_Obj *qualifiedNewNameObj;
4145 const char *fqold;
4146 const char *fqnew;
4148 if (newName[0] == 0) {
4149 return Jim_DeleteCommand(interp, oldName);
4152 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4153 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4155 /* Does it exist? */
4156 he = Jim_FindHashEntry(&interp->commands, fqold);
4157 if (he == NULL) {
4158 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4160 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4161 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4163 else {
4164 /* Add the new name first */
4165 cmdPtr = Jim_GetHashEntryVal(he);
4166 JimIncrCmdRefCount(cmdPtr);
4167 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4168 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4170 /* Now remove the old name */
4171 Jim_DeleteHashEntry(&interp->commands, fqold);
4173 /* Increment the epoch */
4174 Jim_InterpIncrProcEpoch(interp);
4176 ret = JIM_OK;
4179 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4180 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4182 return ret;
4185 /* -----------------------------------------------------------------------------
4186 * Command object
4187 * ---------------------------------------------------------------------------*/
4189 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4191 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4194 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4196 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4197 dupPtr->typePtr = srcPtr->typePtr;
4198 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4201 static const Jim_ObjType commandObjType = {
4202 "command",
4203 FreeCommandInternalRep,
4204 DupCommandInternalRep,
4205 NULL,
4206 JIM_TYPE_REFERENCES,
4209 /* This function returns the command structure for the command name
4210 * stored in objPtr. It tries to specialize the objPtr to contain
4211 * a cached info instead to perform the lookup into the hash table
4212 * every time. The information cached may not be uptodate, in such
4213 * a case the lookup is performed and the cache updated.
4215 * Respects the 'upcall' setting
4217 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4219 Jim_Cmd *cmd;
4221 /* In order to be valid, the proc epoch must match and
4222 * the lookup must have occurred in the same namespace
4224 if (objPtr->typePtr != &commandObjType ||
4225 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4226 #ifdef jim_ext_namespace
4227 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4228 #endif
4230 /* Not cached or out of date, so lookup */
4232 /* Do we need to try the local namespace? */
4233 const char *name = Jim_String(objPtr);
4234 Jim_HashEntry *he;
4236 if (name[0] == ':' && name[1] == ':') {
4237 while (*++name == ':') {
4240 #ifdef jim_ext_namespace
4241 else if (Jim_Length(interp->framePtr->nsObj)) {
4242 /* This command is being defined in a non-global namespace */
4243 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4244 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4245 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4246 Jim_FreeNewObj(interp, nameObj);
4247 if (he) {
4248 goto found;
4251 #endif
4253 /* Lookup in the global namespace */
4254 he = Jim_FindHashEntry(&interp->commands, name);
4255 if (he == NULL) {
4256 if (flags & JIM_ERRMSG) {
4257 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4259 return NULL;
4261 #ifdef jim_ext_namespace
4262 found:
4263 #endif
4264 cmd = Jim_GetHashEntryVal(he);
4266 /* Free the old internal repr and set the new one. */
4267 Jim_FreeIntRep(interp, objPtr);
4268 objPtr->typePtr = &commandObjType;
4269 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4270 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4271 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4272 Jim_IncrRefCount(interp->framePtr->nsObj);
4274 else {
4275 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4277 while (cmd->u.proc.upcall) {
4278 cmd = cmd->prevCmd;
4280 return cmd;
4283 /* -----------------------------------------------------------------------------
4284 * Variables
4285 * ---------------------------------------------------------------------------*/
4287 /* -----------------------------------------------------------------------------
4288 * Variable object
4289 * ---------------------------------------------------------------------------*/
4291 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4293 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4295 static const Jim_ObjType variableObjType = {
4296 "variable",
4297 NULL,
4298 NULL,
4299 NULL,
4300 JIM_TYPE_REFERENCES,
4304 * Check that the name does not contain embedded nulls.
4306 * Variable and procedure names are manipulated as null terminated strings, so
4307 * don't allow names with embedded nulls.
4309 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4311 /* Variable names and proc names can't contain embedded nulls */
4312 if (nameObjPtr->typePtr != &variableObjType) {
4313 int len;
4314 const char *str = Jim_GetString(nameObjPtr, &len);
4315 if (memchr(str, '\0', len)) {
4316 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4317 return JIM_ERR;
4320 return JIM_OK;
4323 /* This method should be called only by the variable API.
4324 * It returns JIM_OK on success (variable already exists),
4325 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4326 * a variable name, but syntax glue for [dict] i.e. the last
4327 * character is ')' */
4328 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4330 const char *varName;
4331 Jim_CallFrame *framePtr;
4332 Jim_HashEntry *he;
4333 int global;
4334 int len;
4336 /* Check if the object is already an uptodate variable */
4337 if (objPtr->typePtr == &variableObjType) {
4338 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4339 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4340 /* nothing to do */
4341 return JIM_OK;
4343 /* Need to re-resolve the variable in the updated callframe */
4345 else if (objPtr->typePtr == &dictSubstObjType) {
4346 return JIM_DICT_SUGAR;
4348 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4349 return JIM_ERR;
4353 varName = Jim_GetString(objPtr, &len);
4355 /* Make sure it's not syntax glue to get/set dict. */
4356 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4357 return JIM_DICT_SUGAR;
4360 if (varName[0] == ':' && varName[1] == ':') {
4361 while (*++varName == ':') {
4363 global = 1;
4364 framePtr = interp->topFramePtr;
4366 else {
4367 global = 0;
4368 framePtr = interp->framePtr;
4371 /* Resolve this name in the variables hash table */
4372 he = Jim_FindHashEntry(&framePtr->vars, varName);
4373 if (he == NULL) {
4374 if (!global && framePtr->staticVars) {
4375 /* Try with static vars. */
4376 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4378 if (he == NULL) {
4379 return JIM_ERR;
4383 /* Free the old internal repr and set the new one. */
4384 Jim_FreeIntRep(interp, objPtr);
4385 objPtr->typePtr = &variableObjType;
4386 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4387 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4388 objPtr->internalRep.varValue.global = global;
4389 return JIM_OK;
4392 /* -------------------- Variables related functions ------------------------- */
4393 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4394 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4396 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4398 const char *name;
4399 Jim_CallFrame *framePtr;
4400 int global;
4402 /* New variable to create */
4403 Jim_Var *var = Jim_Alloc(sizeof(*var));
4405 var->objPtr = valObjPtr;
4406 Jim_IncrRefCount(valObjPtr);
4407 var->linkFramePtr = NULL;
4409 name = Jim_String(nameObjPtr);
4410 if (name[0] == ':' && name[1] == ':') {
4411 while (*++name == ':') {
4413 framePtr = interp->topFramePtr;
4414 global = 1;
4416 else {
4417 framePtr = interp->framePtr;
4418 global = 0;
4421 /* Insert the new variable */
4422 Jim_AddHashEntry(&framePtr->vars, name, var);
4424 /* Make the object int rep a variable */
4425 Jim_FreeIntRep(interp, nameObjPtr);
4426 nameObjPtr->typePtr = &variableObjType;
4427 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4428 nameObjPtr->internalRep.varValue.varPtr = var;
4429 nameObjPtr->internalRep.varValue.global = global;
4431 return var;
4434 /* For now that's dummy. Variables lookup should be optimized
4435 * in many ways, with caching of lookups, and possibly with
4436 * a table of pre-allocated vars in every CallFrame for local vars.
4437 * All the caching should also have an 'epoch' mechanism similar
4438 * to the one used by Tcl for procedures lookup caching. */
4440 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4442 int err;
4443 Jim_Var *var;
4445 switch (SetVariableFromAny(interp, nameObjPtr)) {
4446 case JIM_DICT_SUGAR:
4447 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4449 case JIM_ERR:
4450 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4451 return JIM_ERR;
4453 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4454 break;
4456 case JIM_OK:
4457 var = nameObjPtr->internalRep.varValue.varPtr;
4458 if (var->linkFramePtr == NULL) {
4459 Jim_IncrRefCount(valObjPtr);
4460 Jim_DecrRefCount(interp, var->objPtr);
4461 var->objPtr = valObjPtr;
4463 else { /* Else handle the link */
4464 Jim_CallFrame *savedCallFrame;
4466 savedCallFrame = interp->framePtr;
4467 interp->framePtr = var->linkFramePtr;
4468 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4469 interp->framePtr = savedCallFrame;
4470 if (err != JIM_OK)
4471 return err;
4474 return JIM_OK;
4477 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4479 Jim_Obj *nameObjPtr;
4480 int result;
4482 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4483 Jim_IncrRefCount(nameObjPtr);
4484 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4485 Jim_DecrRefCount(interp, nameObjPtr);
4486 return result;
4489 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4491 Jim_CallFrame *savedFramePtr;
4492 int result;
4494 savedFramePtr = interp->framePtr;
4495 interp->framePtr = interp->topFramePtr;
4496 result = Jim_SetVariableStr(interp, name, objPtr);
4497 interp->framePtr = savedFramePtr;
4498 return result;
4501 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4503 Jim_Obj *nameObjPtr, *valObjPtr;
4504 int result;
4506 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4507 valObjPtr = Jim_NewStringObj(interp, val, -1);
4508 Jim_IncrRefCount(nameObjPtr);
4509 Jim_IncrRefCount(valObjPtr);
4510 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4511 Jim_DecrRefCount(interp, nameObjPtr);
4512 Jim_DecrRefCount(interp, valObjPtr);
4513 return result;
4516 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4517 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4519 const char *varName;
4520 const char *targetName;
4521 Jim_CallFrame *framePtr;
4522 Jim_Var *varPtr;
4524 /* Check for an existing variable or link */
4525 switch (SetVariableFromAny(interp, nameObjPtr)) {
4526 case JIM_DICT_SUGAR:
4527 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4528 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4529 return JIM_ERR;
4531 case JIM_OK:
4532 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4534 if (varPtr->linkFramePtr == NULL) {
4535 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4536 return JIM_ERR;
4539 /* It exists, but is a link, so first delete the link */
4540 varPtr->linkFramePtr = NULL;
4541 break;
4544 /* Resolve the call frames for both variables */
4545 /* XXX: SetVariableFromAny() already did this! */
4546 varName = Jim_String(nameObjPtr);
4548 if (varName[0] == ':' && varName[1] == ':') {
4549 while (*++varName == ':') {
4551 /* Linking a global var does nothing */
4552 framePtr = interp->topFramePtr;
4554 else {
4555 framePtr = interp->framePtr;
4558 targetName = Jim_String(targetNameObjPtr);
4559 if (targetName[0] == ':' && targetName[1] == ':') {
4560 while (*++targetName == ':') {
4562 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4563 targetCallFrame = interp->topFramePtr;
4565 Jim_IncrRefCount(targetNameObjPtr);
4567 if (framePtr->level < targetCallFrame->level) {
4568 Jim_SetResultFormatted(interp,
4569 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4570 nameObjPtr);
4571 Jim_DecrRefCount(interp, targetNameObjPtr);
4572 return JIM_ERR;
4575 /* Check for cycles. */
4576 if (framePtr == targetCallFrame) {
4577 Jim_Obj *objPtr = targetNameObjPtr;
4579 /* Cycles are only possible with 'uplevel 0' */
4580 while (1) {
4581 if (strcmp(Jim_String(objPtr), varName) == 0) {
4582 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4583 Jim_DecrRefCount(interp, targetNameObjPtr);
4584 return JIM_ERR;
4586 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4587 break;
4588 varPtr = objPtr->internalRep.varValue.varPtr;
4589 if (varPtr->linkFramePtr != targetCallFrame)
4590 break;
4591 objPtr = varPtr->objPtr;
4595 /* Perform the binding */
4596 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4597 /* We are now sure 'nameObjPtr' type is variableObjType */
4598 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4599 Jim_DecrRefCount(interp, targetNameObjPtr);
4600 return JIM_OK;
4603 /* Return the Jim_Obj pointer associated with a variable name,
4604 * or NULL if the variable was not found in the current context.
4605 * The same optimization discussed in the comment to the
4606 * 'SetVariable' function should apply here.
4608 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4609 * in a dictionary which is shared, the array variable value is duplicated first.
4610 * This allows the array element to be updated (e.g. append, lappend) without
4611 * affecting other references to the dictionary.
4613 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4615 switch (SetVariableFromAny(interp, nameObjPtr)) {
4616 case JIM_OK:{
4617 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4619 if (varPtr->linkFramePtr == NULL) {
4620 return varPtr->objPtr;
4622 else {
4623 Jim_Obj *objPtr;
4625 /* The variable is a link? Resolve it. */
4626 Jim_CallFrame *savedCallFrame = interp->framePtr;
4628 interp->framePtr = varPtr->linkFramePtr;
4629 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4630 interp->framePtr = savedCallFrame;
4631 if (objPtr) {
4632 return objPtr;
4634 /* Error, so fall through to the error message */
4637 break;
4639 case JIM_DICT_SUGAR:
4640 /* [dict] syntax sugar. */
4641 return JimDictSugarGet(interp, nameObjPtr, flags);
4643 if (flags & JIM_ERRMSG) {
4644 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4646 return NULL;
4649 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4651 Jim_CallFrame *savedFramePtr;
4652 Jim_Obj *objPtr;
4654 savedFramePtr = interp->framePtr;
4655 interp->framePtr = interp->topFramePtr;
4656 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4657 interp->framePtr = savedFramePtr;
4659 return objPtr;
4662 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4664 Jim_Obj *nameObjPtr, *varObjPtr;
4666 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4667 Jim_IncrRefCount(nameObjPtr);
4668 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4669 Jim_DecrRefCount(interp, nameObjPtr);
4670 return varObjPtr;
4673 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4675 Jim_CallFrame *savedFramePtr;
4676 Jim_Obj *objPtr;
4678 savedFramePtr = interp->framePtr;
4679 interp->framePtr = interp->topFramePtr;
4680 objPtr = Jim_GetVariableStr(interp, name, flags);
4681 interp->framePtr = savedFramePtr;
4683 return objPtr;
4686 /* Unset a variable.
4687 * Note: On success unset invalidates all the variable objects created
4688 * in the current call frame incrementing. */
4689 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4691 Jim_Var *varPtr;
4692 int retval;
4693 Jim_CallFrame *framePtr;
4695 retval = SetVariableFromAny(interp, nameObjPtr);
4696 if (retval == JIM_DICT_SUGAR) {
4697 /* [dict] syntax sugar. */
4698 return JimDictSugarSet(interp, nameObjPtr, NULL);
4700 else if (retval == JIM_OK) {
4701 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4703 /* If it's a link call UnsetVariable recursively */
4704 if (varPtr->linkFramePtr) {
4705 framePtr = interp->framePtr;
4706 interp->framePtr = varPtr->linkFramePtr;
4707 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4708 interp->framePtr = framePtr;
4710 else {
4711 const char *name = Jim_String(nameObjPtr);
4712 if (nameObjPtr->internalRep.varValue.global) {
4713 name += 2;
4714 framePtr = interp->topFramePtr;
4716 else {
4717 framePtr = interp->framePtr;
4720 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4721 if (retval == JIM_OK) {
4722 /* Change the callframe id, invalidating var lookup caching */
4723 framePtr->id = interp->callFrameEpoch++;
4727 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4728 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4730 return retval;
4733 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4735 /* Given a variable name for [dict] operation syntax sugar,
4736 * this function returns two objects, the first with the name
4737 * of the variable to set, and the second with the respective key.
4738 * For example "foo(bar)" will return objects with string repr. of
4739 * "foo" and "bar".
4741 * The returned objects have refcount = 1. The function can't fail. */
4742 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4743 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4745 const char *str, *p;
4746 int len, keyLen;
4747 Jim_Obj *varObjPtr, *keyObjPtr;
4749 str = Jim_GetString(objPtr, &len);
4751 p = strchr(str, '(');
4752 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4754 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4756 p++;
4757 keyLen = (str + len) - p;
4758 if (str[len - 1] == ')') {
4759 keyLen--;
4762 /* Create the objects with the variable name and key. */
4763 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4765 Jim_IncrRefCount(varObjPtr);
4766 Jim_IncrRefCount(keyObjPtr);
4767 *varPtrPtr = varObjPtr;
4768 *keyPtrPtr = keyObjPtr;
4771 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4772 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4773 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4775 int err;
4777 SetDictSubstFromAny(interp, objPtr);
4779 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4780 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4782 if (err == JIM_OK) {
4783 /* Don't keep an extra ref to the result */
4784 Jim_SetEmptyResult(interp);
4786 else {
4787 if (!valObjPtr) {
4788 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4789 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4790 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4791 objPtr);
4792 return err;
4795 /* Make the error more informative and Tcl-compatible */
4796 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4797 (valObjPtr ? "set" : "unset"), objPtr);
4799 return err;
4803 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4805 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4806 * and stored back to the variable before expansion.
4808 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4809 Jim_Obj *keyObjPtr, int flags)
4811 Jim_Obj *dictObjPtr;
4812 Jim_Obj *resObjPtr = NULL;
4813 int ret;
4815 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4816 if (!dictObjPtr) {
4817 return NULL;
4820 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4821 if (ret != JIM_OK) {
4822 Jim_SetResultFormatted(interp,
4823 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4824 ret < 0 ? "variable isn't" : "no such element in");
4826 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4827 /* Update the variable to have an unshared copy */
4828 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4831 return resObjPtr;
4834 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4835 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4837 SetDictSubstFromAny(interp, objPtr);
4839 return JimDictExpandArrayVariable(interp,
4840 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4841 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4844 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4846 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4848 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4849 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4852 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4854 JIM_NOTUSED(interp);
4856 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4857 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4858 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4859 dupPtr->typePtr = &dictSubstObjType;
4862 /* Note: The object *must* be in dict-sugar format */
4863 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4865 if (objPtr->typePtr != &dictSubstObjType) {
4866 Jim_Obj *varObjPtr, *keyObjPtr;
4868 if (objPtr->typePtr == &interpolatedObjType) {
4869 /* An interpolated object in dict-sugar form */
4871 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4872 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4874 Jim_IncrRefCount(varObjPtr);
4875 Jim_IncrRefCount(keyObjPtr);
4877 else {
4878 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4881 Jim_FreeIntRep(interp, objPtr);
4882 objPtr->typePtr = &dictSubstObjType;
4883 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4884 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4888 /* This function is used to expand [dict get] sugar in the form
4889 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4890 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4891 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4892 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4893 * the [dict]ionary contained in variable VARNAME. */
4894 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4896 Jim_Obj *resObjPtr = NULL;
4897 Jim_Obj *substKeyObjPtr = NULL;
4899 SetDictSubstFromAny(interp, objPtr);
4901 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4902 &substKeyObjPtr, JIM_NONE)
4903 != JIM_OK) {
4904 return NULL;
4906 Jim_IncrRefCount(substKeyObjPtr);
4907 resObjPtr =
4908 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4909 substKeyObjPtr, 0);
4910 Jim_DecrRefCount(interp, substKeyObjPtr);
4912 return resObjPtr;
4915 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4917 Jim_Obj *resultObjPtr;
4919 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4920 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4921 resultObjPtr->refCount--;
4922 return resultObjPtr;
4924 return NULL;
4927 /* -----------------------------------------------------------------------------
4928 * CallFrame
4929 * ---------------------------------------------------------------------------*/
4931 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4933 Jim_CallFrame *cf;
4935 if (interp->freeFramesList) {
4936 cf = interp->freeFramesList;
4937 interp->freeFramesList = cf->next;
4939 cf->argv = NULL;
4940 cf->argc = 0;
4941 cf->procArgsObjPtr = NULL;
4942 cf->procBodyObjPtr = NULL;
4943 cf->next = NULL;
4944 cf->staticVars = NULL;
4945 cf->localCommands = NULL;
4946 cf->tailcallObj = NULL;
4947 cf->tailcallCmd = NULL;
4949 else {
4950 cf = Jim_Alloc(sizeof(*cf));
4951 memset(cf, 0, sizeof(*cf));
4953 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4956 cf->id = interp->callFrameEpoch++;
4957 cf->parent = parent;
4958 cf->level = parent ? parent->level + 1 : 0;
4959 cf->nsObj = nsObj;
4960 Jim_IncrRefCount(nsObj);
4962 return cf;
4965 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4967 /* Delete any local procs */
4968 if (localCommands) {
4969 Jim_Obj *cmdNameObj;
4971 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4972 Jim_HashEntry *he;
4973 Jim_Obj *fqObjName;
4974 Jim_HashTable *ht = &interp->commands;
4976 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4978 he = Jim_FindHashEntry(ht, fqname);
4980 if (he) {
4981 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4982 if (cmd->prevCmd) {
4983 Jim_Cmd *prevCmd = cmd->prevCmd;
4984 cmd->prevCmd = NULL;
4986 /* Delete the old command */
4987 JimDecrCmdRefCount(interp, cmd);
4989 /* And restore the original */
4990 Jim_SetHashVal(ht, he, prevCmd);
4992 else {
4993 Jim_DeleteHashEntry(ht, fqname);
4994 Jim_InterpIncrProcEpoch(interp);
4997 Jim_DecrRefCount(interp, cmdNameObj);
4998 JimFreeQualifiedName(interp, fqObjName);
5000 Jim_FreeStack(localCommands);
5001 Jim_Free(localCommands);
5003 return JIM_OK;
5007 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5008 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5009 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5011 JimDeleteLocalProcs(interp, cf->localCommands);
5013 if (cf->procArgsObjPtr)
5014 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5015 if (cf->procBodyObjPtr)
5016 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5017 Jim_DecrRefCount(interp, cf->nsObj);
5018 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5019 Jim_FreeHashTable(&cf->vars);
5020 else {
5021 int i;
5022 Jim_HashEntry **table = cf->vars.table, *he;
5024 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5025 he = table[i];
5026 while (he != NULL) {
5027 Jim_HashEntry *nextEntry = he->next;
5028 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5030 Jim_DecrRefCount(interp, varPtr->objPtr);
5031 Jim_Free(Jim_GetHashEntryKey(he));
5032 Jim_Free(varPtr);
5033 Jim_Free(he);
5034 table[i] = NULL;
5035 he = nextEntry;
5038 cf->vars.used = 0;
5040 cf->next = interp->freeFramesList;
5041 interp->freeFramesList = cf;
5045 /* -----------------------------------------------------------------------------
5046 * References
5047 * ---------------------------------------------------------------------------*/
5048 #ifdef JIM_REFERENCES
5050 /* References HashTable Type.
5052 * Keys are unsigned long integers, dynamically allocated for now but in the
5053 * future it's worth to cache this 4 bytes objects. Values are pointers
5054 * to Jim_References. */
5055 static void JimReferencesHTValDestructor(void *interp, void *val)
5057 Jim_Reference *refPtr = (void *)val;
5059 Jim_DecrRefCount(interp, refPtr->objPtr);
5060 if (refPtr->finalizerCmdNamePtr != NULL) {
5061 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5063 Jim_Free(val);
5066 static unsigned int JimReferencesHTHashFunction(const void *key)
5068 /* Only the least significant bits are used. */
5069 const unsigned long *widePtr = key;
5070 unsigned int intValue = (unsigned int)*widePtr;
5072 return Jim_IntHashFunction(intValue);
5075 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5077 void *copy = Jim_Alloc(sizeof(unsigned long));
5079 JIM_NOTUSED(privdata);
5081 memcpy(copy, key, sizeof(unsigned long));
5082 return copy;
5085 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5087 JIM_NOTUSED(privdata);
5089 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5092 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5094 JIM_NOTUSED(privdata);
5096 Jim_Free(key);
5099 static const Jim_HashTableType JimReferencesHashTableType = {
5100 JimReferencesHTHashFunction, /* hash function */
5101 JimReferencesHTKeyDup, /* key dup */
5102 NULL, /* val dup */
5103 JimReferencesHTKeyCompare, /* key compare */
5104 JimReferencesHTKeyDestructor, /* key destructor */
5105 JimReferencesHTValDestructor /* val destructor */
5108 /* -----------------------------------------------------------------------------
5109 * Reference object type and References API
5110 * ---------------------------------------------------------------------------*/
5112 /* The string representation of references has two features in order
5113 * to make the GC faster. The first is that every reference starts
5114 * with a non common character '<', in order to make the string matching
5115 * faster. The second is that the reference string rep is 42 characters
5116 * in length, this means that it is not necessary to check any object with a string
5117 * repr < 42, and usually there aren't many of these objects. */
5119 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5121 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5123 const char *fmt = "<reference.<%s>.%020lu>";
5125 sprintf(buf, fmt, refPtr->tag, id);
5126 return JIM_REFERENCE_SPACE;
5129 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5131 static const Jim_ObjType referenceObjType = {
5132 "reference",
5133 NULL,
5134 NULL,
5135 UpdateStringOfReference,
5136 JIM_TYPE_REFERENCES,
5139 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5141 char buf[JIM_REFERENCE_SPACE + 1];
5143 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5144 JimSetStringBytes(objPtr, buf);
5147 /* returns true if 'c' is a valid reference tag character.
5148 * i.e. inside the range [_a-zA-Z0-9] */
5149 static int isrefchar(int c)
5151 return (c == '_' || isalnum(c));
5154 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5156 unsigned long value;
5157 int i, len;
5158 const char *str, *start, *end;
5159 char refId[21];
5160 Jim_Reference *refPtr;
5161 Jim_HashEntry *he;
5162 char *endptr;
5164 /* Get the string representation */
5165 str = Jim_GetString(objPtr, &len);
5166 /* Check if it looks like a reference */
5167 if (len < JIM_REFERENCE_SPACE)
5168 goto badformat;
5169 /* Trim spaces */
5170 start = str;
5171 end = str + len - 1;
5172 while (*start == ' ')
5173 start++;
5174 while (*end == ' ' && end > start)
5175 end--;
5176 if (end - start + 1 != JIM_REFERENCE_SPACE)
5177 goto badformat;
5178 /* <reference.<1234567>.%020> */
5179 if (memcmp(start, "<reference.<", 12) != 0)
5180 goto badformat;
5181 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5182 goto badformat;
5183 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5184 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5185 if (!isrefchar(start[12 + i]))
5186 goto badformat;
5188 /* Extract info from the reference. */
5189 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5190 refId[20] = '\0';
5191 /* Try to convert the ID into an unsigned long */
5192 value = strtoul(refId, &endptr, 10);
5193 if (JimCheckConversion(refId, endptr) != JIM_OK)
5194 goto badformat;
5195 /* Check if the reference really exists! */
5196 he = Jim_FindHashEntry(&interp->references, &value);
5197 if (he == NULL) {
5198 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5199 return JIM_ERR;
5201 refPtr = Jim_GetHashEntryVal(he);
5202 /* Free the old internal repr and set the new one. */
5203 Jim_FreeIntRep(interp, objPtr);
5204 objPtr->typePtr = &referenceObjType;
5205 objPtr->internalRep.refValue.id = value;
5206 objPtr->internalRep.refValue.refPtr = refPtr;
5207 return JIM_OK;
5209 badformat:
5210 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5211 return JIM_ERR;
5214 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5215 * as finalizer command (or NULL if there is no finalizer).
5216 * The returned reference object has refcount = 0. */
5217 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5219 struct Jim_Reference *refPtr;
5220 unsigned long id;
5221 Jim_Obj *refObjPtr;
5222 const char *tag;
5223 int tagLen, i;
5225 /* Perform the Garbage Collection if needed. */
5226 Jim_CollectIfNeeded(interp);
5228 refPtr = Jim_Alloc(sizeof(*refPtr));
5229 refPtr->objPtr = objPtr;
5230 Jim_IncrRefCount(objPtr);
5231 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5232 if (cmdNamePtr)
5233 Jim_IncrRefCount(cmdNamePtr);
5234 id = interp->referenceNextId++;
5235 Jim_AddHashEntry(&interp->references, &id, refPtr);
5236 refObjPtr = Jim_NewObj(interp);
5237 refObjPtr->typePtr = &referenceObjType;
5238 refObjPtr->bytes = NULL;
5239 refObjPtr->internalRep.refValue.id = id;
5240 refObjPtr->internalRep.refValue.refPtr = refPtr;
5241 interp->referenceNextId++;
5242 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5243 * that does not pass the 'isrefchar' test is replaced with '_' */
5244 tag = Jim_GetString(tagPtr, &tagLen);
5245 if (tagLen > JIM_REFERENCE_TAGLEN)
5246 tagLen = JIM_REFERENCE_TAGLEN;
5247 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5248 if (i < tagLen && isrefchar(tag[i]))
5249 refPtr->tag[i] = tag[i];
5250 else
5251 refPtr->tag[i] = '_';
5253 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5254 return refObjPtr;
5257 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5259 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5260 return NULL;
5261 return objPtr->internalRep.refValue.refPtr;
5264 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5266 Jim_Reference *refPtr;
5268 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5269 return JIM_ERR;
5270 Jim_IncrRefCount(cmdNamePtr);
5271 if (refPtr->finalizerCmdNamePtr)
5272 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5273 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5274 return JIM_OK;
5277 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5279 Jim_Reference *refPtr;
5281 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5282 return JIM_ERR;
5283 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5284 return JIM_OK;
5287 /* -----------------------------------------------------------------------------
5288 * References Garbage Collection
5289 * ---------------------------------------------------------------------------*/
5291 /* This the hash table type for the "MARK" phase of the GC */
5292 static const Jim_HashTableType JimRefMarkHashTableType = {
5293 JimReferencesHTHashFunction, /* hash function */
5294 JimReferencesHTKeyDup, /* key dup */
5295 NULL, /* val dup */
5296 JimReferencesHTKeyCompare, /* key compare */
5297 JimReferencesHTKeyDestructor, /* key destructor */
5298 NULL /* val destructor */
5301 /* Performs the garbage collection. */
5302 int Jim_Collect(Jim_Interp *interp)
5304 int collected = 0;
5305 #ifndef JIM_BOOTSTRAP
5306 Jim_HashTable marks;
5307 Jim_HashTableIterator htiter;
5308 Jim_HashEntry *he;
5309 Jim_Obj *objPtr;
5311 /* Avoid recursive calls */
5312 if (interp->lastCollectId == -1) {
5313 /* Jim_Collect() already running. Return just now. */
5314 return 0;
5316 interp->lastCollectId = -1;
5318 /* Mark all the references found into the 'mark' hash table.
5319 * The references are searched in every live object that
5320 * is of a type that can contain references. */
5321 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5322 objPtr = interp->liveList;
5323 while (objPtr) {
5324 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5325 const char *str, *p;
5326 int len;
5328 /* If the object is of type reference, to get the
5329 * Id is simple... */
5330 if (objPtr->typePtr == &referenceObjType) {
5331 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5332 #ifdef JIM_DEBUG_GC
5333 printf("MARK (reference): %d refcount: %d\n",
5334 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5335 #endif
5336 objPtr = objPtr->nextObjPtr;
5337 continue;
5339 /* Get the string repr of the object we want
5340 * to scan for references. */
5341 p = str = Jim_GetString(objPtr, &len);
5342 /* Skip objects too little to contain references. */
5343 if (len < JIM_REFERENCE_SPACE) {
5344 objPtr = objPtr->nextObjPtr;
5345 continue;
5347 /* Extract references from the object string repr. */
5348 while (1) {
5349 int i;
5350 unsigned long id;
5352 if ((p = strstr(p, "<reference.<")) == NULL)
5353 break;
5354 /* Check if it's a valid reference. */
5355 if (len - (p - str) < JIM_REFERENCE_SPACE)
5356 break;
5357 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5358 break;
5359 for (i = 21; i <= 40; i++)
5360 if (!isdigit(UCHAR(p[i])))
5361 break;
5362 /* Get the ID */
5363 id = strtoul(p + 21, NULL, 10);
5365 /* Ok, a reference for the given ID
5366 * was found. Mark it. */
5367 Jim_AddHashEntry(&marks, &id, NULL);
5368 #ifdef JIM_DEBUG_GC
5369 printf("MARK: %d\n", (int)id);
5370 #endif
5371 p += JIM_REFERENCE_SPACE;
5374 objPtr = objPtr->nextObjPtr;
5377 /* Run the references hash table to destroy every reference that
5378 * is not referenced outside (not present in the mark HT). */
5379 JimInitHashTableIterator(&interp->references, &htiter);
5380 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5381 const unsigned long *refId;
5382 Jim_Reference *refPtr;
5384 refId = he->key;
5385 /* Check if in the mark phase we encountered
5386 * this reference. */
5387 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5388 #ifdef JIM_DEBUG_GC
5389 printf("COLLECTING %d\n", (int)*refId);
5390 #endif
5391 collected++;
5392 /* Drop the reference, but call the
5393 * finalizer first if registered. */
5394 refPtr = Jim_GetHashEntryVal(he);
5395 if (refPtr->finalizerCmdNamePtr) {
5396 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5397 Jim_Obj *objv[3], *oldResult;
5399 JimFormatReference(refstr, refPtr, *refId);
5401 objv[0] = refPtr->finalizerCmdNamePtr;
5402 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5403 objv[2] = refPtr->objPtr;
5405 /* Drop the reference itself */
5406 /* Avoid the finaliser being freed here */
5407 Jim_IncrRefCount(objv[0]);
5408 /* Don't remove the reference from the hash table just yet
5409 * since that will free refPtr, and hence refPtr->objPtr
5412 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5413 oldResult = interp->result;
5414 Jim_IncrRefCount(oldResult);
5415 Jim_EvalObjVector(interp, 3, objv);
5416 Jim_SetResult(interp, oldResult);
5417 Jim_DecrRefCount(interp, oldResult);
5419 Jim_DecrRefCount(interp, objv[0]);
5421 Jim_DeleteHashEntry(&interp->references, refId);
5424 Jim_FreeHashTable(&marks);
5425 interp->lastCollectId = interp->referenceNextId;
5426 interp->lastCollectTime = time(NULL);
5427 #endif /* JIM_BOOTSTRAP */
5428 return collected;
5431 #define JIM_COLLECT_ID_PERIOD 5000
5432 #define JIM_COLLECT_TIME_PERIOD 300
5434 void Jim_CollectIfNeeded(Jim_Interp *interp)
5436 unsigned long elapsedId;
5437 int elapsedTime;
5439 elapsedId = interp->referenceNextId - interp->lastCollectId;
5440 elapsedTime = time(NULL) - interp->lastCollectTime;
5443 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5444 Jim_Collect(interp);
5447 #endif
5449 int Jim_IsBigEndian(void)
5451 union {
5452 unsigned short s;
5453 unsigned char c[2];
5454 } uval = {0x0102};
5456 return uval.c[0] == 1;
5459 /* -----------------------------------------------------------------------------
5460 * Interpreter related functions
5461 * ---------------------------------------------------------------------------*/
5463 Jim_Interp *Jim_CreateInterp(void)
5465 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5467 memset(i, 0, sizeof(*i));
5469 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5470 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5471 i->lastCollectTime = time(NULL);
5473 /* Note that we can create objects only after the
5474 * interpreter liveList and freeList pointers are
5475 * initialized to NULL. */
5476 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5477 #ifdef JIM_REFERENCES
5478 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5479 #endif
5480 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5481 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5482 i->emptyObj = Jim_NewEmptyStringObj(i);
5483 i->trueObj = Jim_NewIntObj(i, 1);
5484 i->falseObj = Jim_NewIntObj(i, 0);
5485 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5486 i->errorFileNameObj = i->emptyObj;
5487 i->result = i->emptyObj;
5488 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5489 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5490 i->errorProc = i->emptyObj;
5491 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5492 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5493 Jim_IncrRefCount(i->emptyObj);
5494 Jim_IncrRefCount(i->errorFileNameObj);
5495 Jim_IncrRefCount(i->result);
5496 Jim_IncrRefCount(i->stackTrace);
5497 Jim_IncrRefCount(i->unknown);
5498 Jim_IncrRefCount(i->currentScriptObj);
5499 Jim_IncrRefCount(i->nullScriptObj);
5500 Jim_IncrRefCount(i->errorProc);
5501 Jim_IncrRefCount(i->trueObj);
5502 Jim_IncrRefCount(i->falseObj);
5504 /* Initialize key variables every interpreter should contain */
5505 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5506 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5508 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5509 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5510 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5511 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5512 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5513 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5514 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5515 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5517 return i;
5520 void Jim_FreeInterp(Jim_Interp *i)
5522 Jim_CallFrame *cf, *cfx;
5524 Jim_Obj *objPtr, *nextObjPtr;
5526 /* Free the active call frames list - must be done before i->commands is destroyed */
5527 for (cf = i->framePtr; cf; cf = cfx) {
5528 cfx = cf->parent;
5529 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5532 Jim_DecrRefCount(i, i->emptyObj);
5533 Jim_DecrRefCount(i, i->trueObj);
5534 Jim_DecrRefCount(i, i->falseObj);
5535 Jim_DecrRefCount(i, i->result);
5536 Jim_DecrRefCount(i, i->stackTrace);
5537 Jim_DecrRefCount(i, i->errorProc);
5538 Jim_DecrRefCount(i, i->unknown);
5539 Jim_DecrRefCount(i, i->errorFileNameObj);
5540 Jim_DecrRefCount(i, i->currentScriptObj);
5541 Jim_DecrRefCount(i, i->nullScriptObj);
5542 Jim_FreeHashTable(&i->commands);
5543 #ifdef JIM_REFERENCES
5544 Jim_FreeHashTable(&i->references);
5545 #endif
5546 Jim_FreeHashTable(&i->packages);
5547 Jim_Free(i->prngState);
5548 Jim_FreeHashTable(&i->assocData);
5550 /* Check that the live object list is empty, otherwise
5551 * there is a memory leak. */
5552 #ifdef JIM_MAINTAINER
5553 if (i->liveList != NULL) {
5554 objPtr = i->liveList;
5556 printf("\n-------------------------------------\n");
5557 printf("Objects still in the free list:\n");
5558 while (objPtr) {
5559 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5561 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5562 printf("%p (%d) %-10s: '%.20s...'\n",
5563 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5565 else {
5566 printf("%p (%d) %-10s: '%s'\n",
5567 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5569 if (objPtr->typePtr == &sourceObjType) {
5570 printf("FILE %s LINE %d\n",
5571 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5572 objPtr->internalRep.sourceValue.lineNumber);
5574 objPtr = objPtr->nextObjPtr;
5576 printf("-------------------------------------\n\n");
5577 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5579 #endif
5581 /* Free all the freed objects. */
5582 objPtr = i->freeList;
5583 while (objPtr) {
5584 nextObjPtr = objPtr->nextObjPtr;
5585 Jim_Free(objPtr);
5586 objPtr = nextObjPtr;
5589 /* Free the free call frames list */
5590 for (cf = i->freeFramesList; cf; cf = cfx) {
5591 cfx = cf->next;
5592 if (cf->vars.table)
5593 Jim_FreeHashTable(&cf->vars);
5594 Jim_Free(cf);
5597 /* Free the interpreter structure. */
5598 Jim_Free(i);
5601 /* Returns the call frame relative to the level represented by
5602 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5604 * This function accepts the 'level' argument in the form
5605 * of the commands [uplevel] and [upvar].
5607 * Returns NULL on error.
5609 * Note: for a function accepting a relative integer as level suitable
5610 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5612 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5614 long level;
5615 const char *str;
5616 Jim_CallFrame *framePtr;
5618 if (levelObjPtr) {
5619 str = Jim_String(levelObjPtr);
5620 if (str[0] == '#') {
5621 char *endptr;
5623 level = jim_strtol(str + 1, &endptr);
5624 if (str[1] == '\0' || endptr[0] != '\0') {
5625 level = -1;
5628 else {
5629 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5630 level = -1;
5632 else {
5633 /* Convert from a relative to an absolute level */
5634 level = interp->framePtr->level - level;
5638 else {
5639 str = "1"; /* Needed to format the error message. */
5640 level = interp->framePtr->level - 1;
5643 if (level == 0) {
5644 return interp->topFramePtr;
5646 if (level > 0) {
5647 /* Lookup */
5648 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5649 if (framePtr->level == level) {
5650 return framePtr;
5655 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5656 return NULL;
5659 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5660 * as a relative integer like in the [info level ?level?] command.
5662 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5664 long level;
5665 Jim_CallFrame *framePtr;
5667 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5668 if (level <= 0) {
5669 /* Convert from a relative to an absolute level */
5670 level = interp->framePtr->level + level;
5673 if (level == 0) {
5674 return interp->topFramePtr;
5677 /* Lookup */
5678 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5679 if (framePtr->level == level) {
5680 return framePtr;
5685 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5686 return NULL;
5689 static void JimResetStackTrace(Jim_Interp *interp)
5691 Jim_DecrRefCount(interp, interp->stackTrace);
5692 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5693 Jim_IncrRefCount(interp->stackTrace);
5696 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5698 int len;
5700 /* Increment reference first in case these are the same object */
5701 Jim_IncrRefCount(stackTraceObj);
5702 Jim_DecrRefCount(interp, interp->stackTrace);
5703 interp->stackTrace = stackTraceObj;
5704 interp->errorFlag = 1;
5706 /* This is a bit ugly.
5707 * If the filename of the last entry of the stack trace is empty,
5708 * the next stack level should be added.
5710 len = Jim_ListLength(interp, interp->stackTrace);
5711 if (len >= 3) {
5712 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5713 interp->addStackTrace = 1;
5718 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5719 Jim_Obj *fileNameObj, int linenr)
5721 if (strcmp(procname, "unknown") == 0) {
5722 procname = "";
5724 if (!*procname && !Jim_Length(fileNameObj)) {
5725 /* No useful info here */
5726 return;
5729 if (Jim_IsShared(interp->stackTrace)) {
5730 Jim_DecrRefCount(interp, interp->stackTrace);
5731 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5732 Jim_IncrRefCount(interp->stackTrace);
5735 /* If we have no procname but the previous element did, merge with that frame */
5736 if (!*procname && Jim_Length(fileNameObj)) {
5737 /* Just a filename. Check the previous entry */
5738 int len = Jim_ListLength(interp, interp->stackTrace);
5740 if (len >= 3) {
5741 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5742 if (Jim_Length(objPtr)) {
5743 /* Yes, the previous level had procname */
5744 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5745 if (Jim_Length(objPtr) == 0) {
5746 /* But no filename, so merge the new info with that frame */
5747 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5748 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5749 return;
5755 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5756 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5757 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5760 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5761 void *data)
5763 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5765 assocEntryPtr->delProc = delProc;
5766 assocEntryPtr->data = data;
5767 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5770 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5772 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5774 if (entryPtr != NULL) {
5775 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5776 return assocEntryPtr->data;
5778 return NULL;
5781 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5783 return Jim_DeleteHashEntry(&interp->assocData, key);
5786 int Jim_GetExitCode(Jim_Interp *interp)
5788 return interp->exitCode;
5791 /* -----------------------------------------------------------------------------
5792 * Integer object
5793 * ---------------------------------------------------------------------------*/
5794 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5795 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5797 static const Jim_ObjType intObjType = {
5798 "int",
5799 NULL,
5800 NULL,
5801 UpdateStringOfInt,
5802 JIM_TYPE_NONE,
5805 /* A coerced double is closer to an int than a double.
5806 * It is an int value temporarily masquerading as a double value.
5807 * i.e. it has the same string value as an int and Jim_GetWide()
5808 * succeeds, but also Jim_GetDouble() returns the value directly.
5810 static const Jim_ObjType coercedDoubleObjType = {
5811 "coerced-double",
5812 NULL,
5813 NULL,
5814 UpdateStringOfInt,
5815 JIM_TYPE_NONE,
5819 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5821 char buf[JIM_INTEGER_SPACE + 1];
5822 jim_wide wideValue = JimWideValue(objPtr);
5823 int pos = 0;
5825 if (wideValue == 0) {
5826 buf[pos++] = '0';
5828 else {
5829 char tmp[JIM_INTEGER_SPACE];
5830 int num = 0;
5831 int i;
5833 if (wideValue < 0) {
5834 buf[pos++] = '-';
5835 i = wideValue % 10;
5836 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5837 * whereas C99 is always -6
5838 * coverity[dead_error_line]
5840 tmp[num++] = (i > 0) ? (10 - i) : -i;
5841 wideValue /= -10;
5844 while (wideValue) {
5845 tmp[num++] = wideValue % 10;
5846 wideValue /= 10;
5849 for (i = 0; i < num; i++) {
5850 buf[pos++] = '0' + tmp[num - i - 1];
5853 buf[pos] = 0;
5855 JimSetStringBytes(objPtr, buf);
5858 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5860 jim_wide wideValue;
5861 const char *str;
5863 if (objPtr->typePtr == &coercedDoubleObjType) {
5864 /* Simple switch */
5865 objPtr->typePtr = &intObjType;
5866 return JIM_OK;
5869 /* Get the string representation */
5870 str = Jim_String(objPtr);
5871 /* Try to convert into a jim_wide */
5872 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5873 if (flags & JIM_ERRMSG) {
5874 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5876 return JIM_ERR;
5878 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5879 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5880 return JIM_ERR;
5882 /* Free the old internal repr and set the new one. */
5883 Jim_FreeIntRep(interp, objPtr);
5884 objPtr->typePtr = &intObjType;
5885 objPtr->internalRep.wideValue = wideValue;
5886 return JIM_OK;
5889 #ifdef JIM_OPTIMIZATION
5890 static int JimIsWide(Jim_Obj *objPtr)
5892 return objPtr->typePtr == &intObjType;
5894 #endif
5896 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5898 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5899 return JIM_ERR;
5900 *widePtr = JimWideValue(objPtr);
5901 return JIM_OK;
5904 /* Get a wide but does not set an error if the format is bad. */
5905 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5907 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5908 return JIM_ERR;
5909 *widePtr = JimWideValue(objPtr);
5910 return JIM_OK;
5913 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5915 jim_wide wideValue;
5916 int retval;
5918 retval = Jim_GetWide(interp, objPtr, &wideValue);
5919 if (retval == JIM_OK) {
5920 *longPtr = (long)wideValue;
5921 return JIM_OK;
5923 return JIM_ERR;
5926 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5928 Jim_Obj *objPtr;
5930 objPtr = Jim_NewObj(interp);
5931 objPtr->typePtr = &intObjType;
5932 objPtr->bytes = NULL;
5933 objPtr->internalRep.wideValue = wideValue;
5934 return objPtr;
5937 /* -----------------------------------------------------------------------------
5938 * Double object
5939 * ---------------------------------------------------------------------------*/
5940 #define JIM_DOUBLE_SPACE 30
5942 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5943 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5945 static const Jim_ObjType doubleObjType = {
5946 "double",
5947 NULL,
5948 NULL,
5949 UpdateStringOfDouble,
5950 JIM_TYPE_NONE,
5953 #ifndef HAVE_ISNAN
5954 #undef isnan
5955 #define isnan(X) ((X) != (X))
5956 #endif
5957 #ifndef HAVE_ISINF
5958 #undef isinf
5959 #define isinf(X) (1.0 / (X) == 0.0)
5960 #endif
5962 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5964 double value = objPtr->internalRep.doubleValue;
5966 if (isnan(value)) {
5967 JimSetStringBytes(objPtr, "NaN");
5968 return;
5970 if (isinf(value)) {
5971 if (value < 0) {
5972 JimSetStringBytes(objPtr, "-Inf");
5974 else {
5975 JimSetStringBytes(objPtr, "Inf");
5977 return;
5980 char buf[JIM_DOUBLE_SPACE + 1];
5981 int i;
5982 int len = sprintf(buf, "%.12g", value);
5984 /* Add a final ".0" if necessary */
5985 for (i = 0; i < len; i++) {
5986 if (buf[i] == '.' || buf[i] == 'e') {
5987 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5988 /* If 'buf' ends in e-0nn or e+0nn, remove
5989 * the 0 after the + or - and reduce the length by 1
5991 char *e = strchr(buf, 'e');
5992 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5993 /* Move it up */
5994 e += 2;
5995 memmove(e, e + 1, len - (e - buf));
5997 #endif
5998 break;
6001 if (buf[i] == '\0') {
6002 buf[i++] = '.';
6003 buf[i++] = '0';
6004 buf[i] = '\0';
6006 JimSetStringBytes(objPtr, buf);
6010 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6012 double doubleValue;
6013 jim_wide wideValue;
6014 const char *str;
6016 /* Preserve the string representation.
6017 * Needed so we can convert back to int without loss
6019 str = Jim_String(objPtr);
6021 #ifdef HAVE_LONG_LONG
6022 /* Assume a 53 bit mantissa */
6023 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6024 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6026 if (objPtr->typePtr == &intObjType
6027 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6028 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6030 /* Direct conversion to coerced double */
6031 objPtr->typePtr = &coercedDoubleObjType;
6032 return JIM_OK;
6034 else
6035 #endif
6036 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6037 /* Managed to convert to an int, so we can use this as a cooerced double */
6038 Jim_FreeIntRep(interp, objPtr);
6039 objPtr->typePtr = &coercedDoubleObjType;
6040 objPtr->internalRep.wideValue = wideValue;
6041 return JIM_OK;
6043 else {
6044 /* Try to convert into a double */
6045 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6046 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6047 return JIM_ERR;
6049 /* Free the old internal repr and set the new one. */
6050 Jim_FreeIntRep(interp, objPtr);
6052 objPtr->typePtr = &doubleObjType;
6053 objPtr->internalRep.doubleValue = doubleValue;
6054 return JIM_OK;
6057 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6059 if (objPtr->typePtr == &coercedDoubleObjType) {
6060 *doublePtr = JimWideValue(objPtr);
6061 return JIM_OK;
6063 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6064 return JIM_ERR;
6066 if (objPtr->typePtr == &coercedDoubleObjType) {
6067 *doublePtr = JimWideValue(objPtr);
6069 else {
6070 *doublePtr = objPtr->internalRep.doubleValue;
6072 return JIM_OK;
6075 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6077 Jim_Obj *objPtr;
6079 objPtr = Jim_NewObj(interp);
6080 objPtr->typePtr = &doubleObjType;
6081 objPtr->bytes = NULL;
6082 objPtr->internalRep.doubleValue = doubleValue;
6083 return objPtr;
6086 /* -----------------------------------------------------------------------------
6087 * Boolean conversion
6088 * ---------------------------------------------------------------------------*/
6089 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6091 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6093 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6094 return JIM_ERR;
6095 *booleanPtr = (int) JimWideValue(objPtr);
6096 return JIM_OK;
6099 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6101 static const char * const falses[] = {
6102 "0", "false", "no", "off", NULL
6104 static const char * const trues[] = {
6105 "1", "true", "yes", "on", NULL
6108 int boolean;
6110 int index;
6111 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6112 boolean = 0;
6113 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6114 boolean = 1;
6115 } else {
6116 if (flags & JIM_ERRMSG) {
6117 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6119 return JIM_ERR;
6122 /* Free the old internal repr and set the new one. */
6123 Jim_FreeIntRep(interp, objPtr);
6124 objPtr->typePtr = &intObjType;
6125 objPtr->internalRep.wideValue = boolean;
6126 return JIM_OK;
6129 /* -----------------------------------------------------------------------------
6130 * List object
6131 * ---------------------------------------------------------------------------*/
6132 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6133 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6134 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6135 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6136 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6137 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6139 /* Note that while the elements of the list may contain references,
6140 * the list object itself can't. This basically means that the
6141 * list object string representation as a whole can't contain references
6142 * that are not presents in the single elements. */
6143 static const Jim_ObjType listObjType = {
6144 "list",
6145 FreeListInternalRep,
6146 DupListInternalRep,
6147 UpdateStringOfList,
6148 JIM_TYPE_NONE,
6151 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6153 int i;
6155 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6156 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6158 Jim_Free(objPtr->internalRep.listValue.ele);
6161 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6163 int i;
6165 JIM_NOTUSED(interp);
6167 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6168 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6169 dupPtr->internalRep.listValue.ele =
6170 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6171 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6172 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6173 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6174 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6176 dupPtr->typePtr = &listObjType;
6179 /* The following function checks if a given string can be encoded
6180 * into a list element without any kind of quoting, surrounded by braces,
6181 * or using escapes to quote. */
6182 #define JIM_ELESTR_SIMPLE 0
6183 #define JIM_ELESTR_BRACE 1
6184 #define JIM_ELESTR_QUOTE 2
6185 static unsigned char ListElementQuotingType(const char *s, int len)
6187 int i, level, blevel, trySimple = 1;
6189 /* Try with the SIMPLE case */
6190 if (len == 0)
6191 return JIM_ELESTR_BRACE;
6192 if (s[0] == '"' || s[0] == '{') {
6193 trySimple = 0;
6194 goto testbrace;
6196 for (i = 0; i < len; i++) {
6197 switch (s[i]) {
6198 case ' ':
6199 case '$':
6200 case '"':
6201 case '[':
6202 case ']':
6203 case ';':
6204 case '\\':
6205 case '\r':
6206 case '\n':
6207 case '\t':
6208 case '\f':
6209 case '\v':
6210 trySimple = 0;
6211 /* fall through */
6212 case '{':
6213 case '}':
6214 goto testbrace;
6217 return JIM_ELESTR_SIMPLE;
6219 testbrace:
6220 /* Test if it's possible to do with braces */
6221 if (s[len - 1] == '\\')
6222 return JIM_ELESTR_QUOTE;
6223 level = 0;
6224 blevel = 0;
6225 for (i = 0; i < len; i++) {
6226 switch (s[i]) {
6227 case '{':
6228 level++;
6229 break;
6230 case '}':
6231 level--;
6232 if (level < 0)
6233 return JIM_ELESTR_QUOTE;
6234 break;
6235 case '[':
6236 blevel++;
6237 break;
6238 case ']':
6239 blevel--;
6240 break;
6241 case '\\':
6242 if (s[i + 1] == '\n')
6243 return JIM_ELESTR_QUOTE;
6244 else if (s[i + 1] != '\0')
6245 i++;
6246 break;
6249 if (blevel < 0) {
6250 return JIM_ELESTR_QUOTE;
6253 if (level == 0) {
6254 if (!trySimple)
6255 return JIM_ELESTR_BRACE;
6256 for (i = 0; i < len; i++) {
6257 switch (s[i]) {
6258 case ' ':
6259 case '$':
6260 case '"':
6261 case '[':
6262 case ']':
6263 case ';':
6264 case '\\':
6265 case '\r':
6266 case '\n':
6267 case '\t':
6268 case '\f':
6269 case '\v':
6270 return JIM_ELESTR_BRACE;
6271 break;
6274 return JIM_ELESTR_SIMPLE;
6276 return JIM_ELESTR_QUOTE;
6279 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6280 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6281 * scenario.
6282 * Returns the length of the result.
6284 static int BackslashQuoteString(const char *s, int len, char *q)
6286 char *p = q;
6288 while (len--) {
6289 switch (*s) {
6290 case ' ':
6291 case '$':
6292 case '"':
6293 case '[':
6294 case ']':
6295 case '{':
6296 case '}':
6297 case ';':
6298 case '\\':
6299 *p++ = '\\';
6300 *p++ = *s++;
6301 break;
6302 case '\n':
6303 *p++ = '\\';
6304 *p++ = 'n';
6305 s++;
6306 break;
6307 case '\r':
6308 *p++ = '\\';
6309 *p++ = 'r';
6310 s++;
6311 break;
6312 case '\t':
6313 *p++ = '\\';
6314 *p++ = 't';
6315 s++;
6316 break;
6317 case '\f':
6318 *p++ = '\\';
6319 *p++ = 'f';
6320 s++;
6321 break;
6322 case '\v':
6323 *p++ = '\\';
6324 *p++ = 'v';
6325 s++;
6326 break;
6327 default:
6328 *p++ = *s++;
6329 break;
6332 *p = '\0';
6334 return p - q;
6337 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6339 #define STATIC_QUOTING_LEN 32
6340 int i, bufLen, realLength;
6341 const char *strRep;
6342 char *p;
6343 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6345 /* Estimate the space needed. */
6346 if (objc > STATIC_QUOTING_LEN) {
6347 quotingType = Jim_Alloc(objc);
6349 else {
6350 quotingType = staticQuoting;
6352 bufLen = 0;
6353 for (i = 0; i < objc; i++) {
6354 int len;
6356 strRep = Jim_GetString(objv[i], &len);
6357 quotingType[i] = ListElementQuotingType(strRep, len);
6358 switch (quotingType[i]) {
6359 case JIM_ELESTR_SIMPLE:
6360 if (i != 0 || strRep[0] != '#') {
6361 bufLen += len;
6362 break;
6364 /* Special case '#' on first element needs braces */
6365 quotingType[i] = JIM_ELESTR_BRACE;
6366 /* fall through */
6367 case JIM_ELESTR_BRACE:
6368 bufLen += len + 2;
6369 break;
6370 case JIM_ELESTR_QUOTE:
6371 bufLen += len * 2;
6372 break;
6374 bufLen++; /* elements separator. */
6376 bufLen++;
6378 /* Generate the string rep. */
6379 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6380 realLength = 0;
6381 for (i = 0; i < objc; i++) {
6382 int len, qlen;
6384 strRep = Jim_GetString(objv[i], &len);
6386 switch (quotingType[i]) {
6387 case JIM_ELESTR_SIMPLE:
6388 memcpy(p, strRep, len);
6389 p += len;
6390 realLength += len;
6391 break;
6392 case JIM_ELESTR_BRACE:
6393 *p++ = '{';
6394 memcpy(p, strRep, len);
6395 p += len;
6396 *p++ = '}';
6397 realLength += len + 2;
6398 break;
6399 case JIM_ELESTR_QUOTE:
6400 if (i == 0 && strRep[0] == '#') {
6401 *p++ = '\\';
6402 realLength++;
6404 qlen = BackslashQuoteString(strRep, len, p);
6405 p += qlen;
6406 realLength += qlen;
6407 break;
6409 /* Add a separating space */
6410 if (i + 1 != objc) {
6411 *p++ = ' ';
6412 realLength++;
6415 *p = '\0'; /* nul term. */
6416 objPtr->length = realLength;
6418 if (quotingType != staticQuoting) {
6419 Jim_Free(quotingType);
6423 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6425 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6428 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6430 struct JimParserCtx parser;
6431 const char *str;
6432 int strLen;
6433 Jim_Obj *fileNameObj;
6434 int linenr;
6436 if (objPtr->typePtr == &listObjType) {
6437 return JIM_OK;
6440 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6441 * it also preserves any source location of the dict elements
6442 * which can be very useful
6444 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6445 Jim_Obj **listObjPtrPtr;
6446 int len;
6447 int i;
6449 listObjPtrPtr = JimDictPairs(objPtr, &len);
6450 for (i = 0; i < len; i++) {
6451 Jim_IncrRefCount(listObjPtrPtr[i]);
6454 /* Now just switch the internal rep */
6455 Jim_FreeIntRep(interp, objPtr);
6456 objPtr->typePtr = &listObjType;
6457 objPtr->internalRep.listValue.len = len;
6458 objPtr->internalRep.listValue.maxLen = len;
6459 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6461 return JIM_OK;
6464 /* Try to preserve information about filename / line number */
6465 if (objPtr->typePtr == &sourceObjType) {
6466 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6467 linenr = objPtr->internalRep.sourceValue.lineNumber;
6469 else {
6470 fileNameObj = interp->emptyObj;
6471 linenr = 1;
6473 Jim_IncrRefCount(fileNameObj);
6475 /* Get the string representation */
6476 str = Jim_GetString(objPtr, &strLen);
6478 /* Free the old internal repr just now and initialize the
6479 * new one just now. The string->list conversion can't fail. */
6480 Jim_FreeIntRep(interp, objPtr);
6481 objPtr->typePtr = &listObjType;
6482 objPtr->internalRep.listValue.len = 0;
6483 objPtr->internalRep.listValue.maxLen = 0;
6484 objPtr->internalRep.listValue.ele = NULL;
6486 /* Convert into a list */
6487 if (strLen) {
6488 JimParserInit(&parser, str, strLen, linenr);
6489 while (!parser.eof) {
6490 Jim_Obj *elementPtr;
6492 JimParseList(&parser);
6493 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6494 continue;
6495 elementPtr = JimParserGetTokenObj(interp, &parser);
6496 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6497 ListAppendElement(objPtr, elementPtr);
6500 Jim_DecrRefCount(interp, fileNameObj);
6501 return JIM_OK;
6504 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6506 Jim_Obj *objPtr;
6508 objPtr = Jim_NewObj(interp);
6509 objPtr->typePtr = &listObjType;
6510 objPtr->bytes = NULL;
6511 objPtr->internalRep.listValue.ele = NULL;
6512 objPtr->internalRep.listValue.len = 0;
6513 objPtr->internalRep.listValue.maxLen = 0;
6515 if (len) {
6516 ListInsertElements(objPtr, 0, len, elements);
6519 return objPtr;
6522 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6523 * length of the vector. Note that the user of this function should make
6524 * sure that the list object can't shimmer while the vector returned
6525 * is in use, this vector is the one stored inside the internal representation
6526 * of the list object. This function is not exported, extensions should
6527 * always access to the List object elements using Jim_ListIndex(). */
6528 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6529 Jim_Obj ***listVec)
6531 *listLen = Jim_ListLength(interp, listObj);
6532 *listVec = listObj->internalRep.listValue.ele;
6535 /* Sorting uses ints, but commands may return wide */
6536 static int JimSign(jim_wide w)
6538 if (w == 0) {
6539 return 0;
6541 else if (w < 0) {
6542 return -1;
6544 return 1;
6547 /* ListSortElements type values */
6548 struct lsort_info {
6549 jmp_buf jmpbuf;
6550 Jim_Obj *command;
6551 Jim_Interp *interp;
6552 enum {
6553 JIM_LSORT_ASCII,
6554 JIM_LSORT_NOCASE,
6555 JIM_LSORT_INTEGER,
6556 JIM_LSORT_REAL,
6557 JIM_LSORT_COMMAND
6558 } type;
6559 int order;
6560 int index;
6561 int indexed;
6562 int unique;
6563 int (*subfn)(Jim_Obj **, Jim_Obj **);
6566 static struct lsort_info *sort_info;
6568 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6570 Jim_Obj *lObj, *rObj;
6572 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6573 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6574 longjmp(sort_info->jmpbuf, JIM_ERR);
6576 return sort_info->subfn(&lObj, &rObj);
6579 /* Sort the internal rep of a list. */
6580 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6582 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6585 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6587 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6590 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6592 jim_wide lhs = 0, rhs = 0;
6594 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6595 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6596 longjmp(sort_info->jmpbuf, JIM_ERR);
6599 return JimSign(lhs - rhs) * sort_info->order;
6602 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6604 double lhs = 0, rhs = 0;
6606 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6607 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6608 longjmp(sort_info->jmpbuf, JIM_ERR);
6610 if (lhs == rhs) {
6611 return 0;
6613 if (lhs > rhs) {
6614 return sort_info->order;
6616 return -sort_info->order;
6619 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6621 Jim_Obj *compare_script;
6622 int rc;
6624 jim_wide ret = 0;
6626 /* This must be a valid list */
6627 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6628 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6629 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6631 rc = Jim_EvalObj(sort_info->interp, compare_script);
6633 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6634 longjmp(sort_info->jmpbuf, rc);
6637 return JimSign(ret) * sort_info->order;
6640 /* Remove duplicate elements from the (sorted) list in-place, according to the
6641 * comparison function, comp.
6643 * Note that the last unique value is kept, not the first
6645 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6647 int src;
6648 int dst = 0;
6649 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6651 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6652 if (comp(&ele[dst], &ele[src]) == 0) {
6653 /* Match, so replace the dest with the current source */
6654 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6656 else {
6657 /* No match, so keep the current source and move to the next destination */
6658 dst++;
6660 ele[dst] = ele[src];
6662 /* At end of list, keep the final element */
6663 ele[++dst] = ele[src];
6665 /* Set the new length */
6666 listObjPtr->internalRep.listValue.len = dst;
6669 /* Sort a list *in place*. MUST be called with a non-shared list. */
6670 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6672 struct lsort_info *prev_info;
6674 typedef int (qsort_comparator) (const void *, const void *);
6675 int (*fn) (Jim_Obj **, Jim_Obj **);
6676 Jim_Obj **vector;
6677 int len;
6678 int rc;
6680 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6681 SetListFromAny(interp, listObjPtr);
6683 /* Allow lsort to be called reentrantly */
6684 prev_info = sort_info;
6685 sort_info = info;
6687 vector = listObjPtr->internalRep.listValue.ele;
6688 len = listObjPtr->internalRep.listValue.len;
6689 switch (info->type) {
6690 case JIM_LSORT_ASCII:
6691 fn = ListSortString;
6692 break;
6693 case JIM_LSORT_NOCASE:
6694 fn = ListSortStringNoCase;
6695 break;
6696 case JIM_LSORT_INTEGER:
6697 fn = ListSortInteger;
6698 break;
6699 case JIM_LSORT_REAL:
6700 fn = ListSortReal;
6701 break;
6702 case JIM_LSORT_COMMAND:
6703 fn = ListSortCommand;
6704 break;
6705 default:
6706 fn = NULL; /* avoid warning */
6707 JimPanic((1, "ListSort called with invalid sort type"));
6708 return -1; /* Should not be run but keeps static analysers happy */
6711 if (info->indexed) {
6712 /* Need to interpose a "list index" function */
6713 info->subfn = fn;
6714 fn = ListSortIndexHelper;
6717 if ((rc = setjmp(info->jmpbuf)) == 0) {
6718 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6720 if (info->unique && len > 1) {
6721 ListRemoveDuplicates(listObjPtr, fn);
6724 Jim_InvalidateStringRep(listObjPtr);
6726 sort_info = prev_info;
6728 return rc;
6731 /* This is the low-level function to insert elements into a list.
6732 * The higher-level Jim_ListInsertElements() performs shared object
6733 * check and invalidates the string repr. This version is used
6734 * in the internals of the List Object and is not exported.
6736 * NOTE: this function can be called only against objects
6737 * with internal type of List.
6739 * An insertion point (idx) of -1 means end-of-list.
6741 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6743 int currentLen = listPtr->internalRep.listValue.len;
6744 int requiredLen = currentLen + elemc;
6745 int i;
6746 Jim_Obj **point;
6748 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6749 if (requiredLen < 2) {
6750 /* Don't do allocations of under 4 pointers. */
6751 requiredLen = 4;
6753 else {
6754 requiredLen *= 2;
6757 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6758 sizeof(Jim_Obj *) * requiredLen);
6760 listPtr->internalRep.listValue.maxLen = requiredLen;
6762 if (idx < 0) {
6763 idx = currentLen;
6765 point = listPtr->internalRep.listValue.ele + idx;
6766 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6767 for (i = 0; i < elemc; ++i) {
6768 point[i] = elemVec[i];
6769 Jim_IncrRefCount(point[i]);
6771 listPtr->internalRep.listValue.len += elemc;
6774 /* Convenience call to ListInsertElements() to append a single element.
6776 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6778 ListInsertElements(listPtr, -1, 1, &objPtr);
6781 /* Appends every element of appendListPtr into listPtr.
6782 * Both have to be of the list type.
6783 * Convenience call to ListInsertElements()
6785 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6787 ListInsertElements(listPtr, -1,
6788 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6791 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6793 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6794 SetListFromAny(interp, listPtr);
6795 Jim_InvalidateStringRep(listPtr);
6796 ListAppendElement(listPtr, objPtr);
6799 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6801 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6802 SetListFromAny(interp, listPtr);
6803 SetListFromAny(interp, appendListPtr);
6804 Jim_InvalidateStringRep(listPtr);
6805 ListAppendList(listPtr, appendListPtr);
6808 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6810 SetListFromAny(interp, objPtr);
6811 return objPtr->internalRep.listValue.len;
6814 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6815 int objc, Jim_Obj *const *objVec)
6817 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6818 SetListFromAny(interp, listPtr);
6819 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6820 idx = listPtr->internalRep.listValue.len;
6821 else if (idx < 0)
6822 idx = 0;
6823 Jim_InvalidateStringRep(listPtr);
6824 ListInsertElements(listPtr, idx, objc, objVec);
6827 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6829 SetListFromAny(interp, listPtr);
6830 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6831 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6832 return NULL;
6834 if (idx < 0)
6835 idx = listPtr->internalRep.listValue.len + idx;
6836 return listPtr->internalRep.listValue.ele[idx];
6839 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6841 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6842 if (*objPtrPtr == NULL) {
6843 if (flags & JIM_ERRMSG) {
6844 Jim_SetResultString(interp, "list index out of range", -1);
6846 return JIM_ERR;
6848 return JIM_OK;
6851 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6852 Jim_Obj *newObjPtr, int flags)
6854 SetListFromAny(interp, listPtr);
6855 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6856 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6857 if (flags & JIM_ERRMSG) {
6858 Jim_SetResultString(interp, "list index out of range", -1);
6860 return JIM_ERR;
6862 if (idx < 0)
6863 idx = listPtr->internalRep.listValue.len + idx;
6864 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6865 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6866 Jim_IncrRefCount(newObjPtr);
6867 return JIM_OK;
6870 /* Modify the list stored in the variable named 'varNamePtr'
6871 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6872 * with the new element 'newObjptr'. (implements the [lset] command) */
6873 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6874 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6876 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6877 int shared, i, idx;
6879 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6880 if (objPtr == NULL)
6881 return JIM_ERR;
6882 if ((shared = Jim_IsShared(objPtr)))
6883 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6884 for (i = 0; i < indexc - 1; i++) {
6885 listObjPtr = objPtr;
6886 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6887 goto err;
6888 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6889 goto err;
6891 if (Jim_IsShared(objPtr)) {
6892 objPtr = Jim_DuplicateObj(interp, objPtr);
6893 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6895 Jim_InvalidateStringRep(listObjPtr);
6897 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6898 goto err;
6899 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6900 goto err;
6901 Jim_InvalidateStringRep(objPtr);
6902 Jim_InvalidateStringRep(varObjPtr);
6903 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6904 goto err;
6905 Jim_SetResult(interp, varObjPtr);
6906 return JIM_OK;
6907 err:
6908 if (shared) {
6909 Jim_FreeNewObj(interp, varObjPtr);
6911 return JIM_ERR;
6914 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6916 int i;
6917 int listLen = Jim_ListLength(interp, listObjPtr);
6918 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6920 for (i = 0; i < listLen; ) {
6921 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6922 if (++i != listLen) {
6923 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6926 return resObjPtr;
6929 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6931 int i;
6933 /* If all the objects in objv are lists,
6934 * it's possible to return a list as result, that's the
6935 * concatenation of all the lists. */
6936 for (i = 0; i < objc; i++) {
6937 if (!Jim_IsList(objv[i]))
6938 break;
6940 if (i == objc) {
6941 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6943 for (i = 0; i < objc; i++)
6944 ListAppendList(objPtr, objv[i]);
6945 return objPtr;
6947 else {
6948 /* Else... we have to glue strings together */
6949 int len = 0, objLen;
6950 char *bytes, *p;
6952 /* Compute the length */
6953 for (i = 0; i < objc; i++) {
6954 len += Jim_Length(objv[i]);
6956 if (objc)
6957 len += objc - 1;
6958 /* Create the string rep, and a string object holding it. */
6959 p = bytes = Jim_Alloc(len + 1);
6960 for (i = 0; i < objc; i++) {
6961 const char *s = Jim_GetString(objv[i], &objLen);
6963 /* Remove leading space */
6964 while (objLen && isspace(UCHAR(*s))) {
6965 s++;
6966 objLen--;
6967 len--;
6969 /* And trailing space */
6970 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6971 /* Handle trailing backslash-space case */
6972 if (objLen > 1 && s[objLen - 2] == '\\') {
6973 break;
6975 objLen--;
6976 len--;
6978 memcpy(p, s, objLen);
6979 p += objLen;
6980 if (i + 1 != objc) {
6981 if (objLen)
6982 *p++ = ' ';
6983 else {
6984 /* Drop the space calculated for this
6985 * element that is instead null. */
6986 len--;
6990 *p = '\0';
6991 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6995 /* Returns a list composed of the elements in the specified range.
6996 * first and start are directly accepted as Jim_Objects and
6997 * processed for the end?-index? case. */
6998 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6999 Jim_Obj *lastObjPtr)
7001 int first, last;
7002 int len, rangeLen;
7004 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7005 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7006 return NULL;
7007 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7008 first = JimRelToAbsIndex(len, first);
7009 last = JimRelToAbsIndex(len, last);
7010 JimRelToAbsRange(len, &first, &last, &rangeLen);
7011 if (first == 0 && last == len) {
7012 return listObjPtr;
7014 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7017 /* -----------------------------------------------------------------------------
7018 * Dict object
7019 * ---------------------------------------------------------------------------*/
7020 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7021 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7022 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7023 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7025 /* Dict HashTable Type.
7027 * Keys and Values are Jim objects. */
7029 static unsigned int JimObjectHTHashFunction(const void *key)
7031 int len;
7032 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7033 return Jim_GenHashFunction((const unsigned char *)str, len);
7036 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7038 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7041 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7043 Jim_IncrRefCount((Jim_Obj *)val);
7044 return (void *)val;
7047 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7049 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7052 static const Jim_HashTableType JimDictHashTableType = {
7053 JimObjectHTHashFunction, /* hash function */
7054 JimObjectHTKeyValDup, /* key dup */
7055 JimObjectHTKeyValDup, /* val dup */
7056 JimObjectHTKeyCompare, /* key compare */
7057 JimObjectHTKeyValDestructor, /* key destructor */
7058 JimObjectHTKeyValDestructor /* val destructor */
7061 /* Note that while the elements of the dict may contain references,
7062 * the list object itself can't. This basically means that the
7063 * dict object string representation as a whole can't contain references
7064 * that are not presents in the single elements. */
7065 static const Jim_ObjType dictObjType = {
7066 "dict",
7067 FreeDictInternalRep,
7068 DupDictInternalRep,
7069 UpdateStringOfDict,
7070 JIM_TYPE_NONE,
7073 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7075 JIM_NOTUSED(interp);
7077 Jim_FreeHashTable(objPtr->internalRep.ptr);
7078 Jim_Free(objPtr->internalRep.ptr);
7081 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7083 Jim_HashTable *ht, *dupHt;
7084 Jim_HashTableIterator htiter;
7085 Jim_HashEntry *he;
7087 /* Create a new hash table */
7088 ht = srcPtr->internalRep.ptr;
7089 dupHt = Jim_Alloc(sizeof(*dupHt));
7090 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7091 if (ht->size != 0)
7092 Jim_ExpandHashTable(dupHt, ht->size);
7093 /* Copy every element from the source to the dup hash table */
7094 JimInitHashTableIterator(ht, &htiter);
7095 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7096 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7099 dupPtr->internalRep.ptr = dupHt;
7100 dupPtr->typePtr = &dictObjType;
7103 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7105 Jim_HashTable *ht;
7106 Jim_HashTableIterator htiter;
7107 Jim_HashEntry *he;
7108 Jim_Obj **objv;
7109 int i;
7111 ht = dictPtr->internalRep.ptr;
7113 /* Turn the hash table into a flat vector of Jim_Objects. */
7114 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7115 JimInitHashTableIterator(ht, &htiter);
7116 i = 0;
7117 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7118 objv[i++] = Jim_GetHashEntryKey(he);
7119 objv[i++] = Jim_GetHashEntryVal(he);
7121 *len = i;
7122 return objv;
7125 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7127 /* Turn the hash table into a flat vector of Jim_Objects. */
7128 int len;
7129 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7131 /* And now generate the string rep as a list */
7132 JimMakeListStringRep(objPtr, objv, len);
7134 Jim_Free(objv);
7137 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7139 int listlen;
7141 if (objPtr->typePtr == &dictObjType) {
7142 return JIM_OK;
7145 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7146 /* A shared list, so get the string representation now to avoid
7147 * changing the order in case of fast conversion to dict.
7149 Jim_String(objPtr);
7152 /* For simplicity, convert a non-list object to a list and then to a dict */
7153 listlen = Jim_ListLength(interp, objPtr);
7154 if (listlen % 2) {
7155 Jim_SetResultString(interp, "missing value to go with key", -1);
7156 return JIM_ERR;
7158 else {
7159 /* Converting from a list to a dict can't fail */
7160 Jim_HashTable *ht;
7161 int i;
7163 ht = Jim_Alloc(sizeof(*ht));
7164 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7166 for (i = 0; i < listlen; i += 2) {
7167 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7168 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7170 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7173 Jim_FreeIntRep(interp, objPtr);
7174 objPtr->typePtr = &dictObjType;
7175 objPtr->internalRep.ptr = ht;
7177 return JIM_OK;
7181 /* Dict object API */
7183 /* Add an element to a dict. objPtr must be of the "dict" type.
7184 * The higher-level exported function is Jim_DictAddElement().
7185 * If an element with the specified key already exists, the value
7186 * associated is replaced with the new one.
7188 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7189 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7190 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7192 Jim_HashTable *ht = objPtr->internalRep.ptr;
7194 if (valueObjPtr == NULL) { /* unset */
7195 return Jim_DeleteHashEntry(ht, keyObjPtr);
7197 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7198 return JIM_OK;
7201 /* Add an element, higher-level interface for DictAddElement().
7202 * If valueObjPtr == NULL, the key is removed if it exists. */
7203 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7204 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7206 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7207 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7208 return JIM_ERR;
7210 Jim_InvalidateStringRep(objPtr);
7211 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7214 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7216 Jim_Obj *objPtr;
7217 int i;
7219 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7221 objPtr = Jim_NewObj(interp);
7222 objPtr->typePtr = &dictObjType;
7223 objPtr->bytes = NULL;
7224 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7225 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7226 for (i = 0; i < len; i += 2)
7227 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7228 return objPtr;
7231 /* Return the value associated to the specified dict key
7232 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7234 * Sets *objPtrPtr to non-NULL only upon success.
7236 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7237 Jim_Obj **objPtrPtr, int flags)
7239 Jim_HashEntry *he;
7240 Jim_HashTable *ht;
7242 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7243 return -1;
7245 ht = dictPtr->internalRep.ptr;
7246 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7247 if (flags & JIM_ERRMSG) {
7248 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7250 return JIM_ERR;
7252 *objPtrPtr = he->u.val;
7253 return JIM_OK;
7256 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7257 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7259 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7260 return JIM_ERR;
7262 *objPtrPtr = JimDictPairs(dictPtr, len);
7264 return JIM_OK;
7268 /* Return the value associated to the specified dict keys */
7269 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7270 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7272 int i;
7274 if (keyc == 0) {
7275 *objPtrPtr = dictPtr;
7276 return JIM_OK;
7279 for (i = 0; i < keyc; i++) {
7280 Jim_Obj *objPtr;
7282 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7283 if (rc != JIM_OK) {
7284 return rc;
7286 dictPtr = objPtr;
7288 *objPtrPtr = dictPtr;
7289 return JIM_OK;
7292 /* Modify the dict stored into the variable named 'varNamePtr'
7293 * setting the element specified by the 'keyc' keys objects in 'keyv',
7294 * with the new value of the element 'newObjPtr'.
7296 * If newObjPtr == NULL the operation is to remove the given key
7297 * from the dictionary.
7299 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7300 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7302 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7303 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7305 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7306 int shared, i;
7308 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7309 if (objPtr == NULL) {
7310 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7311 /* Cannot remove a key from non existing var */
7312 return JIM_ERR;
7314 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7315 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7316 Jim_FreeNewObj(interp, varObjPtr);
7317 return JIM_ERR;
7320 if ((shared = Jim_IsShared(objPtr)))
7321 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7322 for (i = 0; i < keyc; i++) {
7323 dictObjPtr = objPtr;
7325 /* Check if it's a valid dictionary */
7326 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7327 goto err;
7330 if (i == keyc - 1) {
7331 /* Last key: Note that error on unset with missing last key is OK */
7332 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7333 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7334 goto err;
7337 break;
7340 /* Check if the given key exists. */
7341 Jim_InvalidateStringRep(dictObjPtr);
7342 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7343 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7344 /* This key exists at the current level.
7345 * Make sure it's not shared!. */
7346 if (Jim_IsShared(objPtr)) {
7347 objPtr = Jim_DuplicateObj(interp, objPtr);
7348 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7351 else {
7352 /* Key not found. If it's an [unset] operation
7353 * this is an error. Only the last key may not
7354 * exist. */
7355 if (newObjPtr == NULL) {
7356 goto err;
7358 /* Otherwise set an empty dictionary
7359 * as key's value. */
7360 objPtr = Jim_NewDictObj(interp, NULL, 0);
7361 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7364 /* XXX: Is this necessary? */
7365 Jim_InvalidateStringRep(objPtr);
7366 Jim_InvalidateStringRep(varObjPtr);
7367 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7368 goto err;
7370 Jim_SetResult(interp, varObjPtr);
7371 return JIM_OK;
7372 err:
7373 if (shared) {
7374 Jim_FreeNewObj(interp, varObjPtr);
7376 return JIM_ERR;
7379 /* -----------------------------------------------------------------------------
7380 * Index object
7381 * ---------------------------------------------------------------------------*/
7382 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7383 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7385 static const Jim_ObjType indexObjType = {
7386 "index",
7387 NULL,
7388 NULL,
7389 UpdateStringOfIndex,
7390 JIM_TYPE_NONE,
7393 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7395 if (objPtr->internalRep.intValue == -1) {
7396 JimSetStringBytes(objPtr, "end");
7398 else {
7399 char buf[JIM_INTEGER_SPACE + 1];
7400 if (objPtr->internalRep.intValue >= 0) {
7401 sprintf(buf, "%d", objPtr->internalRep.intValue);
7403 else {
7404 /* Must be <= -2 */
7405 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7407 JimSetStringBytes(objPtr, buf);
7411 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7413 int idx, end = 0;
7414 const char *str;
7415 char *endptr;
7417 /* Get the string representation */
7418 str = Jim_String(objPtr);
7420 /* Try to convert into an index */
7421 if (strncmp(str, "end", 3) == 0) {
7422 end = 1;
7423 str += 3;
7424 idx = 0;
7426 else {
7427 idx = jim_strtol(str, &endptr);
7429 if (endptr == str) {
7430 goto badindex;
7432 str = endptr;
7435 /* Now str may include or +<num> or -<num> */
7436 if (*str == '+' || *str == '-') {
7437 int sign = (*str == '+' ? 1 : -1);
7439 idx += sign * jim_strtol(++str, &endptr);
7440 if (str == endptr || *endptr) {
7441 goto badindex;
7443 str = endptr;
7445 /* The only thing left should be spaces */
7446 while (isspace(UCHAR(*str))) {
7447 str++;
7449 if (*str) {
7450 goto badindex;
7452 if (end) {
7453 if (idx > 0) {
7454 idx = INT_MAX;
7456 else {
7457 /* end-1 is repesented as -2 */
7458 idx--;
7461 else if (idx < 0) {
7462 idx = -INT_MAX;
7465 /* Free the old internal repr and set the new one. */
7466 Jim_FreeIntRep(interp, objPtr);
7467 objPtr->typePtr = &indexObjType;
7468 objPtr->internalRep.intValue = idx;
7469 return JIM_OK;
7471 badindex:
7472 Jim_SetResultFormatted(interp,
7473 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7474 return JIM_ERR;
7477 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7479 /* Avoid shimmering if the object is an integer. */
7480 if (objPtr->typePtr == &intObjType) {
7481 jim_wide val = JimWideValue(objPtr);
7483 if (val < 0)
7484 *indexPtr = -INT_MAX;
7485 else if (val > INT_MAX)
7486 *indexPtr = INT_MAX;
7487 else
7488 *indexPtr = (int)val;
7489 return JIM_OK;
7491 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7492 return JIM_ERR;
7493 *indexPtr = objPtr->internalRep.intValue;
7494 return JIM_OK;
7497 /* -----------------------------------------------------------------------------
7498 * Return Code Object.
7499 * ---------------------------------------------------------------------------*/
7501 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7502 static const char * const jimReturnCodes[] = {
7503 "ok",
7504 "error",
7505 "return",
7506 "break",
7507 "continue",
7508 "signal",
7509 "exit",
7510 "eval",
7511 NULL
7514 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7516 static const Jim_ObjType returnCodeObjType = {
7517 "return-code",
7518 NULL,
7519 NULL,
7520 NULL,
7521 JIM_TYPE_NONE,
7524 /* Converts a (standard) return code to a string. Returns "?" for
7525 * non-standard return codes.
7527 const char *Jim_ReturnCode(int code)
7529 if (code < 0 || code >= (int)jimReturnCodesSize) {
7530 return "?";
7532 else {
7533 return jimReturnCodes[code];
7537 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7539 int returnCode;
7540 jim_wide wideValue;
7542 /* Try to convert into an integer */
7543 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7544 returnCode = (int)wideValue;
7545 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7546 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7547 return JIM_ERR;
7549 /* Free the old internal repr and set the new one. */
7550 Jim_FreeIntRep(interp, objPtr);
7551 objPtr->typePtr = &returnCodeObjType;
7552 objPtr->internalRep.intValue = returnCode;
7553 return JIM_OK;
7556 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7558 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7559 return JIM_ERR;
7560 *intPtr = objPtr->internalRep.intValue;
7561 return JIM_OK;
7564 /* -----------------------------------------------------------------------------
7565 * Expression Parsing
7566 * ---------------------------------------------------------------------------*/
7567 static int JimParseExprOperator(struct JimParserCtx *pc);
7568 static int JimParseExprNumber(struct JimParserCtx *pc);
7569 static int JimParseExprIrrational(struct JimParserCtx *pc);
7570 static int JimParseExprBoolean(struct JimParserCtx *pc);
7572 /* Exrp's Stack machine operators opcodes. */
7574 /* Binary operators (numbers) */
7575 enum
7577 /* Continues on from the JIM_TT_ space */
7578 /* Operations */
7579 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7580 JIM_EXPROP_DIV,
7581 JIM_EXPROP_MOD,
7582 JIM_EXPROP_SUB,
7583 JIM_EXPROP_ADD,
7584 JIM_EXPROP_LSHIFT,
7585 JIM_EXPROP_RSHIFT,
7586 JIM_EXPROP_ROTL,
7587 JIM_EXPROP_ROTR,
7588 JIM_EXPROP_LT,
7589 JIM_EXPROP_GT,
7590 JIM_EXPROP_LTE,
7591 JIM_EXPROP_GTE,
7592 JIM_EXPROP_NUMEQ,
7593 JIM_EXPROP_NUMNE,
7594 JIM_EXPROP_BITAND, /* 35 */
7595 JIM_EXPROP_BITXOR,
7596 JIM_EXPROP_BITOR,
7598 /* Note must keep these together */
7599 JIM_EXPROP_LOGICAND, /* 38 */
7600 JIM_EXPROP_LOGICAND_LEFT,
7601 JIM_EXPROP_LOGICAND_RIGHT,
7603 /* and these */
7604 JIM_EXPROP_LOGICOR, /* 41 */
7605 JIM_EXPROP_LOGICOR_LEFT,
7606 JIM_EXPROP_LOGICOR_RIGHT,
7608 /* and these */
7609 /* Ternary operators */
7610 JIM_EXPROP_TERNARY, /* 44 */
7611 JIM_EXPROP_TERNARY_LEFT,
7612 JIM_EXPROP_TERNARY_RIGHT,
7614 /* and these */
7615 JIM_EXPROP_COLON, /* 47 */
7616 JIM_EXPROP_COLON_LEFT,
7617 JIM_EXPROP_COLON_RIGHT,
7619 JIM_EXPROP_POW, /* 50 */
7621 /* Binary operators (strings) */
7622 JIM_EXPROP_STREQ, /* 51 */
7623 JIM_EXPROP_STRNE,
7624 JIM_EXPROP_STRIN,
7625 JIM_EXPROP_STRNI,
7627 /* Unary operators (numbers) */
7628 JIM_EXPROP_NOT, /* 55 */
7629 JIM_EXPROP_BITNOT,
7630 JIM_EXPROP_UNARYMINUS,
7631 JIM_EXPROP_UNARYPLUS,
7633 /* Functions */
7634 JIM_EXPROP_FUNC_FIRST, /* 59 */
7635 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7636 JIM_EXPROP_FUNC_WIDE,
7637 JIM_EXPROP_FUNC_ABS,
7638 JIM_EXPROP_FUNC_DOUBLE,
7639 JIM_EXPROP_FUNC_ROUND,
7640 JIM_EXPROP_FUNC_RAND,
7641 JIM_EXPROP_FUNC_SRAND,
7643 /* math functions from libm */
7644 JIM_EXPROP_FUNC_SIN, /* 65 */
7645 JIM_EXPROP_FUNC_COS,
7646 JIM_EXPROP_FUNC_TAN,
7647 JIM_EXPROP_FUNC_ASIN,
7648 JIM_EXPROP_FUNC_ACOS,
7649 JIM_EXPROP_FUNC_ATAN,
7650 JIM_EXPROP_FUNC_ATAN2,
7651 JIM_EXPROP_FUNC_SINH,
7652 JIM_EXPROP_FUNC_COSH,
7653 JIM_EXPROP_FUNC_TANH,
7654 JIM_EXPROP_FUNC_CEIL,
7655 JIM_EXPROP_FUNC_FLOOR,
7656 JIM_EXPROP_FUNC_EXP,
7657 JIM_EXPROP_FUNC_LOG,
7658 JIM_EXPROP_FUNC_LOG10,
7659 JIM_EXPROP_FUNC_SQRT,
7660 JIM_EXPROP_FUNC_POW,
7661 JIM_EXPROP_FUNC_HYPOT,
7662 JIM_EXPROP_FUNC_FMOD,
7665 struct JimExprState
7667 Jim_Obj **stack;
7668 int stacklen;
7669 int opcode;
7670 int skip;
7673 /* Operators table */
7674 typedef struct Jim_ExprOperator
7676 const char *name;
7677 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7678 unsigned char precedence;
7679 unsigned char arity;
7680 unsigned char lazy;
7681 unsigned char namelen;
7682 } Jim_ExprOperator;
7684 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7686 Jim_IncrRefCount(obj);
7687 e->stack[e->stacklen++] = obj;
7690 static Jim_Obj *ExprPop(struct JimExprState *e)
7692 return e->stack[--e->stacklen];
7695 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7697 int intresult = 1;
7698 int rc = JIM_OK;
7699 Jim_Obj *A = ExprPop(e);
7700 double dA, dC = 0;
7701 jim_wide wA, wC = 0;
7703 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7704 switch (e->opcode) {
7705 case JIM_EXPROP_FUNC_INT:
7706 case JIM_EXPROP_FUNC_WIDE:
7707 case JIM_EXPROP_FUNC_ROUND:
7708 case JIM_EXPROP_UNARYPLUS:
7709 wC = wA;
7710 break;
7711 case JIM_EXPROP_FUNC_DOUBLE:
7712 dC = wA;
7713 intresult = 0;
7714 break;
7715 case JIM_EXPROP_FUNC_ABS:
7716 wC = wA >= 0 ? wA : -wA;
7717 break;
7718 case JIM_EXPROP_UNARYMINUS:
7719 wC = -wA;
7720 break;
7721 case JIM_EXPROP_NOT:
7722 wC = !wA;
7723 break;
7724 default:
7725 abort();
7728 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7729 switch (e->opcode) {
7730 case JIM_EXPROP_FUNC_INT:
7731 case JIM_EXPROP_FUNC_WIDE:
7732 wC = dA;
7733 break;
7734 case JIM_EXPROP_FUNC_ROUND:
7735 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7736 break;
7737 case JIM_EXPROP_FUNC_DOUBLE:
7738 case JIM_EXPROP_UNARYPLUS:
7739 dC = dA;
7740 intresult = 0;
7741 break;
7742 case JIM_EXPROP_FUNC_ABS:
7743 dC = dA >= 0 ? dA : -dA;
7744 intresult = 0;
7745 break;
7746 case JIM_EXPROP_UNARYMINUS:
7747 dC = -dA;
7748 intresult = 0;
7749 break;
7750 case JIM_EXPROP_NOT:
7751 wC = !dA;
7752 break;
7753 default:
7754 abort();
7758 if (rc == JIM_OK) {
7759 if (intresult) {
7760 ExprPush(e, Jim_NewIntObj(interp, wC));
7762 else {
7763 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7767 Jim_DecrRefCount(interp, A);
7769 return rc;
7772 static double JimRandDouble(Jim_Interp *interp)
7774 unsigned long x;
7775 JimRandomBytes(interp, &x, sizeof(x));
7777 return (double)x / (unsigned long)~0;
7780 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7782 Jim_Obj *A = ExprPop(e);
7783 jim_wide wA;
7785 int rc = Jim_GetWide(interp, A, &wA);
7786 if (rc == JIM_OK) {
7787 switch (e->opcode) {
7788 case JIM_EXPROP_BITNOT:
7789 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7790 break;
7791 case JIM_EXPROP_FUNC_SRAND:
7792 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7793 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7794 break;
7795 default:
7796 abort();
7800 Jim_DecrRefCount(interp, A);
7802 return rc;
7805 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7807 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7809 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7811 return JIM_OK;
7814 #ifdef JIM_MATH_FUNCTIONS
7815 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7817 int rc;
7818 Jim_Obj *A = ExprPop(e);
7819 double dA, dC;
7821 rc = Jim_GetDouble(interp, A, &dA);
7822 if (rc == JIM_OK) {
7823 switch (e->opcode) {
7824 case JIM_EXPROP_FUNC_SIN:
7825 dC = sin(dA);
7826 break;
7827 case JIM_EXPROP_FUNC_COS:
7828 dC = cos(dA);
7829 break;
7830 case JIM_EXPROP_FUNC_TAN:
7831 dC = tan(dA);
7832 break;
7833 case JIM_EXPROP_FUNC_ASIN:
7834 dC = asin(dA);
7835 break;
7836 case JIM_EXPROP_FUNC_ACOS:
7837 dC = acos(dA);
7838 break;
7839 case JIM_EXPROP_FUNC_ATAN:
7840 dC = atan(dA);
7841 break;
7842 case JIM_EXPROP_FUNC_SINH:
7843 dC = sinh(dA);
7844 break;
7845 case JIM_EXPROP_FUNC_COSH:
7846 dC = cosh(dA);
7847 break;
7848 case JIM_EXPROP_FUNC_TANH:
7849 dC = tanh(dA);
7850 break;
7851 case JIM_EXPROP_FUNC_CEIL:
7852 dC = ceil(dA);
7853 break;
7854 case JIM_EXPROP_FUNC_FLOOR:
7855 dC = floor(dA);
7856 break;
7857 case JIM_EXPROP_FUNC_EXP:
7858 dC = exp(dA);
7859 break;
7860 case JIM_EXPROP_FUNC_LOG:
7861 dC = log(dA);
7862 break;
7863 case JIM_EXPROP_FUNC_LOG10:
7864 dC = log10(dA);
7865 break;
7866 case JIM_EXPROP_FUNC_SQRT:
7867 dC = sqrt(dA);
7868 break;
7869 default:
7870 abort();
7872 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7875 Jim_DecrRefCount(interp, A);
7877 return rc;
7879 #endif
7881 /* A binary operation on two ints */
7882 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7884 Jim_Obj *B = ExprPop(e);
7885 Jim_Obj *A = ExprPop(e);
7886 jim_wide wA, wB;
7887 int rc = JIM_ERR;
7889 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7890 jim_wide wC;
7892 rc = JIM_OK;
7894 switch (e->opcode) {
7895 case JIM_EXPROP_LSHIFT:
7896 wC = wA << wB;
7897 break;
7898 case JIM_EXPROP_RSHIFT:
7899 wC = wA >> wB;
7900 break;
7901 case JIM_EXPROP_BITAND:
7902 wC = wA & wB;
7903 break;
7904 case JIM_EXPROP_BITXOR:
7905 wC = wA ^ wB;
7906 break;
7907 case JIM_EXPROP_BITOR:
7908 wC = wA | wB;
7909 break;
7910 case JIM_EXPROP_MOD:
7911 if (wB == 0) {
7912 wC = 0;
7913 Jim_SetResultString(interp, "Division by zero", -1);
7914 rc = JIM_ERR;
7916 else {
7918 * From Tcl 8.x
7920 * This code is tricky: C doesn't guarantee much
7921 * about the quotient or remainder, but Tcl does.
7922 * The remainder always has the same sign as the
7923 * divisor and a smaller absolute value.
7925 int negative = 0;
7927 if (wB < 0) {
7928 wB = -wB;
7929 wA = -wA;
7930 negative = 1;
7932 wC = wA % wB;
7933 if (wC < 0) {
7934 wC += wB;
7936 if (negative) {
7937 wC = -wC;
7940 break;
7941 case JIM_EXPROP_ROTL:
7942 case JIM_EXPROP_ROTR:{
7943 /* uint32_t would be better. But not everyone has inttypes.h? */
7944 unsigned long uA = (unsigned long)wA;
7945 unsigned long uB = (unsigned long)wB;
7946 const unsigned int S = sizeof(unsigned long) * 8;
7948 /* Shift left by the word size or more is undefined. */
7949 uB %= S;
7951 if (e->opcode == JIM_EXPROP_ROTR) {
7952 uB = S - uB;
7954 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7955 break;
7957 default:
7958 abort();
7960 ExprPush(e, Jim_NewIntObj(interp, wC));
7964 Jim_DecrRefCount(interp, A);
7965 Jim_DecrRefCount(interp, B);
7967 return rc;
7971 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7972 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7974 int rc = JIM_OK;
7975 double dA, dB, dC = 0;
7976 jim_wide wA, wB, wC = 0;
7978 Jim_Obj *B = ExprPop(e);
7979 Jim_Obj *A = ExprPop(e);
7981 if ((A->typePtr != &doubleObjType || A->bytes) &&
7982 (B->typePtr != &doubleObjType || B->bytes) &&
7983 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7985 /* Both are ints */
7987 switch (e->opcode) {
7988 case JIM_EXPROP_POW:
7989 case JIM_EXPROP_FUNC_POW:
7990 if (wA == 0 && wB < 0) {
7991 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
7992 rc = JIM_ERR;
7993 goto done;
7995 wC = JimPowWide(wA, wB);
7996 goto intresult;
7997 case JIM_EXPROP_ADD:
7998 wC = wA + wB;
7999 goto intresult;
8000 case JIM_EXPROP_SUB:
8001 wC = wA - wB;
8002 goto intresult;
8003 case JIM_EXPROP_MUL:
8004 wC = wA * wB;
8005 goto intresult;
8006 case JIM_EXPROP_DIV:
8007 if (wB == 0) {
8008 Jim_SetResultString(interp, "Division by zero", -1);
8009 rc = JIM_ERR;
8010 goto done;
8012 else {
8014 * From Tcl 8.x
8016 * This code is tricky: C doesn't guarantee much
8017 * about the quotient or remainder, but Tcl does.
8018 * The remainder always has the same sign as the
8019 * divisor and a smaller absolute value.
8021 if (wB < 0) {
8022 wB = -wB;
8023 wA = -wA;
8025 wC = wA / wB;
8026 if (wA % wB < 0) {
8027 wC--;
8029 goto intresult;
8031 case JIM_EXPROP_LT:
8032 wC = wA < wB;
8033 goto intresult;
8034 case JIM_EXPROP_GT:
8035 wC = wA > wB;
8036 goto intresult;
8037 case JIM_EXPROP_LTE:
8038 wC = wA <= wB;
8039 goto intresult;
8040 case JIM_EXPROP_GTE:
8041 wC = wA >= wB;
8042 goto intresult;
8043 case JIM_EXPROP_NUMEQ:
8044 wC = wA == wB;
8045 goto intresult;
8046 case JIM_EXPROP_NUMNE:
8047 wC = wA != wB;
8048 goto intresult;
8051 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8052 switch (e->opcode) {
8053 #ifndef JIM_MATH_FUNCTIONS
8054 case JIM_EXPROP_POW:
8055 case JIM_EXPROP_FUNC_POW:
8056 case JIM_EXPROP_FUNC_ATAN2:
8057 case JIM_EXPROP_FUNC_HYPOT:
8058 case JIM_EXPROP_FUNC_FMOD:
8059 Jim_SetResultString(interp, "unsupported", -1);
8060 rc = JIM_ERR;
8061 goto done;
8062 #else
8063 case JIM_EXPROP_POW:
8064 case JIM_EXPROP_FUNC_POW:
8065 dC = pow(dA, dB);
8066 goto doubleresult;
8067 case JIM_EXPROP_FUNC_ATAN2:
8068 dC = atan2(dA, dB);
8069 goto doubleresult;
8070 case JIM_EXPROP_FUNC_HYPOT:
8071 dC = hypot(dA, dB);
8072 goto doubleresult;
8073 case JIM_EXPROP_FUNC_FMOD:
8074 dC = fmod(dA, dB);
8075 goto doubleresult;
8076 #endif
8077 case JIM_EXPROP_ADD:
8078 dC = dA + dB;
8079 goto doubleresult;
8080 case JIM_EXPROP_SUB:
8081 dC = dA - dB;
8082 goto doubleresult;
8083 case JIM_EXPROP_MUL:
8084 dC = dA * dB;
8085 goto doubleresult;
8086 case JIM_EXPROP_DIV:
8087 if (dB == 0) {
8088 #ifdef INFINITY
8089 dC = dA < 0 ? -INFINITY : INFINITY;
8090 #else
8091 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8092 #endif
8094 else {
8095 dC = dA / dB;
8097 goto doubleresult;
8098 case JIM_EXPROP_LT:
8099 wC = dA < dB;
8100 goto intresult;
8101 case JIM_EXPROP_GT:
8102 wC = dA > dB;
8103 goto intresult;
8104 case JIM_EXPROP_LTE:
8105 wC = dA <= dB;
8106 goto intresult;
8107 case JIM_EXPROP_GTE:
8108 wC = dA >= dB;
8109 goto intresult;
8110 case JIM_EXPROP_NUMEQ:
8111 wC = dA == dB;
8112 goto intresult;
8113 case JIM_EXPROP_NUMNE:
8114 wC = dA != dB;
8115 goto intresult;
8118 else {
8119 /* Handle the string case */
8121 /* XXX: Could optimise the eq/ne case by checking lengths */
8122 int i = Jim_StringCompareObj(interp, A, B, 0);
8124 switch (e->opcode) {
8125 case JIM_EXPROP_LT:
8126 wC = i < 0;
8127 goto intresult;
8128 case JIM_EXPROP_GT:
8129 wC = i > 0;
8130 goto intresult;
8131 case JIM_EXPROP_LTE:
8132 wC = i <= 0;
8133 goto intresult;
8134 case JIM_EXPROP_GTE:
8135 wC = i >= 0;
8136 goto intresult;
8137 case JIM_EXPROP_NUMEQ:
8138 wC = i == 0;
8139 goto intresult;
8140 case JIM_EXPROP_NUMNE:
8141 wC = i != 0;
8142 goto intresult;
8145 /* If we get here, it is an error */
8146 rc = JIM_ERR;
8147 done:
8148 Jim_DecrRefCount(interp, A);
8149 Jim_DecrRefCount(interp, B);
8150 return rc;
8151 intresult:
8152 ExprPush(e, Jim_NewIntObj(interp, wC));
8153 goto done;
8154 doubleresult:
8155 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8156 goto done;
8159 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8161 int listlen;
8162 int i;
8164 listlen = Jim_ListLength(interp, listObjPtr);
8165 for (i = 0; i < listlen; i++) {
8166 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8167 return 1;
8170 return 0;
8173 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8175 Jim_Obj *B = ExprPop(e);
8176 Jim_Obj *A = ExprPop(e);
8178 jim_wide wC;
8180 switch (e->opcode) {
8181 case JIM_EXPROP_STREQ:
8182 case JIM_EXPROP_STRNE:
8183 wC = Jim_StringEqObj(A, B);
8184 if (e->opcode == JIM_EXPROP_STRNE) {
8185 wC = !wC;
8187 break;
8188 case JIM_EXPROP_STRIN:
8189 wC = JimSearchList(interp, B, A);
8190 break;
8191 case JIM_EXPROP_STRNI:
8192 wC = !JimSearchList(interp, B, A);
8193 break;
8194 default:
8195 abort();
8197 ExprPush(e, Jim_NewIntObj(interp, wC));
8199 Jim_DecrRefCount(interp, A);
8200 Jim_DecrRefCount(interp, B);
8202 return JIM_OK;
8205 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8207 long l;
8208 double d;
8209 int b;
8211 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8212 return l != 0;
8214 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8215 return d != 0;
8217 if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8218 return b != 0;
8220 return -1;
8223 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8225 Jim_Obj *skip = ExprPop(e);
8226 Jim_Obj *A = ExprPop(e);
8227 int rc = JIM_OK;
8229 switch (ExprBool(interp, A)) {
8230 case 0:
8231 /* false, so skip RHS opcodes with a 0 result */
8232 e->skip = JimWideValue(skip);
8233 ExprPush(e, Jim_NewIntObj(interp, 0));
8234 break;
8236 case 1:
8237 /* true so continue */
8238 break;
8240 case -1:
8241 /* Invalid */
8242 rc = JIM_ERR;
8244 Jim_DecrRefCount(interp, A);
8245 Jim_DecrRefCount(interp, skip);
8247 return rc;
8250 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8252 Jim_Obj *skip = ExprPop(e);
8253 Jim_Obj *A = ExprPop(e);
8254 int rc = JIM_OK;
8256 switch (ExprBool(interp, A)) {
8257 case 0:
8258 /* false, so do nothing */
8259 break;
8261 case 1:
8262 /* true so skip RHS opcodes with a 1 result */
8263 e->skip = JimWideValue(skip);
8264 ExprPush(e, Jim_NewIntObj(interp, 1));
8265 break;
8267 case -1:
8268 /* Invalid */
8269 rc = JIM_ERR;
8270 break;
8272 Jim_DecrRefCount(interp, A);
8273 Jim_DecrRefCount(interp, skip);
8275 return rc;
8278 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8280 Jim_Obj *A = ExprPop(e);
8281 int rc = JIM_OK;
8283 switch (ExprBool(interp, A)) {
8284 case 0:
8285 ExprPush(e, Jim_NewIntObj(interp, 0));
8286 break;
8288 case 1:
8289 ExprPush(e, Jim_NewIntObj(interp, 1));
8290 break;
8292 case -1:
8293 /* Invalid */
8294 rc = JIM_ERR;
8295 break;
8297 Jim_DecrRefCount(interp, A);
8299 return rc;
8302 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8304 Jim_Obj *skip = ExprPop(e);
8305 Jim_Obj *A = ExprPop(e);
8306 int rc = JIM_OK;
8308 /* Repush A */
8309 ExprPush(e, A);
8311 switch (ExprBool(interp, A)) {
8312 case 0:
8313 /* false, skip RHS opcodes */
8314 e->skip = JimWideValue(skip);
8315 /* Push a dummy value */
8316 ExprPush(e, Jim_NewIntObj(interp, 0));
8317 break;
8319 case 1:
8320 /* true so do nothing */
8321 break;
8323 case -1:
8324 /* Invalid */
8325 rc = JIM_ERR;
8326 break;
8328 Jim_DecrRefCount(interp, A);
8329 Jim_DecrRefCount(interp, skip);
8331 return rc;
8334 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8336 Jim_Obj *skip = ExprPop(e);
8337 Jim_Obj *B = ExprPop(e);
8338 Jim_Obj *A = ExprPop(e);
8340 /* No need to check for A as non-boolean */
8341 if (ExprBool(interp, A)) {
8342 /* true, so skip RHS opcodes */
8343 e->skip = JimWideValue(skip);
8344 /* Repush B as the answer */
8345 ExprPush(e, B);
8348 Jim_DecrRefCount(interp, skip);
8349 Jim_DecrRefCount(interp, A);
8350 Jim_DecrRefCount(interp, B);
8351 return JIM_OK;
8354 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8356 return JIM_OK;
8359 enum
8361 LAZY_NONE,
8362 LAZY_OP,
8363 LAZY_LEFT,
8364 LAZY_RIGHT,
8365 RIGHT_ASSOC, /* reuse this field for right associativity too */
8368 /* name - precedence - arity - opcode
8370 * This array *must* be kept in sync with the JIM_EXPROP enum.
8372 * The following macros pre-compute the string length at compile time.
8374 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8375 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, LAZY_NONE)
8377 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8378 OPRINIT("*", 110, 2, JimExprOpBin),
8379 OPRINIT("/", 110, 2, JimExprOpBin),
8380 OPRINIT("%", 110, 2, JimExprOpIntBin),
8382 OPRINIT("-", 100, 2, JimExprOpBin),
8383 OPRINIT("+", 100, 2, JimExprOpBin),
8385 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8386 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8388 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8389 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8391 OPRINIT("<", 80, 2, JimExprOpBin),
8392 OPRINIT(">", 80, 2, JimExprOpBin),
8393 OPRINIT("<=", 80, 2, JimExprOpBin),
8394 OPRINIT(">=", 80, 2, JimExprOpBin),
8396 OPRINIT("==", 70, 2, JimExprOpBin),
8397 OPRINIT("!=", 70, 2, JimExprOpBin),
8399 OPRINIT("&", 50, 2, JimExprOpIntBin),
8400 OPRINIT("^", 49, 2, JimExprOpIntBin),
8401 OPRINIT("|", 48, 2, JimExprOpIntBin),
8403 OPRINIT_ATTR("&&", 10, 2, NULL, LAZY_OP),
8404 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8405 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8407 OPRINIT_ATTR("||", 9, 2, NULL, LAZY_OP),
8408 OPRINIT_ATTR(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8409 OPRINIT_ATTR(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8411 OPRINIT_ATTR("?", 5, 2, JimExprOpNull, LAZY_OP),
8412 OPRINIT_ATTR(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8413 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8415 OPRINIT_ATTR(":", 5, 2, JimExprOpNull, LAZY_OP),
8416 OPRINIT_ATTR(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8417 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8419 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8420 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, RIGHT_ASSOC),
8422 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8423 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8425 OPRINIT("in", 55, 2, JimExprOpStrBin),
8426 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8428 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8429 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8430 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8431 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8435 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8436 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8437 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8438 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8439 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8440 OPRINIT("rand", 200, 0, JimExprOpNone),
8441 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8443 #ifdef JIM_MATH_FUNCTIONS
8444 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8445 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8446 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8447 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8448 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8449 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8450 OPRINIT("atan2", 200, 2, JimExprOpBin),
8451 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8452 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8453 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8454 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8455 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8456 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8457 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8458 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8459 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8460 OPRINIT("pow", 200, 2, JimExprOpBin),
8461 OPRINIT("hypot", 200, 2, JimExprOpBin),
8462 OPRINIT("fmod", 200, 2, JimExprOpBin),
8463 #endif
8465 #undef OPRINIT
8466 #undef OPRINIT_LAZY
8468 #define JIM_EXPR_OPERATORS_NUM \
8469 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8471 static int JimParseExpression(struct JimParserCtx *pc)
8473 /* Discard spaces and quoted newline */
8474 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8475 if (*pc->p == '\n') {
8476 pc->linenr++;
8478 pc->p++;
8479 pc->len--;
8482 /* Common case */
8483 pc->tline = pc->linenr;
8484 pc->tstart = pc->p;
8486 if (pc->len == 0) {
8487 pc->tend = pc->p;
8488 pc->tt = JIM_TT_EOL;
8489 pc->eof = 1;
8490 return JIM_OK;
8492 switch (*(pc->p)) {
8493 case '(':
8494 pc->tt = JIM_TT_SUBEXPR_START;
8495 goto singlechar;
8496 case ')':
8497 pc->tt = JIM_TT_SUBEXPR_END;
8498 goto singlechar;
8499 case ',':
8500 pc->tt = JIM_TT_SUBEXPR_COMMA;
8501 singlechar:
8502 pc->tend = pc->p;
8503 pc->p++;
8504 pc->len--;
8505 break;
8506 case '[':
8507 return JimParseCmd(pc);
8508 case '$':
8509 if (JimParseVar(pc) == JIM_ERR)
8510 return JimParseExprOperator(pc);
8511 else {
8512 /* Don't allow expr sugar in expressions */
8513 if (pc->tt == JIM_TT_EXPRSUGAR) {
8514 return JIM_ERR;
8516 return JIM_OK;
8518 break;
8519 case '0':
8520 case '1':
8521 case '2':
8522 case '3':
8523 case '4':
8524 case '5':
8525 case '6':
8526 case '7':
8527 case '8':
8528 case '9':
8529 case '.':
8530 return JimParseExprNumber(pc);
8531 case '"':
8532 return JimParseQuote(pc);
8533 case '{':
8534 return JimParseBrace(pc);
8536 case 'N':
8537 case 'I':
8538 case 'n':
8539 case 'i':
8540 if (JimParseExprIrrational(pc) == JIM_ERR)
8541 if (JimParseExprBoolean(pc) == JIM_ERR)
8542 return JimParseExprOperator(pc);
8543 break;
8544 case 't':
8545 case 'f':
8546 case 'o':
8547 case 'y':
8548 if (JimParseExprBoolean(pc) == JIM_ERR)
8549 return JimParseExprOperator(pc);
8550 break;
8551 default:
8552 return JimParseExprOperator(pc);
8553 break;
8555 return JIM_OK;
8558 static int JimParseExprNumber(struct JimParserCtx *pc)
8560 char *end;
8562 /* Assume an integer for now */
8563 pc->tt = JIM_TT_EXPR_INT;
8565 jim_strtoull(pc->p, (char **)&pc->p);
8566 /* Tried as an integer, but perhaps it parses as a double */
8567 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8568 /* Some stupid compilers insist they are cleverer that
8569 * we are. Even a (void) cast doesn't prevent this warning!
8571 if (strtod(pc->tstart, &end)) { /* nothing */ }
8572 if (end == pc->tstart)
8573 return JIM_ERR;
8574 if (end > pc->p) {
8575 /* Yes, double captured more chars */
8576 pc->tt = JIM_TT_EXPR_DOUBLE;
8577 pc->p = end;
8580 pc->tend = pc->p - 1;
8581 pc->len -= (pc->p - pc->tstart);
8582 return JIM_OK;
8585 static int JimParseExprIrrational(struct JimParserCtx *pc)
8587 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8588 int i;
8590 for (i = 0; irrationals[i]; i++) {
8591 const char *irr = irrationals[i];
8593 if (strncmp(irr, pc->p, 3) == 0) {
8594 pc->p += 3;
8595 pc->len -= 3;
8596 pc->tend = pc->p - 1;
8597 pc->tt = JIM_TT_EXPR_DOUBLE;
8598 return JIM_OK;
8601 return JIM_ERR;
8604 static int JimParseExprBoolean(struct JimParserCtx *pc)
8606 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8607 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8608 int i;
8610 for (i = 0; booleans[i]; i++) {
8611 const char *boolean = booleans[i];
8612 int length = lengths[i];
8614 if (strncmp(boolean, pc->p, length) == 0) {
8615 pc->p += length;
8616 pc->len -= length;
8617 pc->tend = pc->p - 1;
8618 pc->tt = JIM_TT_EXPR_BOOLEAN;
8619 return JIM_OK;
8622 return JIM_ERR;
8625 static int JimParseExprOperator(struct JimParserCtx *pc)
8627 int i;
8628 int bestIdx = -1, bestLen = 0;
8630 /* Try to get the longest match. */
8631 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8632 const char * const opname = Jim_ExprOperators[i].name;
8633 const int oplen = Jim_ExprOperators[i].namelen;
8635 if (opname == NULL || opname[0] != pc->p[0]) {
8636 continue;
8639 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8640 bestIdx = i + JIM_TT_EXPR_OP;
8641 bestLen = oplen;
8644 if (bestIdx == -1) {
8645 return JIM_ERR;
8648 /* Validate paretheses around function arguments */
8649 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8650 const char *p = pc->p + bestLen;
8651 int len = pc->len - bestLen;
8653 while (len && isspace(UCHAR(*p))) {
8654 len--;
8655 p++;
8657 if (*p != '(') {
8658 return JIM_ERR;
8661 pc->tend = pc->p + bestLen - 1;
8662 pc->p += bestLen;
8663 pc->len -= bestLen;
8665 pc->tt = bestIdx;
8666 return JIM_OK;
8669 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8671 static Jim_ExprOperator dummy_op;
8672 if (opcode < JIM_TT_EXPR_OP) {
8673 return &dummy_op;
8675 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8678 const char *jim_tt_name(int type)
8680 static const char * const tt_names[JIM_TT_EXPR_OP] =
8681 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8682 "DBL", "BOO", "$()" };
8683 if (type < JIM_TT_EXPR_OP) {
8684 return tt_names[type];
8686 else if (type == JIM_EXPROP_UNARYMINUS) {
8687 return "-VE";
8689 else if (type == JIM_EXPROP_UNARYPLUS) {
8690 return "+VE";
8692 else {
8693 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8694 static char buf[20];
8696 if (op->name) {
8697 return op->name;
8699 sprintf(buf, "(%d)", type);
8700 return buf;
8704 /* -----------------------------------------------------------------------------
8705 * Expression Object
8706 * ---------------------------------------------------------------------------*/
8707 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8708 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8709 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8711 static const Jim_ObjType exprObjType = {
8712 "expression",
8713 FreeExprInternalRep,
8714 DupExprInternalRep,
8715 NULL,
8716 JIM_TYPE_REFERENCES,
8719 /* Expr bytecode structure */
8720 typedef struct ExprByteCode
8722 ScriptToken *token; /* Tokens array. */
8723 int len; /* Length as number of tokens. */
8724 int inUse; /* Used for sharing. */
8725 } ExprByteCode;
8727 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8729 int i;
8731 for (i = 0; i < expr->len; i++) {
8732 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8734 Jim_Free(expr->token);
8735 Jim_Free(expr);
8738 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8740 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8742 if (expr) {
8743 if (--expr->inUse != 0) {
8744 return;
8747 ExprFreeByteCode(interp, expr);
8751 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8753 JIM_NOTUSED(interp);
8754 JIM_NOTUSED(srcPtr);
8756 /* Just returns an simple string. */
8757 dupPtr->typePtr = NULL;
8760 /* Check if an expr program looks correct
8761 * Sets an error result on invalid
8763 static int ExprCheckCorrectness(Jim_Interp *interp, Jim_Obj *exprObjPtr, ExprByteCode * expr)
8765 int i;
8766 int stacklen = 0;
8767 int ternary = 0;
8768 int lasttt = JIM_TT_NONE;
8769 const char *errmsg;
8771 /* Try to check if there are stack underflows,
8772 * and make sure at the end of the program there is
8773 * a single result on the stack. */
8774 for (i = 0; i < expr->len; i++) {
8775 ScriptToken *t = &expr->token[i];
8776 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8777 lasttt = t->type;
8779 stacklen -= op->arity;
8781 if (stacklen < 0) {
8782 break;
8784 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8785 ternary++;
8787 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8788 ternary--;
8791 /* All operations and operands add one to the stack */
8792 stacklen++;
8794 if (stacklen == 1 && ternary == 0) {
8795 return JIM_OK;
8798 if (stacklen <= 0) {
8799 /* Too few args */
8800 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8801 errmsg = "too few arguments for math function";
8802 Jim_SetResultString(interp, "too few arguments for math function", -1);
8803 } else {
8804 errmsg = "premature end of expression";
8807 else if (stacklen > 1) {
8808 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8809 errmsg = "too many arguments for math function";
8810 } else {
8811 errmsg = "extra tokens at end of expression";
8814 else {
8815 errmsg = "invalid ternary expression";
8817 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": %s", exprObjPtr, errmsg);
8818 return JIM_ERR;
8821 /* This procedure converts every occurrence of || and && opereators
8822 * in lazy unary versions.
8824 * a b || is converted into:
8826 * a <offset> |L b |R
8828 * a b && is converted into:
8830 * a <offset> &L b &R
8832 * "|L" checks if 'a' is true:
8833 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8834 * the opcode just after |R.
8835 * 2) if it is false does nothing.
8836 * "|R" checks if 'b' is true:
8837 * 1) if it is true pushes 1, otherwise pushes 0.
8839 * "&L" checks if 'a' is true:
8840 * 1) if it is true does nothing.
8841 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8842 * the opcode just after &R
8843 * "&R" checks if 'a' is true:
8844 * if it is true pushes 1, otherwise pushes 0.
8846 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8848 int i;
8850 int leftindex, arity, offset;
8852 /* Search for the end of the first operator */
8853 leftindex = expr->len - 1;
8855 arity = 1;
8856 while (arity) {
8857 ScriptToken *tt = &expr->token[leftindex];
8859 if (tt->type >= JIM_TT_EXPR_OP) {
8860 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8862 arity--;
8863 if (--leftindex < 0) {
8864 return JIM_ERR;
8867 leftindex++;
8869 /* Move them up */
8870 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8871 sizeof(*expr->token) * (expr->len - leftindex));
8872 expr->len += 2;
8873 offset = (expr->len - leftindex) - 1;
8875 /* Now we rely on the fact that the left and right version have opcodes
8876 * 1 and 2 after the main opcode respectively
8878 expr->token[leftindex + 1].type = t->type + 1;
8879 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8881 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8882 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8884 /* Now add the 'R' operator */
8885 expr->token[expr->len].objPtr = interp->emptyObj;
8886 expr->token[expr->len].type = t->type + 2;
8887 expr->len++;
8889 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8890 for (i = leftindex - 1; i > 0; i--) {
8891 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8892 if (op->lazy == LAZY_LEFT) {
8893 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8894 JimWideValue(expr->token[i - 1].objPtr) += 2;
8898 return JIM_OK;
8901 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8903 struct ScriptToken *token = &expr->token[expr->len];
8904 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8906 if (op->lazy == LAZY_OP) {
8907 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8908 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8909 return JIM_ERR;
8912 else {
8913 token->objPtr = interp->emptyObj;
8914 token->type = t->type;
8915 expr->len++;
8917 return JIM_OK;
8921 * Returns the index of the COLON_LEFT to the left of 'right_index'
8922 * taking into account nesting.
8924 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8926 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8928 int ternary_count = 1;
8930 right_index--;
8932 while (right_index > 1) {
8933 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8934 ternary_count--;
8936 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8937 ternary_count++;
8939 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8940 return right_index;
8942 right_index--;
8945 /*notreached*/
8946 return -1;
8950 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8952 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8953 * Otherwise returns 0.
8955 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8957 int i = right_index - 1;
8958 int ternary_count = 1;
8960 while (i > 1) {
8961 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8962 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8963 *prev_right_index = i - 2;
8964 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8965 return 1;
8968 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8969 if (ternary_count == 0) {
8970 return 0;
8972 ternary_count++;
8974 i--;
8976 return 0;
8980 * ExprTernaryReorderExpression description
8981 * ========================================
8983 * ?: is right-to-left associative which doesn't work with the stack-based
8984 * expression engine. The fix is to reorder the bytecode.
8986 * The expression:
8988 * expr 1?2:0?3:4
8990 * Has initial bytecode:
8992 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8993 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8995 * The fix involves simulating this expression instead:
8997 * expr 1?2:(0?3:4)
8999 * With the following bytecode:
9001 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
9002 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
9004 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
9005 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
9006 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
9007 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
9009 * ExprTernaryReorderExpression works thus as follows :
9010 * - start from the end of the stack
9011 * - while walking towards the beginning of the stack
9012 * if token=JIM_EXPROP_COLON_RIGHT then
9013 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
9014 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
9015 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
9016 * if all found then
9017 * perform the rotation
9018 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
9019 * end if
9020 * end if
9022 * Note: care has to be taken for nested ternary constructs!!!
9024 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
9026 int i;
9028 for (i = expr->len - 1; i > 1; i--) {
9029 int prev_right_index;
9030 int prev_left_index;
9031 int j;
9032 ScriptToken tmp;
9034 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
9035 continue;
9038 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
9039 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
9040 continue;
9044 ** rotate tokens down
9046 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
9047 ** | | |
9048 ** | V V
9049 ** | [...] : ...
9050 ** | | |
9051 ** | V V
9052 ** | [...] : ...
9053 ** | | |
9054 ** | V V
9055 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
9057 tmp = expr->token[prev_right_index];
9058 for (j = prev_right_index; j < i; j++) {
9059 expr->token[j] = expr->token[j + 1];
9061 expr->token[i] = tmp;
9063 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
9065 * This is 'colon left increment' = i - prev_right_index
9067 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
9068 * [prev_left_index-1] : skip_count
9071 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
9073 /* Adjust for i-- in the loop */
9074 i++;
9078 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9080 Jim_Stack stack;
9081 ExprByteCode *expr;
9082 int ok = 1;
9083 int i;
9084 int prevtt = JIM_TT_NONE;
9085 int have_ternary = 0;
9087 /* -1 for EOL */
9088 int count = tokenlist->count - 1;
9090 expr = Jim_Alloc(sizeof(*expr));
9091 expr->inUse = 1;
9092 expr->len = 0;
9094 Jim_InitStack(&stack);
9096 /* Need extra bytecodes for lazy operators.
9097 * Also check for the ternary operator
9099 for (i = 0; i < tokenlist->count; i++) {
9100 ParseToken *t = &tokenlist->list[i];
9101 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
9103 if (op->lazy == LAZY_OP) {
9104 count += 2;
9105 /* Ternary is a lazy op but also needs reordering */
9106 if (t->type == JIM_EXPROP_TERNARY) {
9107 have_ternary = 1;
9112 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
9114 for (i = 0; i < tokenlist->count && ok; i++) {
9115 ParseToken *t = &tokenlist->list[i];
9117 /* Next token will be stored here */
9118 struct ScriptToken *token = &expr->token[expr->len];
9120 if (t->type == JIM_TT_EOL) {
9121 break;
9124 if (TOKEN_IS_EXPR_OP(t->type)) {
9125 const struct Jim_ExprOperator *op;
9126 ParseToken *tt;
9128 /* Convert -/+ to unary minus or unary plus if necessary */
9129 if (prevtt == JIM_TT_NONE || prevtt == JIM_TT_SUBEXPR_START || prevtt == JIM_TT_SUBEXPR_COMMA || prevtt >= JIM_TT_EXPR_OP) {
9130 if (t->type == JIM_EXPROP_SUB) {
9131 t->type = JIM_EXPROP_UNARYMINUS;
9133 else if (t->type == JIM_EXPROP_ADD) {
9134 t->type = JIM_EXPROP_UNARYPLUS;
9138 op = JimExprOperatorInfoByOpcode(t->type);
9140 /* Handle precedence */
9141 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9142 const struct Jim_ExprOperator *tt_op =
9143 JimExprOperatorInfoByOpcode(tt->type);
9145 /* Note that right-to-left associativity of ?: operator is handled later.
9148 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9149 /* Don't reduce if right associative with equal precedence? */
9150 if (tt_op->precedence == op->precedence && tt_op->lazy == RIGHT_ASSOC) {
9151 break;
9153 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9154 ok = 0;
9155 goto err;
9157 Jim_StackPop(&stack);
9159 else {
9160 break;
9163 Jim_StackPush(&stack, t);
9165 else if (t->type == JIM_TT_SUBEXPR_START) {
9166 Jim_StackPush(&stack, t);
9168 else if (t->type == JIM_TT_SUBEXPR_END || t->type == JIM_TT_SUBEXPR_COMMA) {
9169 /* Reduce the expression back to the previous ( or , */
9170 ok = 0;
9171 while (Jim_StackLen(&stack)) {
9172 ParseToken *tt = Jim_StackPop(&stack);
9174 if (tt->type == JIM_TT_SUBEXPR_START || tt->type == JIM_TT_SUBEXPR_COMMA) {
9175 if (t->type == JIM_TT_SUBEXPR_COMMA) {
9176 /* Need to push back the previous START or COMMA in the case of comma */
9177 Jim_StackPush(&stack, tt);
9179 ok = 1;
9180 break;
9182 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9183 goto err;
9186 if (!ok) {
9187 Jim_SetResultFormatted(interp, "Unexpected close parenthesis in expression: \"%#s\"", exprObjPtr);
9188 goto err;
9191 else {
9192 Jim_Obj *objPtr = NULL;
9194 /* This is a simple non-operator term, so create and push the appropriate object */
9195 token->type = t->type;
9197 /* Two consecutive terms without an operator is invalid */
9198 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9199 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", exprObjPtr);
9200 ok = 0;
9201 goto err;
9204 /* Immediately create a double or int object? */
9205 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9206 char *endptr;
9207 if (t->type == JIM_TT_EXPR_INT) {
9208 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9210 else {
9211 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9213 if (endptr != t->token + t->len) {
9214 /* Conversion failed, so just store it as a string */
9215 Jim_FreeNewObj(interp, objPtr);
9216 objPtr = NULL;
9220 if (objPtr) {
9221 token->objPtr = objPtr;
9223 else {
9224 /* Everything else is stored a simple string term */
9225 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
9226 if (t->type == JIM_TT_CMD) {
9227 /* Only commands need source info */
9228 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
9231 expr->len++;
9233 prevtt = t->type;
9236 /* Reduce any remaining subexpr */
9237 while (Jim_StackLen(&stack)) {
9238 ParseToken *tt = Jim_StackPop(&stack);
9240 if (tt->type == JIM_TT_SUBEXPR_START) {
9241 ok = 0;
9242 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9243 goto err;
9245 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9246 ok = 0;
9247 goto err;
9251 if (have_ternary) {
9252 ExprTernaryReorderExpression(interp, expr);
9255 err:
9256 /* Free the stack used for the compilation. */
9257 Jim_FreeStack(&stack);
9259 for (i = 0; i < expr->len; i++) {
9260 Jim_IncrRefCount(expr->token[i].objPtr);
9263 if (!ok) {
9264 ExprFreeByteCode(interp, expr);
9265 return NULL;
9268 return expr;
9272 /* This method takes the string representation of an expression
9273 * and generates a program for the Expr's stack-based VM. */
9274 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9276 int exprTextLen;
9277 const char *exprText;
9278 struct JimParserCtx parser;
9279 struct ExprByteCode *expr;
9280 ParseTokenList tokenlist;
9281 int line;
9282 Jim_Obj *fileNameObj;
9283 int rc = JIM_ERR;
9285 /* Try to get information about filename / line number */
9286 if (objPtr->typePtr == &sourceObjType) {
9287 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9288 line = objPtr->internalRep.sourceValue.lineNumber;
9290 else {
9291 fileNameObj = interp->emptyObj;
9292 line = 1;
9294 Jim_IncrRefCount(fileNameObj);
9296 exprText = Jim_GetString(objPtr, &exprTextLen);
9298 /* Initially tokenise the expression into tokenlist */
9299 ScriptTokenListInit(&tokenlist);
9301 JimParserInit(&parser, exprText, exprTextLen, line);
9302 while (!parser.eof) {
9303 if (JimParseExpression(&parser) != JIM_OK) {
9304 ScriptTokenListFree(&tokenlist);
9305 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9306 expr = NULL;
9307 goto err;
9310 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9311 parser.tline);
9314 #ifdef DEBUG_SHOW_EXPR_TOKENS
9316 int i;
9317 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9318 for (i = 0; i < tokenlist.count; i++) {
9319 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9320 tokenlist.list[i].len, tokenlist.list[i].token);
9323 #endif
9325 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9326 ScriptTokenListFree(&tokenlist);
9327 Jim_DecrRefCount(interp, fileNameObj);
9328 return JIM_ERR;
9331 /* Now create the expression bytecode from the tokenlist */
9332 expr = ExprCreateByteCode(interp, &tokenlist, objPtr, fileNameObj);
9334 /* No longer need the token list */
9335 ScriptTokenListFree(&tokenlist);
9337 if (!expr) {
9338 goto err;
9341 #ifdef DEBUG_SHOW_EXPR
9343 int i;
9345 printf("==== Expr ====\n");
9346 for (i = 0; i < expr->len; i++) {
9347 ScriptToken *t = &expr->token[i];
9349 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9352 #endif
9354 /* Check program correctness. */
9355 if (ExprCheckCorrectness(interp, objPtr, expr) != JIM_OK) {
9356 /* ExprCheckCorrectness set an error in this case */
9357 ExprFreeByteCode(interp, expr);
9358 expr = NULL;
9359 goto err;
9362 rc = JIM_OK;
9364 err:
9365 /* Free the old internal rep and set the new one. */
9366 Jim_DecrRefCount(interp, fileNameObj);
9367 Jim_FreeIntRep(interp, objPtr);
9368 Jim_SetIntRepPtr(objPtr, expr);
9369 objPtr->typePtr = &exprObjType;
9370 return rc;
9373 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9375 if (objPtr->typePtr != &exprObjType) {
9376 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9377 return NULL;
9380 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9383 #ifdef JIM_OPTIMIZATION
9384 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9386 if (token->type == JIM_TT_EXPR_INT)
9387 return token->objPtr;
9388 else if (token->type == JIM_TT_VAR)
9389 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9390 else if (token->type == JIM_TT_DICTSUGAR)
9391 return JimExpandDictSugar(interp, token->objPtr);
9392 else
9393 return NULL;
9395 #endif
9397 /* -----------------------------------------------------------------------------
9398 * Expressions evaluation.
9399 * Jim uses a specialized stack-based virtual machine for expressions,
9400 * that takes advantage of the fact that expr's operators
9401 * can't be redefined.
9403 * Jim_EvalExpression() uses the bytecode compiled by
9404 * SetExprFromAny() method of the "expression" object.
9406 * On success a Tcl Object containing the result of the evaluation
9407 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9408 * returned.
9409 * On error the function returns a retcode != to JIM_OK and set a suitable
9410 * error on the interp.
9411 * ---------------------------------------------------------------------------*/
9412 #define JIM_EE_STATICSTACK_LEN 10
9414 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9416 ExprByteCode *expr;
9417 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9418 int i;
9419 int retcode = JIM_OK;
9420 struct JimExprState e;
9422 expr = JimGetExpression(interp, exprObjPtr);
9423 if (!expr) {
9424 return JIM_ERR; /* error in expression. */
9427 #ifdef JIM_OPTIMIZATION
9428 /* Check for one of the following common expressions used by while/for
9430 * CONST
9431 * $a
9432 * !$a
9433 * $a < CONST, $a < $b
9434 * $a <= CONST, $a <= $b
9435 * $a > CONST, $a > $b
9436 * $a >= CONST, $a >= $b
9437 * $a != CONST, $a != $b
9438 * $a == CONST, $a == $b
9441 Jim_Obj *objPtr;
9443 /* STEP 1 -- Check if there are the conditions to run the specialized
9444 * version of while */
9446 switch (expr->len) {
9447 case 1:
9448 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9449 if (objPtr) {
9450 Jim_IncrRefCount(objPtr);
9451 *exprResultPtrPtr = objPtr;
9452 return JIM_OK;
9454 break;
9456 case 2:
9457 if (expr->token[1].type == JIM_EXPROP_NOT) {
9458 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9460 if (objPtr && JimIsWide(objPtr)) {
9461 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9462 Jim_IncrRefCount(*exprResultPtrPtr);
9463 return JIM_OK;
9466 break;
9468 case 3:
9469 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9470 if (objPtr && JimIsWide(objPtr)) {
9471 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9472 if (objPtr2 && JimIsWide(objPtr2)) {
9473 jim_wide wideValueA = JimWideValue(objPtr);
9474 jim_wide wideValueB = JimWideValue(objPtr2);
9475 int cmpRes;
9476 switch (expr->token[2].type) {
9477 case JIM_EXPROP_LT:
9478 cmpRes = wideValueA < wideValueB;
9479 break;
9480 case JIM_EXPROP_LTE:
9481 cmpRes = wideValueA <= wideValueB;
9482 break;
9483 case JIM_EXPROP_GT:
9484 cmpRes = wideValueA > wideValueB;
9485 break;
9486 case JIM_EXPROP_GTE:
9487 cmpRes = wideValueA >= wideValueB;
9488 break;
9489 case JIM_EXPROP_NUMEQ:
9490 cmpRes = wideValueA == wideValueB;
9491 break;
9492 case JIM_EXPROP_NUMNE:
9493 cmpRes = wideValueA != wideValueB;
9494 break;
9495 default:
9496 goto noopt;
9498 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9499 Jim_IncrRefCount(*exprResultPtrPtr);
9500 return JIM_OK;
9503 break;
9506 noopt:
9507 #endif
9509 /* In order to avoid that the internal repr gets freed due to
9510 * shimmering of the exprObjPtr's object, we make the internal rep
9511 * shared. */
9512 expr->inUse++;
9514 /* The stack-based expr VM itself */
9516 /* Stack allocation. Expr programs have the feature that
9517 * a program of length N can't require a stack longer than
9518 * N. */
9519 if (expr->len > JIM_EE_STATICSTACK_LEN)
9520 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9521 else
9522 e.stack = staticStack;
9524 e.stacklen = 0;
9526 /* Execute every instruction */
9527 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9528 Jim_Obj *objPtr;
9530 switch (expr->token[i].type) {
9531 case JIM_TT_EXPR_INT:
9532 case JIM_TT_EXPR_DOUBLE:
9533 case JIM_TT_EXPR_BOOLEAN:
9534 case JIM_TT_STR:
9535 ExprPush(&e, expr->token[i].objPtr);
9536 break;
9538 case JIM_TT_VAR:
9539 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9540 if (objPtr) {
9541 ExprPush(&e, objPtr);
9543 else {
9544 retcode = JIM_ERR;
9546 break;
9548 case JIM_TT_DICTSUGAR:
9549 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9550 if (objPtr) {
9551 ExprPush(&e, objPtr);
9553 else {
9554 retcode = JIM_ERR;
9556 break;
9558 case JIM_TT_ESC:
9559 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9560 if (retcode == JIM_OK) {
9561 ExprPush(&e, objPtr);
9563 break;
9565 case JIM_TT_CMD:
9566 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9567 if (retcode == JIM_OK) {
9568 ExprPush(&e, Jim_GetResult(interp));
9570 break;
9572 default:{
9573 /* Find and execute the operation */
9574 e.skip = 0;
9575 e.opcode = expr->token[i].type;
9577 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9578 /* Skip some opcodes if necessary */
9579 i += e.skip;
9580 continue;
9585 expr->inUse--;
9587 if (retcode == JIM_OK) {
9588 *exprResultPtrPtr = ExprPop(&e);
9590 else {
9591 for (i = 0; i < e.stacklen; i++) {
9592 Jim_DecrRefCount(interp, e.stack[i]);
9595 if (e.stack != staticStack) {
9596 Jim_Free(e.stack);
9598 return retcode;
9601 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9603 int retcode;
9604 jim_wide wideValue;
9605 double doubleValue;
9606 int booleanValue;
9607 Jim_Obj *exprResultPtr;
9609 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9610 if (retcode != JIM_OK)
9611 return retcode;
9613 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9614 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9615 if (Jim_GetBoolean(interp, exprResultPtr, &booleanValue) != JIM_OK) {
9616 Jim_DecrRefCount(interp, exprResultPtr);
9617 return JIM_ERR;
9618 } else {
9619 Jim_DecrRefCount(interp, exprResultPtr);
9620 *boolPtr = booleanValue;
9621 return JIM_OK;
9624 else {
9625 Jim_DecrRefCount(interp, exprResultPtr);
9626 *boolPtr = doubleValue != 0;
9627 return JIM_OK;
9630 *boolPtr = wideValue != 0;
9632 Jim_DecrRefCount(interp, exprResultPtr);
9633 return JIM_OK;
9636 /* -----------------------------------------------------------------------------
9637 * ScanFormat String Object
9638 * ---------------------------------------------------------------------------*/
9640 /* This Jim_Obj will held a parsed representation of a format string passed to
9641 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9642 * to be parsed in its entirely first and then, if correct, can be used for
9643 * scanning. To avoid endless re-parsing, the parsed representation will be
9644 * stored in an internal representation and re-used for performance reason. */
9646 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9647 * scanformat string. This part will later be used to extract information
9648 * out from the string to be parsed by Jim_ScanString */
9650 typedef struct ScanFmtPartDescr
9652 char *arg; /* Specification of a CHARSET conversion */
9653 char *prefix; /* Prefix to be scanned literally before conversion */
9654 size_t width; /* Maximal width of input to be converted */
9655 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9656 char type; /* Type of conversion (e.g. c, d, f) */
9657 char modifier; /* Modify type (e.g. l - long, h - short */
9658 } ScanFmtPartDescr;
9660 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9661 * string parsed and separated in part descriptions. Furthermore it contains
9662 * the original string representation of the scanformat string to allow for
9663 * fast update of the Jim_Obj's string representation part.
9665 * As an add-on the internal object representation adds some scratch pad area
9666 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9667 * memory for purpose of string scanning.
9669 * The error member points to a static allocated string in case of a mal-
9670 * formed scanformat string or it contains '0' (NULL) in case of a valid
9671 * parse representation.
9673 * The whole memory of the internal representation is allocated as a single
9674 * area of memory that will be internally separated. So freeing and duplicating
9675 * of such an object is cheap */
9677 typedef struct ScanFmtStringObj
9679 jim_wide size; /* Size of internal repr in bytes */
9680 char *stringRep; /* Original string representation */
9681 size_t count; /* Number of ScanFmtPartDescr contained */
9682 size_t convCount; /* Number of conversions that will assign */
9683 size_t maxPos; /* Max position index if XPG3 is used */
9684 const char *error; /* Ptr to error text (NULL if no error */
9685 char *scratch; /* Some scratch pad used by Jim_ScanString */
9686 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9687 } ScanFmtStringObj;
9690 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9691 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9692 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9694 static const Jim_ObjType scanFmtStringObjType = {
9695 "scanformatstring",
9696 FreeScanFmtInternalRep,
9697 DupScanFmtInternalRep,
9698 UpdateStringOfScanFmt,
9699 JIM_TYPE_NONE,
9702 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9704 JIM_NOTUSED(interp);
9705 Jim_Free((char *)objPtr->internalRep.ptr);
9706 objPtr->internalRep.ptr = 0;
9709 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9711 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9712 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9714 JIM_NOTUSED(interp);
9715 memcpy(newVec, srcPtr->internalRep.ptr, size);
9716 dupPtr->internalRep.ptr = newVec;
9717 dupPtr->typePtr = &scanFmtStringObjType;
9720 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9722 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9725 /* SetScanFmtFromAny will parse a given string and create the internal
9726 * representation of the format specification. In case of an error
9727 * the error data member of the internal representation will be set
9728 * to an descriptive error text and the function will be left with
9729 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9730 * specification */
9732 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9734 ScanFmtStringObj *fmtObj;
9735 char *buffer;
9736 int maxCount, i, approxSize, lastPos = -1;
9737 const char *fmt = objPtr->bytes;
9738 int maxFmtLen = objPtr->length;
9739 const char *fmtEnd = fmt + maxFmtLen;
9740 int curr;
9742 Jim_FreeIntRep(interp, objPtr);
9743 /* Count how many conversions could take place maximally */
9744 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9745 if (fmt[i] == '%')
9746 ++maxCount;
9747 /* Calculate an approximation of the memory necessary */
9748 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9749 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9750 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9751 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9752 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9753 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9754 +1; /* safety byte */
9755 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9756 memset(fmtObj, 0, approxSize);
9757 fmtObj->size = approxSize;
9758 fmtObj->maxPos = 0;
9759 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9760 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9761 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9762 buffer = fmtObj->stringRep + maxFmtLen + 1;
9763 objPtr->internalRep.ptr = fmtObj;
9764 objPtr->typePtr = &scanFmtStringObjType;
9765 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9766 int width = 0, skip;
9767 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9769 fmtObj->count++;
9770 descr->width = 0; /* Assume width unspecified */
9771 /* Overread and store any "literal" prefix */
9772 if (*fmt != '%' || fmt[1] == '%') {
9773 descr->type = 0;
9774 descr->prefix = &buffer[i];
9775 for (; fmt < fmtEnd; ++fmt) {
9776 if (*fmt == '%') {
9777 if (fmt[1] != '%')
9778 break;
9779 ++fmt;
9781 buffer[i++] = *fmt;
9783 buffer[i++] = 0;
9785 /* Skip the conversion introducing '%' sign */
9786 ++fmt;
9787 /* End reached due to non-conversion literal only? */
9788 if (fmt >= fmtEnd)
9789 goto done;
9790 descr->pos = 0; /* Assume "natural" positioning */
9791 if (*fmt == '*') {
9792 descr->pos = -1; /* Okay, conversion will not be assigned */
9793 ++fmt;
9795 else
9796 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9797 /* Check if next token is a number (could be width or pos */
9798 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9799 fmt += skip;
9800 /* Was the number a XPG3 position specifier? */
9801 if (descr->pos != -1 && *fmt == '$') {
9802 int prev;
9804 ++fmt;
9805 descr->pos = width;
9806 width = 0;
9807 /* Look if "natural" postioning and XPG3 one was mixed */
9808 if ((lastPos == 0 && descr->pos > 0)
9809 || (lastPos > 0 && descr->pos == 0)) {
9810 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9811 return JIM_ERR;
9813 /* Look if this position was already used */
9814 for (prev = 0; prev < curr; ++prev) {
9815 if (fmtObj->descr[prev].pos == -1)
9816 continue;
9817 if (fmtObj->descr[prev].pos == descr->pos) {
9818 fmtObj->error =
9819 "variable is assigned by multiple \"%n$\" conversion specifiers";
9820 return JIM_ERR;
9823 /* Try to find a width after the XPG3 specifier */
9824 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9825 descr->width = width;
9826 fmt += skip;
9828 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9829 fmtObj->maxPos = descr->pos;
9831 else {
9832 /* Number was not a XPG3, so it has to be a width */
9833 descr->width = width;
9836 /* If positioning mode was undetermined yet, fix this */
9837 if (lastPos == -1)
9838 lastPos = descr->pos;
9839 /* Handle CHARSET conversion type ... */
9840 if (*fmt == '[') {
9841 int swapped = 1, beg = i, end, j;
9843 descr->type = '[';
9844 descr->arg = &buffer[i];
9845 ++fmt;
9846 if (*fmt == '^')
9847 buffer[i++] = *fmt++;
9848 if (*fmt == ']')
9849 buffer[i++] = *fmt++;
9850 while (*fmt && *fmt != ']')
9851 buffer[i++] = *fmt++;
9852 if (*fmt != ']') {
9853 fmtObj->error = "unmatched [ in format string";
9854 return JIM_ERR;
9856 end = i;
9857 buffer[i++] = 0;
9858 /* In case a range fence was given "backwards", swap it */
9859 while (swapped) {
9860 swapped = 0;
9861 for (j = beg + 1; j < end - 1; ++j) {
9862 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9863 char tmp = buffer[j - 1];
9865 buffer[j - 1] = buffer[j + 1];
9866 buffer[j + 1] = tmp;
9867 swapped = 1;
9872 else {
9873 /* Remember any valid modifier if given */
9874 if (strchr("hlL", *fmt) != 0)
9875 descr->modifier = tolower((int)*fmt++);
9877 descr->type = *fmt;
9878 if (strchr("efgcsndoxui", *fmt) == 0) {
9879 fmtObj->error = "bad scan conversion character";
9880 return JIM_ERR;
9882 else if (*fmt == 'c' && descr->width != 0) {
9883 fmtObj->error = "field width may not be specified in %c " "conversion";
9884 return JIM_ERR;
9886 else if (*fmt == 'u' && descr->modifier == 'l') {
9887 fmtObj->error = "unsigned wide not supported";
9888 return JIM_ERR;
9891 curr++;
9893 done:
9894 return JIM_OK;
9897 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9899 #define FormatGetCnvCount(_fo_) \
9900 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9901 #define FormatGetMaxPos(_fo_) \
9902 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9903 #define FormatGetError(_fo_) \
9904 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9906 /* JimScanAString is used to scan an unspecified string that ends with
9907 * next WS, or a string that is specified via a charset.
9910 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9912 char *buffer = Jim_StrDup(str);
9913 char *p = buffer;
9915 while (*str) {
9916 int c;
9917 int n;
9919 if (!sdescr && isspace(UCHAR(*str)))
9920 break; /* EOS via WS if unspecified */
9922 n = utf8_tounicode(str, &c);
9923 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9924 break;
9925 while (n--)
9926 *p++ = *str++;
9928 *p = 0;
9929 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9932 /* ScanOneEntry will scan one entry out of the string passed as argument.
9933 * It use the sscanf() function for this task. After extracting and
9934 * converting of the value, the count of scanned characters will be
9935 * returned of -1 in case of no conversion tool place and string was
9936 * already scanned thru */
9938 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9939 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9941 const char *tok;
9942 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9943 size_t scanned = 0;
9944 size_t anchor = pos;
9945 int i;
9946 Jim_Obj *tmpObj = NULL;
9948 /* First pessimistically assume, we will not scan anything :-) */
9949 *valObjPtr = 0;
9950 if (descr->prefix) {
9951 /* There was a prefix given before the conversion, skip it and adjust
9952 * the string-to-be-parsed accordingly */
9953 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9954 /* If prefix require, skip WS */
9955 if (isspace(UCHAR(descr->prefix[i])))
9956 while (pos < strLen && isspace(UCHAR(str[pos])))
9957 ++pos;
9958 else if (descr->prefix[i] != str[pos])
9959 break; /* Prefix do not match here, leave the loop */
9960 else
9961 ++pos; /* Prefix matched so far, next round */
9963 if (pos >= strLen) {
9964 return -1; /* All of str consumed: EOF condition */
9966 else if (descr->prefix[i] != 0)
9967 return 0; /* Not whole prefix consumed, no conversion possible */
9969 /* For all but following conversion, skip leading WS */
9970 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9971 while (isspace(UCHAR(str[pos])))
9972 ++pos;
9973 /* Determine how much skipped/scanned so far */
9974 scanned = pos - anchor;
9976 /* %c is a special, simple case. no width */
9977 if (descr->type == 'n') {
9978 /* Return pseudo conversion means: how much scanned so far? */
9979 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9981 else if (pos >= strLen) {
9982 /* Cannot scan anything, as str is totally consumed */
9983 return -1;
9985 else if (descr->type == 'c') {
9986 int c;
9987 scanned += utf8_tounicode(&str[pos], &c);
9988 *valObjPtr = Jim_NewIntObj(interp, c);
9989 return scanned;
9991 else {
9992 /* Processing of conversions follows ... */
9993 if (descr->width > 0) {
9994 /* Do not try to scan as fas as possible but only the given width.
9995 * To ensure this, we copy the part that should be scanned. */
9996 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9997 size_t tLen = descr->width > sLen ? sLen : descr->width;
9999 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
10000 tok = tmpObj->bytes;
10002 else {
10003 /* As no width was given, simply refer to the original string */
10004 tok = &str[pos];
10006 switch (descr->type) {
10007 case 'd':
10008 case 'o':
10009 case 'x':
10010 case 'u':
10011 case 'i':{
10012 char *endp; /* Position where the number finished */
10013 jim_wide w;
10015 int base = descr->type == 'o' ? 8
10016 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
10018 /* Try to scan a number with the given base */
10019 if (base == 0) {
10020 w = jim_strtoull(tok, &endp);
10022 else {
10023 w = strtoull(tok, &endp, base);
10026 if (endp != tok) {
10027 /* There was some number sucessfully scanned! */
10028 *valObjPtr = Jim_NewIntObj(interp, w);
10030 /* Adjust the number-of-chars scanned so far */
10031 scanned += endp - tok;
10033 else {
10034 /* Nothing was scanned. We have to determine if this
10035 * happened due to e.g. prefix mismatch or input str
10036 * exhausted */
10037 scanned = *tok ? 0 : -1;
10039 break;
10041 case 's':
10042 case '[':{
10043 *valObjPtr = JimScanAString(interp, descr->arg, tok);
10044 scanned += Jim_Length(*valObjPtr);
10045 break;
10047 case 'e':
10048 case 'f':
10049 case 'g':{
10050 char *endp;
10051 double value = strtod(tok, &endp);
10053 if (endp != tok) {
10054 /* There was some number sucessfully scanned! */
10055 *valObjPtr = Jim_NewDoubleObj(interp, value);
10056 /* Adjust the number-of-chars scanned so far */
10057 scanned += endp - tok;
10059 else {
10060 /* Nothing was scanned. We have to determine if this
10061 * happened due to e.g. prefix mismatch or input str
10062 * exhausted */
10063 scanned = *tok ? 0 : -1;
10065 break;
10068 /* If a substring was allocated (due to pre-defined width) do not
10069 * forget to free it */
10070 if (tmpObj) {
10071 Jim_FreeNewObj(interp, tmpObj);
10074 return scanned;
10077 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
10078 * string and returns all converted (and not ignored) values in a list back
10079 * to the caller. If an error occured, a NULL pointer will be returned */
10081 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
10083 size_t i, pos;
10084 int scanned = 1;
10085 const char *str = Jim_String(strObjPtr);
10086 int strLen = Jim_Utf8Length(interp, strObjPtr);
10087 Jim_Obj *resultList = 0;
10088 Jim_Obj **resultVec = 0;
10089 int resultc;
10090 Jim_Obj *emptyStr = 0;
10091 ScanFmtStringObj *fmtObj;
10093 /* This should never happen. The format object should already be of the correct type */
10094 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
10096 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
10097 /* Check if format specification was valid */
10098 if (fmtObj->error != 0) {
10099 if (flags & JIM_ERRMSG)
10100 Jim_SetResultString(interp, fmtObj->error, -1);
10101 return 0;
10103 /* Allocate a new "shared" empty string for all unassigned conversions */
10104 emptyStr = Jim_NewEmptyStringObj(interp);
10105 Jim_IncrRefCount(emptyStr);
10106 /* Create a list and fill it with empty strings up to max specified XPG3 */
10107 resultList = Jim_NewListObj(interp, NULL, 0);
10108 if (fmtObj->maxPos > 0) {
10109 for (i = 0; i < fmtObj->maxPos; ++i)
10110 Jim_ListAppendElement(interp, resultList, emptyStr);
10111 JimListGetElements(interp, resultList, &resultc, &resultVec);
10113 /* Now handle every partial format description */
10114 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
10115 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
10116 Jim_Obj *value = 0;
10118 /* Only last type may be "literal" w/o conversion - skip it! */
10119 if (descr->type == 0)
10120 continue;
10121 /* As long as any conversion could be done, we will proceed */
10122 if (scanned > 0)
10123 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
10124 /* In case our first try results in EOF, we will leave */
10125 if (scanned == -1 && i == 0)
10126 goto eof;
10127 /* Advance next pos-to-be-scanned for the amount scanned already */
10128 pos += scanned;
10130 /* value == 0 means no conversion took place so take empty string */
10131 if (value == 0)
10132 value = Jim_NewEmptyStringObj(interp);
10133 /* If value is a non-assignable one, skip it */
10134 if (descr->pos == -1) {
10135 Jim_FreeNewObj(interp, value);
10137 else if (descr->pos == 0)
10138 /* Otherwise append it to the result list if no XPG3 was given */
10139 Jim_ListAppendElement(interp, resultList, value);
10140 else if (resultVec[descr->pos - 1] == emptyStr) {
10141 /* But due to given XPG3, put the value into the corr. slot */
10142 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
10143 Jim_IncrRefCount(value);
10144 resultVec[descr->pos - 1] = value;
10146 else {
10147 /* Otherwise, the slot was already used - free obj and ERROR */
10148 Jim_FreeNewObj(interp, value);
10149 goto err;
10152 Jim_DecrRefCount(interp, emptyStr);
10153 return resultList;
10154 eof:
10155 Jim_DecrRefCount(interp, emptyStr);
10156 Jim_FreeNewObj(interp, resultList);
10157 return (Jim_Obj *)EOF;
10158 err:
10159 Jim_DecrRefCount(interp, emptyStr);
10160 Jim_FreeNewObj(interp, resultList);
10161 return 0;
10164 /* -----------------------------------------------------------------------------
10165 * Pseudo Random Number Generation
10166 * ---------------------------------------------------------------------------*/
10167 /* Initialize the sbox with the numbers from 0 to 255 */
10168 static void JimPrngInit(Jim_Interp *interp)
10170 #define PRNG_SEED_SIZE 256
10171 int i;
10172 unsigned int *seed;
10173 time_t t = time(NULL);
10175 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10177 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10178 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10179 seed[i] = (rand() ^ t ^ clock());
10181 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10182 Jim_Free(seed);
10185 /* Generates N bytes of random data */
10186 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10188 Jim_PrngState *prng;
10189 unsigned char *destByte = (unsigned char *)dest;
10190 unsigned int si, sj, x;
10192 /* initialization, only needed the first time */
10193 if (interp->prngState == NULL)
10194 JimPrngInit(interp);
10195 prng = interp->prngState;
10196 /* generates 'len' bytes of pseudo-random numbers */
10197 for (x = 0; x < len; x++) {
10198 prng->i = (prng->i + 1) & 0xff;
10199 si = prng->sbox[prng->i];
10200 prng->j = (prng->j + si) & 0xff;
10201 sj = prng->sbox[prng->j];
10202 prng->sbox[prng->i] = sj;
10203 prng->sbox[prng->j] = si;
10204 *destByte++ = prng->sbox[(si + sj) & 0xff];
10208 /* Re-seed the generator with user-provided bytes */
10209 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10211 int i;
10212 Jim_PrngState *prng;
10214 /* initialization, only needed the first time */
10215 if (interp->prngState == NULL)
10216 JimPrngInit(interp);
10217 prng = interp->prngState;
10219 /* Set the sbox[i] with i */
10220 for (i = 0; i < 256; i++)
10221 prng->sbox[i] = i;
10222 /* Now use the seed to perform a random permutation of the sbox */
10223 for (i = 0; i < seedLen; i++) {
10224 unsigned char t;
10226 t = prng->sbox[i & 0xFF];
10227 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10228 prng->sbox[seed[i]] = t;
10230 prng->i = prng->j = 0;
10232 /* discard at least the first 256 bytes of stream.
10233 * borrow the seed buffer for this
10235 for (i = 0; i < 256; i += seedLen) {
10236 JimRandomBytes(interp, seed, seedLen);
10240 /* [incr] */
10241 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10243 jim_wide wideValue, increment = 1;
10244 Jim_Obj *intObjPtr;
10246 if (argc != 2 && argc != 3) {
10247 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10248 return JIM_ERR;
10250 if (argc == 3) {
10251 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10252 return JIM_ERR;
10254 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10255 if (!intObjPtr) {
10256 /* Set missing variable to 0 */
10257 wideValue = 0;
10259 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10260 return JIM_ERR;
10262 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10263 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10264 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10265 Jim_FreeNewObj(interp, intObjPtr);
10266 return JIM_ERR;
10269 else {
10270 /* Can do it the quick way */
10271 Jim_InvalidateStringRep(intObjPtr);
10272 JimWideValue(intObjPtr) = wideValue + increment;
10274 /* The following step is required in order to invalidate the
10275 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10276 if (argv[1]->typePtr != &variableObjType) {
10277 /* Note that this can't fail since GetVariable already succeeded */
10278 Jim_SetVariable(interp, argv[1], intObjPtr);
10281 Jim_SetResult(interp, intObjPtr);
10282 return JIM_OK;
10286 /* -----------------------------------------------------------------------------
10287 * Eval
10288 * ---------------------------------------------------------------------------*/
10289 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10290 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10292 /* Handle calls to the [unknown] command */
10293 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10295 int retcode;
10297 /* If JimUnknown() is recursively called too many times...
10298 * done here
10300 if (interp->unknown_called > 50) {
10301 return JIM_ERR;
10304 /* The object interp->unknown just contains
10305 * the "unknown" string, it is used in order to
10306 * avoid to lookup the unknown command every time
10307 * but instead to cache the result. */
10309 /* If the [unknown] command does not exist ... */
10310 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10311 return JIM_ERR;
10313 interp->unknown_called++;
10314 /* XXX: Are we losing fileNameObj and linenr? */
10315 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10316 interp->unknown_called--;
10318 return retcode;
10321 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10323 int retcode;
10324 Jim_Cmd *cmdPtr;
10326 #if 0
10327 printf("invoke");
10328 int j;
10329 for (j = 0; j < objc; j++) {
10330 printf(" '%s'", Jim_String(objv[j]));
10332 printf("\n");
10333 #endif
10335 if (interp->framePtr->tailcallCmd) {
10336 /* Special tailcall command was pre-resolved */
10337 cmdPtr = interp->framePtr->tailcallCmd;
10338 interp->framePtr->tailcallCmd = NULL;
10340 else {
10341 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10342 if (cmdPtr == NULL) {
10343 return JimUnknown(interp, objc, objv);
10345 JimIncrCmdRefCount(cmdPtr);
10348 if (interp->evalDepth == interp->maxEvalDepth) {
10349 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10350 retcode = JIM_ERR;
10351 goto out;
10353 interp->evalDepth++;
10355 /* Call it -- Make sure result is an empty object. */
10356 Jim_SetEmptyResult(interp);
10357 if (cmdPtr->isproc) {
10358 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10360 else {
10361 interp->cmdPrivData = cmdPtr->u.native.privData;
10362 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10364 interp->evalDepth--;
10366 out:
10367 JimDecrCmdRefCount(interp, cmdPtr);
10369 return retcode;
10372 /* Eval the object vector 'objv' composed of 'objc' elements.
10373 * Every element is used as single argument.
10374 * Jim_EvalObj() will call this function every time its object
10375 * argument is of "list" type, with no string representation.
10377 * This is possible because the string representation of a
10378 * list object generated by the UpdateStringOfList is made
10379 * in a way that ensures that every list element is a different
10380 * command argument. */
10381 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10383 int i, retcode;
10385 /* Incr refcount of arguments. */
10386 for (i = 0; i < objc; i++)
10387 Jim_IncrRefCount(objv[i]);
10389 retcode = JimInvokeCommand(interp, objc, objv);
10391 /* Decr refcount of arguments and return the retcode */
10392 for (i = 0; i < objc; i++)
10393 Jim_DecrRefCount(interp, objv[i]);
10395 return retcode;
10399 * Invokes 'prefix' as a command with the objv array as arguments.
10401 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10403 int ret;
10404 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10406 nargv[0] = prefix;
10407 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10408 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10409 Jim_Free(nargv);
10410 return ret;
10413 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10415 if (!interp->errorFlag) {
10416 /* This is the first error, so save the file/line information and reset the stack */
10417 interp->errorFlag = 1;
10418 Jim_IncrRefCount(script->fileNameObj);
10419 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10420 interp->errorFileNameObj = script->fileNameObj;
10421 interp->errorLine = script->linenr;
10423 JimResetStackTrace(interp);
10424 /* Always add a level where the error first occurs */
10425 interp->addStackTrace++;
10428 /* Now if this is an "interesting" level, add it to the stack trace */
10429 if (interp->addStackTrace > 0) {
10430 /* Add the stack info for the current level */
10432 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10434 /* Note: if we didn't have a filename for this level,
10435 * don't clear the addStackTrace flag
10436 * so we can pick it up at the next level
10438 if (Jim_Length(script->fileNameObj)) {
10439 interp->addStackTrace = 0;
10442 Jim_DecrRefCount(interp, interp->errorProc);
10443 interp->errorProc = interp->emptyObj;
10444 Jim_IncrRefCount(interp->errorProc);
10448 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10450 Jim_Obj *objPtr;
10452 switch (token->type) {
10453 case JIM_TT_STR:
10454 case JIM_TT_ESC:
10455 objPtr = token->objPtr;
10456 break;
10457 case JIM_TT_VAR:
10458 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10459 break;
10460 case JIM_TT_DICTSUGAR:
10461 objPtr = JimExpandDictSugar(interp, token->objPtr);
10462 break;
10463 case JIM_TT_EXPRSUGAR:
10464 objPtr = JimExpandExprSugar(interp, token->objPtr);
10465 break;
10466 case JIM_TT_CMD:
10467 switch (Jim_EvalObj(interp, token->objPtr)) {
10468 case JIM_OK:
10469 case JIM_RETURN:
10470 objPtr = interp->result;
10471 break;
10472 case JIM_BREAK:
10473 /* Stop substituting */
10474 return JIM_BREAK;
10475 case JIM_CONTINUE:
10476 /* just skip this one */
10477 return JIM_CONTINUE;
10478 default:
10479 return JIM_ERR;
10481 break;
10482 default:
10483 JimPanic((1,
10484 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10485 objPtr = NULL;
10486 break;
10488 if (objPtr) {
10489 *objPtrPtr = objPtr;
10490 return JIM_OK;
10492 return JIM_ERR;
10495 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10496 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10497 * The returned object has refcount = 0.
10499 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10501 int totlen = 0, i;
10502 Jim_Obj **intv;
10503 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10504 Jim_Obj *objPtr;
10505 char *s;
10507 if (tokens <= JIM_EVAL_SINTV_LEN)
10508 intv = sintv;
10509 else
10510 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10512 /* Compute every token forming the argument
10513 * in the intv objects vector. */
10514 for (i = 0; i < tokens; i++) {
10515 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10516 case JIM_OK:
10517 case JIM_RETURN:
10518 break;
10519 case JIM_BREAK:
10520 if (flags & JIM_SUBST_FLAG) {
10521 /* Stop here */
10522 tokens = i;
10523 continue;
10525 /* XXX: Should probably set an error about break outside loop */
10526 /* fall through to error */
10527 case JIM_CONTINUE:
10528 if (flags & JIM_SUBST_FLAG) {
10529 intv[i] = NULL;
10530 continue;
10532 /* XXX: Ditto continue outside loop */
10533 /* fall through to error */
10534 default:
10535 while (i--) {
10536 Jim_DecrRefCount(interp, intv[i]);
10538 if (intv != sintv) {
10539 Jim_Free(intv);
10541 return NULL;
10543 Jim_IncrRefCount(intv[i]);
10544 Jim_String(intv[i]);
10545 totlen += intv[i]->length;
10548 /* Fast path return for a single token */
10549 if (tokens == 1 && intv[0] && intv == sintv) {
10550 Jim_DecrRefCount(interp, intv[0]);
10551 return intv[0];
10554 /* Concatenate every token in an unique
10555 * object. */
10556 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10558 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10559 && token[2].type == JIM_TT_VAR) {
10560 /* May be able to do fast interpolated object -> dictSubst */
10561 objPtr->typePtr = &interpolatedObjType;
10562 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10563 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10564 Jim_IncrRefCount(intv[2]);
10566 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10567 /* The first interpolated token is source, so preserve the source info */
10568 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10572 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10573 objPtr->length = totlen;
10574 for (i = 0; i < tokens; i++) {
10575 if (intv[i]) {
10576 memcpy(s, intv[i]->bytes, intv[i]->length);
10577 s += intv[i]->length;
10578 Jim_DecrRefCount(interp, intv[i]);
10581 objPtr->bytes[totlen] = '\0';
10582 /* Free the intv vector if not static. */
10583 if (intv != sintv) {
10584 Jim_Free(intv);
10587 return objPtr;
10591 /* listPtr *must* be a list.
10592 * The contents of the list is evaluated with the first element as the command and
10593 * the remaining elements as the arguments.
10595 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10597 int retcode = JIM_OK;
10599 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10601 if (listPtr->internalRep.listValue.len) {
10602 Jim_IncrRefCount(listPtr);
10603 retcode = JimInvokeCommand(interp,
10604 listPtr->internalRep.listValue.len,
10605 listPtr->internalRep.listValue.ele);
10606 Jim_DecrRefCount(interp, listPtr);
10608 return retcode;
10611 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10613 SetListFromAny(interp, listPtr);
10614 return JimEvalObjList(interp, listPtr);
10617 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10619 int i;
10620 ScriptObj *script;
10621 ScriptToken *token;
10622 int retcode = JIM_OK;
10623 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10624 Jim_Obj *prevScriptObj;
10626 /* If the object is of type "list", with no string rep we can call
10627 * a specialized version of Jim_EvalObj() */
10628 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10629 return JimEvalObjList(interp, scriptObjPtr);
10632 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10633 script = JimGetScript(interp, scriptObjPtr);
10634 if (!JimScriptValid(interp, script)) {
10635 Jim_DecrRefCount(interp, scriptObjPtr);
10636 return JIM_ERR;
10639 /* Reset the interpreter result. This is useful to
10640 * return the empty result in the case of empty program. */
10641 Jim_SetEmptyResult(interp);
10643 token = script->token;
10645 #ifdef JIM_OPTIMIZATION
10646 /* Check for one of the following common scripts used by for, while
10648 * {}
10649 * incr a
10651 if (script->len == 0) {
10652 Jim_DecrRefCount(interp, scriptObjPtr);
10653 return JIM_OK;
10655 if (script->len == 3
10656 && token[1].objPtr->typePtr == &commandObjType
10657 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10658 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10659 && token[2].objPtr->typePtr == &variableObjType) {
10661 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10663 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10664 JimWideValue(objPtr)++;
10665 Jim_InvalidateStringRep(objPtr);
10666 Jim_DecrRefCount(interp, scriptObjPtr);
10667 Jim_SetResult(interp, objPtr);
10668 return JIM_OK;
10671 #endif
10673 /* Now we have to make sure the internal repr will not be
10674 * freed on shimmering.
10676 * Think for example to this:
10678 * set x {llength $x; ... some more code ...}; eval $x
10680 * In order to preserve the internal rep, we increment the
10681 * inUse field of the script internal rep structure. */
10682 script->inUse++;
10684 /* Stash the current script */
10685 prevScriptObj = interp->currentScriptObj;
10686 interp->currentScriptObj = scriptObjPtr;
10688 interp->errorFlag = 0;
10689 argv = sargv;
10691 /* Execute every command sequentially until the end of the script
10692 * or an error occurs.
10694 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10695 int argc;
10696 int j;
10698 /* First token of the line is always JIM_TT_LINE */
10699 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10700 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10702 /* Allocate the arguments vector if required */
10703 if (argc > JIM_EVAL_SARGV_LEN)
10704 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10706 /* Skip the JIM_TT_LINE token */
10707 i++;
10709 /* Populate the arguments objects.
10710 * If an error occurs, retcode will be set and
10711 * 'j' will be set to the number of args expanded
10713 for (j = 0; j < argc; j++) {
10714 long wordtokens = 1;
10715 int expand = 0;
10716 Jim_Obj *wordObjPtr = NULL;
10718 if (token[i].type == JIM_TT_WORD) {
10719 wordtokens = JimWideValue(token[i++].objPtr);
10720 if (wordtokens < 0) {
10721 expand = 1;
10722 wordtokens = -wordtokens;
10726 if (wordtokens == 1) {
10727 /* Fast path if the token does not
10728 * need interpolation */
10730 switch (token[i].type) {
10731 case JIM_TT_ESC:
10732 case JIM_TT_STR:
10733 wordObjPtr = token[i].objPtr;
10734 break;
10735 case JIM_TT_VAR:
10736 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10737 break;
10738 case JIM_TT_EXPRSUGAR:
10739 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10740 break;
10741 case JIM_TT_DICTSUGAR:
10742 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10743 break;
10744 case JIM_TT_CMD:
10745 retcode = Jim_EvalObj(interp, token[i].objPtr);
10746 if (retcode == JIM_OK) {
10747 wordObjPtr = Jim_GetResult(interp);
10749 break;
10750 default:
10751 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10754 else {
10755 /* For interpolation we call a helper
10756 * function to do the work for us. */
10757 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10760 if (!wordObjPtr) {
10761 if (retcode == JIM_OK) {
10762 retcode = JIM_ERR;
10764 break;
10767 Jim_IncrRefCount(wordObjPtr);
10768 i += wordtokens;
10770 if (!expand) {
10771 argv[j] = wordObjPtr;
10773 else {
10774 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10775 int len = Jim_ListLength(interp, wordObjPtr);
10776 int newargc = argc + len - 1;
10777 int k;
10779 if (len > 1) {
10780 if (argv == sargv) {
10781 if (newargc > JIM_EVAL_SARGV_LEN) {
10782 argv = Jim_Alloc(sizeof(*argv) * newargc);
10783 memcpy(argv, sargv, sizeof(*argv) * j);
10786 else {
10787 /* Need to realloc to make room for (len - 1) more entries */
10788 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10792 /* Now copy in the expanded version */
10793 for (k = 0; k < len; k++) {
10794 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10795 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10798 /* The original object reference is no longer needed,
10799 * after the expansion it is no longer present on
10800 * the argument vector, but the single elements are
10801 * in its place. */
10802 Jim_DecrRefCount(interp, wordObjPtr);
10804 /* And update the indexes */
10805 j--;
10806 argc += len - 1;
10810 if (retcode == JIM_OK && argc) {
10811 /* Invoke the command */
10812 retcode = JimInvokeCommand(interp, argc, argv);
10813 /* Check for a signal after each command */
10814 if (Jim_CheckSignal(interp)) {
10815 retcode = JIM_SIGNAL;
10819 /* Finished with the command, so decrement ref counts of each argument */
10820 while (j-- > 0) {
10821 Jim_DecrRefCount(interp, argv[j]);
10824 if (argv != sargv) {
10825 Jim_Free(argv);
10826 argv = sargv;
10830 /* Possibly add to the error stack trace */
10831 if (retcode == JIM_ERR) {
10832 JimAddErrorToStack(interp, script);
10834 /* Propagate the addStackTrace value through 'return -code error' */
10835 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10836 /* No need to add stack trace */
10837 interp->addStackTrace = 0;
10840 /* Restore the current script */
10841 interp->currentScriptObj = prevScriptObj;
10843 /* Note that we don't have to decrement inUse, because the
10844 * following code transfers our use of the reference again to
10845 * the script object. */
10846 Jim_FreeIntRep(interp, scriptObjPtr);
10847 scriptObjPtr->typePtr = &scriptObjType;
10848 Jim_SetIntRepPtr(scriptObjPtr, script);
10849 Jim_DecrRefCount(interp, scriptObjPtr);
10851 return retcode;
10854 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10856 int retcode;
10857 /* If argObjPtr begins with '&', do an automatic upvar */
10858 const char *varname = Jim_String(argNameObj);
10859 if (*varname == '&') {
10860 /* First check that the target variable exists */
10861 Jim_Obj *objPtr;
10862 Jim_CallFrame *savedCallFrame = interp->framePtr;
10864 interp->framePtr = interp->framePtr->parent;
10865 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10866 interp->framePtr = savedCallFrame;
10867 if (!objPtr) {
10868 return JIM_ERR;
10871 /* It exists, so perform the binding. */
10872 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10873 Jim_IncrRefCount(objPtr);
10874 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10875 Jim_DecrRefCount(interp, objPtr);
10877 else {
10878 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10880 return retcode;
10884 * Sets the interp result to be an error message indicating the required proc args.
10886 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10888 /* Create a nice error message, consistent with Tcl 8.5 */
10889 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10890 int i;
10892 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10893 Jim_AppendString(interp, argmsg, " ", 1);
10895 if (i == cmd->u.proc.argsPos) {
10896 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10897 /* Renamed args */
10898 Jim_AppendString(interp, argmsg, "?", 1);
10899 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10900 Jim_AppendString(interp, argmsg, " ...?", -1);
10902 else {
10903 /* We have plain args */
10904 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10907 else {
10908 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10909 Jim_AppendString(interp, argmsg, "?", 1);
10910 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10911 Jim_AppendString(interp, argmsg, "?", 1);
10913 else {
10914 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10915 if (*arg == '&') {
10916 arg++;
10918 Jim_AppendString(interp, argmsg, arg, -1);
10922 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10923 Jim_FreeNewObj(interp, argmsg);
10926 #ifdef jim_ext_namespace
10928 * [namespace eval]
10930 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10932 Jim_CallFrame *callFramePtr;
10933 int retcode;
10935 /* Create a new callframe */
10936 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10937 callFramePtr->argv = &interp->emptyObj;
10938 callFramePtr->argc = 0;
10939 callFramePtr->procArgsObjPtr = NULL;
10940 callFramePtr->procBodyObjPtr = scriptObj;
10941 callFramePtr->staticVars = NULL;
10942 callFramePtr->fileNameObj = interp->emptyObj;
10943 callFramePtr->line = 0;
10944 Jim_IncrRefCount(scriptObj);
10945 interp->framePtr = callFramePtr;
10947 /* Check if there are too nested calls */
10948 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10949 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10950 retcode = JIM_ERR;
10952 else {
10953 /* Eval the body */
10954 retcode = Jim_EvalObj(interp, scriptObj);
10957 /* Destroy the callframe */
10958 interp->framePtr = interp->framePtr->parent;
10959 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10961 return retcode;
10963 #endif
10965 /* Call a procedure implemented in Tcl.
10966 * It's possible to speed-up a lot this function, currently
10967 * the callframes are not cached, but allocated and
10968 * destroied every time. What is expecially costly is
10969 * to create/destroy the local vars hash table every time.
10971 * This can be fixed just implementing callframes caching
10972 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10973 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10975 Jim_CallFrame *callFramePtr;
10976 int i, d, retcode, optargs;
10977 ScriptObj *script;
10979 /* Check arity */
10980 if (argc - 1 < cmd->u.proc.reqArity ||
10981 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10982 JimSetProcWrongArgs(interp, argv[0], cmd);
10983 return JIM_ERR;
10986 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10987 /* Optimise for procedure with no body - useful for optional debugging */
10988 return JIM_OK;
10991 /* Check if there are too nested calls */
10992 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10993 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10994 return JIM_ERR;
10997 /* Create a new callframe */
10998 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10999 callFramePtr->argv = argv;
11000 callFramePtr->argc = argc;
11001 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
11002 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
11003 callFramePtr->staticVars = cmd->u.proc.staticVars;
11005 /* Remember where we were called from. */
11006 script = JimGetScript(interp, interp->currentScriptObj);
11007 callFramePtr->fileNameObj = script->fileNameObj;
11008 callFramePtr->line = script->linenr;
11010 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
11011 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
11012 interp->framePtr = callFramePtr;
11014 /* How many optional args are available */
11015 optargs = (argc - 1 - cmd->u.proc.reqArity);
11017 /* Step 'i' along the actual args, and step 'd' along the formal args */
11018 i = 1;
11019 for (d = 0; d < cmd->u.proc.argListLen; d++) {
11020 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
11021 if (d == cmd->u.proc.argsPos) {
11022 /* assign $args */
11023 Jim_Obj *listObjPtr;
11024 int argsLen = 0;
11025 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
11026 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
11028 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
11030 /* It is possible to rename args. */
11031 if (cmd->u.proc.arglist[d].defaultObjPtr) {
11032 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
11034 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
11035 if (retcode != JIM_OK) {
11036 goto badargset;
11039 i += argsLen;
11040 continue;
11043 /* Optional or required? */
11044 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
11045 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
11047 else {
11048 /* Ran out, so use the default */
11049 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
11051 if (retcode != JIM_OK) {
11052 goto badargset;
11056 /* Eval the body */
11057 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
11059 badargset:
11061 /* Free the callframe */
11062 interp->framePtr = interp->framePtr->parent;
11063 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
11065 /* Now chain any tailcalls in the parent frame */
11066 if (interp->framePtr->tailcallObj) {
11067 do {
11068 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
11070 interp->framePtr->tailcallObj = NULL;
11072 if (retcode == JIM_EVAL) {
11073 retcode = Jim_EvalObjList(interp, tailcallObj);
11074 if (retcode == JIM_RETURN) {
11075 /* If the result of the tailcall is 'return', push
11076 * it up to the caller
11078 interp->returnLevel++;
11081 Jim_DecrRefCount(interp, tailcallObj);
11082 } while (interp->framePtr->tailcallObj);
11084 /* If the tailcall chain finished early, may need to manually discard the command */
11085 if (interp->framePtr->tailcallCmd) {
11086 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
11087 interp->framePtr->tailcallCmd = NULL;
11091 /* Handle the JIM_RETURN return code */
11092 if (retcode == JIM_RETURN) {
11093 if (--interp->returnLevel <= 0) {
11094 retcode = interp->returnCode;
11095 interp->returnCode = JIM_OK;
11096 interp->returnLevel = 0;
11099 else if (retcode == JIM_ERR) {
11100 interp->addStackTrace++;
11101 Jim_DecrRefCount(interp, interp->errorProc);
11102 interp->errorProc = argv[0];
11103 Jim_IncrRefCount(interp->errorProc);
11106 return retcode;
11109 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
11111 int retval;
11112 Jim_Obj *scriptObjPtr;
11114 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
11115 Jim_IncrRefCount(scriptObjPtr);
11117 if (filename) {
11118 Jim_Obj *prevScriptObj;
11120 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
11122 prevScriptObj = interp->currentScriptObj;
11123 interp->currentScriptObj = scriptObjPtr;
11125 retval = Jim_EvalObj(interp, scriptObjPtr);
11127 interp->currentScriptObj = prevScriptObj;
11129 else {
11130 retval = Jim_EvalObj(interp, scriptObjPtr);
11132 Jim_DecrRefCount(interp, scriptObjPtr);
11133 return retval;
11136 int Jim_Eval(Jim_Interp *interp, const char *script)
11138 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
11141 /* Execute script in the scope of the global level */
11142 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
11144 int retval;
11145 Jim_CallFrame *savedFramePtr = interp->framePtr;
11147 interp->framePtr = interp->topFramePtr;
11148 retval = Jim_Eval(interp, script);
11149 interp->framePtr = savedFramePtr;
11151 return retval;
11154 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
11156 int retval;
11157 Jim_CallFrame *savedFramePtr = interp->framePtr;
11159 interp->framePtr = interp->topFramePtr;
11160 retval = Jim_EvalFile(interp, filename);
11161 interp->framePtr = savedFramePtr;
11163 return retval;
11166 #include <sys/stat.h>
11168 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11170 FILE *fp;
11171 char *buf;
11172 Jim_Obj *scriptObjPtr;
11173 Jim_Obj *prevScriptObj;
11174 struct stat sb;
11175 int retcode;
11176 int readlen;
11178 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11179 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11180 return JIM_ERR;
11182 if (sb.st_size == 0) {
11183 fclose(fp);
11184 return JIM_OK;
11187 buf = Jim_Alloc(sb.st_size + 1);
11188 readlen = fread(buf, 1, sb.st_size, fp);
11189 if (ferror(fp)) {
11190 fclose(fp);
11191 Jim_Free(buf);
11192 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11193 return JIM_ERR;
11195 fclose(fp);
11196 buf[readlen] = 0;
11198 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11199 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11200 Jim_IncrRefCount(scriptObjPtr);
11202 prevScriptObj = interp->currentScriptObj;
11203 interp->currentScriptObj = scriptObjPtr;
11205 retcode = Jim_EvalObj(interp, scriptObjPtr);
11207 /* Handle the JIM_RETURN return code */
11208 if (retcode == JIM_RETURN) {
11209 if (--interp->returnLevel <= 0) {
11210 retcode = interp->returnCode;
11211 interp->returnCode = JIM_OK;
11212 interp->returnLevel = 0;
11215 if (retcode == JIM_ERR) {
11216 /* EvalFile changes context, so add a stack frame here */
11217 interp->addStackTrace++;
11220 interp->currentScriptObj = prevScriptObj;
11222 Jim_DecrRefCount(interp, scriptObjPtr);
11224 return retcode;
11227 /* -----------------------------------------------------------------------------
11228 * Subst
11229 * ---------------------------------------------------------------------------*/
11230 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11232 pc->tstart = pc->p;
11233 pc->tline = pc->linenr;
11235 if (pc->len == 0) {
11236 pc->tend = pc->p;
11237 pc->tt = JIM_TT_EOL;
11238 pc->eof = 1;
11239 return;
11241 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11242 JimParseCmd(pc);
11243 return;
11245 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11246 if (JimParseVar(pc) == JIM_OK) {
11247 return;
11249 /* Not a var, so treat as a string */
11250 pc->tstart = pc->p;
11251 flags |= JIM_SUBST_NOVAR;
11253 while (pc->len) {
11254 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11255 break;
11257 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11258 break;
11260 if (*pc->p == '\\' && pc->len > 1) {
11261 pc->p++;
11262 pc->len--;
11264 pc->p++;
11265 pc->len--;
11267 pc->tend = pc->p - 1;
11268 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11271 /* The subst object type reuses most of the data structures and functions
11272 * of the script object. Script's data structures are a bit more complex
11273 * for what is needed for [subst]itution tasks, but the reuse helps to
11274 * deal with a single data structure at the cost of some more memory
11275 * usage for substitutions. */
11277 /* This method takes the string representation of an object
11278 * as a Tcl string where to perform [subst]itution, and generates
11279 * the pre-parsed internal representation. */
11280 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11282 int scriptTextLen;
11283 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11284 struct JimParserCtx parser;
11285 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11286 ParseTokenList tokenlist;
11288 /* Initially parse the subst into tokens (in tokenlist) */
11289 ScriptTokenListInit(&tokenlist);
11291 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11292 while (1) {
11293 JimParseSubst(&parser, flags);
11294 if (parser.eof) {
11295 /* Note that subst doesn't need the EOL token */
11296 break;
11298 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11299 parser.tline);
11302 /* Create the "real" subst/script tokens from the initial token list */
11303 script->inUse = 1;
11304 script->substFlags = flags;
11305 script->fileNameObj = interp->emptyObj;
11306 Jim_IncrRefCount(script->fileNameObj);
11307 SubstObjAddTokens(interp, script, &tokenlist);
11309 /* No longer need the token list */
11310 ScriptTokenListFree(&tokenlist);
11312 #ifdef DEBUG_SHOW_SUBST
11314 int i;
11316 printf("==== Subst ====\n");
11317 for (i = 0; i < script->len; i++) {
11318 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11319 Jim_String(script->token[i].objPtr));
11322 #endif
11324 /* Free the old internal rep and set the new one. */
11325 Jim_FreeIntRep(interp, objPtr);
11326 Jim_SetIntRepPtr(objPtr, script);
11327 objPtr->typePtr = &scriptObjType;
11328 return JIM_OK;
11331 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11333 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11334 SetSubstFromAny(interp, objPtr, flags);
11335 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11338 /* Performs commands,variables,blackslashes substitution,
11339 * storing the result object (with refcount 0) into
11340 * resObjPtrPtr. */
11341 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11343 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11345 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11346 /* In order to preserve the internal rep, we increment the
11347 * inUse field of the script internal rep structure. */
11348 script->inUse++;
11350 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11352 script->inUse--;
11353 Jim_DecrRefCount(interp, substObjPtr);
11354 if (*resObjPtrPtr == NULL) {
11355 return JIM_ERR;
11357 return JIM_OK;
11360 /* -----------------------------------------------------------------------------
11361 * Core commands utility functions
11362 * ---------------------------------------------------------------------------*/
11363 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11365 Jim_Obj *objPtr;
11366 Jim_Obj *listObjPtr;
11368 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11370 listObjPtr = Jim_NewListObj(interp, argv, argc);
11372 if (*msg) {
11373 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11375 Jim_IncrRefCount(listObjPtr);
11376 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11377 Jim_DecrRefCount(interp, listObjPtr);
11379 Jim_IncrRefCount(objPtr);
11380 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11381 Jim_DecrRefCount(interp, objPtr);
11385 * May add the key and/or value to the list.
11387 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11388 Jim_HashEntry *he, int type);
11390 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11393 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11394 * invoke the callback to add entries to a list.
11395 * Returns the list.
11397 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11398 JimHashtableIteratorCallbackType *callback, int type)
11400 Jim_HashEntry *he;
11401 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11403 /* Check for the non-pattern case. We can do this much more efficiently. */
11404 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11405 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11406 if (he) {
11407 callback(interp, listObjPtr, he, type);
11410 else {
11411 Jim_HashTableIterator htiter;
11412 JimInitHashTableIterator(ht, &htiter);
11413 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11414 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11415 callback(interp, listObjPtr, he, type);
11419 return listObjPtr;
11422 /* Keep these in order */
11423 #define JIM_CMDLIST_COMMANDS 0
11424 #define JIM_CMDLIST_PROCS 1
11425 #define JIM_CMDLIST_CHANNELS 2
11428 * Adds matching command names (procs, channels) to the list.
11430 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11431 Jim_HashEntry *he, int type)
11433 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11434 Jim_Obj *objPtr;
11436 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11437 /* not a proc */
11438 return;
11441 objPtr = Jim_NewStringObj(interp, he->key, -1);
11442 Jim_IncrRefCount(objPtr);
11444 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11445 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11447 Jim_DecrRefCount(interp, objPtr);
11450 /* type is JIM_CMDLIST_xxx */
11451 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11453 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11456 /* Keep these in order */
11457 #define JIM_VARLIST_GLOBALS 0
11458 #define JIM_VARLIST_LOCALS 1
11459 #define JIM_VARLIST_VARS 2
11461 #define JIM_VARLIST_VALUES 0x1000
11464 * Adds matching variable names to the list.
11466 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11467 Jim_HashEntry *he, int type)
11469 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11471 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11472 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11473 if (type & JIM_VARLIST_VALUES) {
11474 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11479 /* mode is JIM_VARLIST_xxx */
11480 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11482 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11483 /* For [info locals], if we are at top level an emtpy list
11484 * is returned. I don't agree, but we aim at compatibility (SS) */
11485 return interp->emptyObj;
11487 else {
11488 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11489 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11493 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11494 Jim_Obj **objPtrPtr, int info_level_cmd)
11496 Jim_CallFrame *targetCallFrame;
11498 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11499 if (targetCallFrame == NULL) {
11500 return JIM_ERR;
11502 /* No proc call at toplevel callframe */
11503 if (targetCallFrame == interp->topFramePtr) {
11504 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11505 return JIM_ERR;
11507 if (info_level_cmd) {
11508 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11510 else {
11511 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11513 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11514 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11515 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11516 *objPtrPtr = listObj;
11518 return JIM_OK;
11521 /* -----------------------------------------------------------------------------
11522 * Core commands
11523 * ---------------------------------------------------------------------------*/
11525 /* fake [puts] -- not the real puts, just for debugging. */
11526 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11528 if (argc != 2 && argc != 3) {
11529 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11530 return JIM_ERR;
11532 if (argc == 3) {
11533 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11534 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11535 return JIM_ERR;
11537 else {
11538 fputs(Jim_String(argv[2]), stdout);
11541 else {
11542 puts(Jim_String(argv[1]));
11544 return JIM_OK;
11547 /* Helper for [+] and [*] */
11548 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11550 jim_wide wideValue, res;
11551 double doubleValue, doubleRes;
11552 int i;
11554 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11556 for (i = 1; i < argc; i++) {
11557 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11558 goto trydouble;
11559 if (op == JIM_EXPROP_ADD)
11560 res += wideValue;
11561 else
11562 res *= wideValue;
11564 Jim_SetResultInt(interp, res);
11565 return JIM_OK;
11566 trydouble:
11567 doubleRes = (double)res;
11568 for (; i < argc; i++) {
11569 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11570 return JIM_ERR;
11571 if (op == JIM_EXPROP_ADD)
11572 doubleRes += doubleValue;
11573 else
11574 doubleRes *= doubleValue;
11576 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11577 return JIM_OK;
11580 /* Helper for [-] and [/] */
11581 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11583 jim_wide wideValue, res = 0;
11584 double doubleValue, doubleRes = 0;
11585 int i = 2;
11587 if (argc < 2) {
11588 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11589 return JIM_ERR;
11591 else if (argc == 2) {
11592 /* The arity = 2 case is different. For [- x] returns -x,
11593 * while [/ x] returns 1/x. */
11594 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11595 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11596 return JIM_ERR;
11598 else {
11599 if (op == JIM_EXPROP_SUB)
11600 doubleRes = -doubleValue;
11601 else
11602 doubleRes = 1.0 / doubleValue;
11603 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11604 return JIM_OK;
11607 if (op == JIM_EXPROP_SUB) {
11608 res = -wideValue;
11609 Jim_SetResultInt(interp, res);
11611 else {
11612 doubleRes = 1.0 / wideValue;
11613 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11615 return JIM_OK;
11617 else {
11618 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11619 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11620 != JIM_OK) {
11621 return JIM_ERR;
11623 else {
11624 goto trydouble;
11628 for (i = 2; i < argc; i++) {
11629 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11630 doubleRes = (double)res;
11631 goto trydouble;
11633 if (op == JIM_EXPROP_SUB)
11634 res -= wideValue;
11635 else
11636 res /= wideValue;
11638 Jim_SetResultInt(interp, res);
11639 return JIM_OK;
11640 trydouble:
11641 for (; i < argc; i++) {
11642 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11643 return JIM_ERR;
11644 if (op == JIM_EXPROP_SUB)
11645 doubleRes -= doubleValue;
11646 else
11647 doubleRes /= doubleValue;
11649 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11650 return JIM_OK;
11654 /* [+] */
11655 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11657 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11660 /* [*] */
11661 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11663 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11666 /* [-] */
11667 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11669 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11672 /* [/] */
11673 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11675 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11678 /* [set] */
11679 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11681 if (argc != 2 && argc != 3) {
11682 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11683 return JIM_ERR;
11685 if (argc == 2) {
11686 Jim_Obj *objPtr;
11688 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11689 if (!objPtr)
11690 return JIM_ERR;
11691 Jim_SetResult(interp, objPtr);
11692 return JIM_OK;
11694 /* argc == 3 case. */
11695 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11696 return JIM_ERR;
11697 Jim_SetResult(interp, argv[2]);
11698 return JIM_OK;
11701 /* [unset]
11703 * unset ?-nocomplain? ?--? ?varName ...?
11705 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11707 int i = 1;
11708 int complain = 1;
11710 while (i < argc) {
11711 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11712 i++;
11713 break;
11715 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11716 complain = 0;
11717 i++;
11718 continue;
11720 break;
11723 while (i < argc) {
11724 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11725 && complain) {
11726 return JIM_ERR;
11728 i++;
11730 return JIM_OK;
11733 /* [while] */
11734 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11736 if (argc != 3) {
11737 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11738 return JIM_ERR;
11741 /* The general purpose implementation of while starts here */
11742 while (1) {
11743 int boolean, retval;
11745 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11746 return retval;
11747 if (!boolean)
11748 break;
11750 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11751 switch (retval) {
11752 case JIM_BREAK:
11753 goto out;
11754 break;
11755 case JIM_CONTINUE:
11756 continue;
11757 break;
11758 default:
11759 return retval;
11763 out:
11764 Jim_SetEmptyResult(interp);
11765 return JIM_OK;
11768 /* [for] */
11769 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11771 int retval;
11772 int boolean = 1;
11773 Jim_Obj *varNamePtr = NULL;
11774 Jim_Obj *stopVarNamePtr = NULL;
11776 if (argc != 5) {
11777 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11778 return JIM_ERR;
11781 /* Do the initialisation */
11782 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11783 return retval;
11786 /* And do the first test now. Better for optimisation
11787 * if we can do next/test at the bottom of the loop
11789 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11791 /* Ready to do the body as follows:
11792 * while (1) {
11793 * body // check retcode
11794 * next // check retcode
11795 * test // check retcode/test bool
11799 #ifdef JIM_OPTIMIZATION
11800 /* Check if the for is on the form:
11801 * for ... {$i < CONST} {incr i}
11802 * for ... {$i < $j} {incr i}
11804 if (retval == JIM_OK && boolean) {
11805 ScriptObj *incrScript;
11806 ExprByteCode *expr;
11807 jim_wide stop, currentVal;
11808 Jim_Obj *objPtr;
11809 int cmpOffset;
11811 /* Do it only if there aren't shared arguments */
11812 expr = JimGetExpression(interp, argv[2]);
11813 incrScript = JimGetScript(interp, argv[3]);
11815 /* Ensure proper lengths to start */
11816 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11817 goto evalstart;
11819 /* Ensure proper token types. */
11820 if (incrScript->token[1].type != JIM_TT_ESC ||
11821 expr->token[0].type != JIM_TT_VAR ||
11822 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11823 goto evalstart;
11826 if (expr->token[2].type == JIM_EXPROP_LT) {
11827 cmpOffset = 0;
11829 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11830 cmpOffset = 1;
11832 else {
11833 goto evalstart;
11836 /* Update command must be incr */
11837 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11838 goto evalstart;
11841 /* incr, expression must be about the same variable */
11842 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11843 goto evalstart;
11846 /* Get the stop condition (must be a variable or integer) */
11847 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11848 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11849 goto evalstart;
11852 else {
11853 stopVarNamePtr = expr->token[1].objPtr;
11854 Jim_IncrRefCount(stopVarNamePtr);
11855 /* Keep the compiler happy */
11856 stop = 0;
11859 /* Initialization */
11860 varNamePtr = expr->token[0].objPtr;
11861 Jim_IncrRefCount(varNamePtr);
11863 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11864 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11865 goto testcond;
11868 /* --- OPTIMIZED FOR --- */
11869 while (retval == JIM_OK) {
11870 /* === Check condition === */
11871 /* Note that currentVal is already set here */
11873 /* Immediate or Variable? get the 'stop' value if the latter. */
11874 if (stopVarNamePtr) {
11875 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11876 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11877 goto testcond;
11881 if (currentVal >= stop + cmpOffset) {
11882 break;
11885 /* Eval body */
11886 retval = Jim_EvalObj(interp, argv[4]);
11887 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11888 retval = JIM_OK;
11890 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11892 /* Increment */
11893 if (objPtr == NULL) {
11894 retval = JIM_ERR;
11895 goto out;
11897 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11898 currentVal = ++JimWideValue(objPtr);
11899 Jim_InvalidateStringRep(objPtr);
11901 else {
11902 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11903 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11904 ++currentVal)) != JIM_OK) {
11905 goto evalnext;
11910 goto out;
11912 evalstart:
11913 #endif
11915 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11916 /* Body */
11917 retval = Jim_EvalObj(interp, argv[4]);
11919 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11920 /* increment */
11921 JIM_IF_OPTIM(evalnext:)
11922 retval = Jim_EvalObj(interp, argv[3]);
11923 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11924 /* test */
11925 JIM_IF_OPTIM(testcond:)
11926 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11930 JIM_IF_OPTIM(out:)
11931 if (stopVarNamePtr) {
11932 Jim_DecrRefCount(interp, stopVarNamePtr);
11934 if (varNamePtr) {
11935 Jim_DecrRefCount(interp, varNamePtr);
11938 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11939 Jim_SetEmptyResult(interp);
11940 return JIM_OK;
11943 return retval;
11946 /* [loop] */
11947 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11949 int retval;
11950 jim_wide i;
11951 jim_wide limit;
11952 jim_wide incr = 1;
11953 Jim_Obj *bodyObjPtr;
11955 if (argc != 5 && argc != 6) {
11956 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11957 return JIM_ERR;
11960 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11961 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11962 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11963 return JIM_ERR;
11965 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11967 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11969 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11970 retval = Jim_EvalObj(interp, bodyObjPtr);
11971 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11972 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11974 retval = JIM_OK;
11976 /* Increment */
11977 i += incr;
11979 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11980 if (argv[1]->typePtr != &variableObjType) {
11981 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11982 return JIM_ERR;
11985 JimWideValue(objPtr) = i;
11986 Jim_InvalidateStringRep(objPtr);
11988 /* The following step is required in order to invalidate the
11989 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11990 if (argv[1]->typePtr != &variableObjType) {
11991 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11992 retval = JIM_ERR;
11993 break;
11997 else {
11998 objPtr = Jim_NewIntObj(interp, i);
11999 retval = Jim_SetVariable(interp, argv[1], objPtr);
12000 if (retval != JIM_OK) {
12001 Jim_FreeNewObj(interp, objPtr);
12007 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
12008 Jim_SetEmptyResult(interp);
12009 return JIM_OK;
12011 return retval;
12014 /* List iterators make it easy to iterate over a list.
12015 * At some point iterators will be expanded to support generators.
12017 typedef struct {
12018 Jim_Obj *objPtr;
12019 int idx;
12020 } Jim_ListIter;
12023 * Initialise the iterator at the start of the list.
12025 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
12027 iter->objPtr = objPtr;
12028 iter->idx = 0;
12032 * Returns the next object from the list, or NULL on end-of-list.
12034 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
12036 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
12037 return NULL;
12039 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
12043 * Returns 1 if end-of-list has been reached.
12045 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
12047 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
12050 /* foreach + lmap implementation. */
12051 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
12053 int result = JIM_OK;
12054 int i, numargs;
12055 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
12056 Jim_ListIter *iters;
12057 Jim_Obj *script;
12058 Jim_Obj *resultObj;
12060 if (argc < 4 || argc % 2 != 0) {
12061 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
12062 return JIM_ERR;
12064 script = argv[argc - 1]; /* Last argument is a script */
12065 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
12067 if (numargs == 2) {
12068 iters = twoiters;
12070 else {
12071 iters = Jim_Alloc(numargs * sizeof(*iters));
12073 for (i = 0; i < numargs; i++) {
12074 JimListIterInit(&iters[i], argv[i + 1]);
12075 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
12076 result = JIM_ERR;
12079 if (result != JIM_OK) {
12080 Jim_SetResultString(interp, "foreach varlist is empty", -1);
12081 return result;
12084 if (doMap) {
12085 resultObj = Jim_NewListObj(interp, NULL, 0);
12087 else {
12088 resultObj = interp->emptyObj;
12090 Jim_IncrRefCount(resultObj);
12092 while (1) {
12093 /* Have we expired all lists? */
12094 for (i = 0; i < numargs; i += 2) {
12095 if (!JimListIterDone(interp, &iters[i + 1])) {
12096 break;
12099 if (i == numargs) {
12100 /* All done */
12101 break;
12104 /* For each list */
12105 for (i = 0; i < numargs; i += 2) {
12106 Jim_Obj *varName;
12108 /* foreach var */
12109 JimListIterInit(&iters[i], argv[i + 1]);
12110 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
12111 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
12112 if (!valObj) {
12113 /* Ran out, so store the empty string */
12114 valObj = interp->emptyObj;
12116 /* Avoid shimmering */
12117 Jim_IncrRefCount(valObj);
12118 result = Jim_SetVariable(interp, varName, valObj);
12119 Jim_DecrRefCount(interp, valObj);
12120 if (result != JIM_OK) {
12121 goto err;
12125 switch (result = Jim_EvalObj(interp, script)) {
12126 case JIM_OK:
12127 if (doMap) {
12128 Jim_ListAppendElement(interp, resultObj, interp->result);
12130 break;
12131 case JIM_CONTINUE:
12132 break;
12133 case JIM_BREAK:
12134 goto out;
12135 default:
12136 goto err;
12139 out:
12140 result = JIM_OK;
12141 Jim_SetResult(interp, resultObj);
12142 err:
12143 Jim_DecrRefCount(interp, resultObj);
12144 if (numargs > 2) {
12145 Jim_Free(iters);
12147 return result;
12150 /* [foreach] */
12151 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12153 return JimForeachMapHelper(interp, argc, argv, 0);
12156 /* [lmap] */
12157 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12159 return JimForeachMapHelper(interp, argc, argv, 1);
12162 /* [lassign] */
12163 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12165 int result = JIM_ERR;
12166 int i;
12167 Jim_ListIter iter;
12168 Jim_Obj *resultObj;
12170 if (argc < 2) {
12171 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12172 return JIM_ERR;
12175 JimListIterInit(&iter, argv[1]);
12177 for (i = 2; i < argc; i++) {
12178 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12179 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12180 if (result != JIM_OK) {
12181 return result;
12185 resultObj = Jim_NewListObj(interp, NULL, 0);
12186 while (!JimListIterDone(interp, &iter)) {
12187 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12190 Jim_SetResult(interp, resultObj);
12192 return JIM_OK;
12195 /* [if] */
12196 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12198 int boolean, retval, current = 1, falsebody = 0;
12200 if (argc >= 3) {
12201 while (1) {
12202 /* Far not enough arguments given! */
12203 if (current >= argc)
12204 goto err;
12205 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12206 != JIM_OK)
12207 return retval;
12208 /* There lacks something, isn't it? */
12209 if (current >= argc)
12210 goto err;
12211 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12212 current++;
12213 /* Tsk tsk, no then-clause? */
12214 if (current >= argc)
12215 goto err;
12216 if (boolean)
12217 return Jim_EvalObj(interp, argv[current]);
12218 /* Ok: no else-clause follows */
12219 if (++current >= argc) {
12220 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12221 return JIM_OK;
12223 falsebody = current++;
12224 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12225 /* IIICKS - else-clause isn't last cmd? */
12226 if (current != argc - 1)
12227 goto err;
12228 return Jim_EvalObj(interp, argv[current]);
12230 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12231 /* Ok: elseif follows meaning all the stuff
12232 * again (how boring...) */
12233 continue;
12234 /* OOPS - else-clause is not last cmd? */
12235 else if (falsebody != argc - 1)
12236 goto err;
12237 return Jim_EvalObj(interp, argv[falsebody]);
12239 return JIM_OK;
12241 err:
12242 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12243 return JIM_ERR;
12247 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12248 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12249 Jim_Obj *stringObj, int nocase)
12251 Jim_Obj *parms[4];
12252 int argc = 0;
12253 long eq;
12254 int rc;
12256 parms[argc++] = commandObj;
12257 if (nocase) {
12258 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12260 parms[argc++] = patternObj;
12261 parms[argc++] = stringObj;
12263 rc = Jim_EvalObjVector(interp, argc, parms);
12265 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12266 eq = -rc;
12269 return eq;
12272 enum
12273 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12275 /* [switch] */
12276 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12278 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12279 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12280 Jim_Obj *script = 0;
12282 if (argc < 3) {
12283 wrongnumargs:
12284 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12285 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12286 return JIM_ERR;
12288 for (opt = 1; opt < argc; ++opt) {
12289 const char *option = Jim_String(argv[opt]);
12291 if (*option != '-')
12292 break;
12293 else if (strncmp(option, "--", 2) == 0) {
12294 ++opt;
12295 break;
12297 else if (strncmp(option, "-exact", 2) == 0)
12298 matchOpt = SWITCH_EXACT;
12299 else if (strncmp(option, "-glob", 2) == 0)
12300 matchOpt = SWITCH_GLOB;
12301 else if (strncmp(option, "-regexp", 2) == 0)
12302 matchOpt = SWITCH_RE;
12303 else if (strncmp(option, "-command", 2) == 0) {
12304 matchOpt = SWITCH_CMD;
12305 if ((argc - opt) < 2)
12306 goto wrongnumargs;
12307 command = argv[++opt];
12309 else {
12310 Jim_SetResultFormatted(interp,
12311 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12312 argv[opt]);
12313 return JIM_ERR;
12315 if ((argc - opt) < 2)
12316 goto wrongnumargs;
12318 strObj = argv[opt++];
12319 patCount = argc - opt;
12320 if (patCount == 1) {
12321 Jim_Obj **vector;
12323 JimListGetElements(interp, argv[opt], &patCount, &vector);
12324 caseList = vector;
12326 else
12327 caseList = &argv[opt];
12328 if (patCount == 0 || patCount % 2 != 0)
12329 goto wrongnumargs;
12330 for (i = 0; script == 0 && i < patCount; i += 2) {
12331 Jim_Obj *patObj = caseList[i];
12333 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12334 || i < (patCount - 2)) {
12335 switch (matchOpt) {
12336 case SWITCH_EXACT:
12337 if (Jim_StringEqObj(strObj, patObj))
12338 script = caseList[i + 1];
12339 break;
12340 case SWITCH_GLOB:
12341 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12342 script = caseList[i + 1];
12343 break;
12344 case SWITCH_RE:
12345 command = Jim_NewStringObj(interp, "regexp", -1);
12346 /* Fall thru intentionally */
12347 case SWITCH_CMD:{
12348 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12350 /* After the execution of a command we need to
12351 * make sure to reconvert the object into a list
12352 * again. Only for the single-list style [switch]. */
12353 if (argc - opt == 1) {
12354 Jim_Obj **vector;
12356 JimListGetElements(interp, argv[opt], &patCount, &vector);
12357 caseList = vector;
12359 /* command is here already decref'd */
12360 if (rc < 0) {
12361 return -rc;
12363 if (rc)
12364 script = caseList[i + 1];
12365 break;
12369 else {
12370 script = caseList[i + 1];
12373 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12374 script = caseList[i + 1];
12375 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12376 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12377 return JIM_ERR;
12379 Jim_SetEmptyResult(interp);
12380 if (script) {
12381 return Jim_EvalObj(interp, script);
12383 return JIM_OK;
12386 /* [list] */
12387 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12389 Jim_Obj *listObjPtr;
12391 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12392 Jim_SetResult(interp, listObjPtr);
12393 return JIM_OK;
12396 /* [lindex] */
12397 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12399 Jim_Obj *objPtr, *listObjPtr;
12400 int i;
12401 int idx;
12403 if (argc < 2) {
12404 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12405 return JIM_ERR;
12407 objPtr = argv[1];
12408 Jim_IncrRefCount(objPtr);
12409 for (i = 2; i < argc; i++) {
12410 listObjPtr = objPtr;
12411 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12412 Jim_DecrRefCount(interp, listObjPtr);
12413 return JIM_ERR;
12415 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12416 /* Returns an empty object if the index
12417 * is out of range. */
12418 Jim_DecrRefCount(interp, listObjPtr);
12419 Jim_SetEmptyResult(interp);
12420 return JIM_OK;
12422 Jim_IncrRefCount(objPtr);
12423 Jim_DecrRefCount(interp, listObjPtr);
12425 Jim_SetResult(interp, objPtr);
12426 Jim_DecrRefCount(interp, objPtr);
12427 return JIM_OK;
12430 /* [llength] */
12431 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12433 if (argc != 2) {
12434 Jim_WrongNumArgs(interp, 1, argv, "list");
12435 return JIM_ERR;
12437 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12438 return JIM_OK;
12441 /* [lsearch] */
12442 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12444 static const char * const options[] = {
12445 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12446 NULL
12448 enum
12449 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12450 OPT_COMMAND };
12451 int i;
12452 int opt_bool = 0;
12453 int opt_not = 0;
12454 int opt_nocase = 0;
12455 int opt_all = 0;
12456 int opt_inline = 0;
12457 int opt_match = OPT_EXACT;
12458 int listlen;
12459 int rc = JIM_OK;
12460 Jim_Obj *listObjPtr = NULL;
12461 Jim_Obj *commandObj = NULL;
12463 if (argc < 3) {
12464 wrongargs:
12465 Jim_WrongNumArgs(interp, 1, argv,
12466 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12467 return JIM_ERR;
12470 for (i = 1; i < argc - 2; i++) {
12471 int option;
12473 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12474 return JIM_ERR;
12476 switch (option) {
12477 case OPT_BOOL:
12478 opt_bool = 1;
12479 opt_inline = 0;
12480 break;
12481 case OPT_NOT:
12482 opt_not = 1;
12483 break;
12484 case OPT_NOCASE:
12485 opt_nocase = 1;
12486 break;
12487 case OPT_INLINE:
12488 opt_inline = 1;
12489 opt_bool = 0;
12490 break;
12491 case OPT_ALL:
12492 opt_all = 1;
12493 break;
12494 case OPT_COMMAND:
12495 if (i >= argc - 2) {
12496 goto wrongargs;
12498 commandObj = argv[++i];
12499 /* fallthru */
12500 case OPT_EXACT:
12501 case OPT_GLOB:
12502 case OPT_REGEXP:
12503 opt_match = option;
12504 break;
12508 argv += i;
12510 if (opt_all) {
12511 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12513 if (opt_match == OPT_REGEXP) {
12514 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12516 if (commandObj) {
12517 Jim_IncrRefCount(commandObj);
12520 listlen = Jim_ListLength(interp, argv[0]);
12521 for (i = 0; i < listlen; i++) {
12522 int eq = 0;
12523 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12525 switch (opt_match) {
12526 case OPT_EXACT:
12527 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12528 break;
12530 case OPT_GLOB:
12531 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12532 break;
12534 case OPT_REGEXP:
12535 case OPT_COMMAND:
12536 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12537 if (eq < 0) {
12538 if (listObjPtr) {
12539 Jim_FreeNewObj(interp, listObjPtr);
12541 rc = JIM_ERR;
12542 goto done;
12544 break;
12547 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12548 if (!eq && opt_bool && opt_not && !opt_all) {
12549 continue;
12552 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12553 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12554 Jim_Obj *resultObj;
12556 if (opt_bool) {
12557 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12559 else if (!opt_inline) {
12560 resultObj = Jim_NewIntObj(interp, i);
12562 else {
12563 resultObj = objPtr;
12566 if (opt_all) {
12567 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12569 else {
12570 Jim_SetResult(interp, resultObj);
12571 goto done;
12576 if (opt_all) {
12577 Jim_SetResult(interp, listObjPtr);
12579 else {
12580 /* No match */
12581 if (opt_bool) {
12582 Jim_SetResultBool(interp, opt_not);
12584 else if (!opt_inline) {
12585 Jim_SetResultInt(interp, -1);
12589 done:
12590 if (commandObj) {
12591 Jim_DecrRefCount(interp, commandObj);
12593 return rc;
12596 /* [lappend] */
12597 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12599 Jim_Obj *listObjPtr;
12600 int new_obj = 0;
12601 int i;
12603 if (argc < 2) {
12604 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12605 return JIM_ERR;
12607 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12608 if (!listObjPtr) {
12609 /* Create the list if it does not exist */
12610 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12611 new_obj = 1;
12613 else if (Jim_IsShared(listObjPtr)) {
12614 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12615 new_obj = 1;
12617 for (i = 2; i < argc; i++)
12618 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12619 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12620 if (new_obj)
12621 Jim_FreeNewObj(interp, listObjPtr);
12622 return JIM_ERR;
12624 Jim_SetResult(interp, listObjPtr);
12625 return JIM_OK;
12628 /* [linsert] */
12629 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12631 int idx, len;
12632 Jim_Obj *listPtr;
12634 if (argc < 3) {
12635 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12636 return JIM_ERR;
12638 listPtr = argv[1];
12639 if (Jim_IsShared(listPtr))
12640 listPtr = Jim_DuplicateObj(interp, listPtr);
12641 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12642 goto err;
12643 len = Jim_ListLength(interp, listPtr);
12644 if (idx >= len)
12645 idx = len;
12646 else if (idx < 0)
12647 idx = len + idx + 1;
12648 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12649 Jim_SetResult(interp, listPtr);
12650 return JIM_OK;
12651 err:
12652 if (listPtr != argv[1]) {
12653 Jim_FreeNewObj(interp, listPtr);
12655 return JIM_ERR;
12658 /* [lreplace] */
12659 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12661 int first, last, len, rangeLen;
12662 Jim_Obj *listObj;
12663 Jim_Obj *newListObj;
12665 if (argc < 4) {
12666 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12667 return JIM_ERR;
12669 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12670 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12671 return JIM_ERR;
12674 listObj = argv[1];
12675 len = Jim_ListLength(interp, listObj);
12677 first = JimRelToAbsIndex(len, first);
12678 last = JimRelToAbsIndex(len, last);
12679 JimRelToAbsRange(len, &first, &last, &rangeLen);
12681 /* Now construct a new list which consists of:
12682 * <elements before first> <supplied elements> <elements after last>
12685 /* Check to see if trying to replace past the end of the list */
12686 if (first < len) {
12687 /* OK. Not past the end */
12689 else if (len == 0) {
12690 /* Special for empty list, adjust first to 0 */
12691 first = 0;
12693 else {
12694 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12695 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12696 return JIM_ERR;
12699 /* Add the first set of elements */
12700 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12702 /* Add supplied elements */
12703 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12705 /* Add the remaining elements */
12706 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12708 Jim_SetResult(interp, newListObj);
12709 return JIM_OK;
12712 /* [lset] */
12713 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12715 if (argc < 3) {
12716 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12717 return JIM_ERR;
12719 else if (argc == 3) {
12720 /* With no indexes, simply implements [set] */
12721 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12722 return JIM_ERR;
12723 Jim_SetResult(interp, argv[2]);
12724 return JIM_OK;
12726 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12729 /* [lsort] */
12730 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12732 static const char * const options[] = {
12733 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12735 enum
12736 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12737 Jim_Obj *resObj;
12738 int i;
12739 int retCode;
12741 struct lsort_info info;
12743 if (argc < 2) {
12744 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12745 return JIM_ERR;
12748 info.type = JIM_LSORT_ASCII;
12749 info.order = 1;
12750 info.indexed = 0;
12751 info.unique = 0;
12752 info.command = NULL;
12753 info.interp = interp;
12755 for (i = 1; i < (argc - 1); i++) {
12756 int option;
12758 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12759 != JIM_OK)
12760 return JIM_ERR;
12761 switch (option) {
12762 case OPT_ASCII:
12763 info.type = JIM_LSORT_ASCII;
12764 break;
12765 case OPT_NOCASE:
12766 info.type = JIM_LSORT_NOCASE;
12767 break;
12768 case OPT_INTEGER:
12769 info.type = JIM_LSORT_INTEGER;
12770 break;
12771 case OPT_REAL:
12772 info.type = JIM_LSORT_REAL;
12773 break;
12774 case OPT_INCREASING:
12775 info.order = 1;
12776 break;
12777 case OPT_DECREASING:
12778 info.order = -1;
12779 break;
12780 case OPT_UNIQUE:
12781 info.unique = 1;
12782 break;
12783 case OPT_COMMAND:
12784 if (i >= (argc - 2)) {
12785 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12786 return JIM_ERR;
12788 info.type = JIM_LSORT_COMMAND;
12789 info.command = argv[i + 1];
12790 i++;
12791 break;
12792 case OPT_INDEX:
12793 if (i >= (argc - 2)) {
12794 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12795 return JIM_ERR;
12797 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12798 return JIM_ERR;
12800 info.indexed = 1;
12801 i++;
12802 break;
12805 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12806 retCode = ListSortElements(interp, resObj, &info);
12807 if (retCode == JIM_OK) {
12808 Jim_SetResult(interp, resObj);
12810 else {
12811 Jim_FreeNewObj(interp, resObj);
12813 return retCode;
12816 /* [append] */
12817 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12819 Jim_Obj *stringObjPtr;
12820 int i;
12822 if (argc < 2) {
12823 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12824 return JIM_ERR;
12826 if (argc == 2) {
12827 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12828 if (!stringObjPtr)
12829 return JIM_ERR;
12831 else {
12832 int new_obj = 0;
12833 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12834 if (!stringObjPtr) {
12835 /* Create the string if it doesn't exist */
12836 stringObjPtr = Jim_NewEmptyStringObj(interp);
12837 new_obj = 1;
12839 else if (Jim_IsShared(stringObjPtr)) {
12840 new_obj = 1;
12841 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12843 for (i = 2; i < argc; i++) {
12844 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12846 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12847 if (new_obj) {
12848 Jim_FreeNewObj(interp, stringObjPtr);
12850 return JIM_ERR;
12853 Jim_SetResult(interp, stringObjPtr);
12854 return JIM_OK;
12857 /* [debug] */
12858 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12860 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12861 static const char * const options[] = {
12862 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12863 "exprbc", "show",
12864 NULL
12866 enum
12868 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12869 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12871 int option;
12873 if (argc < 2) {
12874 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12875 return JIM_ERR;
12877 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12878 return JIM_ERR;
12879 if (option == OPT_REFCOUNT) {
12880 if (argc != 3) {
12881 Jim_WrongNumArgs(interp, 2, argv, "object");
12882 return JIM_ERR;
12884 Jim_SetResultInt(interp, argv[2]->refCount);
12885 return JIM_OK;
12887 else if (option == OPT_OBJCOUNT) {
12888 int freeobj = 0, liveobj = 0;
12889 char buf[256];
12890 Jim_Obj *objPtr;
12892 if (argc != 2) {
12893 Jim_WrongNumArgs(interp, 2, argv, "");
12894 return JIM_ERR;
12896 /* Count the number of free objects. */
12897 objPtr = interp->freeList;
12898 while (objPtr) {
12899 freeobj++;
12900 objPtr = objPtr->nextObjPtr;
12902 /* Count the number of live objects. */
12903 objPtr = interp->liveList;
12904 while (objPtr) {
12905 liveobj++;
12906 objPtr = objPtr->nextObjPtr;
12908 /* Set the result string and return. */
12909 sprintf(buf, "free %d used %d", freeobj, liveobj);
12910 Jim_SetResultString(interp, buf, -1);
12911 return JIM_OK;
12913 else if (option == OPT_OBJECTS) {
12914 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12916 /* Count the number of live objects. */
12917 objPtr = interp->liveList;
12918 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12919 while (objPtr) {
12920 char buf[128];
12921 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12923 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12924 sprintf(buf, "%p", objPtr);
12925 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12926 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12927 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12928 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12929 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12930 objPtr = objPtr->nextObjPtr;
12932 Jim_SetResult(interp, listObjPtr);
12933 return JIM_OK;
12935 else if (option == OPT_INVSTR) {
12936 Jim_Obj *objPtr;
12938 if (argc != 3) {
12939 Jim_WrongNumArgs(interp, 2, argv, "object");
12940 return JIM_ERR;
12942 objPtr = argv[2];
12943 if (objPtr->typePtr != NULL)
12944 Jim_InvalidateStringRep(objPtr);
12945 Jim_SetEmptyResult(interp);
12946 return JIM_OK;
12948 else if (option == OPT_SHOW) {
12949 const char *s;
12950 int len, charlen;
12952 if (argc != 3) {
12953 Jim_WrongNumArgs(interp, 2, argv, "object");
12954 return JIM_ERR;
12956 s = Jim_GetString(argv[2], &len);
12957 #ifdef JIM_UTF8
12958 charlen = utf8_strlen(s, len);
12959 #else
12960 charlen = len;
12961 #endif
12962 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12963 printf("chars (%d): <<%s>>\n", charlen, s);
12964 printf("bytes (%d):", len);
12965 while (len--) {
12966 printf(" %02x", (unsigned char)*s++);
12968 printf("\n");
12969 return JIM_OK;
12971 else if (option == OPT_SCRIPTLEN) {
12972 ScriptObj *script;
12974 if (argc != 3) {
12975 Jim_WrongNumArgs(interp, 2, argv, "script");
12976 return JIM_ERR;
12978 script = JimGetScript(interp, argv[2]);
12979 if (script == NULL)
12980 return JIM_ERR;
12981 Jim_SetResultInt(interp, script->len);
12982 return JIM_OK;
12984 else if (option == OPT_EXPRLEN) {
12985 ExprByteCode *expr;
12987 if (argc != 3) {
12988 Jim_WrongNumArgs(interp, 2, argv, "expression");
12989 return JIM_ERR;
12991 expr = JimGetExpression(interp, argv[2]);
12992 if (expr == NULL)
12993 return JIM_ERR;
12994 Jim_SetResultInt(interp, expr->len);
12995 return JIM_OK;
12997 else if (option == OPT_EXPRBC) {
12998 Jim_Obj *objPtr;
12999 ExprByteCode *expr;
13000 int i;
13002 if (argc != 3) {
13003 Jim_WrongNumArgs(interp, 2, argv, "expression");
13004 return JIM_ERR;
13006 expr = JimGetExpression(interp, argv[2]);
13007 if (expr == NULL)
13008 return JIM_ERR;
13009 objPtr = Jim_NewListObj(interp, NULL, 0);
13010 for (i = 0; i < expr->len; i++) {
13011 const char *type;
13012 const Jim_ExprOperator *op;
13013 Jim_Obj *obj = expr->token[i].objPtr;
13015 switch (expr->token[i].type) {
13016 case JIM_TT_EXPR_INT:
13017 type = "int";
13018 break;
13019 case JIM_TT_EXPR_DOUBLE:
13020 type = "double";
13021 break;
13022 case JIM_TT_EXPR_BOOLEAN:
13023 type = "boolean";
13024 break;
13025 case JIM_TT_CMD:
13026 type = "command";
13027 break;
13028 case JIM_TT_VAR:
13029 type = "variable";
13030 break;
13031 case JIM_TT_DICTSUGAR:
13032 type = "dictsugar";
13033 break;
13034 case JIM_TT_EXPRSUGAR:
13035 type = "exprsugar";
13036 break;
13037 case JIM_TT_ESC:
13038 type = "subst";
13039 break;
13040 case JIM_TT_STR:
13041 type = "string";
13042 break;
13043 default:
13044 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
13045 if (op == NULL) {
13046 type = "private";
13048 else {
13049 type = "operator";
13051 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
13052 break;
13054 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
13055 Jim_ListAppendElement(interp, objPtr, obj);
13057 Jim_SetResult(interp, objPtr);
13058 return JIM_OK;
13060 else {
13061 Jim_SetResultString(interp,
13062 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
13063 return JIM_ERR;
13065 /* unreached */
13066 #endif /* JIM_BOOTSTRAP */
13067 #if !defined(JIM_DEBUG_COMMAND)
13068 Jim_SetResultString(interp, "unsupported", -1);
13069 return JIM_ERR;
13070 #endif
13073 /* [eval] */
13074 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13076 int rc;
13078 if (argc < 2) {
13079 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
13080 return JIM_ERR;
13083 if (argc == 2) {
13084 rc = Jim_EvalObj(interp, argv[1]);
13086 else {
13087 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13090 if (rc == JIM_ERR) {
13091 /* eval is "interesting", so add a stack frame here */
13092 interp->addStackTrace++;
13094 return rc;
13097 /* [uplevel] */
13098 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13100 if (argc >= 2) {
13101 int retcode;
13102 Jim_CallFrame *savedCallFrame, *targetCallFrame;
13103 const char *str;
13105 /* Save the old callframe pointer */
13106 savedCallFrame = interp->framePtr;
13108 /* Lookup the target frame pointer */
13109 str = Jim_String(argv[1]);
13110 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
13111 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13112 argc--;
13113 argv++;
13115 else {
13116 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13118 if (targetCallFrame == NULL) {
13119 return JIM_ERR;
13121 if (argc < 2) {
13122 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
13123 return JIM_ERR;
13125 /* Eval the code in the target callframe. */
13126 interp->framePtr = targetCallFrame;
13127 if (argc == 2) {
13128 retcode = Jim_EvalObj(interp, argv[1]);
13130 else {
13131 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13133 interp->framePtr = savedCallFrame;
13134 return retcode;
13136 else {
13137 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
13138 return JIM_ERR;
13142 /* [expr] */
13143 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13145 Jim_Obj *exprResultPtr;
13146 int retcode;
13148 if (argc == 2) {
13149 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
13151 else if (argc > 2) {
13152 Jim_Obj *objPtr;
13154 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13155 Jim_IncrRefCount(objPtr);
13156 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
13157 Jim_DecrRefCount(interp, objPtr);
13159 else {
13160 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13161 return JIM_ERR;
13163 if (retcode != JIM_OK)
13164 return retcode;
13165 Jim_SetResult(interp, exprResultPtr);
13166 Jim_DecrRefCount(interp, exprResultPtr);
13167 return JIM_OK;
13170 /* [break] */
13171 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13173 if (argc != 1) {
13174 Jim_WrongNumArgs(interp, 1, argv, "");
13175 return JIM_ERR;
13177 return JIM_BREAK;
13180 /* [continue] */
13181 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13183 if (argc != 1) {
13184 Jim_WrongNumArgs(interp, 1, argv, "");
13185 return JIM_ERR;
13187 return JIM_CONTINUE;
13190 /* [return] */
13191 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13193 int i;
13194 Jim_Obj *stackTraceObj = NULL;
13195 Jim_Obj *errorCodeObj = NULL;
13196 int returnCode = JIM_OK;
13197 long level = 1;
13199 for (i = 1; i < argc - 1; i += 2) {
13200 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13201 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13202 return JIM_ERR;
13205 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13206 stackTraceObj = argv[i + 1];
13208 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13209 errorCodeObj = argv[i + 1];
13211 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13212 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13213 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13214 return JIM_ERR;
13217 else {
13218 break;
13222 if (i != argc - 1 && i != argc) {
13223 Jim_WrongNumArgs(interp, 1, argv,
13224 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13227 /* If a stack trace is supplied and code is error, set the stack trace */
13228 if (stackTraceObj && returnCode == JIM_ERR) {
13229 JimSetStackTrace(interp, stackTraceObj);
13231 /* If an error code list is supplied, set the global $errorCode */
13232 if (errorCodeObj && returnCode == JIM_ERR) {
13233 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13235 interp->returnCode = returnCode;
13236 interp->returnLevel = level;
13238 if (i == argc - 1) {
13239 Jim_SetResult(interp, argv[i]);
13241 return JIM_RETURN;
13244 /* [tailcall] */
13245 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13247 if (interp->framePtr->level == 0) {
13248 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13249 return JIM_ERR;
13251 else if (argc >= 2) {
13252 /* Need to resolve the tailcall command in the current context */
13253 Jim_CallFrame *cf = interp->framePtr->parent;
13255 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13256 if (cmdPtr == NULL) {
13257 return JIM_ERR;
13260 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13262 /* And stash this pre-resolved command */
13263 JimIncrCmdRefCount(cmdPtr);
13264 cf->tailcallCmd = cmdPtr;
13266 /* And stash the command list */
13267 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13269 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13270 Jim_IncrRefCount(cf->tailcallObj);
13272 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13273 return JIM_EVAL;
13275 return JIM_OK;
13278 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13280 Jim_Obj *cmdList;
13281 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13283 /* prefixListObj is a list to which the args need to be appended */
13284 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13285 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13287 return JimEvalObjList(interp, cmdList);
13290 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13292 Jim_Obj *prefixListObj = privData;
13293 Jim_DecrRefCount(interp, prefixListObj);
13296 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13298 Jim_Obj *prefixListObj;
13299 const char *newname;
13301 if (argc < 3) {
13302 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13303 return JIM_ERR;
13306 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13307 Jim_IncrRefCount(prefixListObj);
13308 newname = Jim_String(argv[1]);
13309 if (newname[0] == ':' && newname[1] == ':') {
13310 while (*++newname == ':') {
13314 Jim_SetResult(interp, argv[1]);
13316 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13319 /* [proc] */
13320 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13322 Jim_Cmd *cmd;
13324 if (argc != 4 && argc != 5) {
13325 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13326 return JIM_ERR;
13329 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13330 return JIM_ERR;
13333 if (argc == 4) {
13334 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13336 else {
13337 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13340 if (cmd) {
13341 /* Add the new command */
13342 Jim_Obj *qualifiedCmdNameObj;
13343 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13345 JimCreateCommand(interp, cmdname, cmd);
13347 /* Calculate and set the namespace for this proc */
13348 JimUpdateProcNamespace(interp, cmd, cmdname);
13350 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13352 /* Unlike Tcl, set the name of the proc as the result */
13353 Jim_SetResult(interp, argv[1]);
13354 return JIM_OK;
13356 return JIM_ERR;
13359 /* [local] */
13360 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13362 int retcode;
13364 if (argc < 2) {
13365 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13366 return JIM_ERR;
13369 /* Evaluate the arguments with 'local' in force */
13370 interp->local++;
13371 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13372 interp->local--;
13375 /* If OK, and the result is a proc, add it to the list of local procs */
13376 if (retcode == 0) {
13377 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13379 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13380 return JIM_ERR;
13382 if (interp->framePtr->localCommands == NULL) {
13383 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13384 Jim_InitStack(interp->framePtr->localCommands);
13386 Jim_IncrRefCount(cmdNameObj);
13387 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13390 return retcode;
13393 /* [upcall] */
13394 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13396 if (argc < 2) {
13397 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13398 return JIM_ERR;
13400 else {
13401 int retcode;
13403 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13404 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13405 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13406 return JIM_ERR;
13408 /* OK. Mark this command as being in an upcall */
13409 cmdPtr->u.proc.upcall++;
13410 JimIncrCmdRefCount(cmdPtr);
13412 /* Invoke the command as normal */
13413 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13415 /* No longer in an upcall */
13416 cmdPtr->u.proc.upcall--;
13417 JimDecrCmdRefCount(interp, cmdPtr);
13419 return retcode;
13423 /* [apply] */
13424 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13426 if (argc < 2) {
13427 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13428 return JIM_ERR;
13430 else {
13431 int ret;
13432 Jim_Cmd *cmd;
13433 Jim_Obj *argListObjPtr;
13434 Jim_Obj *bodyObjPtr;
13435 Jim_Obj *nsObj = NULL;
13436 Jim_Obj **nargv;
13438 int len = Jim_ListLength(interp, argv[1]);
13439 if (len != 2 && len != 3) {
13440 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13441 return JIM_ERR;
13444 if (len == 3) {
13445 #ifdef jim_ext_namespace
13446 /* Need to canonicalise the given namespace. */
13447 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13448 #else
13449 Jim_SetResultString(interp, "namespaces not enabled", -1);
13450 return JIM_ERR;
13451 #endif
13453 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13454 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13456 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13458 if (cmd) {
13459 /* Create a new argv array with a dummy argv[0], for error messages */
13460 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13461 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13462 Jim_IncrRefCount(nargv[0]);
13463 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13464 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13465 Jim_DecrRefCount(interp, nargv[0]);
13466 Jim_Free(nargv);
13468 JimDecrCmdRefCount(interp, cmd);
13469 return ret;
13471 return JIM_ERR;
13476 /* [concat] */
13477 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13479 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13480 return JIM_OK;
13483 /* [upvar] */
13484 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13486 int i;
13487 Jim_CallFrame *targetCallFrame;
13489 /* Lookup the target frame pointer */
13490 if (argc > 3 && (argc % 2 == 0)) {
13491 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13492 argc--;
13493 argv++;
13495 else {
13496 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13498 if (targetCallFrame == NULL) {
13499 return JIM_ERR;
13502 /* Check for arity */
13503 if (argc < 3) {
13504 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13505 return JIM_ERR;
13508 /* Now... for every other/local couple: */
13509 for (i = 1; i < argc; i += 2) {
13510 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13511 return JIM_ERR;
13513 return JIM_OK;
13516 /* [global] */
13517 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13519 int i;
13521 if (argc < 2) {
13522 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13523 return JIM_ERR;
13525 /* Link every var to the toplevel having the same name */
13526 if (interp->framePtr->level == 0)
13527 return JIM_OK; /* global at toplevel... */
13528 for (i = 1; i < argc; i++) {
13529 /* global ::blah does nothing */
13530 const char *name = Jim_String(argv[i]);
13531 if (name[0] != ':' || name[1] != ':') {
13532 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13533 return JIM_ERR;
13536 return JIM_OK;
13539 /* does the [string map] operation. On error NULL is returned,
13540 * otherwise a new string object with the result, having refcount = 0,
13541 * is returned. */
13542 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13543 Jim_Obj *objPtr, int nocase)
13545 int numMaps;
13546 const char *str, *noMatchStart = NULL;
13547 int strLen, i;
13548 Jim_Obj *resultObjPtr;
13550 numMaps = Jim_ListLength(interp, mapListObjPtr);
13551 if (numMaps % 2) {
13552 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13553 return NULL;
13556 str = Jim_String(objPtr);
13557 strLen = Jim_Utf8Length(interp, objPtr);
13559 /* Map it */
13560 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13561 while (strLen) {
13562 for (i = 0; i < numMaps; i += 2) {
13563 Jim_Obj *objPtr;
13564 const char *k;
13565 int kl;
13567 objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13568 k = Jim_String(objPtr);
13569 kl = Jim_Utf8Length(interp, objPtr);
13571 if (strLen >= kl && kl) {
13572 int rc;
13573 rc = JimStringCompareLen(str, k, kl, nocase);
13574 if (rc == 0) {
13575 if (noMatchStart) {
13576 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13577 noMatchStart = NULL;
13579 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13580 str += utf8_index(str, kl);
13581 strLen -= kl;
13582 break;
13586 if (i == numMaps) { /* no match */
13587 int c;
13588 if (noMatchStart == NULL)
13589 noMatchStart = str;
13590 str += utf8_tounicode(str, &c);
13591 strLen--;
13594 if (noMatchStart) {
13595 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13597 return resultObjPtr;
13600 /* [string] */
13601 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13603 int len;
13604 int opt_case = 1;
13605 int option;
13606 static const char * const options[] = {
13607 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13608 "map", "repeat", "reverse", "index", "first", "last", "cat",
13609 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13611 enum
13613 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13614 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13615 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13617 static const char * const nocase_options[] = {
13618 "-nocase", NULL
13620 static const char * const nocase_length_options[] = {
13621 "-nocase", "-length", NULL
13624 if (argc < 2) {
13625 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13626 return JIM_ERR;
13628 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13629 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13630 return JIM_ERR;
13632 switch (option) {
13633 case OPT_LENGTH:
13634 case OPT_BYTELENGTH:
13635 if (argc != 3) {
13636 Jim_WrongNumArgs(interp, 2, argv, "string");
13637 return JIM_ERR;
13639 if (option == OPT_LENGTH) {
13640 len = Jim_Utf8Length(interp, argv[2]);
13642 else {
13643 len = Jim_Length(argv[2]);
13645 Jim_SetResultInt(interp, len);
13646 return JIM_OK;
13648 case OPT_CAT:{
13649 Jim_Obj *objPtr;
13650 if (argc == 3) {
13651 /* optimise the one-arg case */
13652 objPtr = argv[2];
13654 else {
13655 int i;
13657 objPtr = Jim_NewStringObj(interp, "", 0);
13659 for (i = 2; i < argc; i++) {
13660 Jim_AppendObj(interp, objPtr, argv[i]);
13663 Jim_SetResult(interp, objPtr);
13664 return JIM_OK;
13667 case OPT_COMPARE:
13668 case OPT_EQUAL:
13670 /* n is the number of remaining option args */
13671 long opt_length = -1;
13672 int n = argc - 4;
13673 int i = 2;
13674 while (n > 0) {
13675 int subopt;
13676 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13677 JIM_ENUM_ABBREV) != JIM_OK) {
13678 badcompareargs:
13679 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13680 return JIM_ERR;
13682 if (subopt == 0) {
13683 /* -nocase */
13684 opt_case = 0;
13685 n--;
13687 else {
13688 /* -length */
13689 if (n < 2) {
13690 goto badcompareargs;
13692 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13693 return JIM_ERR;
13695 n -= 2;
13698 if (n) {
13699 goto badcompareargs;
13701 argv += argc - 2;
13702 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13703 /* Fast version - [string equal], case sensitive, no length */
13704 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13706 else {
13707 if (opt_length >= 0) {
13708 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13710 else {
13711 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13713 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13715 return JIM_OK;
13718 case OPT_MATCH:
13719 if (argc != 4 &&
13720 (argc != 5 ||
13721 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13722 JIM_ENUM_ABBREV) != JIM_OK)) {
13723 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13724 return JIM_ERR;
13726 if (opt_case == 0) {
13727 argv++;
13729 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13730 return JIM_OK;
13732 case OPT_MAP:{
13733 Jim_Obj *objPtr;
13735 if (argc != 4 &&
13736 (argc != 5 ||
13737 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13738 JIM_ENUM_ABBREV) != JIM_OK)) {
13739 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13740 return JIM_ERR;
13743 if (opt_case == 0) {
13744 argv++;
13746 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13747 if (objPtr == NULL) {
13748 return JIM_ERR;
13750 Jim_SetResult(interp, objPtr);
13751 return JIM_OK;
13754 case OPT_RANGE:
13755 case OPT_BYTERANGE:{
13756 Jim_Obj *objPtr;
13758 if (argc != 5) {
13759 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13760 return JIM_ERR;
13762 if (option == OPT_RANGE) {
13763 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13765 else
13767 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13770 if (objPtr == NULL) {
13771 return JIM_ERR;
13773 Jim_SetResult(interp, objPtr);
13774 return JIM_OK;
13777 case OPT_REPLACE:{
13778 Jim_Obj *objPtr;
13780 if (argc != 5 && argc != 6) {
13781 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13782 return JIM_ERR;
13784 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13785 if (objPtr == NULL) {
13786 return JIM_ERR;
13788 Jim_SetResult(interp, objPtr);
13789 return JIM_OK;
13793 case OPT_REPEAT:{
13794 Jim_Obj *objPtr;
13795 jim_wide count;
13797 if (argc != 4) {
13798 Jim_WrongNumArgs(interp, 2, argv, "string count");
13799 return JIM_ERR;
13801 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13802 return JIM_ERR;
13804 objPtr = Jim_NewStringObj(interp, "", 0);
13805 if (count > 0) {
13806 while (count--) {
13807 Jim_AppendObj(interp, objPtr, argv[2]);
13810 Jim_SetResult(interp, objPtr);
13811 return JIM_OK;
13814 case OPT_REVERSE:{
13815 char *buf, *p;
13816 const char *str;
13817 int len;
13818 int i;
13820 if (argc != 3) {
13821 Jim_WrongNumArgs(interp, 2, argv, "string");
13822 return JIM_ERR;
13825 str = Jim_GetString(argv[2], &len);
13826 buf = Jim_Alloc(len + 1);
13827 p = buf + len;
13828 *p = 0;
13829 for (i = 0; i < len; ) {
13830 int c;
13831 int l = utf8_tounicode(str, &c);
13832 memcpy(p - l, str, l);
13833 p -= l;
13834 i += l;
13835 str += l;
13837 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13838 return JIM_OK;
13841 case OPT_INDEX:{
13842 int idx;
13843 const char *str;
13845 if (argc != 4) {
13846 Jim_WrongNumArgs(interp, 2, argv, "string index");
13847 return JIM_ERR;
13849 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13850 return JIM_ERR;
13852 str = Jim_String(argv[2]);
13853 len = Jim_Utf8Length(interp, argv[2]);
13854 if (idx != INT_MIN && idx != INT_MAX) {
13855 idx = JimRelToAbsIndex(len, idx);
13857 if (idx < 0 || idx >= len || str == NULL) {
13858 Jim_SetResultString(interp, "", 0);
13860 else if (len == Jim_Length(argv[2])) {
13861 /* ASCII optimisation */
13862 Jim_SetResultString(interp, str + idx, 1);
13864 else {
13865 int c;
13866 int i = utf8_index(str, idx);
13867 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13869 return JIM_OK;
13872 case OPT_FIRST:
13873 case OPT_LAST:{
13874 int idx = 0, l1, l2;
13875 const char *s1, *s2;
13877 if (argc != 4 && argc != 5) {
13878 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13879 return JIM_ERR;
13881 s1 = Jim_String(argv[2]);
13882 s2 = Jim_String(argv[3]);
13883 l1 = Jim_Utf8Length(interp, argv[2]);
13884 l2 = Jim_Utf8Length(interp, argv[3]);
13885 if (argc == 5) {
13886 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13887 return JIM_ERR;
13889 idx = JimRelToAbsIndex(l2, idx);
13891 else if (option == OPT_LAST) {
13892 idx = l2;
13894 if (option == OPT_FIRST) {
13895 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13897 else {
13898 #ifdef JIM_UTF8
13899 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13900 #else
13901 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13902 #endif
13904 return JIM_OK;
13907 case OPT_TRIM:
13908 case OPT_TRIMLEFT:
13909 case OPT_TRIMRIGHT:{
13910 Jim_Obj *trimchars;
13912 if (argc != 3 && argc != 4) {
13913 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13914 return JIM_ERR;
13916 trimchars = (argc == 4 ? argv[3] : NULL);
13917 if (option == OPT_TRIM) {
13918 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13920 else if (option == OPT_TRIMLEFT) {
13921 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13923 else if (option == OPT_TRIMRIGHT) {
13924 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13926 return JIM_OK;
13929 case OPT_TOLOWER:
13930 case OPT_TOUPPER:
13931 case OPT_TOTITLE:
13932 if (argc != 3) {
13933 Jim_WrongNumArgs(interp, 2, argv, "string");
13934 return JIM_ERR;
13936 if (option == OPT_TOLOWER) {
13937 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13939 else if (option == OPT_TOUPPER) {
13940 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13942 else {
13943 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13945 return JIM_OK;
13947 case OPT_IS:
13948 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13949 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13951 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13952 return JIM_ERR;
13954 return JIM_OK;
13957 /* [time] */
13958 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13960 long i, count = 1;
13961 jim_wide start, elapsed;
13962 char buf[60];
13963 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13965 if (argc < 2) {
13966 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13967 return JIM_ERR;
13969 if (argc == 3) {
13970 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13971 return JIM_ERR;
13973 if (count < 0)
13974 return JIM_OK;
13975 i = count;
13976 start = JimClock();
13977 while (i-- > 0) {
13978 int retval;
13980 retval = Jim_EvalObj(interp, argv[1]);
13981 if (retval != JIM_OK) {
13982 return retval;
13985 elapsed = JimClock() - start;
13986 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13987 Jim_SetResultString(interp, buf, -1);
13988 return JIM_OK;
13991 /* [exit] */
13992 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13994 long exitCode = 0;
13996 if (argc > 2) {
13997 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13998 return JIM_ERR;
14000 if (argc == 2) {
14001 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
14002 return JIM_ERR;
14004 interp->exitCode = exitCode;
14005 return JIM_EXIT;
14008 /* [catch] */
14009 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14011 int exitCode = 0;
14012 int i;
14013 int sig = 0;
14015 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
14016 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
14017 static const int max_ignore_code = sizeof(ignore_mask) * 8;
14019 /* Reset the error code before catch.
14020 * Note that this is not strictly correct.
14022 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
14024 for (i = 1; i < argc - 1; i++) {
14025 const char *arg = Jim_String(argv[i]);
14026 jim_wide option;
14027 int ignore;
14029 /* It's a pity we can't use Jim_GetEnum here :-( */
14030 if (strcmp(arg, "--") == 0) {
14031 i++;
14032 break;
14034 if (*arg != '-') {
14035 break;
14038 if (strncmp(arg, "-no", 3) == 0) {
14039 arg += 3;
14040 ignore = 1;
14042 else {
14043 arg++;
14044 ignore = 0;
14047 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
14048 option = -1;
14050 if (option < 0) {
14051 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
14053 if (option < 0) {
14054 goto wrongargs;
14057 if (ignore) {
14058 ignore_mask |= ((jim_wide)1 << option);
14060 else {
14061 ignore_mask &= (~((jim_wide)1 << option));
14065 argc -= i;
14066 if (argc < 1 || argc > 3) {
14067 wrongargs:
14068 Jim_WrongNumArgs(interp, 1, argv,
14069 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
14070 return JIM_ERR;
14072 argv += i;
14074 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
14075 sig++;
14078 interp->signal_level += sig;
14079 if (Jim_CheckSignal(interp)) {
14080 /* If a signal is set, don't even try to execute the body */
14081 exitCode = JIM_SIGNAL;
14083 else {
14084 exitCode = Jim_EvalObj(interp, argv[0]);
14085 /* Don't want any caught error included in a later stack trace */
14086 interp->errorFlag = 0;
14088 interp->signal_level -= sig;
14090 /* Catch or pass through? Only the first 32/64 codes can be passed through */
14091 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
14092 /* Not caught, pass it up */
14093 return exitCode;
14096 if (sig && exitCode == JIM_SIGNAL) {
14097 /* Catch the signal at this level */
14098 if (interp->signal_set_result) {
14099 interp->signal_set_result(interp, interp->sigmask);
14101 else {
14102 Jim_SetResultInt(interp, interp->sigmask);
14104 interp->sigmask = 0;
14107 if (argc >= 2) {
14108 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
14109 return JIM_ERR;
14111 if (argc == 3) {
14112 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
14114 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
14115 Jim_ListAppendElement(interp, optListObj,
14116 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
14117 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
14118 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
14119 if (exitCode == JIM_ERR) {
14120 Jim_Obj *errorCode;
14121 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
14122 -1));
14123 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
14125 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
14126 if (errorCode) {
14127 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
14128 Jim_ListAppendElement(interp, optListObj, errorCode);
14131 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
14132 return JIM_ERR;
14136 Jim_SetResultInt(interp, exitCode);
14137 return JIM_OK;
14140 #ifdef JIM_REFERENCES
14142 /* [ref] */
14143 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14145 if (argc != 3 && argc != 4) {
14146 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
14147 return JIM_ERR;
14149 if (argc == 3) {
14150 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
14152 else {
14153 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
14155 return JIM_OK;
14158 /* [getref] */
14159 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14161 Jim_Reference *refPtr;
14163 if (argc != 2) {
14164 Jim_WrongNumArgs(interp, 1, argv, "reference");
14165 return JIM_ERR;
14167 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14168 return JIM_ERR;
14169 Jim_SetResult(interp, refPtr->objPtr);
14170 return JIM_OK;
14173 /* [setref] */
14174 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14176 Jim_Reference *refPtr;
14178 if (argc != 3) {
14179 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14180 return JIM_ERR;
14182 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14183 return JIM_ERR;
14184 Jim_IncrRefCount(argv[2]);
14185 Jim_DecrRefCount(interp, refPtr->objPtr);
14186 refPtr->objPtr = argv[2];
14187 Jim_SetResult(interp, argv[2]);
14188 return JIM_OK;
14191 /* [collect] */
14192 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14194 if (argc != 1) {
14195 Jim_WrongNumArgs(interp, 1, argv, "");
14196 return JIM_ERR;
14198 Jim_SetResultInt(interp, Jim_Collect(interp));
14200 /* Free all the freed objects. */
14201 while (interp->freeList) {
14202 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14203 Jim_Free(interp->freeList);
14204 interp->freeList = nextObjPtr;
14207 return JIM_OK;
14210 /* [finalize] reference ?newValue? */
14211 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14213 if (argc != 2 && argc != 3) {
14214 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14215 return JIM_ERR;
14217 if (argc == 2) {
14218 Jim_Obj *cmdNamePtr;
14220 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14221 return JIM_ERR;
14222 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14223 Jim_SetResult(interp, cmdNamePtr);
14225 else {
14226 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14227 return JIM_ERR;
14228 Jim_SetResult(interp, argv[2]);
14230 return JIM_OK;
14233 /* [info references] */
14234 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14236 Jim_Obj *listObjPtr;
14237 Jim_HashTableIterator htiter;
14238 Jim_HashEntry *he;
14240 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14242 JimInitHashTableIterator(&interp->references, &htiter);
14243 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14244 char buf[JIM_REFERENCE_SPACE + 1];
14245 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14246 const unsigned long *refId = he->key;
14248 JimFormatReference(buf, refPtr, *refId);
14249 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14251 Jim_SetResult(interp, listObjPtr);
14252 return JIM_OK;
14254 #endif
14256 /* [rename] */
14257 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14259 if (argc != 3) {
14260 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14261 return JIM_ERR;
14264 if (JimValidName(interp, "new procedure", argv[2])) {
14265 return JIM_ERR;
14268 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14271 #define JIM_DICTMATCH_VALUES 0x0001
14273 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14275 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14277 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14278 if (type & JIM_DICTMATCH_VALUES) {
14279 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14284 * Like JimHashtablePatternMatch, but for dictionaries.
14286 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14287 JimDictMatchCallbackType *callback, int type)
14289 Jim_HashEntry *he;
14290 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14292 /* Check for the non-pattern case. We can do this much more efficiently. */
14293 Jim_HashTableIterator htiter;
14294 JimInitHashTableIterator(ht, &htiter);
14295 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14296 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14297 callback(interp, listObjPtr, he, type);
14301 return listObjPtr;
14305 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14307 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14308 return JIM_ERR;
14310 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14311 return JIM_OK;
14314 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14316 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14317 return JIM_ERR;
14319 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14320 return JIM_OK;
14323 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14325 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14326 return -1;
14328 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14331 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14333 Jim_HashTable *ht;
14334 unsigned int i;
14336 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14337 return JIM_ERR;
14340 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14342 /* Note that this uses internal knowledge of the hash table */
14343 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14345 for (i = 0; i < ht->size; i++) {
14346 Jim_HashEntry *he = ht->table[i];
14348 if (he) {
14349 printf("%d: ", i);
14351 while (he) {
14352 printf(" %s", Jim_String(he->key));
14353 he = he->next;
14355 printf("\n");
14358 return JIM_OK;
14361 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14363 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14365 Jim_AppendString(interp, prefixObj, " ", 1);
14366 Jim_AppendString(interp, prefixObj, subcmd, -1);
14368 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14371 /* [dict] */
14372 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14374 Jim_Obj *objPtr;
14375 int option;
14376 static const char * const options[] = {
14377 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14378 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14379 "replace", "update", NULL
14381 enum
14383 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14384 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14385 OPT_REPLACE, OPT_UPDATE,
14388 if (argc < 2) {
14389 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14390 return JIM_ERR;
14393 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14394 return JIM_ERR;
14397 switch (option) {
14398 case OPT_GET:
14399 if (argc < 3) {
14400 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14401 return JIM_ERR;
14403 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14404 JIM_ERRMSG) != JIM_OK) {
14405 return JIM_ERR;
14407 Jim_SetResult(interp, objPtr);
14408 return JIM_OK;
14410 case OPT_SET:
14411 if (argc < 5) {
14412 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14413 return JIM_ERR;
14415 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14417 case OPT_EXISTS:
14418 if (argc < 4) {
14419 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14420 return JIM_ERR;
14422 else {
14423 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14424 if (rc < 0) {
14425 return JIM_ERR;
14427 Jim_SetResultBool(interp, rc == JIM_OK);
14428 return JIM_OK;
14431 case OPT_UNSET:
14432 if (argc < 4) {
14433 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14434 return JIM_ERR;
14436 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14437 return JIM_ERR;
14439 return JIM_OK;
14441 case OPT_KEYS:
14442 if (argc != 3 && argc != 4) {
14443 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14444 return JIM_ERR;
14446 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14448 case OPT_SIZE:
14449 if (argc != 3) {
14450 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14451 return JIM_ERR;
14453 else if (Jim_DictSize(interp, argv[2]) < 0) {
14454 return JIM_ERR;
14456 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14457 return JIM_OK;
14459 case OPT_MERGE:
14460 if (argc == 2) {
14461 return JIM_OK;
14463 if (Jim_DictSize(interp, argv[2]) < 0) {
14464 return JIM_ERR;
14466 /* Handle as ensemble */
14467 break;
14469 case OPT_UPDATE:
14470 if (argc < 6 || argc % 2) {
14471 /* Better error message */
14472 argc = 2;
14474 break;
14476 case OPT_CREATE:
14477 if (argc % 2) {
14478 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14479 return JIM_ERR;
14481 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14482 Jim_SetResult(interp, objPtr);
14483 return JIM_OK;
14485 case OPT_INFO:
14486 if (argc != 3) {
14487 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14488 return JIM_ERR;
14490 return Jim_DictInfo(interp, argv[2]);
14492 /* Handle command as an ensemble */
14493 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14496 /* [subst] */
14497 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14499 static const char * const options[] = {
14500 "-nobackslashes", "-nocommands", "-novariables", NULL
14502 enum
14503 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14504 int i;
14505 int flags = JIM_SUBST_FLAG;
14506 Jim_Obj *objPtr;
14508 if (argc < 2) {
14509 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14510 return JIM_ERR;
14512 for (i = 1; i < (argc - 1); i++) {
14513 int option;
14515 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14516 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14517 return JIM_ERR;
14519 switch (option) {
14520 case OPT_NOBACKSLASHES:
14521 flags |= JIM_SUBST_NOESC;
14522 break;
14523 case OPT_NOCOMMANDS:
14524 flags |= JIM_SUBST_NOCMD;
14525 break;
14526 case OPT_NOVARIABLES:
14527 flags |= JIM_SUBST_NOVAR;
14528 break;
14531 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14532 return JIM_ERR;
14534 Jim_SetResult(interp, objPtr);
14535 return JIM_OK;
14538 /* [info] */
14539 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14541 int cmd;
14542 Jim_Obj *objPtr;
14543 int mode = 0;
14545 static const char * const commands[] = {
14546 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14547 "vars", "version", "patchlevel", "complete", "args", "hostname",
14548 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14549 "references", "alias", NULL
14551 enum
14552 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14553 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14554 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14555 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14558 #ifdef jim_ext_namespace
14559 int nons = 0;
14561 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14562 /* This is for internal use only */
14563 argc--;
14564 argv++;
14565 nons = 1;
14567 #endif
14569 if (argc < 2) {
14570 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14571 return JIM_ERR;
14573 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14574 != JIM_OK) {
14575 return JIM_ERR;
14578 /* Test for the most common commands first, just in case it makes a difference */
14579 switch (cmd) {
14580 case INFO_EXISTS:
14581 if (argc != 3) {
14582 Jim_WrongNumArgs(interp, 2, argv, "varName");
14583 return JIM_ERR;
14585 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14586 break;
14588 case INFO_ALIAS:{
14589 Jim_Cmd *cmdPtr;
14591 if (argc != 3) {
14592 Jim_WrongNumArgs(interp, 2, argv, "command");
14593 return JIM_ERR;
14595 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14596 return JIM_ERR;
14598 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14599 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14600 return JIM_ERR;
14602 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14603 return JIM_OK;
14606 case INFO_CHANNELS:
14607 mode++; /* JIM_CMDLIST_CHANNELS */
14608 #ifndef jim_ext_aio
14609 Jim_SetResultString(interp, "aio not enabled", -1);
14610 return JIM_ERR;
14611 #endif
14612 /* fall through */
14613 case INFO_PROCS:
14614 mode++; /* JIM_CMDLIST_PROCS */
14615 /* fall through */
14616 case INFO_COMMANDS:
14617 /* mode 0 => JIM_CMDLIST_COMMANDS */
14618 if (argc != 2 && argc != 3) {
14619 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14620 return JIM_ERR;
14622 #ifdef jim_ext_namespace
14623 if (!nons) {
14624 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14625 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14628 #endif
14629 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14630 break;
14632 case INFO_VARS:
14633 mode++; /* JIM_VARLIST_VARS */
14634 /* fall through */
14635 case INFO_LOCALS:
14636 mode++; /* JIM_VARLIST_LOCALS */
14637 /* fall through */
14638 case INFO_GLOBALS:
14639 /* mode 0 => JIM_VARLIST_GLOBALS */
14640 if (argc != 2 && argc != 3) {
14641 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14642 return JIM_ERR;
14644 #ifdef jim_ext_namespace
14645 if (!nons) {
14646 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14647 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14650 #endif
14651 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14652 break;
14654 case INFO_SCRIPT:
14655 if (argc != 2) {
14656 Jim_WrongNumArgs(interp, 2, argv, "");
14657 return JIM_ERR;
14659 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14660 break;
14662 case INFO_SOURCE:{
14663 jim_wide line;
14664 Jim_Obj *resObjPtr;
14665 Jim_Obj *fileNameObj;
14667 if (argc != 3 && argc != 5) {
14668 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14669 return JIM_ERR;
14671 if (argc == 5) {
14672 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14673 return JIM_ERR;
14675 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14676 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14678 else {
14679 if (argv[2]->typePtr == &sourceObjType) {
14680 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14681 line = argv[2]->internalRep.sourceValue.lineNumber;
14683 else if (argv[2]->typePtr == &scriptObjType) {
14684 ScriptObj *script = JimGetScript(interp, argv[2]);
14685 fileNameObj = script->fileNameObj;
14686 line = script->firstline;
14688 else {
14689 fileNameObj = interp->emptyObj;
14690 line = 1;
14692 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14693 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14694 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14696 Jim_SetResult(interp, resObjPtr);
14697 break;
14700 case INFO_STACKTRACE:
14701 Jim_SetResult(interp, interp->stackTrace);
14702 break;
14704 case INFO_LEVEL:
14705 case INFO_FRAME:
14706 switch (argc) {
14707 case 2:
14708 Jim_SetResultInt(interp, interp->framePtr->level);
14709 break;
14711 case 3:
14712 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14713 return JIM_ERR;
14715 Jim_SetResult(interp, objPtr);
14716 break;
14718 default:
14719 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14720 return JIM_ERR;
14722 break;
14724 case INFO_BODY:
14725 case INFO_STATICS:
14726 case INFO_ARGS:{
14727 Jim_Cmd *cmdPtr;
14729 if (argc != 3) {
14730 Jim_WrongNumArgs(interp, 2, argv, "procname");
14731 return JIM_ERR;
14733 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14734 return JIM_ERR;
14736 if (!cmdPtr->isproc) {
14737 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14738 return JIM_ERR;
14740 switch (cmd) {
14741 case INFO_BODY:
14742 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14743 break;
14744 case INFO_ARGS:
14745 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14746 break;
14747 case INFO_STATICS:
14748 if (cmdPtr->u.proc.staticVars) {
14749 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14750 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14751 NULL, JimVariablesMatch, mode));
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: ***