jim.c: many small code and doc cleanups
[jimtcl.git] / jim.c
blobda67065a5eec242c2301efc358ca9d17944c5368
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 */
45 #include <stdio.h>
46 #include <stdlib.h>
48 #include <string.h>
49 #include <stdarg.h>
50 #include <ctype.h>
51 #include <limits.h>
52 #include <assert.h>
53 #include <errno.h>
54 #include <time.h>
55 #include <setjmp.h>
57 #include "jim.h"
58 #include "jimautoconf.h"
59 #include "utf8.h"
61 #ifdef HAVE_SYS_TIME_H
62 #include <sys/time.h>
63 #endif
64 #ifdef HAVE_BACKTRACE
65 #include <execinfo.h>
66 #endif
67 #ifdef HAVE_CRT_EXTERNS_H
68 #include <crt_externs.h>
69 #endif
71 /* For INFINITY, even if math functions are not enabled */
72 #include <math.h>
74 /* We may decide to switch to using $[...] after all, so leave it as an option */
75 /*#define EXPRSUGAR_BRACKET*/
77 /* For the no-autoconf case */
78 #ifndef TCL_LIBRARY
79 #define TCL_LIBRARY "."
80 #endif
81 #ifndef TCL_PLATFORM_OS
82 #define TCL_PLATFORM_OS "unknown"
83 #endif
84 #ifndef TCL_PLATFORM_PLATFORM
85 #define TCL_PLATFORM_PLATFORM "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PATH_SEPARATOR
88 #define TCL_PLATFORM_PATH_SEPARATOR ":"
89 #endif
91 /*#define DEBUG_SHOW_SCRIPT*/
92 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
93 /*#define DEBUG_SHOW_SUBST*/
94 /*#define DEBUG_SHOW_EXPR*/
95 /*#define DEBUG_SHOW_EXPR_TOKENS*/
96 /*#define JIM_DEBUG_GC*/
97 #ifdef JIM_MAINTAINER
98 #define JIM_DEBUG_COMMAND
99 #define JIM_DEBUG_PANIC
100 #endif
101 /* Enable this (in conjunction with valgrind) to help debug
102 * reference counting issues
104 /*#define JIM_DISABLE_OBJECT_POOL*/
106 /* Maximum size of an integer */
107 #define JIM_INTEGER_SPACE 24
109 const char *jim_tt_name(int type);
111 #ifdef JIM_DEBUG_PANIC
112 static void JimPanicDump(int fail_condition, const char *fmt, ...);
113 #define JimPanic(X) JimPanicDump X
114 #else
115 #define JimPanic(X)
116 #endif
118 /* -----------------------------------------------------------------------------
119 * Global variables
120 * ---------------------------------------------------------------------------*/
122 /* A shared empty string for the objects string representation.
123 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
124 static char JimEmptyStringRep[] = "";
126 /* -----------------------------------------------------------------------------
127 * Required prototypes of not exported functions
128 * ---------------------------------------------------------------------------*/
129 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
130 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
131 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
132 int flags);
133 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
134 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
135 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
136 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
137 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
138 const char *prefix, const char *const *tablePtr, const char *name);
139 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
140 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
141 static int JimSign(jim_wide w);
142 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
143 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
144 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
147 /* Fast access to the int (wide) value of an object which is known to be of int type */
148 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
150 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
152 static int utf8_tounicode_case(const char *s, int *uc, int upper)
154 int l = utf8_tounicode(s, uc);
155 if (upper) {
156 *uc = utf8_upper(*uc);
158 return l;
161 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
162 #define JIM_CHARSET_SCAN 2
163 #define JIM_CHARSET_GLOB 0
166 * pattern points to a string like "[^a-z\ub5]"
168 * The pattern may contain trailing chars, which are ignored.
170 * The pattern is matched against unicode char 'c'.
172 * If (flags & JIM_NOCASE), case is ignored when matching.
173 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
174 * of the charset, per scan, rather than glob/string match.
176 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
177 * or the null character if the ']' is missing.
179 * Returns NULL on no match.
181 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
183 int not = 0;
184 int pchar;
185 int match = 0;
186 int nocase = 0;
188 if (flags & JIM_NOCASE) {
189 nocase++;
190 c = utf8_upper(c);
193 if (flags & JIM_CHARSET_SCAN) {
194 if (*pattern == '^') {
195 not++;
196 pattern++;
199 /* Special case. If the first char is ']', it is part of the set */
200 if (*pattern == ']') {
201 goto first;
205 while (*pattern && *pattern != ']') {
206 /* Exact match */
207 if (pattern[0] == '\\') {
208 first:
209 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
211 else {
212 /* Is this a range? a-z */
213 int start;
214 int end;
216 pattern += utf8_tounicode_case(pattern, &start, nocase);
217 if (pattern[0] == '-' && pattern[1]) {
218 /* skip '-' */
219 pattern += utf8_tounicode(pattern, &pchar);
220 pattern += utf8_tounicode_case(pattern, &end, nocase);
222 /* Handle reversed range too */
223 if ((c >= start && c <= end) || (c >= end && c <= start)) {
224 match = 1;
226 continue;
228 pchar = start;
231 if (pchar == c) {
232 match = 1;
235 if (not) {
236 match = !match;
239 return match ? pattern : NULL;
242 /* Glob-style pattern matching. */
244 /* Note: string *must* be valid UTF-8 sequences
246 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
248 int c;
249 int pchar;
250 while (*pattern) {
251 switch (pattern[0]) {
252 case '*':
253 while (pattern[1] == '*') {
254 pattern++;
256 pattern++;
257 if (!pattern[0]) {
258 return 1; /* match */
260 while (*string) {
261 /* Recursive call - Does the remaining pattern match anywhere? */
262 if (JimGlobMatch(pattern, string, nocase))
263 return 1; /* match */
264 string += utf8_tounicode(string, &c);
266 return 0; /* no match */
268 case '?':
269 string += utf8_tounicode(string, &c);
270 break;
272 case '[': {
273 string += utf8_tounicode(string, &c);
274 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
275 if (!pattern) {
276 return 0;
278 if (!*pattern) {
279 /* Ran out of pattern (no ']') */
280 continue;
282 break;
284 case '\\':
285 if (pattern[1]) {
286 pattern++;
288 /* fall through */
289 default:
290 string += utf8_tounicode_case(string, &c, nocase);
291 utf8_tounicode_case(pattern, &pchar, nocase);
292 if (pchar != c) {
293 return 0;
295 break;
297 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
298 if (!*string) {
299 while (*pattern == '*') {
300 pattern++;
302 break;
305 if (!*pattern && !*string) {
306 return 1;
308 return 0;
312 * string comparison. Works on binary data.
314 * Returns -1, 0 or 1
316 * Note that the lengths are byte lengths, not char lengths.
318 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
320 if (l1 < l2) {
321 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
323 else if (l2 < l1) {
324 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
326 else {
327 return JimSign(memcmp(s1, s2, l1));
332 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
333 * (or end of string if 'maxchars' is -1).
335 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
337 * Note: does not support embedded nulls.
339 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
341 while (*s1 && *s2 && maxchars) {
342 int c1, c2;
343 s1 += utf8_tounicode_case(s1, &c1, nocase);
344 s2 += utf8_tounicode_case(s2, &c2, nocase);
345 if (c1 != c2) {
346 return JimSign(c1 - c2);
348 maxchars--;
350 if (!maxchars) {
351 return 0;
353 /* One string or both terminated */
354 if (*s1) {
355 return 1;
357 if (*s2) {
358 return -1;
360 return 0;
363 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
364 * The index of the first occurrence of s1 in s2 is returned.
365 * If s1 is not found inside s2, -1 is returned. */
366 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
368 int i;
369 int l1bytelen;
371 if (!l1 || !l2 || l1 > l2) {
372 return -1;
374 if (idx < 0)
375 idx = 0;
376 s2 += utf8_index(s2, idx);
378 l1bytelen = utf8_index(s1, l1);
380 for (i = idx; i <= l2 - l1; i++) {
381 int c;
382 if (memcmp(s2, s1, l1bytelen) == 0) {
383 return i;
385 s2 += utf8_tounicode(s2, &c);
387 return -1;
391 * Note: Lengths and return value are in bytes, not chars.
393 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
395 const char *p;
397 if (!l1 || !l2 || l1 > l2)
398 return -1;
400 /* Now search for the needle */
401 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
402 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
403 return p - s2;
406 return -1;
409 #ifdef JIM_UTF8
411 * Note: Lengths and return value are in chars.
413 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
415 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
416 if (n > 0) {
417 n = utf8_strlen(s2, n);
419 return n;
421 #endif
424 * After an strtol()/strtod()-like conversion,
425 * check whether something was converted and that
426 * the only thing left is white space.
428 * Returns JIM_OK or JIM_ERR.
430 static int JimCheckConversion(const char *str, const char *endptr)
432 if (str[0] == '\0' || str == endptr) {
433 return JIM_ERR;
436 if (endptr[0] != '\0') {
437 while (*endptr) {
438 if (!isspace(UCHAR(*endptr))) {
439 return JIM_ERR;
441 endptr++;
444 return JIM_OK;
447 /* Parses the front of a number to determine it's sign and base
448 * Returns the index to start parsing according to the given base
450 static int JimNumberBase(const char *str, int *base, int *sign)
452 int i = 0;
454 *base = 10;
456 while (isspace(UCHAR(str[i]))) {
457 i++;
460 if (str[i] == '-') {
461 *sign = -1;
462 i++;
464 else {
465 if (str[i] == '+') {
466 i++;
468 *sign = 1;
471 if (str[i] != '0') {
472 /* base 10 */
473 return 0;
476 /* We have 0<x>, so see if we can convert it */
477 switch (str[i + 1]) {
478 case 'x': case 'X': *base = 16; break;
479 case 'o': case 'O': *base = 8; break;
480 case 'b': case 'B': *base = 2; break;
481 default: return 0;
483 i += 2;
484 /* Ensure that (e.g.) 0x-5 fails to parse */
485 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
486 /* Parse according to this base */
487 return i;
489 /* Parse as base 10 */
490 *base = 10;
491 return 0;
494 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
495 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
497 static long jim_strtol(const char *str, char **endptr)
499 int sign;
500 int base;
501 int i = JimNumberBase(str, &base, &sign);
503 if (base != 10) {
504 long value = strtol(str + i, endptr, base);
505 if (endptr == NULL || *endptr != str + i) {
506 return value * sign;
510 /* Can just do a regular base-10 conversion */
511 return strtol(str, endptr, 10);
515 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
516 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
518 static jim_wide jim_strtoull(const char *str, char **endptr)
520 #ifdef HAVE_LONG_LONG
521 int sign;
522 int base;
523 int i = JimNumberBase(str, &base, &sign);
525 if (base != 10) {
526 jim_wide value = strtoull(str + i, endptr, base);
527 if (endptr == NULL || *endptr != str + i) {
528 return value * sign;
532 /* Can just do a regular base-10 conversion */
533 return strtoull(str, endptr, 10);
534 #else
535 return (unsigned long)jim_strtol(str, endptr);
536 #endif
539 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
541 char *endptr;
543 if (base) {
544 *widePtr = strtoull(str, &endptr, base);
546 else {
547 *widePtr = jim_strtoull(str, &endptr);
550 return JimCheckConversion(str, endptr);
553 int Jim_StringToDouble(const char *str, double *doublePtr)
555 char *endptr;
557 /* Callers can check for underflow via ERANGE */
558 errno = 0;
560 *doublePtr = strtod(str, &endptr);
562 return JimCheckConversion(str, endptr);
565 static jim_wide JimPowWide(jim_wide b, jim_wide e)
567 jim_wide i, res = 1;
569 if ((b == 0 && e != 0) || (e < 0))
570 return 0;
571 for (i = 0; i < e; i++) {
572 res *= b;
574 return res;
577 /* -----------------------------------------------------------------------------
578 * Special functions
579 * ---------------------------------------------------------------------------*/
580 #ifdef JIM_DEBUG_PANIC
581 void JimPanicDump(int condition, const char *fmt, ...)
583 va_list ap;
585 if (!condition) {
586 return;
589 va_start(ap, fmt);
591 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
592 vfprintf(stderr, fmt, ap);
593 fprintf(stderr, JIM_NL JIM_NL);
594 va_end(ap);
596 #ifdef HAVE_BACKTRACE
598 void *array[40];
599 int size, i;
600 char **strings;
602 size = backtrace(array, 40);
603 strings = backtrace_symbols(array, size);
604 for (i = 0; i < size; i++)
605 fprintf(stderr, "[backtrace] %s" JIM_NL, strings[i]);
606 fprintf(stderr, "[backtrace] Include the above lines and the output" JIM_NL);
607 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
609 #endif
611 exit(1);
613 #endif
615 /* -----------------------------------------------------------------------------
616 * Memory allocation
617 * ---------------------------------------------------------------------------*/
619 void *Jim_Alloc(int size)
621 return size ? malloc(size) : NULL;
624 void Jim_Free(void *ptr)
626 free(ptr);
629 void *Jim_Realloc(void *ptr, int size)
631 return realloc(ptr, size);
634 char *Jim_StrDup(const char *s)
636 return strdup(s);
639 char *Jim_StrDupLen(const char *s, int l)
641 char *copy = Jim_Alloc(l + 1);
643 memcpy(copy, s, l + 1);
644 copy[l] = 0; /* Just to be sure, original could be substring */
645 return copy;
648 /* -----------------------------------------------------------------------------
649 * Time related functions
650 * ---------------------------------------------------------------------------*/
652 /* Returns current time in microseconds */
653 static jim_wide JimClock(void)
655 struct timeval tv;
657 gettimeofday(&tv, NULL);
658 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
661 /* -----------------------------------------------------------------------------
662 * Hash Tables
663 * ---------------------------------------------------------------------------*/
665 /* -------------------------- private prototypes ---------------------------- */
666 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
667 static unsigned int JimHashTableNextPower(unsigned int size);
668 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
670 /* -------------------------- hash functions -------------------------------- */
672 /* Thomas Wang's 32 bit Mix Function */
673 unsigned int Jim_IntHashFunction(unsigned int key)
675 key += ~(key << 15);
676 key ^= (key >> 10);
677 key += (key << 3);
678 key ^= (key >> 6);
679 key += ~(key << 11);
680 key ^= (key >> 16);
681 return key;
684 /* Generic hash function (we are using to multiply by 9 and add the byte
685 * as Tcl) */
686 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
688 unsigned int h = 0;
690 while (len--)
691 h += (h << 3) + *buf++;
692 return h;
695 /* ----------------------------- API implementation ------------------------- */
697 /* reset a hashtable already initialized */
698 static void JimResetHashTable(Jim_HashTable *ht)
700 ht->table = NULL;
701 ht->size = 0;
702 ht->sizemask = 0;
703 ht->used = 0;
704 ht->collisions = 0;
705 #ifdef JIM_RANDOMISE_HASH
706 /* This is initialised to a random value to avoid a hash collision attack.
707 * See: n.runs-SA-2011.004
709 ht->uniq = (rand() ^ time(NULL) ^ clock());
710 #else
711 ht->uniq = 0;
712 #endif
715 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
717 iter->ht = ht;
718 iter->index = -1;
719 iter->entry = NULL;
720 iter->nextEntry = NULL;
723 /* Initialize the hash table */
724 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
726 JimResetHashTable(ht);
727 ht->type = type;
728 ht->privdata = privDataPtr;
729 return JIM_OK;
732 /* Resize the table to the minimal size that contains all the elements,
733 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
734 void Jim_ResizeHashTable(Jim_HashTable *ht)
736 int minimal = ht->used;
738 if (minimal < JIM_HT_INITIAL_SIZE)
739 minimal = JIM_HT_INITIAL_SIZE;
740 Jim_ExpandHashTable(ht, minimal);
743 /* Expand or create the hashtable */
744 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
746 Jim_HashTable n; /* the new hashtable */
747 unsigned int realsize = JimHashTableNextPower(size), i;
749 /* the size is invalid if it is smaller than the number of
750 * elements already inside the hashtable */
751 if (size <= ht->used)
752 return;
754 Jim_InitHashTable(&n, ht->type, ht->privdata);
755 n.size = realsize;
756 n.sizemask = realsize - 1;
757 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
758 /* Keep the same 'uniq' as the original */
759 n.uniq = ht->uniq;
761 /* Initialize all the pointers to NULL */
762 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
764 /* Copy all the elements from the old to the new table:
765 * note that if the old hash table is empty ht->used is zero,
766 * so Jim_ExpandHashTable just creates an empty hash table. */
767 n.used = ht->used;
768 for (i = 0; ht->used > 0; i++) {
769 Jim_HashEntry *he, *nextHe;
771 if (ht->table[i] == NULL)
772 continue;
774 /* For each hash entry on this slot... */
775 he = ht->table[i];
776 while (he) {
777 unsigned int h;
779 nextHe = he->next;
780 /* Get the new element index */
781 h = Jim_HashKey(ht, he->key) & n.sizemask;
782 he->next = n.table[h];
783 n.table[h] = he;
784 ht->used--;
785 /* Pass to the next element */
786 he = nextHe;
789 assert(ht->used == 0);
790 Jim_Free(ht->table);
792 /* Remap the new hashtable in the old */
793 *ht = n;
796 /* Add an element to the target hash table */
797 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
799 Jim_HashEntry *entry;
801 /* Get the index of the new element, or -1 if
802 * the element already exists. */
803 entry = JimInsertHashEntry(ht, key, 0);
804 if (entry == NULL)
805 return JIM_ERR;
807 /* Set the hash entry fields. */
808 Jim_SetHashKey(ht, entry, key);
809 Jim_SetHashVal(ht, entry, val);
810 return JIM_OK;
813 /* Add an element, discarding the old if the key already exists */
814 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
816 int existed;
817 Jim_HashEntry *entry;
819 /* Get the index of the new element, or -1 if
820 * the element already exists. */
821 entry = JimInsertHashEntry(ht, key, 1);
822 if (entry->key) {
823 /* It already exists, so replace the value */
824 Jim_FreeEntryVal(ht, entry);
825 existed = 1;
827 else {
828 /* Doesn't exist, so set the key */
829 Jim_SetHashKey(ht, entry, key);
830 existed = 0;
832 Jim_SetHashVal(ht, entry, val);
834 return existed;
837 /* Search and remove an element */
838 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
840 unsigned int h;
841 Jim_HashEntry *he, *prevHe;
843 if (ht->used == 0)
844 return JIM_ERR;
845 h = Jim_HashKey(ht, key) & ht->sizemask;
846 he = ht->table[h];
848 prevHe = NULL;
849 while (he) {
850 if (Jim_CompareHashKeys(ht, key, he->key)) {
851 /* Unlink the element from the list */
852 if (prevHe)
853 prevHe->next = he->next;
854 else
855 ht->table[h] = he->next;
856 Jim_FreeEntryKey(ht, he);
857 Jim_FreeEntryVal(ht, he);
858 Jim_Free(he);
859 ht->used--;
860 return JIM_OK;
862 prevHe = he;
863 he = he->next;
865 return JIM_ERR; /* not found */
868 /* Destroy an entire hash table */
869 int Jim_FreeHashTable(Jim_HashTable *ht)
871 unsigned int i;
873 /* Free all the elements */
874 for (i = 0; ht->used > 0; i++) {
875 Jim_HashEntry *he, *nextHe;
877 if ((he = ht->table[i]) == NULL)
878 continue;
879 while (he) {
880 nextHe = he->next;
881 Jim_FreeEntryKey(ht, he);
882 Jim_FreeEntryVal(ht, he);
883 Jim_Free(he);
884 ht->used--;
885 he = nextHe;
888 /* Free the table and the allocated cache structure */
889 Jim_Free(ht->table);
890 /* Re-initialize the table */
891 JimResetHashTable(ht);
892 return JIM_OK; /* never fails */
895 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
897 Jim_HashEntry *he;
898 unsigned int h;
900 if (ht->used == 0)
901 return NULL;
902 h = Jim_HashKey(ht, key) & ht->sizemask;
903 he = ht->table[h];
904 while (he) {
905 if (Jim_CompareHashKeys(ht, key, he->key))
906 return he;
907 he = he->next;
909 return NULL;
912 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
914 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
915 JimInitHashTableIterator(ht, iter);
916 return iter;
919 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
921 while (1) {
922 if (iter->entry == NULL) {
923 iter->index++;
924 if (iter->index >= (signed)iter->ht->size)
925 break;
926 iter->entry = iter->ht->table[iter->index];
928 else {
929 iter->entry = iter->nextEntry;
931 if (iter->entry) {
932 /* We need to save the 'next' here, the iterator user
933 * may delete the entry we are returning. */
934 iter->nextEntry = iter->entry->next;
935 return iter->entry;
938 return NULL;
941 /* ------------------------- private functions ------------------------------ */
943 /* Expand the hash table if needed */
944 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
946 /* If the hash table is empty expand it to the intial size,
947 * if the table is "full" dobule its size. */
948 if (ht->size == 0)
949 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
950 if (ht->size == ht->used)
951 Jim_ExpandHashTable(ht, ht->size * 2);
954 /* Our hash table capability is a power of two */
955 static unsigned int JimHashTableNextPower(unsigned int size)
957 unsigned int i = JIM_HT_INITIAL_SIZE;
959 if (size >= 2147483648U)
960 return 2147483648U;
961 while (1) {
962 if (i >= size)
963 return i;
964 i *= 2;
968 /* Returns the index of a free slot that can be populated with
969 * a hash entry for the given 'key'.
970 * If the key already exists, -1 is returned. */
971 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
973 unsigned int h;
974 Jim_HashEntry *he;
976 /* Expand the hashtable if needed */
977 JimExpandHashTableIfNeeded(ht);
979 /* Compute the key hash value */
980 h = Jim_HashKey(ht, key) & ht->sizemask;
981 /* Search if this slot does not already contain the given key */
982 he = ht->table[h];
983 while (he) {
984 if (Jim_CompareHashKeys(ht, key, he->key))
985 return replace ? he : NULL;
986 he = he->next;
989 /* Allocates the memory and stores key */
990 he = Jim_Alloc(sizeof(*he));
991 he->next = ht->table[h];
992 ht->table[h] = he;
993 ht->used++;
994 he->key = NULL;
996 return he;
999 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1001 static unsigned int JimStringCopyHTHashFunction(const void *key)
1003 return Jim_GenHashFunction(key, strlen(key));
1006 static void *JimStringCopyHTDup(void *privdata, const void *key)
1008 return Jim_StrDup(key);
1011 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1013 return strcmp(key1, key2) == 0;
1016 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1018 Jim_Free(key);
1021 static const Jim_HashTableType JimPackageHashTableType = {
1022 JimStringCopyHTHashFunction, /* hash function */
1023 JimStringCopyHTDup, /* key dup */
1024 NULL, /* val dup */
1025 JimStringCopyHTKeyCompare, /* key compare */
1026 JimStringCopyHTKeyDestructor, /* key destructor */
1027 NULL /* val destructor */
1030 typedef struct AssocDataValue
1032 Jim_InterpDeleteProc *delProc;
1033 void *data;
1034 } AssocDataValue;
1036 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1038 AssocDataValue *assocPtr = (AssocDataValue *) data;
1040 if (assocPtr->delProc != NULL)
1041 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1042 Jim_Free(data);
1045 static const Jim_HashTableType JimAssocDataHashTableType = {
1046 JimStringCopyHTHashFunction, /* hash function */
1047 JimStringCopyHTDup, /* key dup */
1048 NULL, /* val dup */
1049 JimStringCopyHTKeyCompare, /* key compare */
1050 JimStringCopyHTKeyDestructor, /* key destructor */
1051 JimAssocDataHashTableValueDestructor /* val destructor */
1054 /* -----------------------------------------------------------------------------
1055 * Stack - This is a simple generic stack implementation. It is used for
1056 * example in the 'expr' expression compiler.
1057 * ---------------------------------------------------------------------------*/
1058 void Jim_InitStack(Jim_Stack *stack)
1060 stack->len = 0;
1061 stack->maxlen = 0;
1062 stack->vector = NULL;
1065 void Jim_FreeStack(Jim_Stack *stack)
1067 Jim_Free(stack->vector);
1070 int Jim_StackLen(Jim_Stack *stack)
1072 return stack->len;
1075 void Jim_StackPush(Jim_Stack *stack, void *element)
1077 int neededLen = stack->len + 1;
1079 if (neededLen > stack->maxlen) {
1080 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1081 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1083 stack->vector[stack->len] = element;
1084 stack->len++;
1087 void *Jim_StackPop(Jim_Stack *stack)
1089 if (stack->len == 0)
1090 return NULL;
1091 stack->len--;
1092 return stack->vector[stack->len];
1095 void *Jim_StackPeek(Jim_Stack *stack)
1097 if (stack->len == 0)
1098 return NULL;
1099 return stack->vector[stack->len - 1];
1102 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1104 int i;
1106 for (i = 0; i < stack->len; i++)
1107 freeFunc(stack->vector[i]);
1110 /* -----------------------------------------------------------------------------
1111 * Tcl Parser
1112 * ---------------------------------------------------------------------------*/
1114 /* Token types */
1115 #define JIM_TT_NONE 0 /* No token returned */
1116 #define JIM_TT_STR 1 /* simple string */
1117 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1118 #define JIM_TT_VAR 3 /* var substitution */
1119 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1120 #define JIM_TT_CMD 5 /* command substitution */
1121 /* Note: Keep these three together for TOKEN_IS_SEP() */
1122 #define JIM_TT_SEP 6 /* word separator (white space) */
1123 #define JIM_TT_EOL 7 /* line separator */
1124 #define JIM_TT_EOF 8 /* end of script */
1126 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1127 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1129 /* Additional token types needed for expressions */
1130 #define JIM_TT_SUBEXPR_START 11
1131 #define JIM_TT_SUBEXPR_END 12
1132 #define JIM_TT_SUBEXPR_COMMA 13
1133 #define JIM_TT_EXPR_INT 14
1134 #define JIM_TT_EXPR_DOUBLE 15
1136 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1138 /* Operator token types start here */
1139 #define JIM_TT_EXPR_OP 20
1141 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1143 /* Parser states */
1144 #define JIM_PS_DEF 0 /* Default state */
1145 #define JIM_PS_QUOTE 1 /* Inside "" */
1146 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1148 /* Parser context structure. The same context is used both to parse
1149 * Tcl scripts and lists. */
1150 struct JimParserCtx
1152 const char *p; /* Pointer to the point of the program we are parsing */
1153 int len; /* Remaining length */
1154 int linenr; /* Current line number */
1155 const char *tstart;
1156 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1157 int tline; /* Line number of the returned token */
1158 int tt; /* Token type */
1159 int eof; /* Non zero if EOF condition is true. */
1160 int state; /* Parser state */
1161 int comment; /* Non zero if the next chars may be a comment. */
1162 char missing; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1163 int missingline; /* Line number starting the missing token */
1167 * Results of missing quotes, braces, etc. from parsing.
1169 struct JimParseResult {
1170 char missing; /* From JimParserCtx.missing */
1171 int line; /* From JimParserCtx.missingline */
1174 static int JimParseScript(struct JimParserCtx *pc);
1175 static int JimParseSep(struct JimParserCtx *pc);
1176 static int JimParseEol(struct JimParserCtx *pc);
1177 static int JimParseCmd(struct JimParserCtx *pc);
1178 static int JimParseQuote(struct JimParserCtx *pc);
1179 static int JimParseVar(struct JimParserCtx *pc);
1180 static int JimParseBrace(struct JimParserCtx *pc);
1181 static int JimParseStr(struct JimParserCtx *pc);
1182 static int JimParseComment(struct JimParserCtx *pc);
1183 static void JimParseSubCmd(struct JimParserCtx *pc);
1184 static int JimParseSubQuote(struct JimParserCtx *pc);
1185 static void JimParseSubCmd(struct JimParserCtx *pc);
1186 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1188 /* Initialize a parser context.
1189 * 'prg' is a pointer to the program text, linenr is the line
1190 * number of the first line contained in the program. */
1191 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1193 pc->p = prg;
1194 pc->len = len;
1195 pc->tstart = NULL;
1196 pc->tend = NULL;
1197 pc->tline = 0;
1198 pc->tt = JIM_TT_NONE;
1199 pc->eof = 0;
1200 pc->state = JIM_PS_DEF;
1201 pc->linenr = linenr;
1202 pc->comment = 1;
1203 pc->missing = ' ';
1204 pc->missingline = linenr;
1207 static int JimParseScript(struct JimParserCtx *pc)
1209 while (1) { /* the while is used to reiterate with continue if needed */
1210 if (!pc->len) {
1211 pc->tstart = pc->p;
1212 pc->tend = pc->p - 1;
1213 pc->tline = pc->linenr;
1214 pc->tt = JIM_TT_EOL;
1215 pc->eof = 1;
1216 return JIM_OK;
1218 switch (*(pc->p)) {
1219 case '\\':
1220 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1221 return JimParseSep(pc);
1223 pc->comment = 0;
1224 return JimParseStr(pc);
1225 case ' ':
1226 case '\t':
1227 case '\r':
1228 case '\f':
1229 if (pc->state == JIM_PS_DEF)
1230 return JimParseSep(pc);
1231 pc->comment = 0;
1232 return JimParseStr(pc);
1233 case '\n':
1234 case ';':
1235 pc->comment = 1;
1236 if (pc->state == JIM_PS_DEF)
1237 return JimParseEol(pc);
1238 return JimParseStr(pc);
1239 case '[':
1240 pc->comment = 0;
1241 return JimParseCmd(pc);
1242 case '$':
1243 pc->comment = 0;
1244 if (JimParseVar(pc) == JIM_ERR) {
1245 /* An orphan $. Create as a separate token */
1246 pc->tstart = pc->tend = pc->p++;
1247 pc->len--;
1248 pc->tt = JIM_TT_ESC;
1250 return JIM_OK;
1251 case '#':
1252 if (pc->comment) {
1253 JimParseComment(pc);
1254 continue;
1256 return JimParseStr(pc);
1257 default:
1258 pc->comment = 0;
1259 return JimParseStr(pc);
1261 return JIM_OK;
1265 static int JimParseSep(struct JimParserCtx *pc)
1267 pc->tstart = pc->p;
1268 pc->tline = pc->linenr;
1269 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1270 if (*pc->p == '\n') {
1271 break;
1273 if (*pc->p == '\\') {
1274 pc->p++;
1275 pc->len--;
1276 pc->linenr++;
1278 pc->p++;
1279 pc->len--;
1281 pc->tend = pc->p - 1;
1282 pc->tt = JIM_TT_SEP;
1283 return JIM_OK;
1286 static int JimParseEol(struct JimParserCtx *pc)
1288 pc->tstart = pc->p;
1289 pc->tline = pc->linenr;
1290 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1291 if (*pc->p == '\n')
1292 pc->linenr++;
1293 pc->p++;
1294 pc->len--;
1296 pc->tend = pc->p - 1;
1297 pc->tt = JIM_TT_EOL;
1298 return JIM_OK;
1302 ** Here are the rules for parsing:
1303 ** {braced expression}
1304 ** - Count open and closing braces
1305 ** - Backslash escapes meaning of braces
1307 ** "quoted expression"
1308 ** - First double quote at start of word terminates the expression
1309 ** - Backslash escapes quote and bracket
1310 ** - [commands brackets] are counted/nested
1311 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1313 ** [command expression]
1314 ** - Count open and closing brackets
1315 ** - Backslash escapes quote, bracket and brace
1316 ** - [commands brackets] are counted/nested
1317 ** - "quoted expressions" are parsed according to quoting rules
1318 ** - {braced expressions} are parsed according to brace rules
1320 ** For everything, backslash escapes the next char, newline increments current line
1324 * Parses a braced expression starting at pc->p.
1326 * Positions the parser at the end of the braced expression,
1327 * sets pc->tend and possibly pc->missing.
1329 static void JimParseSubBrace(struct JimParserCtx *pc)
1331 int level = 1;
1333 /* Skip the brace */
1334 pc->p++;
1335 pc->len--;
1336 while (pc->len) {
1337 switch (*pc->p) {
1338 case '\\':
1339 if (pc->len > 1) {
1340 if (*++pc->p == '\n') {
1341 pc->linenr++;
1343 pc->len--;
1345 break;
1347 case '{':
1348 level++;
1349 break;
1351 case '}':
1352 if (--level == 0) {
1353 pc->tend = pc->p - 1;
1354 pc->p++;
1355 pc->len--;
1356 return;
1358 break;
1360 case '\n':
1361 pc->linenr++;
1362 break;
1364 pc->p++;
1365 pc->len--;
1367 pc->missing = '{';
1368 pc->missingline = pc->tline;
1369 pc->tend = pc->p - 1;
1373 * Parses a quoted expression starting at pc->p.
1375 * Positions the parser at the end of the quoted expression,
1376 * sets pc->tend and possibly pc->missing.
1378 * Returns the type of the token of the string,
1379 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1380 * or JIM_TT_STR.
1382 static int JimParseSubQuote(struct JimParserCtx *pc)
1384 int tt = JIM_TT_STR;
1385 int line = pc->tline;
1387 /* Skip the quote */
1388 pc->p++;
1389 pc->len--;
1390 while (pc->len) {
1391 switch (*pc->p) {
1392 case '\\':
1393 if (pc->len > 1) {
1394 if (*++pc->p == '\n') {
1395 pc->linenr++;
1397 pc->len--;
1398 tt = JIM_TT_ESC;
1400 break;
1402 case '"':
1403 pc->tend = pc->p - 1;
1404 pc->p++;
1405 pc->len--;
1406 return tt;
1408 case '[':
1409 JimParseSubCmd(pc);
1410 tt = JIM_TT_ESC;
1411 continue;
1413 case '\n':
1414 pc->linenr++;
1415 break;
1417 case '$':
1418 tt = JIM_TT_ESC;
1419 break;
1421 pc->p++;
1422 pc->len--;
1424 pc->missing = '"';
1425 pc->missingline = line;
1426 pc->tend = pc->p - 1;
1427 return tt;
1431 * Parses a [command] expression starting at pc->p.
1433 * Positions the parser at the end of the command expression,
1434 * sets pc->tend and possibly pc->missing.
1436 static void JimParseSubCmd(struct JimParserCtx *pc)
1438 int level = 1;
1439 int startofword = 1;
1440 int line = pc->tline;
1442 /* Skip the bracket */
1443 pc->p++;
1444 pc->len--;
1445 while (pc->len) {
1446 switch (*pc->p) {
1447 case '\\':
1448 if (pc->len > 1) {
1449 if (*++pc->p == '\n') {
1450 pc->linenr++;
1452 pc->len--;
1454 break;
1456 case '[':
1457 level++;
1458 break;
1460 case ']':
1461 if (--level == 0) {
1462 pc->tend = pc->p - 1;
1463 pc->p++;
1464 pc->len--;
1465 return;
1467 break;
1469 case '"':
1470 if (startofword) {
1471 JimParseSubQuote(pc);
1472 continue;
1474 break;
1476 case '{':
1477 JimParseSubBrace(pc);
1478 startofword = 0;
1479 continue;
1481 case '\n':
1482 pc->linenr++;
1483 break;
1485 startofword = isspace(UCHAR(*pc->p));
1486 pc->p++;
1487 pc->len--;
1489 pc->missing = '[';
1490 pc->missingline = line;
1491 pc->tend = pc->p - 1;
1494 static int JimParseBrace(struct JimParserCtx *pc)
1496 pc->tstart = pc->p + 1;
1497 pc->tline = pc->linenr;
1498 pc->tt = JIM_TT_STR;
1499 JimParseSubBrace(pc);
1500 return JIM_OK;
1503 static int JimParseCmd(struct JimParserCtx *pc)
1505 pc->tstart = pc->p + 1;
1506 pc->tline = pc->linenr;
1507 pc->tt = JIM_TT_CMD;
1508 JimParseSubCmd(pc);
1509 return JIM_OK;
1512 static int JimParseQuote(struct JimParserCtx *pc)
1514 pc->tstart = pc->p + 1;
1515 pc->tline = pc->linenr;
1516 pc->tt = JimParseSubQuote(pc);
1517 return JIM_OK;
1520 static int JimParseVar(struct JimParserCtx *pc)
1522 /* skip the $ */
1523 pc->p++;
1524 pc->len--;
1526 #ifdef EXPRSUGAR_BRACKET
1527 if (*pc->p == '[') {
1528 /* Parse $[...] expr shorthand syntax */
1529 JimParseCmd(pc);
1530 pc->tt = JIM_TT_EXPRSUGAR;
1531 return JIM_OK;
1533 #endif
1535 pc->tstart = pc->p;
1536 pc->tt = JIM_TT_VAR;
1537 pc->tline = pc->linenr;
1539 if (*pc->p == '{') {
1540 pc->tstart = ++pc->p;
1541 pc->len--;
1543 while (pc->len && *pc->p != '}') {
1544 if (*pc->p == '\n') {
1545 pc->linenr++;
1547 pc->p++;
1548 pc->len--;
1550 pc->tend = pc->p - 1;
1551 if (pc->len) {
1552 pc->p++;
1553 pc->len--;
1556 else {
1557 while (1) {
1558 /* Skip double colon, but not single colon! */
1559 if (pc->p[0] == ':' && pc->p[1] == ':') {
1560 while (*pc->p == ':') {
1561 pc->p++;
1562 pc->len--;
1564 continue;
1566 /* Note that any char >= 0x80 must be part of a utf-8 char.
1567 * We consider all unicode points outside of ASCII as letters
1569 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1570 pc->p++;
1571 pc->len--;
1572 continue;
1574 break;
1576 /* Parse [dict get] syntax sugar. */
1577 if (*pc->p == '(') {
1578 int count = 1;
1579 const char *paren = NULL;
1581 pc->tt = JIM_TT_DICTSUGAR;
1583 while (count && pc->len) {
1584 pc->p++;
1585 pc->len--;
1586 if (*pc->p == '\\' && pc->len >= 1) {
1587 pc->p++;
1588 pc->len--;
1590 else if (*pc->p == '(') {
1591 count++;
1593 else if (*pc->p == ')') {
1594 paren = pc->p;
1595 count--;
1598 if (count == 0) {
1599 pc->p++;
1600 pc->len--;
1602 else if (paren) {
1603 /* Did not find a matching paren. Back up */
1604 paren++;
1605 pc->len += (pc->p - paren);
1606 pc->p = paren;
1608 #ifndef EXPRSUGAR_BRACKET
1609 if (*pc->tstart == '(') {
1610 pc->tt = JIM_TT_EXPRSUGAR;
1612 #endif
1614 pc->tend = pc->p - 1;
1616 /* Check if we parsed just the '$' character.
1617 * That's not a variable so an error is returned
1618 * to tell the state machine to consider this '$' just
1619 * a string. */
1620 if (pc->tstart == pc->p) {
1621 pc->p--;
1622 pc->len++;
1623 return JIM_ERR;
1625 return JIM_OK;
1628 static int JimParseStr(struct JimParserCtx *pc)
1630 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1631 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1632 /* Starting a new word */
1633 if (*pc->p == '{') {
1634 return JimParseBrace(pc);
1636 if (*pc->p == '"') {
1637 pc->state = JIM_PS_QUOTE;
1638 pc->p++;
1639 pc->len--;
1640 /* In case the end quote is missing */
1641 pc->missingline = pc->tline;
1644 pc->tstart = pc->p;
1645 pc->tline = pc->linenr;
1646 while (1) {
1647 if (pc->len == 0) {
1648 if (pc->state == JIM_PS_QUOTE) {
1649 pc->missing = '"';
1651 pc->tend = pc->p - 1;
1652 pc->tt = JIM_TT_ESC;
1653 return JIM_OK;
1655 switch (*pc->p) {
1656 case '\\':
1657 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1658 pc->tend = pc->p - 1;
1659 pc->tt = JIM_TT_ESC;
1660 return JIM_OK;
1662 if (pc->len >= 2) {
1663 if (*(pc->p + 1) == '\n') {
1664 pc->linenr++;
1666 pc->p++;
1667 pc->len--;
1669 else if (pc->len == 1) {
1670 /* End of script with trailing backslash */
1671 pc->missing = '\\';
1673 break;
1674 case '(':
1675 /* If the following token is not '$' just keep going */
1676 if (pc->len > 1 && pc->p[1] != '$') {
1677 break;
1679 case ')':
1680 /* Only need a separate ')' token if the previous was a var */
1681 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1682 if (pc->p == pc->tstart) {
1683 /* At the start of the token, so just return this char */
1684 pc->p++;
1685 pc->len--;
1687 pc->tend = pc->p - 1;
1688 pc->tt = JIM_TT_ESC;
1689 return JIM_OK;
1691 break;
1693 case '$':
1694 case '[':
1695 pc->tend = pc->p - 1;
1696 pc->tt = JIM_TT_ESC;
1697 return JIM_OK;
1698 case ' ':
1699 case '\t':
1700 case '\n':
1701 case '\r':
1702 case '\f':
1703 case ';':
1704 if (pc->state == JIM_PS_DEF) {
1705 pc->tend = pc->p - 1;
1706 pc->tt = JIM_TT_ESC;
1707 return JIM_OK;
1709 else if (*pc->p == '\n') {
1710 pc->linenr++;
1712 break;
1713 case '"':
1714 if (pc->state == JIM_PS_QUOTE) {
1715 pc->tend = pc->p - 1;
1716 pc->tt = JIM_TT_ESC;
1717 pc->p++;
1718 pc->len--;
1719 pc->state = JIM_PS_DEF;
1720 return JIM_OK;
1722 break;
1724 pc->p++;
1725 pc->len--;
1727 return JIM_OK; /* unreached */
1730 static int JimParseComment(struct JimParserCtx *pc)
1732 while (*pc->p) {
1733 if (*pc->p == '\\') {
1734 pc->p++;
1735 pc->len--;
1736 if (pc->len == 0) {
1737 pc->missing = '\\';
1738 return JIM_OK;
1740 if (*pc->p == '\n') {
1741 pc->linenr++;
1744 else if (*pc->p == '\n') {
1745 pc->p++;
1746 pc->len--;
1747 pc->linenr++;
1748 break;
1750 pc->p++;
1751 pc->len--;
1753 return JIM_OK;
1756 /* xdigitval and odigitval are helper functions for JimEscape() */
1757 static int xdigitval(int c)
1759 if (c >= '0' && c <= '9')
1760 return c - '0';
1761 if (c >= 'a' && c <= 'f')
1762 return c - 'a' + 10;
1763 if (c >= 'A' && c <= 'F')
1764 return c - 'A' + 10;
1765 return -1;
1768 static int odigitval(int c)
1770 if (c >= '0' && c <= '7')
1771 return c - '0';
1772 return -1;
1775 /* Perform Tcl escape substitution of 's', storing the result
1776 * string into 'dest'. The escaped string is guaranteed to
1777 * be the same length or shorted than the source string.
1778 * Slen is the length of the string at 's', if it's -1 the string
1779 * length will be calculated by the function.
1781 * The function returns the length of the resulting string. */
1782 static int JimEscape(char *dest, const char *s, int slen)
1784 char *p = dest;
1785 int i, len;
1787 if (slen == -1)
1788 slen = strlen(s);
1790 for (i = 0; i < slen; i++) {
1791 switch (s[i]) {
1792 case '\\':
1793 switch (s[i + 1]) {
1794 case 'a':
1795 *p++ = 0x7;
1796 i++;
1797 break;
1798 case 'b':
1799 *p++ = 0x8;
1800 i++;
1801 break;
1802 case 'f':
1803 *p++ = 0xc;
1804 i++;
1805 break;
1806 case 'n':
1807 *p++ = 0xa;
1808 i++;
1809 break;
1810 case 'r':
1811 *p++ = 0xd;
1812 i++;
1813 break;
1814 case 't':
1815 *p++ = 0x9;
1816 i++;
1817 break;
1818 case 'u':
1819 case 'U':
1820 case 'x':
1821 /* A unicode or hex sequence.
1822 * \x Expect 1-2 hex chars and convert to hex.
1823 * \u Expect 1-4 hex chars and convert to utf-8.
1824 * \U Expect 1-8 hex chars and convert to utf-8.
1825 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1826 * An invalid sequence means simply the escaped char.
1829 unsigned val = 0;
1830 int k;
1831 int maxchars = 2;
1833 i++;
1835 if (s[i] == 'U') {
1836 maxchars = 8;
1838 else if (s[i] == 'u') {
1839 if (s[i + 1] == '{') {
1840 maxchars = 6;
1841 i++;
1843 else {
1844 maxchars = 4;
1848 for (k = 0; k < maxchars; k++) {
1849 int c = xdigitval(s[i + k + 1]);
1850 if (c == -1) {
1851 break;
1853 val = (val << 4) | c;
1855 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1856 if (s[i] == '{') {
1857 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1858 /* Back up */
1859 i--;
1860 k = 0;
1862 else {
1863 /* Skip the closing brace */
1864 k++;
1867 if (k) {
1868 /* Got a valid sequence, so convert */
1869 if (s[i] == 'x') {
1870 *p++ = val;
1872 else {
1873 p += utf8_fromunicode(p, val);
1875 i += k;
1876 break;
1878 /* Not a valid codepoint, just an escaped char */
1879 *p++ = s[i];
1881 break;
1882 case 'v':
1883 *p++ = 0xb;
1884 i++;
1885 break;
1886 case '\0':
1887 *p++ = '\\';
1888 i++;
1889 break;
1890 case '\n':
1891 /* Replace all spaces and tabs after backslash newline with a single space*/
1892 *p++ = ' ';
1893 do {
1894 i++;
1895 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1896 break;
1897 case '0':
1898 case '1':
1899 case '2':
1900 case '3':
1901 case '4':
1902 case '5':
1903 case '6':
1904 case '7':
1905 /* octal escape */
1907 int val = 0;
1908 int c = odigitval(s[i + 1]);
1910 val = c;
1911 c = odigitval(s[i + 2]);
1912 if (c == -1) {
1913 *p++ = val;
1914 i++;
1915 break;
1917 val = (val * 8) + c;
1918 c = odigitval(s[i + 3]);
1919 if (c == -1) {
1920 *p++ = val;
1921 i += 2;
1922 break;
1924 val = (val * 8) + c;
1925 *p++ = val;
1926 i += 3;
1928 break;
1929 default:
1930 *p++ = s[i + 1];
1931 i++;
1932 break;
1934 break;
1935 default:
1936 *p++ = s[i];
1937 break;
1940 len = p - dest;
1941 *p = '\0';
1942 return len;
1945 /* Returns a dynamically allocated copy of the current token in the
1946 * parser context. The function performs conversion of escapes if
1947 * the token is of type JIM_TT_ESC.
1949 * Note that after the conversion, tokens that are grouped with
1950 * braces in the source code, are always recognizable from the
1951 * identical string obtained in a different way from the type.
1953 * For example the string:
1955 * {*}$a
1957 * will return as first token "*", of type JIM_TT_STR
1959 * While the string:
1961 * *$a
1963 * will return as first token "*", of type JIM_TT_ESC
1965 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1967 const char *start, *end;
1968 char *token;
1969 int len;
1971 start = pc->tstart;
1972 end = pc->tend;
1973 if (start > end) {
1974 len = 0;
1975 token = Jim_Alloc(1);
1976 token[0] = '\0';
1978 else {
1979 len = (end - start) + 1;
1980 token = Jim_Alloc(len + 1);
1981 if (pc->tt != JIM_TT_ESC) {
1982 /* No escape conversion needed? Just copy it. */
1983 memcpy(token, start, len);
1984 token[len] = '\0';
1986 else {
1987 /* Else convert the escape chars. */
1988 len = JimEscape(token, start, len);
1992 return Jim_NewStringObjNoAlloc(interp, token, len);
1995 /* Parses the given string to determine if it represents a complete script.
1997 * This is useful for interactive shells implementation, for [info complete].
1999 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2000 * '{' on scripts incomplete missing one or more '}' to be balanced.
2001 * '[' on scripts incomplete missing one or more ']' to be balanced.
2002 * '"' on scripts incomplete missing a '"' char.
2003 * '\\' on scripts with a trailing backslash.
2005 * If the script is complete, 1 is returned, otherwise 0.
2007 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2009 struct JimParserCtx parser;
2011 JimParserInit(&parser, s, len, 1);
2012 while (!parser.eof) {
2013 JimParseScript(&parser);
2015 if (stateCharPtr) {
2016 *stateCharPtr = parser.missing;
2018 return parser.missing == ' ';
2021 /* -----------------------------------------------------------------------------
2022 * Tcl Lists parsing
2023 * ---------------------------------------------------------------------------*/
2024 static int JimParseListSep(struct JimParserCtx *pc);
2025 static int JimParseListStr(struct JimParserCtx *pc);
2026 static int JimParseListQuote(struct JimParserCtx *pc);
2028 static int JimParseList(struct JimParserCtx *pc)
2030 if (isspace(UCHAR(*pc->p))) {
2031 return JimParseListSep(pc);
2033 switch (*pc->p) {
2034 case '"':
2035 return JimParseListQuote(pc);
2037 case '{':
2038 return JimParseBrace(pc);
2040 default:
2041 if (pc->len) {
2042 return JimParseListStr(pc);
2044 break;
2047 pc->tstart = pc->tend = pc->p;
2048 pc->tline = pc->linenr;
2049 pc->tt = JIM_TT_EOL;
2050 pc->eof = 1;
2051 return JIM_OK;
2054 static int JimParseListSep(struct JimParserCtx *pc)
2056 pc->tstart = pc->p;
2057 pc->tline = pc->linenr;
2058 while (isspace(UCHAR(*pc->p))) {
2059 if (*pc->p == '\n') {
2060 pc->linenr++;
2062 pc->p++;
2063 pc->len--;
2065 pc->tend = pc->p - 1;
2066 pc->tt = JIM_TT_SEP;
2067 return JIM_OK;
2070 static int JimParseListQuote(struct JimParserCtx *pc)
2072 pc->p++;
2073 pc->len--;
2075 pc->tstart = pc->p;
2076 pc->tline = pc->linenr;
2077 pc->tt = JIM_TT_STR;
2079 while (pc->len) {
2080 switch (*pc->p) {
2081 case '\\':
2082 pc->tt = JIM_TT_ESC;
2083 if (--pc->len == 0) {
2084 /* Trailing backslash */
2085 pc->tend = pc->p;
2086 return JIM_OK;
2088 pc->p++;
2089 break;
2090 case '\n':
2091 pc->linenr++;
2092 break;
2093 case '"':
2094 pc->tend = pc->p - 1;
2095 pc->p++;
2096 pc->len--;
2097 return JIM_OK;
2099 pc->p++;
2100 pc->len--;
2103 pc->tend = pc->p - 1;
2104 return JIM_OK;
2107 static int JimParseListStr(struct JimParserCtx *pc)
2109 pc->tstart = pc->p;
2110 pc->tline = pc->linenr;
2111 pc->tt = JIM_TT_STR;
2113 while (pc->len) {
2114 if (isspace(UCHAR(*pc->p))) {
2115 pc->tend = pc->p - 1;
2116 return JIM_OK;
2118 if (*pc->p == '\\') {
2119 if (--pc->len == 0) {
2120 /* Trailing backslash */
2121 pc->tend = pc->p;
2122 return JIM_OK;
2124 pc->tt = JIM_TT_ESC;
2125 pc->p++;
2127 pc->p++;
2128 pc->len--;
2130 pc->tend = pc->p - 1;
2131 return JIM_OK;
2134 /* -----------------------------------------------------------------------------
2135 * Jim_Obj related functions
2136 * ---------------------------------------------------------------------------*/
2138 /* Return a new initialized object. */
2139 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2141 Jim_Obj *objPtr;
2143 /* -- Check if there are objects in the free list -- */
2144 if (interp->freeList != NULL) {
2145 /* -- Unlink the object from the free list -- */
2146 objPtr = interp->freeList;
2147 interp->freeList = objPtr->nextObjPtr;
2149 else {
2150 /* -- No ready to use objects: allocate a new one -- */
2151 objPtr = Jim_Alloc(sizeof(*objPtr));
2154 /* Object is returned with refCount of 0. Every
2155 * kind of GC implemented should take care to don't try
2156 * to scan objects with refCount == 0. */
2157 objPtr->refCount = 0;
2158 /* All the other fields are left not initialized to save time.
2159 * The caller will probably want to set them to the right
2160 * value anyway. */
2162 /* -- Put the object into the live list -- */
2163 objPtr->prevObjPtr = NULL;
2164 objPtr->nextObjPtr = interp->liveList;
2165 if (interp->liveList)
2166 interp->liveList->prevObjPtr = objPtr;
2167 interp->liveList = objPtr;
2169 return objPtr;
2172 /* Free an object. Actually objects are never freed, but
2173 * just moved to the free objects list, where they will be
2174 * reused by Jim_NewObj(). */
2175 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2177 /* Check if the object was already freed, panic. */
2178 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2179 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2181 /* Free the internal representation */
2182 Jim_FreeIntRep(interp, objPtr);
2183 /* Free the string representation */
2184 if (objPtr->bytes != NULL) {
2185 if (objPtr->bytes != JimEmptyStringRep)
2186 Jim_Free(objPtr->bytes);
2188 /* Unlink the object from the live objects list */
2189 if (objPtr->prevObjPtr)
2190 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2191 if (objPtr->nextObjPtr)
2192 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2193 if (interp->liveList == objPtr)
2194 interp->liveList = objPtr->nextObjPtr;
2195 #ifdef JIM_DISABLE_OBJECT_POOL
2196 Jim_Free(objPtr);
2197 #else
2198 /* Link the object into the free objects list */
2199 objPtr->prevObjPtr = NULL;
2200 objPtr->nextObjPtr = interp->freeList;
2201 if (interp->freeList)
2202 interp->freeList->prevObjPtr = objPtr;
2203 interp->freeList = objPtr;
2204 objPtr->refCount = -1;
2205 #endif
2208 /* Invalidate the string representation of an object. */
2209 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2211 if (objPtr->bytes != NULL) {
2212 if (objPtr->bytes != JimEmptyStringRep)
2213 Jim_Free(objPtr->bytes);
2215 objPtr->bytes = NULL;
2218 /* Duplicate an object. The returned object has refcount = 0. */
2219 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2221 Jim_Obj *dupPtr;
2223 dupPtr = Jim_NewObj(interp);
2224 if (objPtr->bytes == NULL) {
2225 /* Object does not have a valid string representation. */
2226 dupPtr->bytes = NULL;
2228 else if (objPtr->length == 0) {
2229 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2230 dupPtr->bytes = JimEmptyStringRep;
2231 dupPtr->length = 0;
2232 dupPtr->typePtr = NULL;
2233 return dupPtr;
2235 else {
2236 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2237 dupPtr->length = objPtr->length;
2238 /* Copy the null byte too */
2239 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2242 /* By default, the new object has the same type as the old object */
2243 dupPtr->typePtr = objPtr->typePtr;
2244 if (objPtr->typePtr != NULL) {
2245 if (objPtr->typePtr->dupIntRepProc == NULL) {
2246 dupPtr->internalRep = objPtr->internalRep;
2248 else {
2249 /* The dup proc may set a different type, e.g. NULL */
2250 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2253 return dupPtr;
2256 /* Return the string representation for objPtr. If the object's
2257 * string representation is invalid, calls the updateStringProc method to create
2258 * a new one from the internal representation of the object.
2260 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2262 if (objPtr->bytes == NULL) {
2263 /* Invalid string repr. Generate it. */
2264 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2265 objPtr->typePtr->updateStringProc(objPtr);
2267 if (lenPtr)
2268 *lenPtr = objPtr->length;
2269 return objPtr->bytes;
2272 /* Just returns the length of the object's string rep */
2273 int Jim_Length(Jim_Obj *objPtr)
2275 if (objPtr->bytes == NULL) {
2276 /* Invalid string repr. Generate it. */
2277 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2278 objPtr->typePtr->updateStringProc(objPtr);
2280 return objPtr->length;
2283 /* Just returns the length of the object's string rep */
2284 const char *Jim_String(Jim_Obj *objPtr)
2286 if (objPtr->bytes == NULL) {
2287 /* Invalid string repr. Generate it. */
2288 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2289 objPtr->typePtr->updateStringProc(objPtr);
2291 return objPtr->bytes;
2294 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2296 objPtr->bytes = Jim_StrDup(str);
2297 objPtr->length = strlen(str);
2300 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2301 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2303 static const Jim_ObjType dictSubstObjType = {
2304 "dict-substitution",
2305 FreeDictSubstInternalRep,
2306 DupDictSubstInternalRep,
2307 NULL,
2308 JIM_TYPE_NONE,
2311 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2313 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2316 static const Jim_ObjType interpolatedObjType = {
2317 "interpolated",
2318 FreeInterpolatedInternalRep,
2319 NULL,
2320 NULL,
2321 JIM_TYPE_NONE,
2324 /* -----------------------------------------------------------------------------
2325 * String Object
2326 * ---------------------------------------------------------------------------*/
2327 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2328 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2330 static const Jim_ObjType stringObjType = {
2331 "string",
2332 NULL,
2333 DupStringInternalRep,
2334 NULL,
2335 JIM_TYPE_REFERENCES,
2338 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2340 JIM_NOTUSED(interp);
2342 /* This is a bit subtle: the only caller of this function
2343 * should be Jim_DuplicateObj(), that will copy the
2344 * string representaion. After the copy, the duplicated
2345 * object will not have more room in the buffer than
2346 * srcPtr->length bytes. So we just set it to length. */
2347 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2348 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2351 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2353 if (objPtr->typePtr != &stringObjType) {
2354 /* Get a fresh string representation. */
2355 if (objPtr->bytes == NULL) {
2356 /* Invalid string repr. Generate it. */
2357 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2358 objPtr->typePtr->updateStringProc(objPtr);
2360 /* Free any other internal representation. */
2361 Jim_FreeIntRep(interp, objPtr);
2362 /* Set it as string, i.e. just set the maxLength field. */
2363 objPtr->typePtr = &stringObjType;
2364 objPtr->internalRep.strValue.maxLength = objPtr->length;
2365 /* Don't know the utf-8 length yet */
2366 objPtr->internalRep.strValue.charLength = -1;
2368 return JIM_OK;
2372 * Returns the length of the object string in chars, not bytes.
2374 * These may be different for a utf-8 string.
2376 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2378 #ifdef JIM_UTF8
2379 SetStringFromAny(interp, objPtr);
2381 if (objPtr->internalRep.strValue.charLength < 0) {
2382 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2384 return objPtr->internalRep.strValue.charLength;
2385 #else
2386 return Jim_Length(objPtr);
2387 #endif
2390 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2391 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2393 Jim_Obj *objPtr = Jim_NewObj(interp);
2395 /* Need to find out how many bytes the string requires */
2396 if (len == -1)
2397 len = strlen(s);
2398 /* Alloc/Set the string rep. */
2399 if (len == 0) {
2400 objPtr->bytes = JimEmptyStringRep;
2402 else {
2403 objPtr->bytes = Jim_Alloc(len + 1);
2404 memcpy(objPtr->bytes, s, len);
2405 objPtr->bytes[len] = '\0';
2407 objPtr->length = len;
2409 /* No typePtr field for the vanilla string object. */
2410 objPtr->typePtr = NULL;
2411 return objPtr;
2414 /* charlen is in characters -- see also Jim_NewStringObj() */
2415 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2417 #ifdef JIM_UTF8
2418 /* Need to find out how many bytes the string requires */
2419 int bytelen = utf8_index(s, charlen);
2421 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2423 /* Remember the utf8 length, so set the type */
2424 objPtr->typePtr = &stringObjType;
2425 objPtr->internalRep.strValue.maxLength = bytelen;
2426 objPtr->internalRep.strValue.charLength = charlen;
2428 return objPtr;
2429 #else
2430 return Jim_NewStringObj(interp, s, charlen);
2431 #endif
2434 /* This version does not try to duplicate the 's' pointer, but
2435 * use it directly. */
2436 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2438 Jim_Obj *objPtr = Jim_NewObj(interp);
2440 objPtr->bytes = s;
2441 objPtr->length = (len == -1) ? strlen(s) : len;
2442 objPtr->typePtr = NULL;
2443 return objPtr;
2446 /* Low-level string append. Use it only against unshared objects
2447 * of type "string". */
2448 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2450 int needlen;
2452 if (len == -1)
2453 len = strlen(str);
2454 needlen = objPtr->length + len;
2455 if (objPtr->internalRep.strValue.maxLength < needlen ||
2456 objPtr->internalRep.strValue.maxLength == 0) {
2457 needlen *= 2;
2458 /* Inefficient to malloc() for less than 8 bytes */
2459 if (needlen < 7) {
2460 needlen = 7;
2462 if (objPtr->bytes == JimEmptyStringRep) {
2463 objPtr->bytes = Jim_Alloc(needlen + 1);
2465 else {
2466 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2468 objPtr->internalRep.strValue.maxLength = needlen;
2470 memcpy(objPtr->bytes + objPtr->length, str, len);
2471 objPtr->bytes[objPtr->length + len] = '\0';
2473 if (objPtr->internalRep.strValue.charLength >= 0) {
2474 /* Update the utf-8 char length */
2475 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2477 objPtr->length += len;
2480 /* Higher level API to append strings to objects.
2481 * Object must not be unshared for each of these.
2483 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2485 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2486 SetStringFromAny(interp, objPtr);
2487 StringAppendString(objPtr, str, len);
2490 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2492 int len;
2493 const char *str = Jim_GetString(appendObjPtr, &len);
2494 Jim_AppendString(interp, objPtr, str, len);
2497 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2499 va_list ap;
2501 SetStringFromAny(interp, objPtr);
2502 va_start(ap, objPtr);
2503 while (1) {
2504 const char *s = va_arg(ap, const char *);
2506 if (s == NULL)
2507 break;
2508 Jim_AppendString(interp, objPtr, s, -1);
2510 va_end(ap);
2513 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2515 const char *aStr, *bStr;
2516 int aLen, bLen;
2518 if (aObjPtr == bObjPtr)
2519 return 1;
2520 aStr = Jim_GetString(aObjPtr, &aLen);
2521 bStr = Jim_GetString(bObjPtr, &bLen);
2522 if (aLen != bLen)
2523 return 0;
2524 return JimStringCompare(aStr, aLen, bStr, bLen) == 0;
2528 * Note. Does not support embedded nulls in either the pattern or the object.
2530 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2532 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2536 * Note: does not support embedded nulls for the nocase option.
2538 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2540 int l1, l2;
2541 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2542 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2544 if (nocase) {
2545 /* Do a character compare for nocase */
2546 return JimStringCompareLen(s1, s2, -1, nocase);
2548 return JimStringCompare(s1, l1, s2, l2);
2552 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2554 * Note: does not support embedded nulls
2556 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2558 const char *s1 = Jim_String(firstObjPtr);
2559 const char *s2 = Jim_String(secondObjPtr);
2561 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2564 /* Convert a range, as returned by Jim_GetRange(), into
2565 * an absolute index into an object of the specified length.
2566 * This function may return negative values, or values
2567 * greater than or equal to the length of the list if the index
2568 * is out of range. */
2569 static int JimRelToAbsIndex(int len, int idx)
2571 if (idx < 0)
2572 return len + idx;
2573 return idx;
2576 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2577 * into a form suitable for implementation of commands like [string range] and [lrange].
2579 * The resulting range is guaranteed to address valid elements of
2580 * the structure.
2582 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2584 int rangeLen;
2586 if (*firstPtr > *lastPtr) {
2587 rangeLen = 0;
2589 else {
2590 rangeLen = *lastPtr - *firstPtr + 1;
2591 if (rangeLen) {
2592 if (*firstPtr < 0) {
2593 rangeLen += *firstPtr;
2594 *firstPtr = 0;
2596 if (*lastPtr >= len) {
2597 rangeLen -= (*lastPtr - (len - 1));
2598 *lastPtr = len - 1;
2602 if (rangeLen < 0)
2603 rangeLen = 0;
2605 *rangeLenPtr = rangeLen;
2608 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2609 int len, int *first, int *last, int *range)
2611 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2612 return JIM_ERR;
2614 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2615 return JIM_ERR;
2617 *first = JimRelToAbsIndex(len, *first);
2618 *last = JimRelToAbsIndex(len, *last);
2619 JimRelToAbsRange(len, first, last, range);
2620 return JIM_OK;
2623 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2624 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2626 int first, last;
2627 const char *str;
2628 int rangeLen;
2629 int bytelen;
2631 str = Jim_GetString(strObjPtr, &bytelen);
2633 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2634 return NULL;
2637 if (first == 0 && rangeLen == bytelen) {
2638 return strObjPtr;
2640 return Jim_NewStringObj(interp, str + first, rangeLen);
2643 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2644 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2646 #ifdef JIM_UTF8
2647 int first, last;
2648 const char *str;
2649 int len, rangeLen;
2650 int bytelen;
2652 str = Jim_GetString(strObjPtr, &bytelen);
2653 len = Jim_Utf8Length(interp, strObjPtr);
2655 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2656 return NULL;
2659 if (first == 0 && rangeLen == len) {
2660 return strObjPtr;
2662 if (len == bytelen) {
2663 /* ASCII optimisation */
2664 return Jim_NewStringObj(interp, str + first, rangeLen);
2666 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2667 #else
2668 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2669 #endif
2672 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2673 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2675 int first, last;
2676 const char *str;
2677 int len, rangeLen;
2678 Jim_Obj *objPtr;
2680 len = Jim_Utf8Length(interp, strObjPtr);
2682 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2683 return NULL;
2686 if (last < first) {
2687 return strObjPtr;
2690 str = Jim_String(strObjPtr);
2692 /* Before part */
2693 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2695 /* Replacement */
2696 if (newStrObj) {
2697 Jim_AppendObj(interp, objPtr, newStrObj);
2700 /* After part */
2701 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2703 return objPtr;
2707 * Note: does not support embedded nulls.
2709 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2711 while (*str) {
2712 int c;
2713 str += utf8_tounicode(str, &c);
2714 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2716 *dest = 0;
2720 * Note: does not support embedded nulls.
2722 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2724 char *buf;
2725 int len;
2726 const char *str;
2728 SetStringFromAny(interp, strObjPtr);
2730 str = Jim_GetString(strObjPtr, &len);
2732 #ifdef JIM_UTF8
2733 /* Case mapping can change the utf-8 length of the string.
2734 * But at worst it will be by one extra byte per char
2736 len *= 2;
2737 #endif
2738 buf = Jim_Alloc(len + 1);
2739 JimStrCopyUpperLower(buf, str, 0);
2740 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2744 * Note: does not support embedded nulls.
2746 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2748 char *buf;
2749 const char *str;
2750 int len;
2752 if (strObjPtr->typePtr != &stringObjType) {
2753 SetStringFromAny(interp, strObjPtr);
2756 str = Jim_GetString(strObjPtr, &len);
2758 #ifdef JIM_UTF8
2759 /* Case mapping can change the utf-8 length of the string.
2760 * But at worst it will be by one extra byte per char
2762 len *= 2;
2763 #endif
2764 buf = Jim_Alloc(len + 1);
2765 JimStrCopyUpperLower(buf, str, 1);
2766 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2770 * Note: does not support embedded nulls.
2772 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2774 char *buf, *p;
2775 int len;
2776 int c;
2777 const char *str;
2779 str = Jim_GetString(strObjPtr, &len);
2780 if (len == 0) {
2781 return strObjPtr;
2783 #ifdef JIM_UTF8
2784 /* Case mapping can change the utf-8 length of the string.
2785 * But at worst it will be by one extra byte per char
2787 len *= 2;
2788 #endif
2789 buf = p = Jim_Alloc(len + 1);
2791 str += utf8_tounicode(str, &c);
2792 p += utf8_getchars(p, utf8_title(c));
2794 JimStrCopyUpperLower(p, str, 0);
2796 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2799 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2800 * for unicode character 'c'.
2801 * Returns the position if found or NULL if not
2803 static const char *utf8_memchr(const char *str, int len, int c)
2805 #ifdef JIM_UTF8
2806 while (len) {
2807 int sc;
2808 int n = utf8_tounicode(str, &sc);
2809 if (sc == c) {
2810 return str;
2812 str += n;
2813 len -= n;
2815 return NULL;
2816 #else
2817 return memchr(str, c, len);
2818 #endif
2822 * Searches for the first non-trim char in string (str, len)
2824 * If none is found, returns just past the last char.
2826 * Lengths are in bytes.
2828 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2830 while (len) {
2831 int c;
2832 int n = utf8_tounicode(str, &c);
2834 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2835 /* Not a trim char, so stop */
2836 break;
2838 str += n;
2839 len -= n;
2841 return str;
2845 * Searches backwards for a non-trim char in string (str, len).
2847 * Returns a pointer to just after the non-trim char, or NULL if not found.
2849 * Lengths are in bytes.
2851 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2853 str += len;
2855 while (len) {
2856 int c;
2857 int n = utf8_prev_len(str, len);
2859 len -= n;
2860 str -= n;
2862 n = utf8_tounicode(str, &c);
2864 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2865 return str + n;
2869 return NULL;
2872 static const char default_trim_chars[] = " \t\n\r";
2873 /* sizeof() here includes the null byte */
2874 static int default_trim_chars_len = sizeof(default_trim_chars);
2876 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2878 int len;
2879 const char *str = Jim_GetString(strObjPtr, &len);
2880 const char *trimchars = default_trim_chars;
2881 int trimcharslen = default_trim_chars_len;
2882 const char *newstr;
2884 if (trimcharsObjPtr) {
2885 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2888 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2889 if (newstr == str) {
2890 return strObjPtr;
2893 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2896 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2898 int len;
2899 const char *trimchars = default_trim_chars;
2900 int trimcharslen = default_trim_chars_len;
2901 const char *nontrim;
2903 if (trimcharsObjPtr) {
2904 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2907 SetStringFromAny(interp, strObjPtr);
2909 len = Jim_Length(strObjPtr);
2910 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2912 if (nontrim == NULL) {
2913 /* All trim, so return a zero-length string */
2914 return Jim_NewEmptyStringObj(interp);
2916 if (nontrim == strObjPtr->bytes + len) {
2917 /* All non-trim, so return the original object */
2918 return strObjPtr;
2921 if (Jim_IsShared(strObjPtr)) {
2922 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2924 else {
2925 /* Can modify this string in place */
2926 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2927 strObjPtr->length = (nontrim - strObjPtr->bytes);
2930 return strObjPtr;
2933 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2935 /* First trim left. */
2936 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2938 /* Now trim right */
2939 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2941 /* Note: refCount check is needed since objPtr may be emptyObj */
2942 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2943 /* We don't want this object to be leaked */
2944 Jim_FreeNewObj(interp, objPtr);
2947 return strObjPtr;
2950 /* Some platforms don't have isascii - need a non-macro version */
2951 #ifdef HAVE_ISASCII
2952 #define jim_isascii isascii
2953 #else
2954 static int jim_isascii(int c)
2956 return !(c & ~0x7f);
2958 #endif
2960 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2962 static const char * const strclassnames[] = {
2963 "integer", "alpha", "alnum", "ascii", "digit",
2964 "double", "lower", "upper", "space", "xdigit",
2965 "control", "print", "graph", "punct",
2966 NULL
2968 enum {
2969 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2970 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2971 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2973 int strclass;
2974 int len;
2975 int i;
2976 const char *str;
2977 int (*isclassfunc)(int c) = NULL;
2979 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2980 return JIM_ERR;
2983 str = Jim_GetString(strObjPtr, &len);
2984 if (len == 0) {
2985 Jim_SetResultBool(interp, !strict);
2986 return JIM_OK;
2989 switch (strclass) {
2990 case STR_IS_INTEGER:
2992 jim_wide w;
2993 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2994 return JIM_OK;
2997 case STR_IS_DOUBLE:
2999 double d;
3000 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3001 return JIM_OK;
3004 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3005 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3006 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3007 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3008 case STR_IS_LOWER: isclassfunc = islower; break;
3009 case STR_IS_UPPER: isclassfunc = isupper; break;
3010 case STR_IS_SPACE: isclassfunc = isspace; break;
3011 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3012 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3013 case STR_IS_PRINT: isclassfunc = isprint; break;
3014 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3015 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3016 default:
3017 return JIM_ERR;
3020 for (i = 0; i < len; i++) {
3021 if (!isclassfunc(str[i])) {
3022 Jim_SetResultBool(interp, 0);
3023 return JIM_OK;
3026 Jim_SetResultBool(interp, 1);
3027 return JIM_OK;
3030 /* -----------------------------------------------------------------------------
3031 * Compared String Object
3032 * ---------------------------------------------------------------------------*/
3034 /* This is strange object that allows comparison of a C literal string
3035 * with a Jim object in a very short time if the same comparison is done
3036 * multiple times. For example every time the [if] command is executed,
3037 * Jim has to check if a given argument is "else".
3038 * If the code has no errors, this comparison is true most of the time,
3039 * so we can cache the pointer of the string of the last matching
3040 * comparison inside the object. Because most C compilers perform literal sharing,
3041 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3042 * this works pretty well even if comparisons are at different places
3043 * inside the C code. */
3045 static const Jim_ObjType comparedStringObjType = {
3046 "compared-string",
3047 NULL,
3048 NULL,
3049 NULL,
3050 JIM_TYPE_REFERENCES,
3053 /* The only way this object is exposed to the API is via the following
3054 * function. Returns true if the string and the object string repr.
3055 * are the same, otherwise zero is returned.
3057 * Note: this isn't binary safe, but it hardly needs to be.*/
3058 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3060 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3061 return 1;
3063 else {
3064 const char *objStr = Jim_String(objPtr);
3066 if (strcmp(str, objStr) != 0)
3067 return 0;
3069 if (objPtr->typePtr != &comparedStringObjType) {
3070 Jim_FreeIntRep(interp, objPtr);
3071 objPtr->typePtr = &comparedStringObjType;
3073 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3074 return 1;
3078 static int qsortCompareStringPointers(const void *a, const void *b)
3080 char *const *sa = (char *const *)a;
3081 char *const *sb = (char *const *)b;
3083 return strcmp(*sa, *sb);
3087 /* -----------------------------------------------------------------------------
3088 * Source Object
3090 * This object is just a string from the language point of view, but
3091 * the internal representation contains the filename and line number
3092 * where this token was read. This information is used by
3093 * Jim_EvalObj() if the object passed happens to be of type "source".
3095 * This allows propagation of the information about line numbers and file
3096 * names and gives error messages with absolute line numbers.
3098 * Note that this object uses the internal representation of the Jim_Object,
3099 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3101 * Also the object will be converted to something else if the given
3102 * token it represents in the source file is not something to be
3103 * evaluated (not a script), and will be specialized in some other way,
3104 * so the time overhead is also almost zero.
3105 * ---------------------------------------------------------------------------*/
3107 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3108 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3110 static const Jim_ObjType sourceObjType = {
3111 "source",
3112 FreeSourceInternalRep,
3113 DupSourceInternalRep,
3114 NULL,
3115 JIM_TYPE_REFERENCES,
3118 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3120 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3123 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3125 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3126 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3129 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3130 Jim_Obj *fileNameObj, int lineNumber)
3132 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3133 JimPanic((objPtr->typePtr == &sourceObjType, "JimSetSourceInfo called with non-source object"));
3134 Jim_IncrRefCount(fileNameObj);
3135 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3136 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3137 objPtr->typePtr = &sourceObjType;
3140 /* -----------------------------------------------------------------------------
3141 * ScriptLine Object
3143 * This object is used only in the Script internal represenation.
3144 * For each line of the script, it holds the number of tokens on the line
3145 * and the source line number.
3147 static const Jim_ObjType scriptLineObjType = {
3148 "scriptline",
3149 NULL,
3150 NULL,
3151 NULL,
3152 JIM_NONE,
3155 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3157 Jim_Obj *objPtr;
3159 #ifdef DEBUG_SHOW_SCRIPT
3160 char buf[100];
3161 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3162 objPtr = Jim_NewStringObj(interp, buf, -1);
3163 #else
3164 objPtr = Jim_NewEmptyStringObj(interp);
3165 #endif
3166 objPtr->typePtr = &scriptLineObjType;
3167 objPtr->internalRep.scriptLineValue.argc = argc;
3168 objPtr->internalRep.scriptLineValue.line = line;
3170 return objPtr;
3173 /* -----------------------------------------------------------------------------
3174 * Script Object
3176 * This object holds the parsed internal representation of a script.
3177 * This representation is help within an allocated ScriptObj (see below)
3179 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3180 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3181 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result);
3183 static const Jim_ObjType scriptObjType = {
3184 "script",
3185 FreeScriptInternalRep,
3186 DupScriptInternalRep,
3187 NULL,
3188 JIM_TYPE_REFERENCES,
3191 /* Each token of a script is represented by a ScriptToken.
3192 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3193 * can be specialized by commands operating on it.
3195 typedef struct ScriptToken
3197 Jim_Obj *objPtr;
3198 int type;
3199 } ScriptToken;
3201 /* This is the script object internal representation. An array of
3202 * ScriptToken structures, including a pre-computed representation of the
3203 * command length and arguments.
3205 * For example the script:
3207 * puts hello
3208 * set $i $x$y [foo]BAR
3210 * will produce a ScriptObj with the following ScriptToken's:
3212 * LIN 2
3213 * ESC puts
3214 * ESC hello
3215 * LIN 4
3216 * ESC set
3217 * VAR i
3218 * WRD 2
3219 * VAR x
3220 * VAR y
3221 * WRD 2
3222 * CMD foo
3223 * ESC BAR
3225 * "puts hello" has two args (LIN 2), composed of single tokens.
3226 * (Note that the WRD token is omitted for the common case of a single token.)
3228 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3229 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3231 * The precomputation of the command structure makes Jim_Eval() faster,
3232 * and simpler because there aren't dynamic lengths / allocations.
3234 * -- {expand}/{*} handling --
3236 * Expand is handled in a special way.
3238 * If a "word" begins with {*}, the word token count is -ve.
3240 * For example the command:
3242 * list {*}{a b}
3244 * Will produce the following cmdstruct array:
3246 * LIN 2
3247 * ESC list
3248 * WRD -1
3249 * STR a b
3251 * Note that the 'LIN' token also contains the source information for the
3252 * first word of the line for error reporting purposes
3254 * -- the substFlags field of the structure --
3256 * The scriptObj structure is used to represent both "script" objects
3257 * and "subst" objects. In the second case, the there are no LIN and WRD
3258 * tokens. Instead SEP and EOL tokens are added as-is.
3259 * In addition, the field 'substFlags' is used to represent the flags used to turn
3260 * the string into the internal representation.
3261 * If these flags do not match what the application requires,
3262 * the scriptObj is created again. For example the script:
3264 * subst -nocommands $string
3265 * subst -novariables $string
3267 * Will (re)create the internal representation of the $string object
3268 * two times.
3270 typedef struct ScriptObj
3272 ScriptToken *token; /* Tokens array. */
3273 Jim_Obj *fileNameObj; /* Filename */
3274 int len; /* Length of token[] */
3275 int substFlags; /* flags used for the compilation of "subst" objects */
3276 int inUse; /* Used to share a ScriptObj. Currently
3277 only used by Jim_EvalObj() as protection against
3278 shimmering of the currently evaluated object. */
3279 int firstline; /* Line number of the first line */
3280 int linenr; /* Line number of the current line */
3281 } ScriptObj;
3283 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3285 int i;
3286 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3288 if (--script->inUse != 0)
3289 return;
3290 for (i = 0; i < script->len; i++) {
3291 Jim_DecrRefCount(interp, script->token[i].objPtr);
3293 Jim_Free(script->token);
3294 Jim_DecrRefCount(interp, script->fileNameObj);
3295 Jim_Free(script);
3298 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3300 JIM_NOTUSED(interp);
3301 JIM_NOTUSED(srcPtr);
3303 /* Just return a simple string. We don't try to preserve the source info
3304 * since in practice scripts are never duplicated
3306 dupPtr->typePtr = NULL;
3309 /* A simple parse token.
3310 * As the script is parsed, the created tokens point into the script string rep.
3312 typedef struct
3314 const char *token; /* Pointer to the start of the token */
3315 int len; /* Length of this token */
3316 int type; /* Token type */
3317 int line; /* Line number */
3318 } ParseToken;
3320 /* A list of parsed tokens representing a script.
3321 * Tokens are added to this list as the script is parsed.
3322 * It grows as needed.
3324 typedef struct
3326 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3327 ParseToken *list; /* Array of tokens */
3328 int size; /* Current size of the list */
3329 int count; /* Number of entries used */
3330 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3331 } ParseTokenList;
3333 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3335 tokenlist->list = tokenlist->static_list;
3336 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3337 tokenlist->count = 0;
3340 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3342 if (tokenlist->list != tokenlist->static_list) {
3343 Jim_Free(tokenlist->list);
3348 * Adds the new token to the tokenlist.
3349 * The token has the given length, type and line number.
3350 * The token list is resized as necessary.
3352 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3353 int line)
3355 ParseToken *t;
3357 if (tokenlist->count == tokenlist->size) {
3358 /* Resize the list */
3359 tokenlist->size *= 2;
3360 if (tokenlist->list != tokenlist->static_list) {
3361 tokenlist->list =
3362 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3364 else {
3365 /* The list needs to become allocated */
3366 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3367 memcpy(tokenlist->list, tokenlist->static_list,
3368 tokenlist->count * sizeof(*tokenlist->list));
3371 t = &tokenlist->list[tokenlist->count++];
3372 t->token = token;
3373 t->len = len;
3374 t->type = type;
3375 t->line = line;
3378 /* Counts the number of adjoining non-separator tokens.
3380 * Returns -ve if the first token is the expansion
3381 * operator (in which case the count doesn't include
3382 * that token).
3384 static int JimCountWordTokens(ParseToken *t)
3386 int expand = 1;
3387 int count = 0;
3389 /* Is the first word {*} or {expand}? */
3390 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3391 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3392 /* Create an expand token */
3393 expand = -1;
3394 t++;
3398 /* Now count non-separator words */
3399 while (!TOKEN_IS_SEP(t->type)) {
3400 t++;
3401 count++;
3404 return count * expand;
3408 * Create a script/subst object from the given token.
3410 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3412 Jim_Obj *objPtr;
3414 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3415 /* Convert backlash escapes. The result will never be longer than the original */
3416 int len = t->len;
3417 char *str = Jim_Alloc(len + 1);
3418 len = JimEscape(str, t->token, len);
3419 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3421 else {
3422 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3423 * with a single space.
3425 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3427 return objPtr;
3431 * Takes a tokenlist and creates the allocated list of script tokens
3432 * in script->token, of length script->len.
3434 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3435 * as required.
3437 * Also sets script->line to the line number of the first token
3439 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3440 ParseTokenList *tokenlist)
3442 int i;
3443 struct ScriptToken *token;
3444 /* Number of tokens so far for the current command */
3445 int lineargs = 0;
3446 /* This is the first token for the current command */
3447 ScriptToken *linefirst;
3448 int count;
3449 int linenr;
3451 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3452 printf("==== Tokens ====\n");
3453 for (i = 0; i < tokenlist->count; i++) {
3454 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3455 tokenlist->list[i].len, tokenlist->list[i].token);
3457 #endif
3459 /* May need up to one extra script token for each EOL in the worst case */
3460 count = tokenlist->count;
3461 for (i = 0; i < tokenlist->count; i++) {
3462 if (tokenlist->list[i].type == JIM_TT_EOL) {
3463 count++;
3466 linenr = script->firstline = tokenlist->list[0].line;
3468 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3470 /* This is the first token for the current command */
3471 linefirst = token++;
3473 for (i = 0; i < tokenlist->count; ) {
3474 /* Look ahead to find out how many tokens make up the next word */
3475 int wordtokens;
3477 /* Skip any leading separators */
3478 while (tokenlist->list[i].type == JIM_TT_SEP) {
3479 i++;
3482 wordtokens = JimCountWordTokens(tokenlist->list + i);
3484 if (wordtokens == 0) {
3485 /* None, so at end of line */
3486 if (lineargs) {
3487 linefirst->type = JIM_TT_LINE;
3488 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3489 Jim_IncrRefCount(linefirst->objPtr);
3491 /* Reset for new line */
3492 lineargs = 0;
3493 linefirst = token++;
3495 i++;
3496 continue;
3498 else if (wordtokens != 1) {
3499 /* More than 1, or {*}, so insert a WORD token */
3500 token->type = JIM_TT_WORD;
3501 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3502 Jim_IncrRefCount(token->objPtr);
3503 token++;
3504 if (wordtokens < 0) {
3505 /* Skip the expand token */
3506 i++;
3507 wordtokens = -wordtokens - 1;
3508 lineargs--;
3512 if (lineargs == 0) {
3513 /* First real token on the line, so record the line number */
3514 linenr = tokenlist->list[i].line;
3516 lineargs++;
3518 /* Add each non-separator word token to the line */
3519 while (wordtokens--) {
3520 const ParseToken *t = &tokenlist->list[i++];
3522 token->type = t->type;
3523 token->objPtr = JimMakeScriptObj(interp, t);
3524 Jim_IncrRefCount(token->objPtr);
3526 /* Every object is initially a string of type 'source', but the
3527 * internal type may be specialized during execution of the
3528 * script. */
3529 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3530 token++;
3534 if (lineargs == 0) {
3535 token--;
3538 script->len = token - script->token;
3540 JimPanic((script->len >= count, "allocated script array is too short"));
3542 #ifdef DEBUG_SHOW_SCRIPT
3543 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3544 for (i = 0; i < script->len; i++) {
3545 const ScriptToken *t = &script->token[i];
3546 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3548 #endif
3553 * Similar to ScriptObjAddTokens(), but for subst objects.
3555 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3556 ParseTokenList *tokenlist)
3558 int i;
3559 struct ScriptToken *token;
3561 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3563 for (i = 0; i < tokenlist->count; i++) {
3564 const ParseToken *t = &tokenlist->list[i];
3566 /* Create a token for 't' */
3567 token->type = t->type;
3568 token->objPtr = JimMakeScriptObj(interp, t);
3569 Jim_IncrRefCount(token->objPtr);
3570 token++;
3573 script->len = i;
3576 /* This method takes the string representation of an object
3577 * as a Tcl script, and generates the pre-parsed internal representation
3578 * of the script. */
3579 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result)
3581 int scriptTextLen;
3582 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3583 struct JimParserCtx parser;
3584 struct ScriptObj *script;
3585 ParseTokenList tokenlist;
3586 int line = 1;
3588 /* Try to get information about filename / line number */
3589 if (objPtr->typePtr == &sourceObjType) {
3590 line = objPtr->internalRep.sourceValue.lineNumber;
3593 /* Initially parse the script into tokens (in tokenlist) */
3594 ScriptTokenListInit(&tokenlist);
3596 JimParserInit(&parser, scriptText, scriptTextLen, line);
3597 while (!parser.eof) {
3598 JimParseScript(&parser);
3599 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3600 parser.tline);
3602 /* Note that we accept a trailing backslash without error */
3603 if (result && parser.missing != ' ' && parser.missing != '\\') {
3604 ScriptTokenListFree(&tokenlist);
3605 result->missing = parser.missing;
3606 result->line = parser.missingline;
3607 return JIM_ERR;
3610 /* Add a final EOF token */
3611 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3613 /* Create the "real" script tokens from the parsed tokens */
3614 script = Jim_Alloc(sizeof(*script));
3615 memset(script, 0, sizeof(*script));
3616 script->inUse = 1;
3617 if (objPtr->typePtr == &sourceObjType) {
3618 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3620 else {
3621 script->fileNameObj = interp->emptyObj;
3623 Jim_IncrRefCount(script->fileNameObj);
3625 ScriptObjAddTokens(interp, script, &tokenlist);
3627 /* No longer need the token list */
3628 ScriptTokenListFree(&tokenlist);
3630 /* Free the old internal rep and set the new one. */
3631 Jim_FreeIntRep(interp, objPtr);
3632 Jim_SetIntRepPtr(objPtr, script);
3633 objPtr->typePtr = &scriptObjType;
3635 return JIM_OK;
3638 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3640 if (objPtr == interp->emptyObj) {
3641 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3642 objPtr = interp->nullScriptObj;
3645 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3646 SetScriptFromAny(interp, objPtr, NULL);
3648 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3651 /* -----------------------------------------------------------------------------
3652 * Commands
3653 * ---------------------------------------------------------------------------*/
3654 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3656 cmdPtr->inUse++;
3659 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3661 if (--cmdPtr->inUse == 0) {
3662 if (cmdPtr->isproc) {
3663 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3664 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3665 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3666 if (cmdPtr->u.proc.staticVars) {
3667 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3668 Jim_Free(cmdPtr->u.proc.staticVars);
3671 else {
3672 /* native (C) */
3673 if (cmdPtr->u.native.delProc) {
3674 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3677 if (cmdPtr->prevCmd) {
3678 /* Delete any pushed command too */
3679 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3681 Jim_Free(cmdPtr);
3685 /* Variables HashTable Type.
3687 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3690 /* Variables HashTable Type.
3692 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3693 static void JimVariablesHTValDestructor(void *interp, void *val)
3695 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3696 Jim_Free(val);
3699 static const Jim_HashTableType JimVariablesHashTableType = {
3700 JimStringCopyHTHashFunction, /* hash function */
3701 JimStringCopyHTDup, /* key dup */
3702 NULL, /* val dup */
3703 JimStringCopyHTKeyCompare, /* key compare */
3704 JimStringCopyHTKeyDestructor, /* key destructor */
3705 JimVariablesHTValDestructor /* val destructor */
3708 /* Commands HashTable Type.
3710 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3712 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3714 JimDecrCmdRefCount(interp, val);
3717 static const Jim_HashTableType JimCommandsHashTableType = {
3718 JimStringCopyHTHashFunction, /* hash function */
3719 JimStringCopyHTDup, /* key dup */
3720 NULL, /* val dup */
3721 JimStringCopyHTKeyCompare, /* key compare */
3722 JimStringCopyHTKeyDestructor, /* key destructor */
3723 JimCommandsHT_ValDestructor /* val destructor */
3726 /* ------------------------- Commands related functions --------------------- */
3728 #ifdef jim_ext_namespace
3730 * Returns the "unscoped" version of the given namespace.
3731 * That is, the fully qualfied name without the leading ::
3732 * The returned value is either nsObj, or an object with a zero ref count.
3734 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3736 const char *name = Jim_String(nsObj);
3737 if (name[0] == ':' && name[1] == ':') {
3738 /* This command is being defined in the global namespace */
3739 while (*++name == ':') {
3741 nsObj = Jim_NewStringObj(interp, name, -1);
3743 else if (Jim_Length(interp->framePtr->nsObj)) {
3744 /* This command is being defined in a non-global namespace */
3745 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3746 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3748 return nsObj;
3751 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3753 Jim_Obj *resultObj;
3755 const char *name = Jim_String(nameObjPtr);
3756 if (name[0] == ':' && name[1] == ':') {
3757 return nameObjPtr;
3759 Jim_IncrRefCount(nameObjPtr);
3760 resultObj = Jim_NewStringObj(interp, "::", -1);
3761 Jim_AppendObj(interp, resultObj, nameObjPtr);
3762 Jim_DecrRefCount(interp, nameObjPtr);
3764 return resultObj;
3768 * An efficient version of JimQualifyNameObj() where the name is
3769 * available (and needed) as a 'const char *'.
3770 * Avoids creating an object if not necessary.
3771 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3773 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3775 Jim_Obj *objPtr = interp->emptyObj;
3777 if (name[0] == ':' && name[1] == ':') {
3778 /* This command is being defined in the global namespace */
3779 while (*++name == ':') {
3782 else if (Jim_Length(interp->framePtr->nsObj)) {
3783 /* This command is being defined in a non-global namespace */
3784 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3785 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3786 name = Jim_String(objPtr);
3788 Jim_IncrRefCount(objPtr);
3789 *objPtrPtr = objPtr;
3790 return name;
3793 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3795 #else
3796 /* We can be more efficient in the no-namespace case */
3797 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3798 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3800 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3802 return nameObjPtr;
3804 #endif
3806 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3808 /* It may already exist, so we try to delete the old one.
3809 * Note that reference count means that it won't be deleted yet if
3810 * it exists in the call stack.
3812 * BUT, if 'local' is in force, instead of deleting the existing
3813 * proc, we stash a reference to the old proc here.
3815 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3816 if (he) {
3817 /* There was an old cmd with the same name,
3818 * so this requires a 'proc epoch' update. */
3820 /* If a procedure with the same name didn't exist there is no need
3821 * to increment the 'proc epoch' because creation of a new procedure
3822 * can never affect existing cached commands. We don't do
3823 * negative caching. */
3824 Jim_InterpIncrProcEpoch(interp);
3827 if (he && interp->local) {
3828 /* Push this command over the top of the previous one */
3829 cmd->prevCmd = he->u.val;
3830 he->u.val = cmd;
3832 else {
3833 if (he) {
3834 /* Replace the existing command */
3835 Jim_DeleteHashEntry(&interp->commands, name);
3838 Jim_AddHashEntry(&interp->commands, name, cmd);
3840 return JIM_OK;
3844 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3845 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3847 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3849 /* Store the new details for this command */
3850 memset(cmdPtr, 0, sizeof(*cmdPtr));
3851 cmdPtr->inUse = 1;
3852 cmdPtr->u.native.delProc = delProc;
3853 cmdPtr->u.native.cmdProc = cmdProc;
3854 cmdPtr->u.native.privData = privData;
3856 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3858 return JIM_OK;
3861 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3863 int len, i;
3865 len = Jim_ListLength(interp, staticsListObjPtr);
3866 if (len == 0) {
3867 return JIM_OK;
3870 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3871 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3872 for (i = 0; i < len; i++) {
3873 Jim_Obj *objPtr = NULL, *initObjPtr = NULL, *nameObjPtr = NULL;
3874 Jim_Var *varPtr;
3875 int subLen;
3877 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3878 /* Check if it's composed of two elements. */
3879 subLen = Jim_ListLength(interp, objPtr);
3880 if (subLen == 1 || subLen == 2) {
3881 /* Try to get the variable value from the current
3882 * environment. */
3883 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3884 if (subLen == 1) {
3885 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3886 if (initObjPtr == NULL) {
3887 Jim_SetResultFormatted(interp,
3888 "variable for initialization of static \"%#s\" not found in the local context",
3889 nameObjPtr);
3890 return JIM_ERR;
3893 else {
3894 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3896 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3897 return JIM_ERR;
3900 varPtr = Jim_Alloc(sizeof(*varPtr));
3901 varPtr->objPtr = initObjPtr;
3902 Jim_IncrRefCount(initObjPtr);
3903 varPtr->linkFramePtr = NULL;
3904 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3905 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3906 Jim_SetResultFormatted(interp,
3907 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3908 Jim_DecrRefCount(interp, initObjPtr);
3909 Jim_Free(varPtr);
3910 return JIM_ERR;
3913 else {
3914 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3915 objPtr);
3916 return JIM_ERR;
3919 return JIM_OK;
3922 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3924 #ifdef jim_ext_namespace
3925 if (cmdPtr->isproc) {
3926 /* XXX: Really need JimNamespaceSplit() */
3927 const char *pt = strrchr(cmdname, ':');
3928 if (pt && pt != cmdname && pt[-1] == ':') {
3929 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3930 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3931 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3933 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3934 /* This commands shadows a global command, so a proc epoch update is required */
3935 Jim_InterpIncrProcEpoch(interp);
3939 #endif
3942 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
3943 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
3945 Jim_Cmd *cmdPtr;
3946 int argListLen;
3947 int i;
3949 argListLen = Jim_ListLength(interp, argListObjPtr);
3951 /* Allocate space for both the command pointer and the arg list */
3952 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
3953 memset(cmdPtr, 0, sizeof(*cmdPtr));
3954 cmdPtr->inUse = 1;
3955 cmdPtr->isproc = 1;
3956 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
3957 cmdPtr->u.proc.argListLen = argListLen;
3958 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
3959 cmdPtr->u.proc.argsPos = -1;
3960 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
3961 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
3962 Jim_IncrRefCount(argListObjPtr);
3963 Jim_IncrRefCount(bodyObjPtr);
3964 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3966 /* Create the statics hash table. */
3967 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
3968 goto err;
3971 /* Parse the args out into arglist, validating as we go */
3972 /* Examine the argument list for default parameters and 'args' */
3973 for (i = 0; i < argListLen; i++) {
3974 Jim_Obj *argPtr;
3975 Jim_Obj *nameObjPtr;
3976 Jim_Obj *defaultObjPtr;
3977 int len;
3979 /* Examine a parameter */
3980 Jim_ListIndex(interp, argListObjPtr, i, &argPtr, JIM_NONE);
3981 len = Jim_ListLength(interp, argPtr);
3982 if (len == 0) {
3983 Jim_SetResultString(interp, "argument with no name", -1);
3984 err:
3985 JimDecrCmdRefCount(interp, cmdPtr);
3986 return NULL;
3988 if (len > 2) {
3989 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
3990 goto err;
3993 if (len == 2) {
3994 /* Optional parameter */
3995 Jim_ListIndex(interp, argPtr, 0, &nameObjPtr, JIM_NONE);
3996 Jim_ListIndex(interp, argPtr, 1, &defaultObjPtr, JIM_NONE);
3998 else {
3999 /* Required parameter */
4000 nameObjPtr = argPtr;
4001 defaultObjPtr = NULL;
4005 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4006 if (cmdPtr->u.proc.argsPos >= 0) {
4007 Jim_SetResultString(interp, "'args' specified more than once", -1);
4008 goto err;
4010 cmdPtr->u.proc.argsPos = i;
4012 else {
4013 if (len == 2) {
4014 cmdPtr->u.proc.optArity++;
4016 else {
4017 cmdPtr->u.proc.reqArity++;
4021 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4022 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4025 return cmdPtr;
4028 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4030 int ret = JIM_OK;
4031 Jim_Obj *qualifiedNameObj;
4032 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4034 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4035 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4036 ret = JIM_ERR;
4038 else {
4039 Jim_InterpIncrProcEpoch(interp);
4042 JimFreeQualifiedName(interp, qualifiedNameObj);
4044 return ret;
4047 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4049 int ret = JIM_ERR;
4050 Jim_HashEntry *he;
4051 Jim_Cmd *cmdPtr;
4052 Jim_Obj *qualifiedOldNameObj;
4053 Jim_Obj *qualifiedNewNameObj;
4054 const char *fqold;
4055 const char *fqnew;
4057 if (newName[0] == 0) {
4058 return Jim_DeleteCommand(interp, oldName);
4061 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4062 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4064 /* Does it exist? */
4065 he = Jim_FindHashEntry(&interp->commands, fqold);
4066 if (he == NULL) {
4067 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4069 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4070 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4072 else {
4073 /* Add the new name first */
4074 cmdPtr = he->u.val;
4075 JimIncrCmdRefCount(cmdPtr);
4076 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4077 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4079 /* Now remove the old name */
4080 Jim_DeleteHashEntry(&interp->commands, fqold);
4082 /* Increment the epoch */
4083 Jim_InterpIncrProcEpoch(interp);
4085 ret = JIM_OK;
4088 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4089 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4091 return ret;
4094 /* -----------------------------------------------------------------------------
4095 * Command object
4096 * ---------------------------------------------------------------------------*/
4098 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4100 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4103 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4105 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4106 dupPtr->typePtr = srcPtr->typePtr;
4107 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4110 static const Jim_ObjType commandObjType = {
4111 "command",
4112 FreeCommandInternalRep,
4113 DupCommandInternalRep,
4114 NULL,
4115 JIM_TYPE_REFERENCES,
4118 /* This function returns the command structure for the command name
4119 * stored in objPtr. It tries to specialize the objPtr to contain
4120 * a cached info instead to perform the lookup into the hash table
4121 * every time. The information cached may not be uptodate, in such
4122 * a case the lookup is performed and the cache updated.
4124 * Respects the 'upcall' setting
4126 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4128 Jim_Cmd *cmd;
4130 /* In order to be valid, the proc epoch must match and
4131 * the lookup must have occurred in the same namespace
4133 if (objPtr->typePtr != &commandObjType ||
4134 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4135 #ifdef jim_ext_namespace
4136 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4137 #endif
4139 /* Not cached or out of date, so lookup */
4141 /* Do we need to try the local namespace? */
4142 const char *name = Jim_String(objPtr);
4143 Jim_HashEntry *he;
4145 if (name[0] == ':' && name[1] == ':') {
4146 while (*++name == ':') {
4149 #ifdef jim_ext_namespace
4150 else if (Jim_Length(interp->framePtr->nsObj)) {
4151 /* This command is being defined in a non-global namespace */
4152 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4153 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4154 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4155 Jim_FreeNewObj(interp, nameObj);
4156 if (he) {
4157 goto found;
4160 #endif
4162 /* Lookup in the global namespace */
4163 he = Jim_FindHashEntry(&interp->commands, name);
4164 if (he == NULL) {
4165 if (flags & JIM_ERRMSG) {
4166 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4168 return NULL;
4170 #ifdef jim_ext_namespace
4171 found:
4172 #endif
4173 cmd = (Jim_Cmd *)he->u.val;
4175 /* Free the old internal repr and set the new one. */
4176 Jim_FreeIntRep(interp, objPtr);
4177 objPtr->typePtr = &commandObjType;
4178 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4179 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4180 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4181 Jim_IncrRefCount(interp->framePtr->nsObj);
4183 else {
4184 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4186 while (cmd->u.proc.upcall) {
4187 cmd = cmd->prevCmd;
4189 return cmd;
4192 /* -----------------------------------------------------------------------------
4193 * Variables
4194 * ---------------------------------------------------------------------------*/
4196 /* -----------------------------------------------------------------------------
4197 * Variable object
4198 * ---------------------------------------------------------------------------*/
4200 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4202 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4204 static const Jim_ObjType variableObjType = {
4205 "variable",
4206 NULL,
4207 NULL,
4208 NULL,
4209 JIM_TYPE_REFERENCES,
4213 * Check that the name does not contain embedded nulls.
4215 * Variable and procedure names are maniplated as null terminated strings, so
4216 * don't allow names with embedded nulls.
4218 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4220 /* Variable names and proc names can't contain embedded nulls */
4221 if (nameObjPtr->typePtr != &variableObjType) {
4222 int len;
4223 const char *str = Jim_GetString(nameObjPtr, &len);
4224 if (memchr(str, '\0', len)) {
4225 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4226 return JIM_ERR;
4229 return JIM_OK;
4232 /* This method should be called only by the variable API.
4233 * It returns JIM_OK on success (variable already exists),
4234 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4235 * a variable name, but syntax glue for [dict] i.e. the last
4236 * character is ')' */
4237 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4239 const char *varName;
4240 Jim_CallFrame *framePtr;
4241 Jim_HashEntry *he;
4242 int global;
4243 int len;
4245 /* Check if the object is already an uptodate variable */
4246 if (objPtr->typePtr == &variableObjType) {
4247 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4248 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4249 /* nothing to do */
4250 return JIM_OK;
4252 /* Need to re-resolve the variable in the updated callframe */
4254 else if (objPtr->typePtr == &dictSubstObjType) {
4255 return JIM_DICT_SUGAR;
4257 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4258 return JIM_ERR;
4262 varName = Jim_GetString(objPtr, &len);
4264 /* Make sure it's not syntax glue to get/set dict. */
4265 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4266 return JIM_DICT_SUGAR;
4269 if (varName[0] == ':' && varName[1] == ':') {
4270 while (*++varName == ':') {
4272 global = 1;
4273 framePtr = interp->topFramePtr;
4275 else {
4276 global = 0;
4277 framePtr = interp->framePtr;
4280 /* Resolve this name in the variables hash table */
4281 he = Jim_FindHashEntry(&framePtr->vars, varName);
4282 if (he == NULL) {
4283 if (!global && framePtr->staticVars) {
4284 /* Try with static vars. */
4285 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4287 if (he == NULL) {
4288 return JIM_ERR;
4292 /* Free the old internal repr and set the new one. */
4293 Jim_FreeIntRep(interp, objPtr);
4294 objPtr->typePtr = &variableObjType;
4295 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4296 objPtr->internalRep.varValue.varPtr = he->u.val;
4297 objPtr->internalRep.varValue.global = global;
4298 return JIM_OK;
4301 /* -------------------- Variables related functions ------------------------- */
4302 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4303 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4305 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4307 const char *name;
4308 Jim_CallFrame *framePtr;
4309 int global;
4311 /* New variable to create */
4312 Jim_Var *var = Jim_Alloc(sizeof(*var));
4314 var->objPtr = valObjPtr;
4315 Jim_IncrRefCount(valObjPtr);
4316 var->linkFramePtr = NULL;
4318 name = Jim_String(nameObjPtr);
4319 if (name[0] == ':' && name[1] == ':') {
4320 while (*++name == ':') {
4322 framePtr = interp->topFramePtr;
4323 global = 1;
4325 else {
4326 framePtr = interp->framePtr;
4327 global = 0;
4330 /* Insert the new variable */
4331 Jim_AddHashEntry(&framePtr->vars, name, var);
4333 /* Make the object int rep a variable */
4334 Jim_FreeIntRep(interp, nameObjPtr);
4335 nameObjPtr->typePtr = &variableObjType;
4336 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4337 nameObjPtr->internalRep.varValue.varPtr = var;
4338 nameObjPtr->internalRep.varValue.global = global;
4340 return var;
4343 /* For now that's dummy. Variables lookup should be optimized
4344 * in many ways, with caching of lookups, and possibly with
4345 * a table of pre-allocated vars in every CallFrame for local vars.
4346 * All the caching should also have an 'epoch' mechanism similar
4347 * to the one used by Tcl for procedures lookup caching. */
4349 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4351 int err;
4352 Jim_Var *var;
4354 switch (SetVariableFromAny(interp, nameObjPtr)) {
4355 case JIM_DICT_SUGAR:
4356 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4358 case JIM_ERR:
4359 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4360 return JIM_ERR;
4362 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4363 break;
4365 case JIM_OK:
4366 var = nameObjPtr->internalRep.varValue.varPtr;
4367 if (var->linkFramePtr == NULL) {
4368 Jim_IncrRefCount(valObjPtr);
4369 Jim_DecrRefCount(interp, var->objPtr);
4370 var->objPtr = valObjPtr;
4372 else { /* Else handle the link */
4373 Jim_CallFrame *savedCallFrame;
4375 savedCallFrame = interp->framePtr;
4376 interp->framePtr = var->linkFramePtr;
4377 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4378 interp->framePtr = savedCallFrame;
4379 if (err != JIM_OK)
4380 return err;
4383 return JIM_OK;
4386 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4388 Jim_Obj *nameObjPtr;
4389 int result;
4391 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4392 Jim_IncrRefCount(nameObjPtr);
4393 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4394 Jim_DecrRefCount(interp, nameObjPtr);
4395 return result;
4398 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4400 Jim_CallFrame *savedFramePtr;
4401 int result;
4403 savedFramePtr = interp->framePtr;
4404 interp->framePtr = interp->topFramePtr;
4405 result = Jim_SetVariableStr(interp, name, objPtr);
4406 interp->framePtr = savedFramePtr;
4407 return result;
4410 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4412 Jim_Obj *nameObjPtr, *valObjPtr;
4413 int result;
4415 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4416 valObjPtr = Jim_NewStringObj(interp, val, -1);
4417 Jim_IncrRefCount(nameObjPtr);
4418 Jim_IncrRefCount(valObjPtr);
4419 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4420 Jim_DecrRefCount(interp, nameObjPtr);
4421 Jim_DecrRefCount(interp, valObjPtr);
4422 return result;
4425 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4426 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4428 const char *varName;
4429 const char *targetName;
4430 Jim_CallFrame *framePtr;
4431 Jim_Var *varPtr;
4433 /* Check for an existing variable or link */
4434 switch (SetVariableFromAny(interp, nameObjPtr)) {
4435 case JIM_DICT_SUGAR:
4436 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4437 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4438 return JIM_ERR;
4440 case JIM_OK:
4441 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4443 if (varPtr->linkFramePtr == NULL) {
4444 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4445 return JIM_ERR;
4448 /* It exists, but is a link, so first delete the link */
4449 varPtr->linkFramePtr = NULL;
4450 break;
4453 /* Resolve the call frames for both variables */
4454 /* XXX: SetVariableFromAny() already did this! */
4455 varName = Jim_String(nameObjPtr);
4457 if (varName[0] == ':' && varName[1] == ':') {
4458 while (*++varName == ':') {
4460 /* Linking a global var does nothing */
4461 framePtr = interp->topFramePtr;
4463 else {
4464 framePtr = interp->framePtr;
4467 targetName = Jim_String(targetNameObjPtr);
4468 if (targetName[0] == ':' && targetName[1] == ':') {
4469 while (*++targetName == ':') {
4471 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4472 targetCallFrame = interp->topFramePtr;
4474 Jim_IncrRefCount(targetNameObjPtr);
4476 if (framePtr->level < targetCallFrame->level) {
4477 Jim_SetResultFormatted(interp,
4478 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4479 nameObjPtr);
4480 Jim_DecrRefCount(interp, targetNameObjPtr);
4481 return JIM_ERR;
4484 /* Check for cycles. */
4485 if (framePtr == targetCallFrame) {
4486 Jim_Obj *objPtr = targetNameObjPtr;
4488 /* Cycles are only possible with 'uplevel 0' */
4489 while (1) {
4490 if (strcmp(Jim_String(objPtr), varName) == 0) {
4491 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4492 Jim_DecrRefCount(interp, targetNameObjPtr);
4493 return JIM_ERR;
4495 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4496 break;
4497 varPtr = objPtr->internalRep.varValue.varPtr;
4498 if (varPtr->linkFramePtr != targetCallFrame)
4499 break;
4500 objPtr = varPtr->objPtr;
4504 /* Perform the binding */
4505 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4506 /* We are now sure 'nameObjPtr' type is variableObjType */
4507 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4508 Jim_DecrRefCount(interp, targetNameObjPtr);
4509 return JIM_OK;
4512 /* Return the Jim_Obj pointer associated with a variable name,
4513 * or NULL if the variable was not found in the current context.
4514 * The same optimization discussed in the comment to the
4515 * 'SetVariable' function should apply here.
4517 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4518 * in a dictionary which is shared, the array variable value is duplicated first.
4519 * This allows the array element to be updated (e.g. append, lappend) without
4520 * affecting other references to the dictionary.
4522 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4524 switch (SetVariableFromAny(interp, nameObjPtr)) {
4525 case JIM_OK:{
4526 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4528 if (varPtr->linkFramePtr == NULL) {
4529 return varPtr->objPtr;
4531 else {
4532 Jim_Obj *objPtr;
4534 /* The variable is a link? Resolve it. */
4535 Jim_CallFrame *savedCallFrame = interp->framePtr;
4537 interp->framePtr = varPtr->linkFramePtr;
4538 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4539 interp->framePtr = savedCallFrame;
4540 if (objPtr) {
4541 return objPtr;
4543 /* Error, so fall through to the error message */
4546 break;
4548 case JIM_DICT_SUGAR:
4549 /* [dict] syntax sugar. */
4550 return JimDictSugarGet(interp, nameObjPtr, flags);
4552 if (flags & JIM_ERRMSG) {
4553 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4555 return NULL;
4558 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4560 Jim_CallFrame *savedFramePtr;
4561 Jim_Obj *objPtr;
4563 savedFramePtr = interp->framePtr;
4564 interp->framePtr = interp->topFramePtr;
4565 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4566 interp->framePtr = savedFramePtr;
4568 return objPtr;
4571 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4573 Jim_Obj *nameObjPtr, *varObjPtr;
4575 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4576 Jim_IncrRefCount(nameObjPtr);
4577 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4578 Jim_DecrRefCount(interp, nameObjPtr);
4579 return varObjPtr;
4582 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4584 Jim_CallFrame *savedFramePtr;
4585 Jim_Obj *objPtr;
4587 savedFramePtr = interp->framePtr;
4588 interp->framePtr = interp->topFramePtr;
4589 objPtr = Jim_GetVariableStr(interp, name, flags);
4590 interp->framePtr = savedFramePtr;
4592 return objPtr;
4595 /* Unset a variable.
4596 * Note: On success unset invalidates all the variable objects created
4597 * in the current call frame incrementing. */
4598 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4600 Jim_Var *varPtr;
4601 int retval;
4602 Jim_CallFrame *framePtr;
4604 retval = SetVariableFromAny(interp, nameObjPtr);
4605 if (retval == JIM_DICT_SUGAR) {
4606 /* [dict] syntax sugar. */
4607 return JimDictSugarSet(interp, nameObjPtr, NULL);
4609 else if (retval == JIM_OK) {
4610 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4612 /* If it's a link call UnsetVariable recursively */
4613 if (varPtr->linkFramePtr) {
4614 framePtr = interp->framePtr;
4615 interp->framePtr = varPtr->linkFramePtr;
4616 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4617 interp->framePtr = framePtr;
4619 else {
4620 const char *name = Jim_String(nameObjPtr);
4621 if (nameObjPtr->internalRep.varValue.global) {
4622 name += 2;
4623 framePtr = interp->topFramePtr;
4625 else {
4626 framePtr = interp->framePtr;
4629 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4630 if (retval == JIM_OK) {
4631 /* Change the callframe id, invalidating var lookup caching */
4632 JimChangeCallFrameId(interp, framePtr);
4636 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4637 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4639 return retval;
4642 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4644 /* Given a variable name for [dict] operation syntax sugar,
4645 * this function returns two objects, the first with the name
4646 * of the variable to set, and the second with the rispective key.
4647 * For example "foo(bar)" will return objects with string repr. of
4648 * "foo" and "bar".
4650 * The returned objects have refcount = 1. The function can't fail. */
4651 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4652 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4654 const char *str, *p;
4655 int len, keyLen;
4656 Jim_Obj *varObjPtr, *keyObjPtr;
4658 str = Jim_GetString(objPtr, &len);
4660 p = strchr(str, '(');
4661 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4663 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4665 p++;
4666 keyLen = (str + len) - p;
4667 if (str[len - 1] == ')') {
4668 keyLen--;
4671 /* Create the objects with the variable name and key. */
4672 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4674 Jim_IncrRefCount(varObjPtr);
4675 Jim_IncrRefCount(keyObjPtr);
4676 *varPtrPtr = varObjPtr;
4677 *keyPtrPtr = keyObjPtr;
4680 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4681 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4682 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4684 int err;
4686 SetDictSubstFromAny(interp, objPtr);
4688 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4689 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4691 if (err == JIM_OK) {
4692 /* Don't keep an extra ref to the result */
4693 Jim_SetEmptyResult(interp);
4695 else {
4696 if (!valObjPtr) {
4697 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4698 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4699 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4700 objPtr);
4701 return err;
4704 /* Make the error more informative and Tcl-compatible */
4705 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4706 (valObjPtr ? "set" : "unset"), objPtr);
4708 return err;
4712 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4714 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4715 * and stored back to the variable before expansion.
4717 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4718 Jim_Obj *keyObjPtr, int flags)
4720 Jim_Obj *dictObjPtr;
4721 Jim_Obj *resObjPtr = NULL;
4722 int ret;
4724 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4725 if (!dictObjPtr) {
4726 return NULL;
4729 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4730 if (ret != JIM_OK) {
4731 resObjPtr = NULL;
4732 if (ret < 0) {
4733 Jim_SetResultFormatted(interp,
4734 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr, keyObjPtr);
4736 else {
4737 Jim_SetResultFormatted(interp,
4738 "can't read \"%#s(%#s)\": no such element in array", varObjPtr, keyObjPtr);
4741 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4742 dictObjPtr = Jim_DuplicateObj(interp, dictObjPtr);
4743 if (Jim_SetVariable(interp, varObjPtr, dictObjPtr) != JIM_OK) {
4744 /* This can probably never happen */
4745 JimPanic((1, "SetVariable failed for JIM_UNSHARED"));
4747 /* We know that the key exists. Get the result in the now-unshared dictionary */
4748 Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4751 return resObjPtr;
4754 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4755 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4757 SetDictSubstFromAny(interp, objPtr);
4759 return JimDictExpandArrayVariable(interp,
4760 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4761 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4764 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4766 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4768 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4769 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4772 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4774 JIM_NOTUSED(interp);
4776 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4777 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4778 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4779 dupPtr->typePtr = &dictSubstObjType;
4782 /* Note: The object *must* be in dict-sugar format */
4783 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4785 if (objPtr->typePtr != &dictSubstObjType) {
4786 Jim_Obj *varObjPtr, *keyObjPtr;
4788 if (objPtr->typePtr == &interpolatedObjType) {
4789 /* An interpolated object in dict-sugar form */
4791 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4792 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4794 Jim_IncrRefCount(varObjPtr);
4795 Jim_IncrRefCount(keyObjPtr);
4797 else {
4798 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4801 Jim_FreeIntRep(interp, objPtr);
4802 objPtr->typePtr = &dictSubstObjType;
4803 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4804 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4808 /* This function is used to expand [dict get] sugar in the form
4809 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4810 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4811 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4812 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4813 * the [dict]ionary contained in variable VARNAME. */
4814 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4816 Jim_Obj *resObjPtr = NULL;
4817 Jim_Obj *substKeyObjPtr = NULL;
4819 SetDictSubstFromAny(interp, objPtr);
4821 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4822 &substKeyObjPtr, JIM_NONE)
4823 != JIM_OK) {
4824 return NULL;
4826 Jim_IncrRefCount(substKeyObjPtr);
4827 resObjPtr =
4828 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4829 substKeyObjPtr, 0);
4830 Jim_DecrRefCount(interp, substKeyObjPtr);
4832 return resObjPtr;
4835 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4837 Jim_Obj *resultObjPtr;
4839 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4840 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4841 resultObjPtr->refCount--;
4842 return resultObjPtr;
4844 return NULL;
4847 /* -----------------------------------------------------------------------------
4848 * CallFrame
4849 * ---------------------------------------------------------------------------*/
4851 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4853 Jim_CallFrame *cf;
4855 if (interp->freeFramesList) {
4856 cf = interp->freeFramesList;
4857 interp->freeFramesList = cf->next;
4859 cf->argv = NULL;
4860 cf->argc = 0;
4861 cf->procArgsObjPtr = NULL;
4862 cf->procBodyObjPtr = NULL;
4863 cf->next = NULL;
4864 cf->staticVars = NULL;
4865 cf->localCommands = NULL;
4866 cf->tailcall = 0;
4867 cf->tailcallObj = NULL;
4868 cf->tailcallCmd = NULL;
4870 else {
4871 cf = Jim_Alloc(sizeof(*cf));
4872 memset(cf, 0, sizeof(*cf));
4874 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4877 cf->id = interp->callFrameEpoch++;
4878 cf->parent = parent;
4879 cf->level = parent ? parent->level + 1 : 0;
4880 cf->nsObj = nsObj;
4881 Jim_IncrRefCount(nsObj);
4883 return cf;
4886 /* Used to invalidate every caching related to callframe stability. */
4887 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
4889 cf->id = interp->callFrameEpoch++;
4892 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4894 /* Delete any local procs */
4895 if (localCommands) {
4896 Jim_Obj *cmdNameObj;
4898 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4899 Jim_HashEntry *he;
4900 Jim_Obj *fqObjName;
4902 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4904 he = Jim_FindHashEntry(&interp->commands, fqname);
4906 if (he) {
4907 Jim_Cmd *cmd = he->u.val;
4908 if (cmd->prevCmd) {
4909 Jim_Cmd *prevCmd = cmd->prevCmd;
4910 cmd->prevCmd = NULL;
4912 /* Delete the old command */
4913 JimDecrCmdRefCount(interp, cmd);
4915 /* And restore the original */
4916 he->u.val = prevCmd;
4918 else {
4919 Jim_DeleteHashEntry(&interp->commands, fqname);
4920 Jim_InterpIncrProcEpoch(interp);
4923 Jim_DecrRefCount(interp, cmdNameObj);
4924 JimFreeQualifiedName(interp, fqObjName);
4926 Jim_FreeStack(localCommands);
4927 Jim_Free(localCommands);
4929 return JIM_OK;
4933 #define JIM_FCF_NONE 0 /* no flags */
4934 #define JIM_FCF_NOHT 1 /* don't free the hash table */
4935 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags)
4937 if (cf->procArgsObjPtr)
4938 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4939 if (cf->procBodyObjPtr)
4940 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4941 Jim_DecrRefCount(interp, cf->nsObj);
4942 if (!(flags & JIM_FCF_NOHT))
4943 Jim_FreeHashTable(&cf->vars);
4944 else {
4945 int i;
4946 Jim_HashEntry **table = cf->vars.table, *he;
4948 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4949 he = table[i];
4950 while (he != NULL) {
4951 Jim_HashEntry *nextEntry = he->next;
4952 Jim_Var *varPtr = (void *)he->u.val;
4954 Jim_DecrRefCount(interp, varPtr->objPtr);
4955 Jim_Free(he->u.val);
4956 Jim_Free((void *)he->key); /* ATTENTION: const cast */
4957 Jim_Free(he);
4958 table[i] = NULL;
4959 he = nextEntry;
4962 cf->vars.used = 0;
4965 JimDeleteLocalProcs(interp, cf->localCommands);
4967 cf->next = interp->freeFramesList;
4968 interp->freeFramesList = cf;
4973 /* -----------------------------------------------------------------------------
4974 * References
4975 * ---------------------------------------------------------------------------*/
4976 #ifdef JIM_REFERENCES
4978 /* References HashTable Type.
4980 * Keys are unsigned long integers, dynamically allocated for now but in the
4981 * future it's worth to cache this 4 bytes objects. Values are pointers
4982 * to Jim_References. */
4983 static void JimReferencesHTValDestructor(void *interp, void *val)
4985 Jim_Reference *refPtr = (void *)val;
4987 Jim_DecrRefCount(interp, refPtr->objPtr);
4988 if (refPtr->finalizerCmdNamePtr != NULL) {
4989 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4991 Jim_Free(val);
4994 static unsigned int JimReferencesHTHashFunction(const void *key)
4996 /* Only the least significant bits are used. */
4997 const unsigned long *widePtr = key;
4998 unsigned int intValue = (unsigned int)*widePtr;
5000 return Jim_IntHashFunction(intValue);
5003 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5005 void *copy = Jim_Alloc(sizeof(unsigned long));
5007 JIM_NOTUSED(privdata);
5009 memcpy(copy, key, sizeof(unsigned long));
5010 return copy;
5013 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5015 JIM_NOTUSED(privdata);
5017 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5020 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5022 JIM_NOTUSED(privdata);
5024 Jim_Free(key);
5027 static const Jim_HashTableType JimReferencesHashTableType = {
5028 JimReferencesHTHashFunction, /* hash function */
5029 JimReferencesHTKeyDup, /* key dup */
5030 NULL, /* val dup */
5031 JimReferencesHTKeyCompare, /* key compare */
5032 JimReferencesHTKeyDestructor, /* key destructor */
5033 JimReferencesHTValDestructor /* val destructor */
5036 /* -----------------------------------------------------------------------------
5037 * Reference object type and References API
5038 * ---------------------------------------------------------------------------*/
5040 /* The string representation of references has two features in order
5041 * to make the GC faster. The first is that every reference starts
5042 * with a non common character '<', in order to make the string matching
5043 * faster. The second is that the reference string rep is 42 characters
5044 * in length, this allows to avoid to check every object with a string
5045 * repr < 42, and usually there aren't many of these objects. */
5047 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5049 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5051 const char *fmt = "<reference.<%s>.%020lu>";
5053 sprintf(buf, fmt, refPtr->tag, id);
5054 return JIM_REFERENCE_SPACE;
5057 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5059 static const Jim_ObjType referenceObjType = {
5060 "reference",
5061 NULL,
5062 NULL,
5063 UpdateStringOfReference,
5064 JIM_TYPE_REFERENCES,
5067 void UpdateStringOfReference(struct Jim_Obj *objPtr)
5069 char buf[JIM_REFERENCE_SPACE + 1];
5071 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5072 JimSetStringBytes(objPtr, buf);
5075 /* returns true if 'c' is a valid reference tag character.
5076 * i.e. inside the range [_a-zA-Z0-9] */
5077 static int isrefchar(int c)
5079 return (c == '_' || isalnum(c));
5082 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5084 unsigned long value;
5085 int i, len;
5086 const char *str, *start, *end;
5087 char refId[21];
5088 Jim_Reference *refPtr;
5089 Jim_HashEntry *he;
5090 char *endptr;
5092 /* Get the string representation */
5093 str = Jim_GetString(objPtr, &len);
5094 /* Check if it looks like a reference */
5095 if (len < JIM_REFERENCE_SPACE)
5096 goto badformat;
5097 /* Trim spaces */
5098 start = str;
5099 end = str + len - 1;
5100 while (*start == ' ')
5101 start++;
5102 while (*end == ' ' && end > start)
5103 end--;
5104 if (end - start + 1 != JIM_REFERENCE_SPACE)
5105 goto badformat;
5106 /* <reference.<1234567>.%020> */
5107 if (memcmp(start, "<reference.<", 12) != 0)
5108 goto badformat;
5109 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5110 goto badformat;
5111 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5112 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5113 if (!isrefchar(start[12 + i]))
5114 goto badformat;
5116 /* Extract info from the reference. */
5117 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5118 refId[20] = '\0';
5119 /* Try to convert the ID into an unsigned long */
5120 value = strtoul(refId, &endptr, 10);
5121 if (JimCheckConversion(refId, endptr) != JIM_OK)
5122 goto badformat;
5123 /* Check if the reference really exists! */
5124 he = Jim_FindHashEntry(&interp->references, &value);
5125 if (he == NULL) {
5126 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5127 return JIM_ERR;
5129 refPtr = he->u.val;
5130 /* Free the old internal repr and set the new one. */
5131 Jim_FreeIntRep(interp, objPtr);
5132 objPtr->typePtr = &referenceObjType;
5133 objPtr->internalRep.refValue.id = value;
5134 objPtr->internalRep.refValue.refPtr = refPtr;
5135 return JIM_OK;
5137 badformat:
5138 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5139 return JIM_ERR;
5142 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5143 * as finalizer command (or NULL if there is no finalizer).
5144 * The returned reference object has refcount = 0. */
5145 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5147 struct Jim_Reference *refPtr;
5148 unsigned long id;
5149 Jim_Obj *refObjPtr;
5150 const char *tag;
5151 int tagLen, i;
5153 /* Perform the Garbage Collection if needed. */
5154 Jim_CollectIfNeeded(interp);
5156 refPtr = Jim_Alloc(sizeof(*refPtr));
5157 refPtr->objPtr = objPtr;
5158 Jim_IncrRefCount(objPtr);
5159 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5160 if (cmdNamePtr)
5161 Jim_IncrRefCount(cmdNamePtr);
5162 id = interp->referenceNextId++;
5163 Jim_AddHashEntry(&interp->references, &id, refPtr);
5164 refObjPtr = Jim_NewObj(interp);
5165 refObjPtr->typePtr = &referenceObjType;
5166 refObjPtr->bytes = NULL;
5167 refObjPtr->internalRep.refValue.id = id;
5168 refObjPtr->internalRep.refValue.refPtr = refPtr;
5169 interp->referenceNextId++;
5170 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5171 * that does not pass the 'isrefchar' test is replaced with '_' */
5172 tag = Jim_GetString(tagPtr, &tagLen);
5173 if (tagLen > JIM_REFERENCE_TAGLEN)
5174 tagLen = JIM_REFERENCE_TAGLEN;
5175 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5176 if (i < tagLen && isrefchar(tag[i]))
5177 refPtr->tag[i] = tag[i];
5178 else
5179 refPtr->tag[i] = '_';
5181 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5182 return refObjPtr;
5185 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5187 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5188 return NULL;
5189 return objPtr->internalRep.refValue.refPtr;
5192 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5194 Jim_Reference *refPtr;
5196 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5197 return JIM_ERR;
5198 Jim_IncrRefCount(cmdNamePtr);
5199 if (refPtr->finalizerCmdNamePtr)
5200 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5201 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5202 return JIM_OK;
5205 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5207 Jim_Reference *refPtr;
5209 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5210 return JIM_ERR;
5211 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5212 return JIM_OK;
5215 /* -----------------------------------------------------------------------------
5216 * References Garbage Collection
5217 * ---------------------------------------------------------------------------*/
5219 /* This the hash table type for the "MARK" phase of the GC */
5220 static const Jim_HashTableType JimRefMarkHashTableType = {
5221 JimReferencesHTHashFunction, /* hash function */
5222 JimReferencesHTKeyDup, /* key dup */
5223 NULL, /* val dup */
5224 JimReferencesHTKeyCompare, /* key compare */
5225 JimReferencesHTKeyDestructor, /* key destructor */
5226 NULL /* val destructor */
5229 /* Performs the garbage collection. */
5230 int Jim_Collect(Jim_Interp *interp)
5232 int collected = 0;
5233 #ifndef JIM_BOOTSTRAP
5234 Jim_HashTable marks;
5235 Jim_HashTableIterator htiter;
5236 Jim_HashEntry *he;
5237 Jim_Obj *objPtr;
5239 /* Avoid recursive calls */
5240 if (interp->lastCollectId == -1) {
5241 /* Jim_Collect() already running. Return just now. */
5242 return 0;
5244 interp->lastCollectId = -1;
5246 /* Mark all the references found into the 'mark' hash table.
5247 * The references are searched in every live object that
5248 * is of a type that can contain references. */
5249 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5250 objPtr = interp->liveList;
5251 while (objPtr) {
5252 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5253 const char *str, *p;
5254 int len;
5256 /* If the object is of type reference, to get the
5257 * Id is simple... */
5258 if (objPtr->typePtr == &referenceObjType) {
5259 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5260 #ifdef JIM_DEBUG_GC
5261 printf("MARK (reference): %d refcount: %d" JIM_NL,
5262 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5263 #endif
5264 objPtr = objPtr->nextObjPtr;
5265 continue;
5267 /* Get the string repr of the object we want
5268 * to scan for references. */
5269 p = str = Jim_GetString(objPtr, &len);
5270 /* Skip objects too little to contain references. */
5271 if (len < JIM_REFERENCE_SPACE) {
5272 objPtr = objPtr->nextObjPtr;
5273 continue;
5275 /* Extract references from the object string repr. */
5276 while (1) {
5277 int i;
5278 unsigned long id;
5280 if ((p = strstr(p, "<reference.<")) == NULL)
5281 break;
5282 /* Check if it's a valid reference. */
5283 if (len - (p - str) < JIM_REFERENCE_SPACE)
5284 break;
5285 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5286 break;
5287 for (i = 21; i <= 40; i++)
5288 if (!isdigit(UCHAR(p[i])))
5289 break;
5290 /* Get the ID */
5291 id = strtoul(p + 21, NULL, 10);
5293 /* Ok, a reference for the given ID
5294 * was found. Mark it. */
5295 Jim_AddHashEntry(&marks, &id, NULL);
5296 #ifdef JIM_DEBUG_GC
5297 printf("MARK: %d" JIM_NL, (int)id);
5298 #endif
5299 p += JIM_REFERENCE_SPACE;
5302 objPtr = objPtr->nextObjPtr;
5305 /* Run the references hash table to destroy every reference that
5306 * is not referenced outside (not present in the mark HT). */
5307 JimInitHashTableIterator(&interp->references, &htiter);
5308 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5309 const unsigned long *refId;
5310 Jim_Reference *refPtr;
5312 refId = he->key;
5313 /* Check if in the mark phase we encountered
5314 * this reference. */
5315 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5316 #ifdef JIM_DEBUG_GC
5317 printf("COLLECTING %d" JIM_NL, (int)*refId);
5318 #endif
5319 collected++;
5320 /* Drop the reference, but call the
5321 * finalizer first if registered. */
5322 refPtr = he->u.val;
5323 if (refPtr->finalizerCmdNamePtr) {
5324 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5325 Jim_Obj *objv[3], *oldResult;
5327 JimFormatReference(refstr, refPtr, *refId);
5329 objv[0] = refPtr->finalizerCmdNamePtr;
5330 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5331 objv[2] = refPtr->objPtr;
5333 /* Drop the reference itself */
5334 /* Avoid the finaliser being freed here */
5335 Jim_IncrRefCount(objv[0]);
5336 /* Don't remove the reference from the hash table just yet
5337 * since that will free refPtr, and hence refPtr->objPtr
5340 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5341 oldResult = interp->result;
5342 Jim_IncrRefCount(oldResult);
5343 Jim_EvalObjVector(interp, 3, objv);
5344 Jim_SetResult(interp, oldResult);
5345 Jim_DecrRefCount(interp, oldResult);
5347 Jim_DecrRefCount(interp, objv[0]);
5349 Jim_DeleteHashEntry(&interp->references, refId);
5352 Jim_FreeHashTable(&marks);
5353 interp->lastCollectId = interp->referenceNextId;
5354 interp->lastCollectTime = time(NULL);
5355 #endif /* JIM_BOOTSTRAP */
5356 return collected;
5359 #define JIM_COLLECT_ID_PERIOD 5000
5360 #define JIM_COLLECT_TIME_PERIOD 300
5362 void Jim_CollectIfNeeded(Jim_Interp *interp)
5364 unsigned long elapsedId;
5365 int elapsedTime;
5367 elapsedId = interp->referenceNextId - interp->lastCollectId;
5368 elapsedTime = time(NULL) - interp->lastCollectTime;
5371 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5372 Jim_Collect(interp);
5375 #endif
5377 int Jim_IsBigEndian(void)
5379 union {
5380 unsigned short s;
5381 unsigned char c[2];
5382 } uval = {0x0102};
5384 return uval.c[0] == 1;
5387 /* -----------------------------------------------------------------------------
5388 * Interpreter related functions
5389 * ---------------------------------------------------------------------------*/
5391 Jim_Interp *Jim_CreateInterp(void)
5393 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5395 memset(i, 0, sizeof(*i));
5397 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5398 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5399 i->lastCollectTime = time(NULL);
5401 /* Note that we can create objects only after the
5402 * interpreter liveList and freeList pointers are
5403 * initialized to NULL. */
5404 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5405 #ifdef JIM_REFERENCES
5406 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5407 #endif
5408 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5409 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5410 i->emptyObj = Jim_NewEmptyStringObj(i);
5411 i->trueObj = Jim_NewIntObj(i, 1);
5412 i->falseObj = Jim_NewIntObj(i, 0);
5413 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5414 i->errorFileNameObj = i->emptyObj;
5415 i->result = i->emptyObj;
5416 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5417 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5418 i->errorProc = i->emptyObj;
5419 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5420 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5421 Jim_IncrRefCount(i->emptyObj);
5422 Jim_IncrRefCount(i->errorFileNameObj);
5423 Jim_IncrRefCount(i->result);
5424 Jim_IncrRefCount(i->stackTrace);
5425 Jim_IncrRefCount(i->unknown);
5426 Jim_IncrRefCount(i->currentScriptObj);
5427 Jim_IncrRefCount(i->nullScriptObj);
5428 Jim_IncrRefCount(i->errorProc);
5429 Jim_IncrRefCount(i->trueObj);
5430 Jim_IncrRefCount(i->falseObj);
5432 /* Initialize key variables every interpreter should contain */
5433 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5434 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5436 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5437 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5438 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5439 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5440 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5441 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5442 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5444 return i;
5447 void Jim_FreeInterp(Jim_Interp *i)
5449 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
5450 Jim_Obj *objPtr, *nextObjPtr;
5452 /* Free the call frames list - must be done before i->commands is destroyed */
5453 while (cf) {
5454 prevcf = cf->parent;
5455 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
5456 cf = prevcf;
5459 Jim_DecrRefCount(i, i->emptyObj);
5460 Jim_DecrRefCount(i, i->trueObj);
5461 Jim_DecrRefCount(i, i->falseObj);
5462 Jim_DecrRefCount(i, i->result);
5463 Jim_DecrRefCount(i, i->stackTrace);
5464 Jim_DecrRefCount(i, i->errorProc);
5465 Jim_DecrRefCount(i, i->unknown);
5466 Jim_DecrRefCount(i, i->errorFileNameObj);
5467 Jim_DecrRefCount(i, i->currentScriptObj);
5468 Jim_DecrRefCount(i, i->nullScriptObj);
5469 Jim_FreeHashTable(&i->commands);
5470 #ifdef JIM_REFERENCES
5471 Jim_FreeHashTable(&i->references);
5472 #endif
5473 Jim_FreeHashTable(&i->packages);
5474 Jim_Free(i->prngState);
5475 Jim_FreeHashTable(&i->assocData);
5477 /* Check that the live object list is empty, otherwise
5478 * there is a memory leak. */
5479 if (i->liveList != NULL) {
5480 objPtr = i->liveList;
5482 printf(JIM_NL "-------------------------------------" JIM_NL);
5483 printf("Objects still in the free list:" JIM_NL);
5484 while (objPtr) {
5485 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5487 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5488 printf("%p (%d) %-10s: '%.20s...'" JIM_NL,
5489 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5491 else {
5492 printf("%p (%d) %-10s: '%s'" JIM_NL,
5493 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5495 if (objPtr->typePtr == &sourceObjType) {
5496 printf("FILE %s LINE %d" JIM_NL,
5497 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5498 objPtr->internalRep.sourceValue.lineNumber);
5500 objPtr = objPtr->nextObjPtr;
5502 printf("-------------------------------------" JIM_NL JIM_NL);
5503 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5505 /* Free all the freed objects. */
5506 objPtr = i->freeList;
5507 while (objPtr) {
5508 nextObjPtr = objPtr->nextObjPtr;
5509 Jim_Free(objPtr);
5510 objPtr = nextObjPtr;
5512 /* Free cached CallFrame structures */
5513 cf = i->freeFramesList;
5514 while (cf) {
5515 nextcf = cf->next;
5516 if (cf->vars.table != NULL)
5517 Jim_Free(cf->vars.table);
5518 Jim_Free(cf);
5519 cf = nextcf;
5522 /* Free the interpreter structure. */
5523 Jim_Free(i);
5526 /* Returns the call frame relative to the level represented by
5527 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
5529 * This function accepts the 'level' argument in the form
5530 * of the commands [uplevel] and [upvar].
5532 * For a function accepting a relative integer as level suitable
5533 * for implementation of [info level ?level?] check the
5534 * JimGetCallFrameByInteger() function.
5536 * Returns NULL on error.
5538 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5540 long level;
5541 const char *str;
5542 Jim_CallFrame *framePtr;
5544 if (levelObjPtr) {
5545 str = Jim_String(levelObjPtr);
5546 if (str[0] == '#') {
5547 char *endptr;
5549 level = jim_strtol(str + 1, &endptr);
5550 if (str[1] == '\0' || endptr[0] != '\0') {
5551 level = -1;
5554 else {
5555 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5556 level = -1;
5558 else {
5559 /* Convert from a relative to an absolute level */
5560 level = interp->framePtr->level - level;
5564 else {
5565 str = "1"; /* Needed to format the error message. */
5566 level = interp->framePtr->level - 1;
5569 if (level == 0) {
5570 return interp->topFramePtr;
5572 if (level > 0) {
5573 /* Lookup */
5574 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5575 if (framePtr->level == level) {
5576 return framePtr;
5581 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5582 return NULL;
5585 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5586 * as a relative integer like in the [info level ?level?] command.
5588 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5590 long level;
5591 Jim_CallFrame *framePtr;
5593 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5594 if (level <= 0) {
5595 /* Convert from a relative to an absolute level */
5596 level = interp->framePtr->level + level;
5599 if (level == 0) {
5600 return interp->topFramePtr;
5603 /* Lookup */
5604 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5605 if (framePtr->level == level) {
5606 return framePtr;
5611 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5612 return NULL;
5615 static void JimResetStackTrace(Jim_Interp *interp)
5617 Jim_DecrRefCount(interp, interp->stackTrace);
5618 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5619 Jim_IncrRefCount(interp->stackTrace);
5622 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5624 int len;
5626 /* Increment reference first in case these are the same object */
5627 Jim_IncrRefCount(stackTraceObj);
5628 Jim_DecrRefCount(interp, interp->stackTrace);
5629 interp->stackTrace = stackTraceObj;
5630 interp->errorFlag = 1;
5632 /* This is a bit ugly.
5633 * If the filename of the last entry of the stack trace is empty,
5634 * the next stack level should be added.
5636 len = Jim_ListLength(interp, interp->stackTrace);
5637 if (len >= 3) {
5638 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5639 interp->addStackTrace = 1;
5644 /* Returns 1 if the stack trace information was used or 0 if not */
5645 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5646 Jim_Obj *fileNameObj, int linenr)
5648 if (strcmp(procname, "unknown") == 0) {
5649 procname = "";
5651 if (!*procname && !Jim_Length(fileNameObj)) {
5652 /* No useful info here */
5653 return;
5656 if (Jim_IsShared(interp->stackTrace)) {
5657 Jim_DecrRefCount(interp, interp->stackTrace);
5658 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5659 Jim_IncrRefCount(interp->stackTrace);
5662 /* If we have no procname but the previous element did, merge with that frame */
5663 if (!*procname && Jim_Length(fileNameObj)) {
5664 /* Just a filename. Check the previous entry */
5665 int len = Jim_ListLength(interp, interp->stackTrace);
5667 if (len >= 3) {
5668 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5669 if (Jim_Length(objPtr)) {
5670 /* Yes, the previous level had procname */
5671 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5672 if (Jim_Length(objPtr) == 0) {
5673 /* But no filename, so merge the new info with that frame */
5674 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5675 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5676 return;
5682 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5683 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5684 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5687 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5688 void *data)
5690 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5692 assocEntryPtr->delProc = delProc;
5693 assocEntryPtr->data = data;
5694 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5697 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5699 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5701 if (entryPtr != NULL) {
5702 AssocDataValue *assocEntryPtr = (AssocDataValue *) entryPtr->u.val;
5704 return assocEntryPtr->data;
5706 return NULL;
5709 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5711 return Jim_DeleteHashEntry(&interp->assocData, key);
5714 int Jim_GetExitCode(Jim_Interp *interp)
5716 return interp->exitCode;
5719 /* -----------------------------------------------------------------------------
5720 * Integer object
5721 * ---------------------------------------------------------------------------*/
5722 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5723 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5725 static const Jim_ObjType intObjType = {
5726 "int",
5727 NULL,
5728 NULL,
5729 UpdateStringOfInt,
5730 JIM_TYPE_NONE,
5733 /* A coerced double is closer to an int than a double.
5734 * It is an int value temporarily masquerading as a double value.
5735 * i.e. it has the same string value as an int and Jim_GetWide()
5736 * succeeds, but also Jim_GetDouble() returns the value directly.
5738 static const Jim_ObjType coercedDoubleObjType = {
5739 "coerced-double",
5740 NULL,
5741 NULL,
5742 UpdateStringOfInt,
5743 JIM_TYPE_NONE,
5747 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5749 char buf[JIM_INTEGER_SPACE + 1];
5750 jim_wide wideValue = JimWideValue(objPtr);
5751 int pos = 0;
5753 if (wideValue == 0) {
5754 buf[pos++] = '0';
5756 else {
5757 char tmp[JIM_INTEGER_SPACE];
5758 int num = 0;
5759 int i;
5761 if (wideValue < 0) {
5762 buf[pos++] = '-';
5763 /* -106 % 10 may be -6 or 4! */
5764 i = wideValue % 10;
5765 tmp[num++] = (i > 0) ? (10 - i) : -i;
5766 wideValue /= -10;
5769 while (wideValue) {
5770 tmp[num++] = wideValue % 10;
5771 wideValue /= 10;
5774 for (i = 0; i < num; i++) {
5775 buf[pos++] = '0' + tmp[num - i - 1];
5778 buf[pos] = 0;
5780 JimSetStringBytes(objPtr, buf);
5783 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5785 jim_wide wideValue;
5786 const char *str;
5788 if (objPtr->typePtr == &coercedDoubleObjType) {
5789 /* Simple switcheroo */
5790 objPtr->typePtr = &intObjType;
5791 return JIM_OK;
5794 /* Get the string representation */
5795 str = Jim_String(objPtr);
5796 /* Try to convert into a jim_wide */
5797 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5798 if (flags & JIM_ERRMSG) {
5799 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5801 return JIM_ERR;
5803 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5804 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5805 return JIM_ERR;
5807 /* Free the old internal repr and set the new one. */
5808 Jim_FreeIntRep(interp, objPtr);
5809 objPtr->typePtr = &intObjType;
5810 objPtr->internalRep.wideValue = wideValue;
5811 return JIM_OK;
5814 #ifdef JIM_OPTIMIZATION
5815 static int JimIsWide(Jim_Obj *objPtr)
5817 return objPtr->typePtr == &intObjType;
5819 #endif
5821 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5823 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5824 return JIM_ERR;
5825 *widePtr = JimWideValue(objPtr);
5826 return JIM_OK;
5829 /* Get a wide but does not set an error if the format is bad. */
5830 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5832 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5833 return JIM_ERR;
5834 *widePtr = JimWideValue(objPtr);
5835 return JIM_OK;
5838 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5840 jim_wide wideValue;
5841 int retval;
5843 retval = Jim_GetWide(interp, objPtr, &wideValue);
5844 if (retval == JIM_OK) {
5845 *longPtr = (long)wideValue;
5846 return JIM_OK;
5848 return JIM_ERR;
5851 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5853 Jim_Obj *objPtr;
5855 objPtr = Jim_NewObj(interp);
5856 objPtr->typePtr = &intObjType;
5857 objPtr->bytes = NULL;
5858 objPtr->internalRep.wideValue = wideValue;
5859 return objPtr;
5862 /* -----------------------------------------------------------------------------
5863 * Double object
5864 * ---------------------------------------------------------------------------*/
5865 #define JIM_DOUBLE_SPACE 30
5867 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5868 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5870 static const Jim_ObjType doubleObjType = {
5871 "double",
5872 NULL,
5873 NULL,
5874 UpdateStringOfDouble,
5875 JIM_TYPE_NONE,
5878 #ifndef HAVE_ISNAN
5879 #undef isnan
5880 #define isnan(X) ((X) != (X))
5881 #endif
5882 #ifndef HAVE_ISINF
5883 #undef isinf
5884 #define isinf(X) (1.0 / (X) == 0.0)
5885 #endif
5887 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5889 double value = objPtr->internalRep.doubleValue;
5891 if (isnan(value)) {
5892 JimSetStringBytes(objPtr, "NaN");
5893 return;
5895 if (isinf(value)) {
5896 if (value < 0) {
5897 JimSetStringBytes(objPtr, "-Inf");
5899 else {
5900 JimSetStringBytes(objPtr, "Inf");
5902 return;
5905 char buf[JIM_DOUBLE_SPACE + 1];
5906 int i;
5907 int len = sprintf(buf, "%.12g", value);
5909 /* Add a final ".0" if necessary */
5910 for (i = 0; i < len; i++) {
5911 if (buf[i] == '.' || buf[i] == 'e') {
5912 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5913 /* If 'buf' ends in e-0nn or e+0nn, remove
5914 * the 0 after the + or - and reduce the length by 1
5916 char *e = strchr(buf, 'e');
5917 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5918 /* Move it up */
5919 e += 2;
5920 memmove(e, e + 1, len - (e - buf));
5922 #endif
5923 break;
5926 if (buf[i] == '\0') {
5927 buf[i++] = '.';
5928 buf[i++] = '0';
5929 buf[i] = '\0';
5931 JimSetStringBytes(objPtr, buf);
5935 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5937 double doubleValue;
5938 jim_wide wideValue;
5939 const char *str;
5941 /* Preserve the string representation.
5942 * Needed so we can convert back to int without loss
5944 str = Jim_String(objPtr);
5946 #ifdef HAVE_LONG_LONG
5947 /* Assume a 53 bit mantissa */
5948 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5949 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5951 if (objPtr->typePtr == &intObjType
5952 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5953 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5955 /* Direct conversion to coerced double */
5956 objPtr->typePtr = &coercedDoubleObjType;
5957 return JIM_OK;
5959 else
5960 #endif
5961 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5962 /* Managed to convert to an int, so we can use this as a cooerced double */
5963 Jim_FreeIntRep(interp, objPtr);
5964 objPtr->typePtr = &coercedDoubleObjType;
5965 objPtr->internalRep.wideValue = wideValue;
5966 return JIM_OK;
5968 else {
5969 /* Try to convert into a double */
5970 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
5971 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
5972 return JIM_ERR;
5974 /* Free the old internal repr and set the new one. */
5975 Jim_FreeIntRep(interp, objPtr);
5977 objPtr->typePtr = &doubleObjType;
5978 objPtr->internalRep.doubleValue = doubleValue;
5979 return JIM_OK;
5982 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
5984 if (objPtr->typePtr == &coercedDoubleObjType) {
5985 *doublePtr = JimWideValue(objPtr);
5986 return JIM_OK;
5988 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
5989 return JIM_ERR;
5991 if (objPtr->typePtr == &coercedDoubleObjType) {
5992 *doublePtr = JimWideValue(objPtr);
5994 else {
5995 *doublePtr = objPtr->internalRep.doubleValue;
5997 return JIM_OK;
6000 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6002 Jim_Obj *objPtr;
6004 objPtr = Jim_NewObj(interp);
6005 objPtr->typePtr = &doubleObjType;
6006 objPtr->bytes = NULL;
6007 objPtr->internalRep.doubleValue = doubleValue;
6008 return objPtr;
6011 /* -----------------------------------------------------------------------------
6012 * List object
6013 * ---------------------------------------------------------------------------*/
6014 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6015 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6016 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6017 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6018 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6019 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6021 /* Note that while the elements of the list may contain references,
6022 * the list object itself can't. This basically means that the
6023 * list object string representation as a whole can't contain references
6024 * that are not presents in the single elements. */
6025 static const Jim_ObjType listObjType = {
6026 "list",
6027 FreeListInternalRep,
6028 DupListInternalRep,
6029 UpdateStringOfList,
6030 JIM_TYPE_NONE,
6033 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6035 int i;
6037 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6038 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6040 Jim_Free(objPtr->internalRep.listValue.ele);
6043 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6045 int i;
6047 JIM_NOTUSED(interp);
6049 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6050 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6051 dupPtr->internalRep.listValue.ele =
6052 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6053 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6054 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6055 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6056 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6058 dupPtr->typePtr = &listObjType;
6061 /* The following function checks if a given string can be encoded
6062 * into a list element without any kind of quoting, surrounded by braces,
6063 * or using escapes to quote. */
6064 #define JIM_ELESTR_SIMPLE 0
6065 #define JIM_ELESTR_BRACE 1
6066 #define JIM_ELESTR_QUOTE 2
6067 static unsigned char ListElementQuotingType(const char *s, int len)
6069 int i, level, blevel, trySimple = 1;
6071 /* Try with the SIMPLE case */
6072 if (len == 0)
6073 return JIM_ELESTR_BRACE;
6074 if (s[0] == '"' || s[0] == '{') {
6075 trySimple = 0;
6076 goto testbrace;
6078 for (i = 0; i < len; i++) {
6079 switch (s[i]) {
6080 case ' ':
6081 case '$':
6082 case '"':
6083 case '[':
6084 case ']':
6085 case ';':
6086 case '\\':
6087 case '\r':
6088 case '\n':
6089 case '\t':
6090 case '\f':
6091 case '\v':
6092 trySimple = 0;
6093 case '{':
6094 case '}':
6095 goto testbrace;
6098 return JIM_ELESTR_SIMPLE;
6100 testbrace:
6101 /* Test if it's possible to do with braces */
6102 if (s[len - 1] == '\\')
6103 return JIM_ELESTR_QUOTE;
6104 level = 0;
6105 blevel = 0;
6106 for (i = 0; i < len; i++) {
6107 switch (s[i]) {
6108 case '{':
6109 level++;
6110 break;
6111 case '}':
6112 level--;
6113 if (level < 0)
6114 return JIM_ELESTR_QUOTE;
6115 break;
6116 case '[':
6117 blevel++;
6118 break;
6119 case ']':
6120 blevel--;
6121 break;
6122 case '\\':
6123 if (s[i + 1] == '\n')
6124 return JIM_ELESTR_QUOTE;
6125 else if (s[i + 1] != '\0')
6126 i++;
6127 break;
6130 if (blevel < 0) {
6131 return JIM_ELESTR_QUOTE;
6134 if (level == 0) {
6135 if (!trySimple)
6136 return JIM_ELESTR_BRACE;
6137 for (i = 0; i < len; i++) {
6138 switch (s[i]) {
6139 case ' ':
6140 case '$':
6141 case '"':
6142 case '[':
6143 case ']':
6144 case ';':
6145 case '\\':
6146 case '\r':
6147 case '\n':
6148 case '\t':
6149 case '\f':
6150 case '\v':
6151 return JIM_ELESTR_BRACE;
6152 break;
6155 return JIM_ELESTR_SIMPLE;
6157 return JIM_ELESTR_QUOTE;
6160 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6161 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6162 * scenario.
6163 * Returns the length of the result.
6165 static int BackslashQuoteString(const char *s, int len, char *q)
6167 char *p = q;
6169 while (len--) {
6170 switch (*s) {
6171 case ' ':
6172 case '$':
6173 case '"':
6174 case '[':
6175 case ']':
6176 case '{':
6177 case '}':
6178 case ';':
6179 case '\\':
6180 *p++ = '\\';
6181 *p++ = *s++;
6182 break;
6183 case '\n':
6184 *p++ = '\\';
6185 *p++ = 'n';
6186 s++;
6187 break;
6188 case '\r':
6189 *p++ = '\\';
6190 *p++ = 'r';
6191 s++;
6192 break;
6193 case '\t':
6194 *p++ = '\\';
6195 *p++ = 't';
6196 s++;
6197 break;
6198 case '\f':
6199 *p++ = '\\';
6200 *p++ = 'f';
6201 s++;
6202 break;
6203 case '\v':
6204 *p++ = '\\';
6205 *p++ = 'v';
6206 s++;
6207 break;
6208 default:
6209 *p++ = *s++;
6210 break;
6213 *p = '\0';
6215 return p - q;
6218 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6220 #define STATIC_QUOTING_LEN 32
6221 int i, bufLen, realLength;
6222 const char *strRep;
6223 char *p;
6224 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6226 /* Estimate the space needed. */
6227 if (objc > STATIC_QUOTING_LEN) {
6228 quotingType = Jim_Alloc(objc);
6230 else {
6231 quotingType = staticQuoting;
6233 bufLen = 0;
6234 for (i = 0; i < objc; i++) {
6235 int len;
6237 strRep = Jim_GetString(objv[i], &len);
6238 quotingType[i] = ListElementQuotingType(strRep, len);
6239 switch (quotingType[i]) {
6240 case JIM_ELESTR_SIMPLE:
6241 if (i != 0 || strRep[0] != '#') {
6242 bufLen += len;
6243 break;
6245 /* Special case '#' on first element needs braces */
6246 quotingType[i] = JIM_ELESTR_BRACE;
6247 /* fall through */
6248 case JIM_ELESTR_BRACE:
6249 bufLen += len + 2;
6250 break;
6251 case JIM_ELESTR_QUOTE:
6252 bufLen += len * 2;
6253 break;
6255 bufLen++; /* elements separator. */
6257 bufLen++;
6259 /* Generate the string rep. */
6260 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6261 realLength = 0;
6262 for (i = 0; i < objc; i++) {
6263 int len, qlen;
6265 strRep = Jim_GetString(objv[i], &len);
6267 switch (quotingType[i]) {
6268 case JIM_ELESTR_SIMPLE:
6269 memcpy(p, strRep, len);
6270 p += len;
6271 realLength += len;
6272 break;
6273 case JIM_ELESTR_BRACE:
6274 *p++ = '{';
6275 memcpy(p, strRep, len);
6276 p += len;
6277 *p++ = '}';
6278 realLength += len + 2;
6279 break;
6280 case JIM_ELESTR_QUOTE:
6281 if (i == 0 && strRep[0] == '#') {
6282 *p++ = '\\';
6283 realLength++;
6285 qlen = BackslashQuoteString(strRep, len, p);
6286 p += qlen;
6287 realLength += qlen;
6288 break;
6290 /* Add a separating space */
6291 if (i + 1 != objc) {
6292 *p++ = ' ';
6293 realLength++;
6296 *p = '\0'; /* nul term. */
6297 objPtr->length = realLength;
6299 if (quotingType != staticQuoting) {
6300 Jim_Free(quotingType);
6304 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6306 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6309 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6311 struct JimParserCtx parser;
6312 const char *str;
6313 int strLen;
6314 Jim_Obj *fileNameObj;
6315 int linenr;
6317 if (objPtr->typePtr == &listObjType) {
6318 return JIM_OK;
6321 /* Optimise dict -> list for unshared object. Note that this may only save a little time, but
6322 * it also preserves any source location of the dict elements
6323 * which can be very useful
6325 if (Jim_IsDict(objPtr) && !Jim_IsShared(objPtr)) {
6326 Jim_Obj **listObjPtrPtr;
6327 int len;
6328 int i;
6330 listObjPtrPtr = JimDictPairs(objPtr, &len);
6331 for (i = 0; i < len; i++) {
6332 Jim_IncrRefCount(listObjPtrPtr[i]);
6335 /* Now just switch the internal rep */
6336 Jim_FreeIntRep(interp, objPtr);
6337 objPtr->typePtr = &listObjType;
6338 objPtr->internalRep.listValue.len = len;
6339 objPtr->internalRep.listValue.maxLen = len;
6340 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6342 return JIM_OK;
6345 /* Try to preserve information about filename / line number */
6346 if (objPtr->typePtr == &sourceObjType) {
6347 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6348 linenr = objPtr->internalRep.sourceValue.lineNumber;
6350 else {
6351 fileNameObj = interp->emptyObj;
6352 linenr = 1;
6354 Jim_IncrRefCount(fileNameObj);
6356 /* Get the string representation */
6357 str = Jim_GetString(objPtr, &strLen);
6359 /* Free the old internal repr just now and initialize the
6360 * new one just now. The string->list conversion can't fail. */
6361 Jim_FreeIntRep(interp, objPtr);
6362 objPtr->typePtr = &listObjType;
6363 objPtr->internalRep.listValue.len = 0;
6364 objPtr->internalRep.listValue.maxLen = 0;
6365 objPtr->internalRep.listValue.ele = NULL;
6367 /* Convert into a list */
6368 if (strLen) {
6369 JimParserInit(&parser, str, strLen, linenr);
6370 while (!parser.eof) {
6371 Jim_Obj *elementPtr;
6373 JimParseList(&parser);
6374 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6375 continue;
6376 elementPtr = JimParserGetTokenObj(interp, &parser);
6377 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6378 ListAppendElement(objPtr, elementPtr);
6381 Jim_DecrRefCount(interp, fileNameObj);
6382 return JIM_OK;
6385 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6387 Jim_Obj *objPtr;
6389 objPtr = Jim_NewObj(interp);
6390 objPtr->typePtr = &listObjType;
6391 objPtr->bytes = NULL;
6392 objPtr->internalRep.listValue.ele = NULL;
6393 objPtr->internalRep.listValue.len = 0;
6394 objPtr->internalRep.listValue.maxLen = 0;
6396 if (len) {
6397 ListInsertElements(objPtr, 0, len, elements);
6400 return objPtr;
6403 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6404 * length of the vector. Note that the user of this function should make
6405 * sure that the list object can't shimmer while the vector returned
6406 * is in use, this vector is the one stored inside the internal representation
6407 * of the list object. This function is not exported, extensions should
6408 * always access to the List object elements using Jim_ListIndex(). */
6409 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6410 Jim_Obj ***listVec)
6412 *listLen = Jim_ListLength(interp, listObj);
6413 *listVec = listObj->internalRep.listValue.ele;
6416 /* Sorting uses ints, but commands may return wide */
6417 static int JimSign(jim_wide w)
6419 if (w == 0) {
6420 return 0;
6422 else if (w < 0) {
6423 return -1;
6425 return 1;
6428 /* ListSortElements type values */
6429 struct lsort_info {
6430 jmp_buf jmpbuf;
6431 Jim_Obj *command;
6432 Jim_Interp *interp;
6433 enum {
6434 JIM_LSORT_ASCII,
6435 JIM_LSORT_NOCASE,
6436 JIM_LSORT_INTEGER,
6437 JIM_LSORT_REAL,
6438 JIM_LSORT_COMMAND
6439 } type;
6440 int order;
6441 int index;
6442 int indexed;
6443 int unique;
6444 int (*subfn)(Jim_Obj **, Jim_Obj **);
6447 static struct lsort_info *sort_info;
6449 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6451 Jim_Obj *lObj, *rObj;
6453 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6454 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6455 longjmp(sort_info->jmpbuf, JIM_ERR);
6457 return sort_info->subfn(&lObj, &rObj);
6460 /* Sort the internal rep of a list. */
6461 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6463 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6466 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6468 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6471 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6473 jim_wide lhs = 0, rhs = 0;
6475 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6476 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6477 longjmp(sort_info->jmpbuf, JIM_ERR);
6480 return JimSign(lhs - rhs) * sort_info->order;
6483 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6485 double lhs = 0, rhs = 0;
6487 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6488 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6489 longjmp(sort_info->jmpbuf, JIM_ERR);
6491 if (lhs == rhs) {
6492 return 0;
6494 if (lhs > rhs) {
6495 return sort_info->order;
6497 return -sort_info->order;
6500 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6502 Jim_Obj *compare_script;
6503 int rc;
6505 jim_wide ret = 0;
6507 /* This must be a valid list */
6508 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6509 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6510 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6512 rc = Jim_EvalObj(sort_info->interp, compare_script);
6514 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6515 longjmp(sort_info->jmpbuf, rc);
6518 return JimSign(ret) * sort_info->order;
6521 /* Remove duplicate elements from the (sorted) list in-place, according to the
6522 * comparison function, comp.
6524 * Note that the last unique value is kept, not the first
6526 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6528 int src;
6529 int dst = 0;
6530 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6532 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6533 if (comp(&ele[dst], &ele[src]) == 0) {
6534 /* Match, so replace the dest with the current source */
6535 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6537 else {
6538 /* No match, so keep the current source and move to the next destination */
6539 dst++;
6541 ele[dst] = ele[src];
6543 /* At end of list, keep the final element */
6544 ele[++dst] = ele[src];
6546 /* Set the new length */
6547 listObjPtr->internalRep.listValue.len = dst;
6550 /* Sort a list *in place*. MUST be called with non-shared objects. */
6551 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6553 struct lsort_info *prev_info;
6555 typedef int (qsort_comparator) (const void *, const void *);
6556 int (*fn) (Jim_Obj **, Jim_Obj **);
6557 Jim_Obj **vector;
6558 int len;
6559 int rc;
6561 JimPanic((Jim_IsShared(listObjPtr), "Jim_ListSortElements called with shared object"));
6562 SetListFromAny(interp, listObjPtr);
6564 /* Allow lsort to be called reentrantly */
6565 prev_info = sort_info;
6566 sort_info = info;
6568 vector = listObjPtr->internalRep.listValue.ele;
6569 len = listObjPtr->internalRep.listValue.len;
6570 switch (info->type) {
6571 case JIM_LSORT_ASCII:
6572 fn = ListSortString;
6573 break;
6574 case JIM_LSORT_NOCASE:
6575 fn = ListSortStringNoCase;
6576 break;
6577 case JIM_LSORT_INTEGER:
6578 fn = ListSortInteger;
6579 break;
6580 case JIM_LSORT_REAL:
6581 fn = ListSortReal;
6582 break;
6583 case JIM_LSORT_COMMAND:
6584 fn = ListSortCommand;
6585 break;
6586 default:
6587 fn = NULL; /* avoid warning */
6588 JimPanic((1, "ListSort called with invalid sort type"));
6591 if (info->indexed) {
6592 /* Need to interpose a "list index" function */
6593 info->subfn = fn;
6594 fn = ListSortIndexHelper;
6597 if ((rc = setjmp(info->jmpbuf)) == 0) {
6598 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6600 if (info->unique && len > 1) {
6601 ListRemoveDuplicates(listObjPtr, fn);
6604 Jim_InvalidateStringRep(listObjPtr);
6606 sort_info = prev_info;
6608 return rc;
6611 /* This is the low-level function to insert elements into a list.
6612 * The higher-level Jim_ListInsertElements() performs shared object
6613 * check and invalidate the string repr. This version is used
6614 * in the internals of the List Object and is not exported.
6616 * NOTE: this function can be called only against objects
6617 * with internal type of List.
6619 * An insertion point (idx) of -1 means end-of-list.
6621 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6623 int currentLen = listPtr->internalRep.listValue.len;
6624 int requiredLen = currentLen + elemc;
6625 int i;
6626 Jim_Obj **point;
6628 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6629 if (requiredLen < 2) {
6630 /* Don't do allocations of under 4 pointers. */
6631 requiredLen = 4;
6633 else {
6634 requiredLen *= 2;
6637 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6638 sizeof(Jim_Obj *) * requiredLen);
6640 listPtr->internalRep.listValue.maxLen = requiredLen;
6642 if (idx < 0) {
6643 idx = currentLen;
6645 point = listPtr->internalRep.listValue.ele + idx;
6646 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6647 for (i = 0; i < elemc; ++i) {
6648 point[i] = elemVec[i];
6649 Jim_IncrRefCount(point[i]);
6651 listPtr->internalRep.listValue.len += elemc;
6654 /* Convenience call to ListInsertElements() to append a single element.
6656 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6658 ListInsertElements(listPtr, -1, 1, &objPtr);
6661 /* Appends every element of appendListPtr into listPtr.
6662 * Both have to be of the list type.
6663 * Convenience call to ListInsertElements()
6665 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6667 ListInsertElements(listPtr, -1,
6668 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6671 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6673 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6674 SetListFromAny(interp, listPtr);
6675 Jim_InvalidateStringRep(listPtr);
6676 ListAppendElement(listPtr, objPtr);
6679 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6681 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6682 SetListFromAny(interp, listPtr);
6683 SetListFromAny(interp, appendListPtr);
6684 Jim_InvalidateStringRep(listPtr);
6685 ListAppendList(listPtr, appendListPtr);
6688 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6690 SetListFromAny(interp, objPtr);
6691 return objPtr->internalRep.listValue.len;
6694 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6695 int objc, Jim_Obj *const *objVec)
6697 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6698 SetListFromAny(interp, listPtr);
6699 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6700 idx = listPtr->internalRep.listValue.len;
6701 else if (idx < 0)
6702 idx = 0;
6703 Jim_InvalidateStringRep(listPtr);
6704 ListInsertElements(listPtr, idx, objc, objVec);
6707 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6709 SetListFromAny(interp, listPtr);
6710 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6711 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6712 return NULL;
6714 if (idx < 0)
6715 idx = listPtr->internalRep.listValue.len + idx;
6716 return listPtr->internalRep.listValue.ele[idx];
6719 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6721 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6722 if (*objPtrPtr == NULL) {
6723 if (flags & JIM_ERRMSG) {
6724 Jim_SetResultString(interp, "list index out of range", -1);
6726 return JIM_ERR;
6728 return JIM_OK;
6731 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6732 Jim_Obj *newObjPtr, int flags)
6734 SetListFromAny(interp, listPtr);
6735 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6736 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6737 if (flags & JIM_ERRMSG) {
6738 Jim_SetResultString(interp, "list index out of range", -1);
6740 return JIM_ERR;
6742 if (idx < 0)
6743 idx = listPtr->internalRep.listValue.len + idx;
6744 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6745 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6746 Jim_IncrRefCount(newObjPtr);
6747 return JIM_OK;
6750 /* Modify the list stored into the variable named 'varNamePtr'
6751 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6752 * with the new element 'newObjptr'. */
6753 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6754 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6756 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6757 int shared, i, idx;
6759 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6760 if (objPtr == NULL)
6761 return JIM_ERR;
6762 if ((shared = Jim_IsShared(objPtr)))
6763 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6764 for (i = 0; i < indexc - 1; i++) {
6765 listObjPtr = objPtr;
6766 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6767 goto err;
6768 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6769 goto err;
6771 if (Jim_IsShared(objPtr)) {
6772 objPtr = Jim_DuplicateObj(interp, objPtr);
6773 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6775 Jim_InvalidateStringRep(listObjPtr);
6777 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6778 goto err;
6779 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6780 goto err;
6781 Jim_InvalidateStringRep(objPtr);
6782 Jim_InvalidateStringRep(varObjPtr);
6783 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6784 goto err;
6785 Jim_SetResult(interp, varObjPtr);
6786 return JIM_OK;
6787 err:
6788 if (shared) {
6789 Jim_FreeNewObj(interp, varObjPtr);
6791 return JIM_ERR;
6794 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6796 int i;
6797 int listLen = Jim_ListLength(interp, listObjPtr);
6798 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6800 for (i = 0; i < listLen; ) {
6801 Jim_Obj *objPtr;
6803 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
6804 Jim_AppendObj(interp, resObjPtr, objPtr);
6805 if (++i != listLen) {
6806 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6809 return resObjPtr;
6812 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6814 int i;
6816 /* If all the objects in objv are lists,
6817 * it's possible to return a list as result, that's the
6818 * concatenation of all the lists. */
6819 for (i = 0; i < objc; i++) {
6820 if (!Jim_IsList(objv[i]))
6821 break;
6823 if (i == objc) {
6824 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6826 for (i = 0; i < objc; i++)
6827 ListAppendList(objPtr, objv[i]);
6828 return objPtr;
6830 else {
6831 /* Else... we have to glue strings together */
6832 int len = 0, objLen;
6833 char *bytes, *p;
6835 /* Compute the length */
6836 for (i = 0; i < objc; i++) {
6837 Jim_GetString(objv[i], &objLen);
6838 len += objLen;
6840 if (objc)
6841 len += objc - 1;
6842 /* Create the string rep, and a string object holding it. */
6843 p = bytes = Jim_Alloc(len + 1);
6844 for (i = 0; i < objc; i++) {
6845 const char *s = Jim_GetString(objv[i], &objLen);
6847 /* Remove leading space */
6848 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n')) {
6849 s++;
6850 objLen--;
6851 len--;
6853 /* And trailing space */
6854 while (objLen && (s[objLen - 1] == ' ' ||
6855 s[objLen - 1] == '\n' || s[objLen - 1] == '\t')) {
6856 /* Handle trailing backslash-space case */
6857 if (objLen > 1 && s[objLen - 2] == '\\') {
6858 break;
6860 objLen--;
6861 len--;
6863 memcpy(p, s, objLen);
6864 p += objLen;
6865 if (objLen && i + 1 != objc) {
6866 *p++ = ' ';
6868 else if (i + 1 != objc) {
6869 /* Drop the space calcuated for this
6870 * element that is instead null. */
6871 len--;
6874 *p = '\0';
6875 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6879 /* Returns a list composed of the elements in the specified range.
6880 * first and start are directly accepted as Jim_Objects and
6881 * processed for the end?-index? case. */
6882 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6883 Jim_Obj *lastObjPtr)
6885 int first, last;
6886 int len, rangeLen;
6888 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6889 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6890 return NULL;
6891 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6892 first = JimRelToAbsIndex(len, first);
6893 last = JimRelToAbsIndex(len, last);
6894 JimRelToAbsRange(len, &first, &last, &rangeLen);
6895 if (first == 0 && last == len) {
6896 return listObjPtr;
6898 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6901 /* -----------------------------------------------------------------------------
6902 * Dict object
6903 * ---------------------------------------------------------------------------*/
6904 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6905 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6906 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6907 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6909 /* Dict HashTable Type.
6911 * Keys and Values are Jim objects. */
6913 static unsigned int JimObjectHTHashFunction(const void *key)
6915 int len;
6916 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6917 return Jim_GenHashFunction((const unsigned char *)str, len);
6920 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6922 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6925 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6927 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6930 static const Jim_HashTableType JimDictHashTableType = {
6931 JimObjectHTHashFunction, /* hash function */
6932 NULL, /* key dup */
6933 NULL, /* val dup */
6934 JimObjectHTKeyCompare, /* key compare */
6935 JimObjectHTKeyValDestructor, /* key destructor */
6936 JimObjectHTKeyValDestructor /* val destructor */
6939 /* Note that while the elements of the dict may contain references,
6940 * the list object itself can't. This basically means that the
6941 * dict object string representation as a whole can't contain references
6942 * that are not presents in the single elements. */
6943 static const Jim_ObjType dictObjType = {
6944 "dict",
6945 FreeDictInternalRep,
6946 DupDictInternalRep,
6947 UpdateStringOfDict,
6948 JIM_TYPE_NONE,
6951 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6953 JIM_NOTUSED(interp);
6955 Jim_FreeHashTable(objPtr->internalRep.ptr);
6956 Jim_Free(objPtr->internalRep.ptr);
6959 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6961 Jim_HashTable *ht, *dupHt;
6962 Jim_HashTableIterator htiter;
6963 Jim_HashEntry *he;
6965 /* Create a new hash table */
6966 ht = srcPtr->internalRep.ptr;
6967 dupHt = Jim_Alloc(sizeof(*dupHt));
6968 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
6969 if (ht->size != 0)
6970 Jim_ExpandHashTable(dupHt, ht->size);
6971 /* Copy every element from the source to the dup hash table */
6972 JimInitHashTableIterator(ht, &htiter);
6973 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6974 const Jim_Obj *keyObjPtr = he->key;
6975 Jim_Obj *valObjPtr = he->u.val;
6977 Jim_IncrRefCount((Jim_Obj *)keyObjPtr); /* ATTENTION: const cast */
6978 Jim_IncrRefCount(valObjPtr);
6979 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
6982 dupPtr->internalRep.ptr = dupHt;
6983 dupPtr->typePtr = &dictObjType;
6986 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
6988 Jim_HashTable *ht;
6989 Jim_HashTableIterator htiter;
6990 Jim_HashEntry *he;
6991 Jim_Obj **objv;
6992 int i;
6994 ht = dictPtr->internalRep.ptr;
6996 /* Turn the hash table into a flat vector of Jim_Objects. */
6997 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
6998 JimInitHashTableIterator(ht, &htiter);
6999 i = 0;
7000 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7001 objv[i++] = (Jim_Obj *)he->key;
7002 objv[i++] = he->u.val;
7004 *len = i;
7005 return objv;
7008 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7010 /* Turn the hash table into a flat vector of Jim_Objects. */
7011 int len;
7012 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7014 JimMakeListStringRep(objPtr, objv, len);
7016 Jim_Free(objv);
7019 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7021 int listlen;
7023 if (objPtr->typePtr == &dictObjType) {
7024 return JIM_OK;
7027 /* Get the string representation. Do this first so we don't
7028 * change order in case of fast conversion to dict.
7030 Jim_String(objPtr);
7032 /* For simplicity, convert a non-list object to a list and then to a dict */
7033 listlen = Jim_ListLength(interp, objPtr);
7034 if (listlen % 2) {
7035 Jim_SetResultString(interp, "missing value to go with key", -1);
7036 return JIM_ERR;
7038 else {
7039 /* Now it is easy to convert to a dict from a list, and it can't fail */
7040 Jim_HashTable *ht;
7041 int i;
7043 ht = Jim_Alloc(sizeof(*ht));
7044 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7046 for (i = 0; i < listlen; i += 2) {
7047 Jim_Obj *keyObjPtr;
7048 Jim_Obj *valObjPtr;
7050 Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
7051 Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
7053 Jim_IncrRefCount(keyObjPtr);
7054 Jim_IncrRefCount(valObjPtr);
7056 if (Jim_AddHashEntry(ht, keyObjPtr, valObjPtr) != JIM_OK) {
7057 Jim_HashEntry *he;
7059 he = Jim_FindHashEntry(ht, keyObjPtr);
7060 Jim_DecrRefCount(interp, keyObjPtr);
7061 /* ATTENTION: const cast */
7062 Jim_DecrRefCount(interp, (Jim_Obj *)he->u.val);
7063 he->u.val = valObjPtr;
7067 Jim_FreeIntRep(interp, objPtr);
7068 objPtr->typePtr = &dictObjType;
7069 objPtr->internalRep.ptr = ht;
7071 return JIM_OK;
7075 /* Dict object API */
7077 /* Add an element to a dict. objPtr must be of the "dict" type.
7078 * The higer-level exported function is Jim_DictAddElement().
7079 * If an element with the specified key already exists, the value
7080 * associated is replaced with the new one.
7082 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7083 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7084 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7086 Jim_HashTable *ht = objPtr->internalRep.ptr;
7088 if (valueObjPtr == NULL) { /* unset */
7089 return Jim_DeleteHashEntry(ht, keyObjPtr);
7091 Jim_IncrRefCount(keyObjPtr);
7092 Jim_IncrRefCount(valueObjPtr);
7093 if (Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr)) {
7094 /* Value existed, so need to decrement key ref count */
7095 Jim_DecrRefCount(interp, keyObjPtr);
7097 return JIM_OK;
7100 /* Add an element, higher-level interface for DictAddElement().
7101 * If valueObjPtr == NULL, the key is removed if it exists. */
7102 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7103 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7105 int retcode;
7107 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7108 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7109 return JIM_ERR;
7111 retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7112 Jim_InvalidateStringRep(objPtr);
7113 return retcode;
7116 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7118 Jim_Obj *objPtr;
7119 int i;
7121 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7123 objPtr = Jim_NewObj(interp);
7124 objPtr->typePtr = &dictObjType;
7125 objPtr->bytes = NULL;
7126 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7127 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7128 for (i = 0; i < len; i += 2)
7129 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7130 return objPtr;
7133 /* Return the value associated to the specified dict key
7134 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7136 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7137 Jim_Obj **objPtrPtr, int flags)
7139 Jim_HashEntry *he;
7140 Jim_HashTable *ht;
7142 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7143 return -1;
7145 ht = dictPtr->internalRep.ptr;
7146 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7147 if (flags & JIM_ERRMSG) {
7148 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7150 return JIM_ERR;
7152 *objPtrPtr = he->u.val;
7153 return JIM_OK;
7156 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7157 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7159 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7160 return JIM_ERR;
7162 *objPtrPtr = JimDictPairs(dictPtr, len);
7164 return JIM_OK;
7168 /* Return the value associated to the specified dict keys */
7169 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7170 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7172 int i;
7174 if (keyc == 0) {
7175 *objPtrPtr = dictPtr;
7176 return JIM_OK;
7179 for (i = 0; i < keyc; i++) {
7180 Jim_Obj *objPtr;
7182 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7183 if (rc != JIM_OK) {
7184 return rc;
7186 dictPtr = objPtr;
7188 *objPtrPtr = dictPtr;
7189 return JIM_OK;
7192 /* Modify the dict stored into the variable named 'varNamePtr'
7193 * setting the element specified by the 'keyc' keys objects in 'keyv',
7194 * with the new value of the element 'newObjPtr'.
7196 * If newObjPtr == NULL the operation is to remove the given key
7197 * from the dictionary.
7199 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7200 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7202 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7203 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7205 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7206 int shared, i;
7208 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7209 if (objPtr == NULL) {
7210 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7211 /* Cannot remove a key from non existing var */
7212 return JIM_ERR;
7214 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7215 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7216 Jim_FreeNewObj(interp, varObjPtr);
7217 return JIM_ERR;
7220 if ((shared = Jim_IsShared(objPtr)))
7221 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7222 for (i = 0; i < keyc; i++) {
7223 dictObjPtr = objPtr;
7225 /* Check if it's a valid dictionary */
7226 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7227 goto err;
7230 if (i == keyc - 1) {
7231 /* Last key: Note that error on unset with missing last key is OK */
7232 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7233 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7234 goto err;
7237 break;
7240 /* Check if the given key exists. */
7241 Jim_InvalidateStringRep(dictObjPtr);
7242 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7243 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7244 /* This key exists at the current level.
7245 * Make sure it's not shared!. */
7246 if (Jim_IsShared(objPtr)) {
7247 objPtr = Jim_DuplicateObj(interp, objPtr);
7248 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7251 else {
7252 /* Key not found. If it's an [unset] operation
7253 * this is an error. Only the last key may not
7254 * exist. */
7255 if (newObjPtr == NULL) {
7256 goto err;
7258 /* Otherwise set an empty dictionary
7259 * as key's value. */
7260 objPtr = Jim_NewDictObj(interp, NULL, 0);
7261 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7264 Jim_InvalidateStringRep(objPtr);
7265 Jim_InvalidateStringRep(varObjPtr);
7266 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7267 goto err;
7269 Jim_SetResult(interp, varObjPtr);
7270 return JIM_OK;
7271 err:
7272 if (shared) {
7273 Jim_FreeNewObj(interp, varObjPtr);
7275 return JIM_ERR;
7278 /* -----------------------------------------------------------------------------
7279 * Index object
7280 * ---------------------------------------------------------------------------*/
7281 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7282 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7284 static const Jim_ObjType indexObjType = {
7285 "index",
7286 NULL,
7287 NULL,
7288 UpdateStringOfIndex,
7289 JIM_TYPE_NONE,
7292 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7294 if (objPtr->internalRep.intValue == -1) {
7295 JimSetStringBytes(objPtr, "end");
7297 else {
7298 char buf[JIM_INTEGER_SPACE + 1];
7299 if (objPtr->internalRep.intValue >= 0) {
7300 sprintf(buf, "%d", objPtr->internalRep.intValue);
7302 else {
7303 /* Must be <= -2 */
7304 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7306 JimSetStringBytes(objPtr, buf);
7310 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7312 int idx, end = 0;
7313 const char *str;
7314 char *endptr;
7316 /* Get the string representation */
7317 str = Jim_String(objPtr);
7319 /* Try to convert into an index */
7320 if (strncmp(str, "end", 3) == 0) {
7321 end = 1;
7322 str += 3;
7323 idx = 0;
7325 else {
7326 idx = jim_strtol(str, &endptr);
7328 if (endptr == str) {
7329 goto badindex;
7331 str = endptr;
7334 /* Now str may include or +<num> or -<num> */
7335 if (*str == '+' || *str == '-') {
7336 int sign = (*str == '+' ? 1 : -1);
7338 idx += sign * jim_strtol(++str, &endptr);
7339 if (str == endptr || *endptr) {
7340 goto badindex;
7342 str = endptr;
7344 /* The only thing left should be spaces */
7345 while (isspace(UCHAR(*str))) {
7346 str++;
7348 if (*str) {
7349 goto badindex;
7351 if (end) {
7352 if (idx > 0) {
7353 idx = INT_MAX;
7355 else {
7356 /* end-1 is repesented as -2 */
7357 idx--;
7360 else if (idx < 0) {
7361 idx = -INT_MAX;
7364 /* Free the old internal repr and set the new one. */
7365 Jim_FreeIntRep(interp, objPtr);
7366 objPtr->typePtr = &indexObjType;
7367 objPtr->internalRep.intValue = idx;
7368 return JIM_OK;
7370 badindex:
7371 Jim_SetResultFormatted(interp,
7372 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7373 return JIM_ERR;
7376 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7378 /* Avoid shimmering if the object is an integer. */
7379 if (objPtr->typePtr == &intObjType) {
7380 jim_wide val = JimWideValue(objPtr);
7382 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
7383 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
7384 return JIM_OK;
7387 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7388 return JIM_ERR;
7389 *indexPtr = objPtr->internalRep.intValue;
7390 return JIM_OK;
7393 /* -----------------------------------------------------------------------------
7394 * Return Code Object.
7395 * ---------------------------------------------------------------------------*/
7397 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7398 static const char * const jimReturnCodes[] = {
7399 "ok",
7400 "error",
7401 "return",
7402 "break",
7403 "continue",
7404 "signal",
7405 "exit",
7406 "eval",
7407 NULL
7410 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7412 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
7414 static const Jim_ObjType returnCodeObjType = {
7415 "return-code",
7416 NULL,
7417 NULL,
7418 NULL,
7419 JIM_TYPE_NONE,
7422 /* Converts a (standard) return code to a string. Returns "?" for
7423 * non-standard return codes.
7425 const char *Jim_ReturnCode(int code)
7427 if (code < 0 || code >= (int)jimReturnCodesSize) {
7428 return "?";
7430 else {
7431 return jimReturnCodes[code];
7435 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7437 int returnCode;
7438 jim_wide wideValue;
7440 /* Try to convert into an integer */
7441 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7442 returnCode = (int)wideValue;
7443 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7444 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7445 return JIM_ERR;
7447 /* Free the old internal repr and set the new one. */
7448 Jim_FreeIntRep(interp, objPtr);
7449 objPtr->typePtr = &returnCodeObjType;
7450 objPtr->internalRep.intValue = returnCode;
7451 return JIM_OK;
7454 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7456 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7457 return JIM_ERR;
7458 *intPtr = objPtr->internalRep.intValue;
7459 return JIM_OK;
7462 /* -----------------------------------------------------------------------------
7463 * Expression Parsing
7464 * ---------------------------------------------------------------------------*/
7465 static int JimParseExprOperator(struct JimParserCtx *pc);
7466 static int JimParseExprNumber(struct JimParserCtx *pc);
7467 static int JimParseExprIrrational(struct JimParserCtx *pc);
7469 /* Exrp's Stack machine operators opcodes. */
7471 /* Binary operators (numbers) */
7472 enum
7474 /* Continues on from the JIM_TT_ space */
7475 /* Operations */
7476 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7477 JIM_EXPROP_DIV,
7478 JIM_EXPROP_MOD,
7479 JIM_EXPROP_SUB,
7480 JIM_EXPROP_ADD,
7481 JIM_EXPROP_LSHIFT,
7482 JIM_EXPROP_RSHIFT,
7483 JIM_EXPROP_ROTL,
7484 JIM_EXPROP_ROTR,
7485 JIM_EXPROP_LT,
7486 JIM_EXPROP_GT,
7487 JIM_EXPROP_LTE,
7488 JIM_EXPROP_GTE,
7489 JIM_EXPROP_NUMEQ,
7490 JIM_EXPROP_NUMNE,
7491 JIM_EXPROP_BITAND, /* 35 */
7492 JIM_EXPROP_BITXOR,
7493 JIM_EXPROP_BITOR,
7495 /* Note must keep these together */
7496 JIM_EXPROP_LOGICAND, /* 38 */
7497 JIM_EXPROP_LOGICAND_LEFT,
7498 JIM_EXPROP_LOGICAND_RIGHT,
7500 /* and these */
7501 JIM_EXPROP_LOGICOR, /* 41 */
7502 JIM_EXPROP_LOGICOR_LEFT,
7503 JIM_EXPROP_LOGICOR_RIGHT,
7505 /* and these */
7506 /* Ternary operators */
7507 JIM_EXPROP_TERNARY, /* 44 */
7508 JIM_EXPROP_TERNARY_LEFT,
7509 JIM_EXPROP_TERNARY_RIGHT,
7511 /* and these */
7512 JIM_EXPROP_COLON, /* 47 */
7513 JIM_EXPROP_COLON_LEFT,
7514 JIM_EXPROP_COLON_RIGHT,
7516 JIM_EXPROP_POW, /* 50 */
7518 /* Binary operators (strings) */
7519 JIM_EXPROP_STREQ, /* 51 */
7520 JIM_EXPROP_STRNE,
7521 JIM_EXPROP_STRIN,
7522 JIM_EXPROP_STRNI,
7524 /* Unary operators (numbers) */
7525 JIM_EXPROP_NOT, /* 55 */
7526 JIM_EXPROP_BITNOT,
7527 JIM_EXPROP_UNARYMINUS,
7528 JIM_EXPROP_UNARYPLUS,
7530 /* Functions */
7531 JIM_EXPROP_FUNC_FIRST, /* 59 */
7532 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7533 JIM_EXPROP_FUNC_ABS,
7534 JIM_EXPROP_FUNC_DOUBLE,
7535 JIM_EXPROP_FUNC_ROUND,
7536 JIM_EXPROP_FUNC_RAND,
7537 JIM_EXPROP_FUNC_SRAND,
7539 /* math functions from libm */
7540 JIM_EXPROP_FUNC_SIN, /* 64 */
7541 JIM_EXPROP_FUNC_COS,
7542 JIM_EXPROP_FUNC_TAN,
7543 JIM_EXPROP_FUNC_ASIN,
7544 JIM_EXPROP_FUNC_ACOS,
7545 JIM_EXPROP_FUNC_ATAN,
7546 JIM_EXPROP_FUNC_SINH,
7547 JIM_EXPROP_FUNC_COSH,
7548 JIM_EXPROP_FUNC_TANH,
7549 JIM_EXPROP_FUNC_CEIL,
7550 JIM_EXPROP_FUNC_FLOOR,
7551 JIM_EXPROP_FUNC_EXP,
7552 JIM_EXPROP_FUNC_LOG,
7553 JIM_EXPROP_FUNC_LOG10,
7554 JIM_EXPROP_FUNC_SQRT,
7555 JIM_EXPROP_FUNC_POW,
7558 struct JimExprState
7560 Jim_Obj **stack;
7561 int stacklen;
7562 int opcode;
7563 int skip;
7566 /* Operators table */
7567 typedef struct Jim_ExprOperator
7569 const char *name;
7570 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7571 unsigned char precedence;
7572 unsigned char arity;
7573 unsigned char lazy;
7574 unsigned char namelen;
7575 } Jim_ExprOperator;
7577 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7579 Jim_IncrRefCount(obj);
7580 e->stack[e->stacklen++] = obj;
7583 static Jim_Obj *ExprPop(struct JimExprState *e)
7585 return e->stack[--e->stacklen];
7588 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7590 int intresult = 0;
7591 int rc = JIM_OK;
7592 Jim_Obj *A = ExprPop(e);
7593 double dA, dC = 0;
7594 jim_wide wA, wC = 0;
7596 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7597 intresult = 1;
7599 switch (e->opcode) {
7600 case JIM_EXPROP_FUNC_INT:
7601 wC = wA;
7602 break;
7603 case JIM_EXPROP_FUNC_ROUND:
7604 wC = wA;
7605 break;
7606 case JIM_EXPROP_FUNC_DOUBLE:
7607 dC = wA;
7608 intresult = 0;
7609 break;
7610 case JIM_EXPROP_FUNC_ABS:
7611 wC = wA >= 0 ? wA : -wA;
7612 break;
7613 case JIM_EXPROP_UNARYMINUS:
7614 wC = -wA;
7615 break;
7616 case JIM_EXPROP_UNARYPLUS:
7617 wC = wA;
7618 break;
7619 case JIM_EXPROP_NOT:
7620 wC = !wA;
7621 break;
7622 default:
7623 abort();
7626 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7627 switch (e->opcode) {
7628 case JIM_EXPROP_FUNC_INT:
7629 wC = dA;
7630 intresult = 1;
7631 break;
7632 case JIM_EXPROP_FUNC_ROUND:
7633 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7634 intresult = 1;
7635 break;
7636 case JIM_EXPROP_FUNC_DOUBLE:
7637 dC = dA;
7638 break;
7639 case JIM_EXPROP_FUNC_ABS:
7640 dC = dA >= 0 ? dA : -dA;
7641 break;
7642 case JIM_EXPROP_UNARYMINUS:
7643 dC = -dA;
7644 break;
7645 case JIM_EXPROP_UNARYPLUS:
7646 dC = dA;
7647 break;
7648 case JIM_EXPROP_NOT:
7649 wC = !dA;
7650 intresult = 1;
7651 break;
7652 default:
7653 abort();
7657 if (rc == JIM_OK) {
7658 if (intresult) {
7659 ExprPush(e, Jim_NewIntObj(interp, wC));
7661 else {
7662 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7666 Jim_DecrRefCount(interp, A);
7668 return rc;
7671 static double JimRandDouble(Jim_Interp *interp)
7673 unsigned long x;
7674 JimRandomBytes(interp, &x, sizeof(x));
7676 return (double)x / (unsigned long)~0;
7679 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7681 Jim_Obj *A = ExprPop(e);
7682 jim_wide wA;
7684 int rc = Jim_GetWide(interp, A, &wA);
7685 if (rc == JIM_OK) {
7686 switch (e->opcode) {
7687 case JIM_EXPROP_BITNOT:
7688 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7689 break;
7690 case JIM_EXPROP_FUNC_SRAND:
7691 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7692 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7693 break;
7694 default:
7695 abort();
7699 Jim_DecrRefCount(interp, A);
7701 return rc;
7704 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7706 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7708 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7710 return JIM_OK;
7713 #ifdef JIM_MATH_FUNCTIONS
7714 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7716 int rc;
7717 Jim_Obj *A = ExprPop(e);
7718 double dA, dC;
7720 rc = Jim_GetDouble(interp, A, &dA);
7721 if (rc == JIM_OK) {
7722 switch (e->opcode) {
7723 case JIM_EXPROP_FUNC_SIN:
7724 dC = sin(dA);
7725 break;
7726 case JIM_EXPROP_FUNC_COS:
7727 dC = cos(dA);
7728 break;
7729 case JIM_EXPROP_FUNC_TAN:
7730 dC = tan(dA);
7731 break;
7732 case JIM_EXPROP_FUNC_ASIN:
7733 dC = asin(dA);
7734 break;
7735 case JIM_EXPROP_FUNC_ACOS:
7736 dC = acos(dA);
7737 break;
7738 case JIM_EXPROP_FUNC_ATAN:
7739 dC = atan(dA);
7740 break;
7741 case JIM_EXPROP_FUNC_SINH:
7742 dC = sinh(dA);
7743 break;
7744 case JIM_EXPROP_FUNC_COSH:
7745 dC = cosh(dA);
7746 break;
7747 case JIM_EXPROP_FUNC_TANH:
7748 dC = tanh(dA);
7749 break;
7750 case JIM_EXPROP_FUNC_CEIL:
7751 dC = ceil(dA);
7752 break;
7753 case JIM_EXPROP_FUNC_FLOOR:
7754 dC = floor(dA);
7755 break;
7756 case JIM_EXPROP_FUNC_EXP:
7757 dC = exp(dA);
7758 break;
7759 case JIM_EXPROP_FUNC_LOG:
7760 dC = log(dA);
7761 break;
7762 case JIM_EXPROP_FUNC_LOG10:
7763 dC = log10(dA);
7764 break;
7765 case JIM_EXPROP_FUNC_SQRT:
7766 dC = sqrt(dA);
7767 break;
7768 default:
7769 abort();
7771 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7774 Jim_DecrRefCount(interp, A);
7776 return rc;
7778 #endif
7780 /* A binary operation on two ints */
7781 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7783 Jim_Obj *B = ExprPop(e);
7784 Jim_Obj *A = ExprPop(e);
7785 jim_wide wA, wB;
7786 int rc = JIM_ERR;
7788 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7789 jim_wide wC;
7791 rc = JIM_OK;
7793 switch (e->opcode) {
7794 case JIM_EXPROP_LSHIFT:
7795 wC = wA << wB;
7796 break;
7797 case JIM_EXPROP_RSHIFT:
7798 wC = wA >> wB;
7799 break;
7800 case JIM_EXPROP_BITAND:
7801 wC = wA & wB;
7802 break;
7803 case JIM_EXPROP_BITXOR:
7804 wC = wA ^ wB;
7805 break;
7806 case JIM_EXPROP_BITOR:
7807 wC = wA | wB;
7808 break;
7809 case JIM_EXPROP_MOD:
7810 if (wB == 0) {
7811 wC = 0;
7812 Jim_SetResultString(interp, "Division by zero", -1);
7813 rc = JIM_ERR;
7815 else {
7817 * From Tcl 8.x
7819 * This code is tricky: C doesn't guarantee much
7820 * about the quotient or remainder, but Tcl does.
7821 * The remainder always has the same sign as the
7822 * divisor and a smaller absolute value.
7824 int negative = 0;
7826 if (wB < 0) {
7827 wB = -wB;
7828 wA = -wA;
7829 negative = 1;
7831 wC = wA % wB;
7832 if (wC < 0) {
7833 wC += wB;
7835 if (negative) {
7836 wC = -wC;
7839 break;
7840 case JIM_EXPROP_ROTL:
7841 case JIM_EXPROP_ROTR:{
7842 /* uint32_t would be better. But not everyone has inttypes.h? */
7843 unsigned long uA = (unsigned long)wA;
7844 unsigned long uB = (unsigned long)wB;
7845 const unsigned int S = sizeof(unsigned long) * 8;
7847 /* Shift left by the word size or more is undefined. */
7848 uB %= S;
7850 if (e->opcode == JIM_EXPROP_ROTR) {
7851 uB = S - uB;
7853 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7854 break;
7856 default:
7857 abort();
7859 ExprPush(e, Jim_NewIntObj(interp, wC));
7863 Jim_DecrRefCount(interp, A);
7864 Jim_DecrRefCount(interp, B);
7866 return rc;
7870 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7871 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7873 int intresult = 0;
7874 int rc = JIM_OK;
7875 double dA, dB, dC = 0;
7876 jim_wide wA, wB, wC = 0;
7878 Jim_Obj *B = ExprPop(e);
7879 Jim_Obj *A = ExprPop(e);
7881 if ((A->typePtr != &doubleObjType || A->bytes) &&
7882 (B->typePtr != &doubleObjType || B->bytes) &&
7883 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7885 /* Both are ints */
7887 intresult = 1;
7889 switch (e->opcode) {
7890 case JIM_EXPROP_POW:
7891 case JIM_EXPROP_FUNC_POW:
7892 wC = JimPowWide(wA, wB);
7893 break;
7894 case JIM_EXPROP_ADD:
7895 wC = wA + wB;
7896 break;
7897 case JIM_EXPROP_SUB:
7898 wC = wA - wB;
7899 break;
7900 case JIM_EXPROP_MUL:
7901 wC = wA * wB;
7902 break;
7903 case JIM_EXPROP_DIV:
7904 if (wB == 0) {
7905 Jim_SetResultString(interp, "Division by zero", -1);
7906 rc = JIM_ERR;
7908 else {
7910 * From Tcl 8.x
7912 * This code is tricky: C doesn't guarantee much
7913 * about the quotient or remainder, but Tcl does.
7914 * The remainder always has the same sign as the
7915 * divisor and a smaller absolute value.
7917 if (wB < 0) {
7918 wB = -wB;
7919 wA = -wA;
7921 wC = wA / wB;
7922 if (wA % wB < 0) {
7923 wC--;
7926 break;
7927 case JIM_EXPROP_LT:
7928 wC = wA < wB;
7929 break;
7930 case JIM_EXPROP_GT:
7931 wC = wA > wB;
7932 break;
7933 case JIM_EXPROP_LTE:
7934 wC = wA <= wB;
7935 break;
7936 case JIM_EXPROP_GTE:
7937 wC = wA >= wB;
7938 break;
7939 case JIM_EXPROP_NUMEQ:
7940 wC = wA == wB;
7941 break;
7942 case JIM_EXPROP_NUMNE:
7943 wC = wA != wB;
7944 break;
7945 default:
7946 abort();
7949 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7950 switch (e->opcode) {
7951 case JIM_EXPROP_POW:
7952 case JIM_EXPROP_FUNC_POW:
7953 #ifdef JIM_MATH_FUNCTIONS
7954 dC = pow(dA, dB);
7955 #else
7956 Jim_SetResultString(interp, "unsupported", -1);
7957 rc = JIM_ERR;
7958 #endif
7959 break;
7960 case JIM_EXPROP_ADD:
7961 dC = dA + dB;
7962 break;
7963 case JIM_EXPROP_SUB:
7964 dC = dA - dB;
7965 break;
7966 case JIM_EXPROP_MUL:
7967 dC = dA * dB;
7968 break;
7969 case JIM_EXPROP_DIV:
7970 if (dB == 0) {
7971 #ifdef INFINITY
7972 dC = dA < 0 ? -INFINITY : INFINITY;
7973 #else
7974 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7975 #endif
7977 else {
7978 dC = dA / dB;
7980 break;
7981 case JIM_EXPROP_LT:
7982 wC = dA < dB;
7983 intresult = 1;
7984 break;
7985 case JIM_EXPROP_GT:
7986 wC = dA > dB;
7987 intresult = 1;
7988 break;
7989 case JIM_EXPROP_LTE:
7990 wC = dA <= dB;
7991 intresult = 1;
7992 break;
7993 case JIM_EXPROP_GTE:
7994 wC = dA >= dB;
7995 intresult = 1;
7996 break;
7997 case JIM_EXPROP_NUMEQ:
7998 wC = dA == dB;
7999 intresult = 1;
8000 break;
8001 case JIM_EXPROP_NUMNE:
8002 wC = dA != dB;
8003 intresult = 1;
8004 break;
8005 default:
8006 abort();
8009 else {
8010 /* Handle the string case */
8012 /* REVISIT: Could optimise the eq/ne case by checking lengths */
8013 int i = Jim_StringCompareObj(interp, A, B, 0);
8015 intresult = 1;
8017 switch (e->opcode) {
8018 case JIM_EXPROP_LT:
8019 wC = i < 0;
8020 break;
8021 case JIM_EXPROP_GT:
8022 wC = i > 0;
8023 break;
8024 case JIM_EXPROP_LTE:
8025 wC = i <= 0;
8026 break;
8027 case JIM_EXPROP_GTE:
8028 wC = i >= 0;
8029 break;
8030 case JIM_EXPROP_NUMEQ:
8031 wC = i == 0;
8032 break;
8033 case JIM_EXPROP_NUMNE:
8034 wC = i != 0;
8035 break;
8036 default:
8037 rc = JIM_ERR;
8038 break;
8042 if (rc == JIM_OK) {
8043 if (intresult) {
8044 ExprPush(e, Jim_NewIntObj(interp, wC));
8046 else {
8047 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8051 Jim_DecrRefCount(interp, A);
8052 Jim_DecrRefCount(interp, B);
8054 return rc;
8057 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8059 int listlen;
8060 int i;
8062 listlen = Jim_ListLength(interp, listObjPtr);
8063 for (i = 0; i < listlen; i++) {
8064 Jim_Obj *objPtr;
8066 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
8068 if (Jim_StringEqObj(objPtr, valObj)) {
8069 return 1;
8072 return 0;
8075 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8077 Jim_Obj *B = ExprPop(e);
8078 Jim_Obj *A = ExprPop(e);
8080 jim_wide wC;
8082 switch (e->opcode) {
8083 case JIM_EXPROP_STREQ:
8084 case JIM_EXPROP_STRNE: {
8085 int Alen, Blen;
8086 const char *sA = Jim_GetString(A, &Alen);
8087 const char *sB = Jim_GetString(B, &Blen);
8089 if (e->opcode == JIM_EXPROP_STREQ) {
8090 wC = (Alen == Blen && memcmp(sA, sB, Alen) == 0);
8092 else {
8093 wC = (Alen != Blen || memcmp(sA, sB, Alen) != 0);
8095 break;
8097 case JIM_EXPROP_STRIN:
8098 wC = JimSearchList(interp, B, A);
8099 break;
8100 case JIM_EXPROP_STRNI:
8101 wC = !JimSearchList(interp, B, A);
8102 break;
8103 default:
8104 abort();
8106 ExprPush(e, Jim_NewIntObj(interp, wC));
8108 Jim_DecrRefCount(interp, A);
8109 Jim_DecrRefCount(interp, B);
8111 return JIM_OK;
8114 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8116 long l;
8117 double d;
8119 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8120 return l != 0;
8122 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8123 return d != 0;
8125 return -1;
8128 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8130 Jim_Obj *skip = ExprPop(e);
8131 Jim_Obj *A = ExprPop(e);
8132 int rc = JIM_OK;
8134 switch (ExprBool(interp, A)) {
8135 case 0:
8136 /* false, so skip RHS opcodes with a 0 result */
8137 e->skip = JimWideValue(skip);
8138 ExprPush(e, Jim_NewIntObj(interp, 0));
8139 break;
8141 case 1:
8142 /* true so continue */
8143 break;
8145 case -1:
8146 /* Invalid */
8147 rc = JIM_ERR;
8149 Jim_DecrRefCount(interp, A);
8150 Jim_DecrRefCount(interp, skip);
8152 return rc;
8155 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8157 Jim_Obj *skip = ExprPop(e);
8158 Jim_Obj *A = ExprPop(e);
8159 int rc = JIM_OK;
8161 switch (ExprBool(interp, A)) {
8162 case 0:
8163 /* false, so do nothing */
8164 break;
8166 case 1:
8167 /* true so skip RHS opcodes with a 1 result */
8168 e->skip = JimWideValue(skip);
8169 ExprPush(e, Jim_NewIntObj(interp, 1));
8170 break;
8172 case -1:
8173 /* Invalid */
8174 rc = JIM_ERR;
8175 break;
8177 Jim_DecrRefCount(interp, A);
8178 Jim_DecrRefCount(interp, skip);
8180 return rc;
8183 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8185 Jim_Obj *A = ExprPop(e);
8186 int rc = JIM_OK;
8188 switch (ExprBool(interp, A)) {
8189 case 0:
8190 ExprPush(e, Jim_NewIntObj(interp, 0));
8191 break;
8193 case 1:
8194 ExprPush(e, Jim_NewIntObj(interp, 1));
8195 break;
8197 case -1:
8198 /* Invalid */
8199 rc = JIM_ERR;
8200 break;
8202 Jim_DecrRefCount(interp, A);
8204 return rc;
8207 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8209 Jim_Obj *skip = ExprPop(e);
8210 Jim_Obj *A = ExprPop(e);
8211 int rc = JIM_OK;
8213 /* Repush A */
8214 ExprPush(e, A);
8216 switch (ExprBool(interp, A)) {
8217 case 0:
8218 /* false, skip RHS opcodes */
8219 e->skip = JimWideValue(skip);
8220 /* Push a dummy value */
8221 ExprPush(e, Jim_NewIntObj(interp, 0));
8222 break;
8224 case 1:
8225 /* true so do nothing */
8226 break;
8228 case -1:
8229 /* Invalid */
8230 rc = JIM_ERR;
8231 break;
8233 Jim_DecrRefCount(interp, A);
8234 Jim_DecrRefCount(interp, skip);
8236 return rc;
8239 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8241 Jim_Obj *skip = ExprPop(e);
8242 Jim_Obj *B = ExprPop(e);
8243 Jim_Obj *A = ExprPop(e);
8245 /* No need to check for A as non-boolean */
8246 if (ExprBool(interp, A)) {
8247 /* true, so skip RHS opcodes */
8248 e->skip = JimWideValue(skip);
8249 /* Repush B as the answer */
8250 ExprPush(e, B);
8253 Jim_DecrRefCount(interp, skip);
8254 Jim_DecrRefCount(interp, A);
8255 Jim_DecrRefCount(interp, B);
8256 return JIM_OK;
8259 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8261 return JIM_OK;
8264 enum
8266 LAZY_NONE,
8267 LAZY_OP,
8268 LAZY_LEFT,
8269 LAZY_RIGHT
8272 /* name - precedence - arity - opcode
8274 * This array *must* be kept in sync with the JIM_EXPROP enum.
8276 * The following macro pre-computes the string length at compile time.
8278 #define OPRINIT(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8280 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8281 OPRINIT("*", 110, 2, JimExprOpBin, LAZY_NONE),
8282 OPRINIT("/", 110, 2, JimExprOpBin, LAZY_NONE),
8283 OPRINIT("%", 110, 2, JimExprOpIntBin, LAZY_NONE),
8285 OPRINIT("-", 100, 2, JimExprOpBin, LAZY_NONE),
8286 OPRINIT("+", 100, 2, JimExprOpBin, LAZY_NONE),
8288 OPRINIT("<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8289 OPRINIT(">>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8291 OPRINIT("<<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8292 OPRINIT(">>>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8294 OPRINIT("<", 80, 2, JimExprOpBin, LAZY_NONE),
8295 OPRINIT(">", 80, 2, JimExprOpBin, LAZY_NONE),
8296 OPRINIT("<=", 80, 2, JimExprOpBin, LAZY_NONE),
8297 OPRINIT(">=", 80, 2, JimExprOpBin, LAZY_NONE),
8299 OPRINIT("==", 70, 2, JimExprOpBin, LAZY_NONE),
8300 OPRINIT("!=", 70, 2, JimExprOpBin, LAZY_NONE),
8302 OPRINIT("&", 50, 2, JimExprOpIntBin, LAZY_NONE),
8303 OPRINIT("^", 49, 2, JimExprOpIntBin, LAZY_NONE),
8304 OPRINIT("|", 48, 2, JimExprOpIntBin, LAZY_NONE),
8306 OPRINIT("&&", 10, 2, NULL, LAZY_OP),
8307 OPRINIT(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8308 OPRINIT(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8310 OPRINIT("||", 9, 2, NULL, LAZY_OP),
8311 OPRINIT(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8312 OPRINIT(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8314 OPRINIT("?", 5, 2, JimExprOpNull, LAZY_OP),
8315 OPRINIT(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8316 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8318 OPRINIT(":", 5, 2, JimExprOpNull, LAZY_OP),
8319 OPRINIT(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8320 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8322 OPRINIT("**", 250, 2, JimExprOpBin, LAZY_NONE),
8324 OPRINIT("eq", 60, 2, JimExprOpStrBin, LAZY_NONE),
8325 OPRINIT("ne", 60, 2, JimExprOpStrBin, LAZY_NONE),
8327 OPRINIT("in", 55, 2, JimExprOpStrBin, LAZY_NONE),
8328 OPRINIT("ni", 55, 2, JimExprOpStrBin, LAZY_NONE),
8330 OPRINIT("!", 150, 1, JimExprOpNumUnary, LAZY_NONE),
8331 OPRINIT("~", 150, 1, JimExprOpIntUnary, LAZY_NONE),
8332 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8333 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8337 OPRINIT("int", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8338 OPRINIT("abs", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8339 OPRINIT("double", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8340 OPRINIT("round", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8341 OPRINIT("rand", 200, 0, JimExprOpNone, LAZY_NONE),
8342 OPRINIT("srand", 200, 1, JimExprOpIntUnary, LAZY_NONE),
8344 #ifdef JIM_MATH_FUNCTIONS
8345 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8346 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8347 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8348 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8349 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8350 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8351 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8352 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8353 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8354 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8355 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8356 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8357 OPRINIT("log", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8358 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8359 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8360 OPRINIT("pow", 200, 2, JimExprOpBin, LAZY_NONE),
8361 #endif
8363 #undef OPRINIT
8365 #define JIM_EXPR_OPERATORS_NUM \
8366 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8368 static int JimParseExpression(struct JimParserCtx *pc)
8370 /* Discard spaces and quoted newline */
8371 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8372 if (*pc->p == '\n') {
8373 pc->linenr++;
8375 pc->p++;
8376 pc->len--;
8379 if (pc->len == 0) {
8380 pc->tstart = pc->tend = pc->p;
8381 pc->tline = pc->linenr;
8382 pc->tt = JIM_TT_EOL;
8383 pc->eof = 1;
8384 return JIM_OK;
8386 switch (*(pc->p)) {
8387 case '(':
8388 pc->tt = JIM_TT_SUBEXPR_START;
8389 goto singlechar;
8390 case ')':
8391 pc->tt = JIM_TT_SUBEXPR_END;
8392 goto singlechar;
8393 case ',':
8394 pc->tt = JIM_TT_SUBEXPR_COMMA;
8395 singlechar:
8396 pc->tstart = pc->tend = pc->p;
8397 pc->tline = pc->linenr;
8398 pc->p++;
8399 pc->len--;
8400 break;
8401 case '[':
8402 return JimParseCmd(pc);
8403 case '$':
8404 if (JimParseVar(pc) == JIM_ERR)
8405 return JimParseExprOperator(pc);
8406 else {
8407 /* Don't allow expr sugar in expressions */
8408 if (pc->tt == JIM_TT_EXPRSUGAR) {
8409 return JIM_ERR;
8411 return JIM_OK;
8413 break;
8414 case '0':
8415 case '1':
8416 case '2':
8417 case '3':
8418 case '4':
8419 case '5':
8420 case '6':
8421 case '7':
8422 case '8':
8423 case '9':
8424 case '.':
8425 return JimParseExprNumber(pc);
8426 case '"':
8427 return JimParseQuote(pc);
8428 case '{':
8429 return JimParseBrace(pc);
8431 case 'N':
8432 case 'I':
8433 case 'n':
8434 case 'i':
8435 if (JimParseExprIrrational(pc) == JIM_ERR)
8436 return JimParseExprOperator(pc);
8437 break;
8438 default:
8439 return JimParseExprOperator(pc);
8440 break;
8442 return JIM_OK;
8445 static int JimParseExprNumber(struct JimParserCtx *pc)
8447 int allowdot = 1;
8448 int base = 10;
8450 /* Assume an integer for now */
8451 pc->tt = JIM_TT_EXPR_INT;
8452 pc->tstart = pc->p;
8453 pc->tline = pc->linenr;
8455 /* Parse initial 0<x> */
8456 if (pc->p[0] == '0') {
8457 switch (pc->p[1]) {
8458 case 'x':
8459 case 'X':
8460 base = 16;
8461 allowdot = 0;
8462 pc->p += 2;
8463 pc->len -= 2;
8464 break;
8465 case 'o':
8466 case 'O':
8467 base = 8;
8468 allowdot = 0;
8469 pc->p += 2;
8470 pc->len -= 2;
8471 break;
8472 case 'b':
8473 case 'B':
8474 base = 2;
8475 allowdot = 0;
8476 pc->p += 2;
8477 pc->len -= 2;
8478 break;
8482 while (isdigit(UCHAR(*pc->p))
8483 || (base == 16 && isxdigit(UCHAR(*pc->p)))
8484 || (base == 8 && *pc->p >= '0' && *pc->p <= '7')
8485 || (base == 2 && (*pc->p == '0' || *pc->p == '1'))
8486 || (allowdot && *pc->p == '.')
8488 if (*pc->p == '.') {
8489 allowdot = 0;
8490 pc->tt = JIM_TT_EXPR_DOUBLE;
8492 pc->p++;
8493 pc->len--;
8494 if (base == 10 && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
8495 || isdigit(UCHAR(pc->p[1])))) {
8496 pc->p += 2;
8497 pc->len -= 2;
8498 pc->tt = JIM_TT_EXPR_DOUBLE;
8501 pc->tend = pc->p - 1;
8502 return JIM_OK;
8505 static int JimParseExprIrrational(struct JimParserCtx *pc)
8507 const char *Tokens[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8508 const char **token;
8510 for (token = Tokens; *token != NULL; token++) {
8511 int len = strlen(*token);
8513 if (strncmp(*token, pc->p, len) == 0) {
8514 pc->tstart = pc->p;
8515 pc->tend = pc->p + len - 1;
8516 pc->p += len;
8517 pc->len -= len;
8518 pc->tline = pc->linenr;
8519 pc->tt = JIM_TT_EXPR_DOUBLE;
8520 return JIM_OK;
8523 return JIM_ERR;
8526 static int JimParseExprOperator(struct JimParserCtx *pc)
8528 int i;
8529 int bestIdx = -1, bestLen = 0;
8531 /* Try to get the longest match. */
8532 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8533 const char * const opname = Jim_ExprOperators[i].name;
8534 const int oplen = Jim_ExprOperators[i].namelen;
8536 if (opname == NULL || opname[0] != pc->p[0]) {
8537 continue;
8540 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8541 bestIdx = i + JIM_TT_EXPR_OP;
8542 bestLen = oplen;
8545 if (bestIdx == -1) {
8546 return JIM_ERR;
8549 /* Validate paretheses around function arguments */
8550 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8551 const char *p = pc->p + bestLen;
8552 int len = pc->len - bestLen;
8554 while (len && isspace(UCHAR(*p))) {
8555 len--;
8556 p++;
8558 if (*p != '(') {
8559 return JIM_ERR;
8562 pc->tstart = pc->p;
8563 pc->tend = pc->p + bestLen - 1;
8564 pc->p += bestLen;
8565 pc->len -= bestLen;
8566 pc->tline = pc->linenr;
8568 pc->tt = bestIdx;
8569 return JIM_OK;
8572 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8574 static Jim_ExprOperator dummy_op;
8575 if (opcode < JIM_TT_EXPR_OP) {
8576 return &dummy_op;
8578 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8581 const char *jim_tt_name(int type)
8583 static const char * const tt_names[JIM_TT_EXPR_OP] =
8584 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8585 "DBL", "$()" };
8586 if (type < JIM_TT_EXPR_OP) {
8587 return tt_names[type];
8589 else {
8590 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8591 static char buf[20];
8593 if (op->name) {
8594 return op->name;
8596 sprintf(buf, "(%d)", type);
8597 return buf;
8601 /* -----------------------------------------------------------------------------
8602 * Expression Object
8603 * ---------------------------------------------------------------------------*/
8604 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8605 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8606 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8608 static const Jim_ObjType exprObjType = {
8609 "expression",
8610 FreeExprInternalRep,
8611 DupExprInternalRep,
8612 NULL,
8613 JIM_TYPE_REFERENCES,
8616 /* Expr bytecode structure */
8617 typedef struct ExprByteCode
8619 ScriptToken *token; /* Tokens array. */
8620 int len; /* Length as number of tokens. */
8621 int inUse; /* Used for sharing. */
8622 } ExprByteCode;
8624 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8626 int i;
8628 for (i = 0; i < expr->len; i++) {
8629 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8631 Jim_Free(expr->token);
8632 Jim_Free(expr);
8635 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8637 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8639 if (expr) {
8640 if (--expr->inUse != 0) {
8641 return;
8644 ExprFreeByteCode(interp, expr);
8648 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8650 JIM_NOTUSED(interp);
8651 JIM_NOTUSED(srcPtr);
8653 /* Just returns an simple string. */
8654 dupPtr->typePtr = NULL;
8657 /* Check if an expr program looks correct. */
8658 static int ExprCheckCorrectness(ExprByteCode * expr)
8660 int i;
8661 int stacklen = 0;
8662 int ternary = 0;
8664 /* Try to check if there are stack underflows,
8665 * and make sure at the end of the program there is
8666 * a single result on the stack. */
8667 for (i = 0; i < expr->len; i++) {
8668 ScriptToken *t = &expr->token[i];
8669 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8671 stacklen -= op->arity;
8672 if (stacklen < 0) {
8673 break;
8675 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8676 ternary++;
8678 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8679 ternary--;
8682 /* All operations and operands add one to the stack */
8683 stacklen++;
8685 if (stacklen != 1 || ternary != 0) {
8686 return JIM_ERR;
8688 return JIM_OK;
8691 /* This procedure converts every occurrence of || and && opereators
8692 * in lazy unary versions.
8694 * a b || is converted into:
8696 * a <offset> |L b |R
8698 * a b && is converted into:
8700 * a <offset> &L b &R
8702 * "|L" checks if 'a' is true:
8703 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8704 * the opcode just after |R.
8705 * 2) if it is false does nothing.
8706 * "|R" checks if 'b' is true:
8707 * 1) if it is true pushes 1, otherwise pushes 0.
8709 * "&L" checks if 'a' is true:
8710 * 1) if it is true does nothing.
8711 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8712 * the opcode just after &R
8713 * "&R" checks if 'a' is true:
8714 * if it is true pushes 1, otherwise pushes 0.
8716 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8718 int i;
8720 int leftindex, arity, offset;
8722 /* Search for the end of the first operator */
8723 leftindex = expr->len - 1;
8725 arity = 1;
8726 while (arity) {
8727 ScriptToken *tt = &expr->token[leftindex];
8729 if (tt->type >= JIM_TT_EXPR_OP) {
8730 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8732 arity--;
8733 if (--leftindex < 0) {
8734 return JIM_ERR;
8737 leftindex++;
8739 /* Move them up */
8740 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8741 sizeof(*expr->token) * (expr->len - leftindex));
8742 expr->len += 2;
8743 offset = (expr->len - leftindex) - 1;
8745 /* Now we rely on the fact the the left and right version have opcodes
8746 * 1 and 2 after the main opcode respectively
8748 expr->token[leftindex + 1].type = t->type + 1;
8749 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8751 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8752 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8754 /* Now add the 'R' operator */
8755 expr->token[expr->len].objPtr = interp->emptyObj;
8756 expr->token[expr->len].type = t->type + 2;
8757 expr->len++;
8759 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8760 for (i = leftindex - 1; i > 0; i--) {
8761 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8762 if (op->lazy == LAZY_LEFT) {
8763 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8764 JimWideValue(expr->token[i - 1].objPtr) += 2;
8768 return JIM_OK;
8771 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8773 struct ScriptToken *token = &expr->token[expr->len];
8774 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8776 if (op->lazy == LAZY_OP) {
8777 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8778 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8779 return JIM_ERR;
8782 else {
8783 token->objPtr = interp->emptyObj;
8784 token->type = t->type;
8785 expr->len++;
8787 return JIM_OK;
8791 * Returns the index of the COLON_LEFT to the left of 'right_index'
8792 * taking into account nesting.
8794 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8796 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8798 int ternary_count = 1;
8800 right_index--;
8802 while (right_index > 1) {
8803 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8804 ternary_count--;
8806 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8807 ternary_count++;
8809 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8810 return right_index;
8812 right_index--;
8815 /*notreached*/
8816 return -1;
8820 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8822 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8823 * Otherwise returns 0.
8825 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8827 int i = right_index - 1;
8828 int ternary_count = 1;
8830 while (i > 1) {
8831 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8832 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8833 *prev_right_index = i - 2;
8834 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8835 return 1;
8838 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8839 if (ternary_count == 0) {
8840 return 0;
8842 ternary_count++;
8844 i--;
8846 return 0;
8850 * ExprTernaryReorderExpression description
8851 * ========================================
8853 * ?: is right-to-left associative which doesn't work with the stack-based
8854 * expression engine. The fix is to reorder the bytecode.
8856 * The expression:
8858 * expr 1?2:0?3:4
8860 * Has initial bytecode:
8862 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8863 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8865 * The fix involves simulating this expression instead:
8867 * expr 1?2:(0?3:4)
8869 * With the following bytecode:
8871 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8872 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8874 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8875 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8876 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8877 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8879 * ExprTernaryReorderExpression works thus as follows :
8880 * - start from the end of the stack
8881 * - while walking towards the beginning of the stack
8882 * if token=JIM_EXPROP_COLON_RIGHT then
8883 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8884 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8885 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8886 * if all found then
8887 * perform the rotation
8888 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8889 * end if
8890 * end if
8892 * Note: care has to be taken for nested ternary constructs!!!
8894 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8896 int i;
8898 for (i = expr->len - 1; i > 1; i--) {
8899 int prev_right_index;
8900 int prev_left_index;
8901 int j;
8902 ScriptToken tmp;
8904 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8905 continue;
8908 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8909 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8910 continue;
8914 ** rotate tokens down
8916 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8917 ** | | |
8918 ** | V V
8919 ** | [...] : ...
8920 ** | | |
8921 ** | V V
8922 ** | [...] : ...
8923 ** | | |
8924 ** | V V
8925 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8927 tmp = expr->token[prev_right_index];
8928 for (j = prev_right_index; j < i; j++) {
8929 expr->token[j] = expr->token[j + 1];
8931 expr->token[i] = tmp;
8933 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8935 * This is 'colon left increment' = i - prev_right_index
8937 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8938 * [prev_left_index-1] : skip_count
8941 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8943 /* Adjust for i-- in the loop */
8944 i++;
8948 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8950 Jim_Stack stack;
8951 ExprByteCode *expr;
8952 int ok = 1;
8953 int i;
8954 int prevtt = JIM_TT_NONE;
8955 int have_ternary = 0;
8957 /* -1 for EOL */
8958 int count = tokenlist->count - 1;
8960 expr = Jim_Alloc(sizeof(*expr));
8961 expr->inUse = 1;
8962 expr->len = 0;
8964 Jim_InitStack(&stack);
8966 /* Need extra bytecodes for lazy operators.
8967 * Also check for the ternary operator
8969 for (i = 0; i < tokenlist->count; i++) {
8970 ParseToken *t = &tokenlist->list[i];
8971 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8973 if (op->lazy == LAZY_OP) {
8974 count += 2;
8975 /* Ternary is a lazy op but also needs reordering */
8976 if (t->type == JIM_EXPROP_TERNARY) {
8977 have_ternary = 1;
8982 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8984 for (i = 0; i < tokenlist->count && ok; i++) {
8985 ParseToken *t = &tokenlist->list[i];
8987 /* Next token will be stored here */
8988 struct ScriptToken *token = &expr->token[expr->len];
8990 if (t->type == JIM_TT_EOL) {
8991 break;
8994 switch (t->type) {
8995 case JIM_TT_STR:
8996 case JIM_TT_ESC:
8997 case JIM_TT_VAR:
8998 case JIM_TT_DICTSUGAR:
8999 case JIM_TT_EXPRSUGAR:
9000 case JIM_TT_CMD:
9001 token->type = t->type;
9002 strexpr:
9003 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
9004 if (t->type == JIM_TT_CMD) {
9005 /* Only commands need source info */
9006 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
9008 expr->len++;
9009 break;
9011 case JIM_TT_EXPR_INT:
9012 case JIM_TT_EXPR_DOUBLE:
9014 char *endptr;
9015 if (t->type == JIM_TT_EXPR_INT) {
9016 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9018 else {
9019 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9021 if (endptr != t->token + t->len) {
9022 /* Conversion failed, so just store it as a string */
9023 Jim_FreeNewObj(interp, token->objPtr);
9024 token->type = JIM_TT_STR;
9025 goto strexpr;
9027 token->type = t->type;
9028 expr->len++;
9030 break;
9032 case JIM_TT_SUBEXPR_START:
9033 Jim_StackPush(&stack, t);
9034 prevtt = JIM_TT_NONE;
9035 continue;
9037 case JIM_TT_SUBEXPR_COMMA:
9038 /* Simple approach. Comma is simply ignored */
9039 continue;
9041 case JIM_TT_SUBEXPR_END:
9042 ok = 0;
9043 while (Jim_StackLen(&stack)) {
9044 ParseToken *tt = Jim_StackPop(&stack);
9046 if (tt->type == JIM_TT_SUBEXPR_START) {
9047 ok = 1;
9048 break;
9051 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9052 goto err;
9055 if (!ok) {
9056 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9057 goto err;
9059 break;
9062 default:{
9063 /* Must be an operator */
9064 const struct Jim_ExprOperator *op;
9065 ParseToken *tt;
9067 /* Convert -/+ to unary minus or unary plus if necessary */
9068 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9069 if (t->type == JIM_EXPROP_SUB) {
9070 t->type = JIM_EXPROP_UNARYMINUS;
9072 else if (t->type == JIM_EXPROP_ADD) {
9073 t->type = JIM_EXPROP_UNARYPLUS;
9077 op = JimExprOperatorInfoByOpcode(t->type);
9079 /* Now handle precedence */
9080 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9081 const struct Jim_ExprOperator *tt_op =
9082 JimExprOperatorInfoByOpcode(tt->type);
9084 /* Note that right-to-left associativity of ?: operator is handled later */
9086 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9087 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9088 ok = 0;
9089 goto err;
9091 Jim_StackPop(&stack);
9093 else {
9094 break;
9097 Jim_StackPush(&stack, t);
9098 break;
9101 prevtt = t->type;
9104 /* Reduce any remaining subexpr */
9105 while (Jim_StackLen(&stack)) {
9106 ParseToken *tt = Jim_StackPop(&stack);
9108 if (tt->type == JIM_TT_SUBEXPR_START) {
9109 ok = 0;
9110 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9111 goto err;
9113 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9114 ok = 0;
9115 goto err;
9119 if (have_ternary) {
9120 ExprTernaryReorderExpression(interp, expr);
9123 err:
9124 /* Free the stack used for the compilation. */
9125 Jim_FreeStack(&stack);
9127 for (i = 0; i < expr->len; i++) {
9128 Jim_IncrRefCount(expr->token[i].objPtr);
9131 if (!ok) {
9132 ExprFreeByteCode(interp, expr);
9133 return NULL;
9136 return expr;
9140 /* This method takes the string representation of an expression
9141 * and generates a program for the Expr's stack-based VM. */
9142 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9144 int exprTextLen;
9145 const char *exprText;
9146 struct JimParserCtx parser;
9147 struct ExprByteCode *expr;
9148 ParseTokenList tokenlist;
9149 int line;
9150 Jim_Obj *fileNameObj;
9151 int rc = JIM_ERR;
9153 /* Try to get information about filename / line number */
9154 if (objPtr->typePtr == &sourceObjType) {
9155 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9156 line = objPtr->internalRep.sourceValue.lineNumber;
9158 else {
9159 fileNameObj = interp->emptyObj;
9160 line = 1;
9162 Jim_IncrRefCount(fileNameObj);
9164 exprText = Jim_GetString(objPtr, &exprTextLen);
9166 /* Initially tokenise the expression into tokenlist */
9167 ScriptTokenListInit(&tokenlist);
9169 JimParserInit(&parser, exprText, exprTextLen, line);
9170 while (!parser.eof) {
9171 if (JimParseExpression(&parser) != JIM_OK) {
9172 ScriptTokenListFree(&tokenlist);
9173 invalidexpr:
9174 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9175 expr = NULL;
9176 goto err;
9179 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9180 parser.tline);
9183 #ifdef DEBUG_SHOW_EXPR_TOKENS
9185 int i;
9186 printf("==== Expr Tokens ====\n");
9187 for (i = 0; i < tokenlist.count; i++) {
9188 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9189 tokenlist.list[i].len, tokenlist.list[i].token);
9192 #endif
9194 /* Now create the expression bytecode from the tokenlist */
9195 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9197 /* No longer need the token list */
9198 ScriptTokenListFree(&tokenlist);
9200 if (!expr) {
9201 goto err;
9204 #ifdef DEBUG_SHOW_EXPR
9206 int i;
9208 printf("==== Expr ====\n");
9209 for (i = 0; i < expr->len; i++) {
9210 ScriptToken *t = &expr->token[i];
9212 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9215 #endif
9217 /* Check program correctness. */
9218 if (ExprCheckCorrectness(expr) != JIM_OK) {
9219 ExprFreeByteCode(interp, expr);
9220 goto invalidexpr;
9223 rc = JIM_OK;
9225 err:
9226 /* Free the old internal rep and set the new one. */
9227 Jim_DecrRefCount(interp, fileNameObj);
9228 Jim_FreeIntRep(interp, objPtr);
9229 Jim_SetIntRepPtr(objPtr, expr);
9230 objPtr->typePtr = &exprObjType;
9231 return rc;
9234 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9236 if (objPtr->typePtr != &exprObjType) {
9237 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9238 return NULL;
9241 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9244 /* -----------------------------------------------------------------------------
9245 * Expressions evaluation.
9246 * Jim uses a specialized stack-based virtual machine for expressions,
9247 * that takes advantage of the fact that expr's operators
9248 * can't be redefined.
9250 * Jim_EvalExpression() uses the bytecode compiled by
9251 * SetExprFromAny() method of the "expression" object.
9253 * On success a Tcl Object containing the result of the evaluation
9254 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9255 * returned.
9256 * On error the function returns a retcode != to JIM_OK and set a suitable
9257 * error on the interp.
9258 * ---------------------------------------------------------------------------*/
9259 #define JIM_EE_STATICSTACK_LEN 10
9261 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9263 ExprByteCode *expr;
9264 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9265 int i;
9266 int retcode = JIM_OK;
9267 struct JimExprState e;
9269 expr = JimGetExpression(interp, exprObjPtr);
9270 if (!expr) {
9271 return JIM_ERR; /* error in expression. */
9274 #ifdef JIM_OPTIMIZATION
9275 /* Check for one of the following common expressions used by while/for
9277 * CONST
9278 * $a
9279 * !$a
9280 * $a < CONST, $a < $b
9281 * $a <= CONST, $a <= $b
9282 * $a > CONST, $a > $b
9283 * $a >= CONST, $a >= $b
9284 * $a != CONST, $a != $b
9285 * $a == CONST, $a == $b
9288 Jim_Obj *objPtr;
9290 /* STEP 1 -- Check if there are the conditions to run the specialized
9291 * version of while */
9293 switch (expr->len) {
9294 case 1:
9295 if (expr->token[0].type == JIM_TT_EXPR_INT) {
9296 *exprResultPtrPtr = expr->token[0].objPtr;
9297 Jim_IncrRefCount(*exprResultPtrPtr);
9298 return JIM_OK;
9300 if (expr->token[0].type == JIM_TT_VAR) {
9301 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_ERRMSG);
9302 if (objPtr) {
9303 *exprResultPtrPtr = objPtr;
9304 Jim_IncrRefCount(*exprResultPtrPtr);
9305 return JIM_OK;
9308 break;
9310 case 2:
9311 if (expr->token[1].type == JIM_EXPROP_NOT && expr->token[0].type == JIM_TT_VAR) {
9312 jim_wide wideValue;
9314 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
9315 if (objPtr && JimIsWide(objPtr)
9316 && Jim_GetWide(interp, objPtr, &wideValue) == JIM_OK) {
9317 *exprResultPtrPtr = wideValue ? interp->falseObj : interp->trueObj;
9318 Jim_IncrRefCount(*exprResultPtrPtr);
9319 return JIM_OK;
9322 break;
9324 case 3:
9325 if (expr->token[0].type == JIM_TT_VAR && (expr->token[1].type == JIM_TT_EXPR_INT
9326 || expr->token[1].type == JIM_TT_VAR)) {
9327 switch (expr->token[2].type) {
9328 case JIM_EXPROP_LT:
9329 case JIM_EXPROP_LTE:
9330 case JIM_EXPROP_GT:
9331 case JIM_EXPROP_GTE:
9332 case JIM_EXPROP_NUMEQ:
9333 case JIM_EXPROP_NUMNE:{
9334 /* optimise ok */
9335 jim_wide wideValueA;
9336 jim_wide wideValueB;
9338 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
9339 if (objPtr && JimIsWide(objPtr)
9340 && Jim_GetWide(interp, objPtr, &wideValueA) == JIM_OK) {
9341 if (expr->token[1].type == JIM_TT_VAR) {
9342 objPtr =
9343 Jim_GetVariable(interp, expr->token[1].objPtr,
9344 JIM_NONE);
9346 else {
9347 objPtr = expr->token[1].objPtr;
9349 if (objPtr && JimIsWide(objPtr)
9350 && Jim_GetWide(interp, objPtr, &wideValueB) == JIM_OK) {
9351 int cmpRes;
9353 switch (expr->token[2].type) {
9354 case JIM_EXPROP_LT:
9355 cmpRes = wideValueA < wideValueB;
9356 break;
9357 case JIM_EXPROP_LTE:
9358 cmpRes = wideValueA <= wideValueB;
9359 break;
9360 case JIM_EXPROP_GT:
9361 cmpRes = wideValueA > wideValueB;
9362 break;
9363 case JIM_EXPROP_GTE:
9364 cmpRes = wideValueA >= wideValueB;
9365 break;
9366 case JIM_EXPROP_NUMEQ:
9367 cmpRes = wideValueA == wideValueB;
9368 break;
9369 case JIM_EXPROP_NUMNE:
9370 cmpRes = wideValueA != wideValueB;
9371 break;
9372 default: /*notreached */
9373 cmpRes = 0;
9375 *exprResultPtrPtr =
9376 cmpRes ? interp->trueObj : interp->falseObj;
9377 Jim_IncrRefCount(*exprResultPtrPtr);
9378 return JIM_OK;
9384 break;
9387 #endif
9389 /* In order to avoid that the internal repr gets freed due to
9390 * shimmering of the exprObjPtr's object, we make the internal rep
9391 * shared. */
9392 expr->inUse++;
9394 /* The stack-based expr VM itself */
9396 /* Stack allocation. Expr programs have the feature that
9397 * a program of length N can't require a stack longer than
9398 * N. */
9399 if (expr->len > JIM_EE_STATICSTACK_LEN)
9400 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9401 else
9402 e.stack = staticStack;
9404 e.stacklen = 0;
9406 /* Execute every instruction */
9407 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9408 Jim_Obj *objPtr;
9410 switch (expr->token[i].type) {
9411 case JIM_TT_EXPR_INT:
9412 case JIM_TT_EXPR_DOUBLE:
9413 case JIM_TT_STR:
9414 ExprPush(&e, expr->token[i].objPtr);
9415 break;
9417 case JIM_TT_VAR:
9418 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9419 if (objPtr) {
9420 ExprPush(&e, objPtr);
9422 else {
9423 retcode = JIM_ERR;
9425 break;
9427 case JIM_TT_DICTSUGAR:
9428 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9429 if (objPtr) {
9430 ExprPush(&e, objPtr);
9432 else {
9433 retcode = JIM_ERR;
9435 break;
9437 case JIM_TT_ESC:
9438 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9439 if (retcode == JIM_OK) {
9440 ExprPush(&e, objPtr);
9442 break;
9444 case JIM_TT_CMD:
9445 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9446 if (retcode == JIM_OK) {
9447 ExprPush(&e, Jim_GetResult(interp));
9449 break;
9451 default:{
9452 /* Find and execute the operation */
9453 e.skip = 0;
9454 e.opcode = expr->token[i].type;
9456 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9457 /* Skip some opcodes if necessary */
9458 i += e.skip;
9459 continue;
9464 expr->inUse--;
9466 if (retcode == JIM_OK) {
9467 *exprResultPtrPtr = ExprPop(&e);
9469 else {
9470 for (i = 0; i < e.stacklen; i++) {
9471 Jim_DecrRefCount(interp, e.stack[i]);
9474 if (e.stack != staticStack) {
9475 Jim_Free(e.stack);
9477 return retcode;
9480 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9482 int retcode;
9483 jim_wide wideValue;
9484 double doubleValue;
9485 Jim_Obj *exprResultPtr;
9487 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9488 if (retcode != JIM_OK)
9489 return retcode;
9491 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9492 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9493 Jim_DecrRefCount(interp, exprResultPtr);
9494 return JIM_ERR;
9496 else {
9497 Jim_DecrRefCount(interp, exprResultPtr);
9498 *boolPtr = doubleValue != 0;
9499 return JIM_OK;
9502 *boolPtr = wideValue != 0;
9504 Jim_DecrRefCount(interp, exprResultPtr);
9505 return JIM_OK;
9508 /* -----------------------------------------------------------------------------
9509 * ScanFormat String Object
9510 * ---------------------------------------------------------------------------*/
9512 /* This Jim_Obj will held a parsed representation of a format string passed to
9513 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9514 * to be parsed in its entirely first and then, if correct, can be used for
9515 * scanning. To avoid endless re-parsing, the parsed representation will be
9516 * stored in an internal representation and re-used for performance reason. */
9518 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9519 * scanformat string. This part will later be used to extract information
9520 * out from the string to be parsed by Jim_ScanString */
9522 typedef struct ScanFmtPartDescr
9524 char *arg; /* Specification of a CHARSET conversion */
9525 char *prefix; /* Prefix to be scanned literally before conversion */
9526 size_t width; /* Maximal width of input to be converted */
9527 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9528 char type; /* Type of conversion (e.g. c, d, f) */
9529 char modifier; /* Modify type (e.g. l - long, h - short */
9530 } ScanFmtPartDescr;
9532 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9533 * string parsed and separated in part descriptions. Furthermore it contains
9534 * the original string representation of the scanformat string to allow for
9535 * fast update of the Jim_Obj's string representation part.
9537 * As an add-on the internal object representation adds some scratch pad area
9538 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9539 * memory for purpose of string scanning.
9541 * The error member points to a static allocated string in case of a mal-
9542 * formed scanformat string or it contains '0' (NULL) in case of a valid
9543 * parse representation.
9545 * The whole memory of the internal representation is allocated as a single
9546 * area of memory that will be internally separated. So freeing and duplicating
9547 * of such an object is cheap */
9549 typedef struct ScanFmtStringObj
9551 jim_wide size; /* Size of internal repr in bytes */
9552 char *stringRep; /* Original string representation */
9553 size_t count; /* Number of ScanFmtPartDescr contained */
9554 size_t convCount; /* Number of conversions that will assign */
9555 size_t maxPos; /* Max position index if XPG3 is used */
9556 const char *error; /* Ptr to error text (NULL if no error */
9557 char *scratch; /* Some scratch pad used by Jim_ScanString */
9558 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9559 } ScanFmtStringObj;
9562 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9563 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9564 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9566 static const Jim_ObjType scanFmtStringObjType = {
9567 "scanformatstring",
9568 FreeScanFmtInternalRep,
9569 DupScanFmtInternalRep,
9570 UpdateStringOfScanFmt,
9571 JIM_TYPE_NONE,
9574 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9576 JIM_NOTUSED(interp);
9577 Jim_Free((char *)objPtr->internalRep.ptr);
9578 objPtr->internalRep.ptr = 0;
9581 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9583 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9584 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9586 JIM_NOTUSED(interp);
9587 memcpy(newVec, srcPtr->internalRep.ptr, size);
9588 dupPtr->internalRep.ptr = newVec;
9589 dupPtr->typePtr = &scanFmtStringObjType;
9592 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9594 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9597 /* SetScanFmtFromAny will parse a given string and create the internal
9598 * representation of the format specification. In case of an error
9599 * the error data member of the internal representation will be set
9600 * to an descriptive error text and the function will be left with
9601 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9602 * specification */
9604 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9606 ScanFmtStringObj *fmtObj;
9607 char *buffer;
9608 int maxCount, i, approxSize, lastPos = -1;
9609 const char *fmt = objPtr->bytes;
9610 int maxFmtLen = objPtr->length;
9611 const char *fmtEnd = fmt + maxFmtLen;
9612 int curr;
9614 Jim_FreeIntRep(interp, objPtr);
9615 /* Count how many conversions could take place maximally */
9616 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9617 if (fmt[i] == '%')
9618 ++maxCount;
9619 /* Calculate an approximation of the memory necessary */
9620 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9621 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9622 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9623 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9624 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9625 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9626 +1; /* safety byte */
9627 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9628 memset(fmtObj, 0, approxSize);
9629 fmtObj->size = approxSize;
9630 fmtObj->maxPos = 0;
9631 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9632 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9633 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9634 buffer = fmtObj->stringRep + maxFmtLen + 1;
9635 objPtr->internalRep.ptr = fmtObj;
9636 objPtr->typePtr = &scanFmtStringObjType;
9637 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9638 int width = 0, skip;
9639 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9641 fmtObj->count++;
9642 descr->width = 0; /* Assume width unspecified */
9643 /* Overread and store any "literal" prefix */
9644 if (*fmt != '%' || fmt[1] == '%') {
9645 descr->type = 0;
9646 descr->prefix = &buffer[i];
9647 for (; fmt < fmtEnd; ++fmt) {
9648 if (*fmt == '%') {
9649 if (fmt[1] != '%')
9650 break;
9651 ++fmt;
9653 buffer[i++] = *fmt;
9655 buffer[i++] = 0;
9657 /* Skip the conversion introducing '%' sign */
9658 ++fmt;
9659 /* End reached due to non-conversion literal only? */
9660 if (fmt >= fmtEnd)
9661 goto done;
9662 descr->pos = 0; /* Assume "natural" positioning */
9663 if (*fmt == '*') {
9664 descr->pos = -1; /* Okay, conversion will not be assigned */
9665 ++fmt;
9667 else
9668 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9669 /* Check if next token is a number (could be width or pos */
9670 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9671 fmt += skip;
9672 /* Was the number a XPG3 position specifier? */
9673 if (descr->pos != -1 && *fmt == '$') {
9674 int prev;
9676 ++fmt;
9677 descr->pos = width;
9678 width = 0;
9679 /* Look if "natural" postioning and XPG3 one was mixed */
9680 if ((lastPos == 0 && descr->pos > 0)
9681 || (lastPos > 0 && descr->pos == 0)) {
9682 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9683 return JIM_ERR;
9685 /* Look if this position was already used */
9686 for (prev = 0; prev < curr; ++prev) {
9687 if (fmtObj->descr[prev].pos == -1)
9688 continue;
9689 if (fmtObj->descr[prev].pos == descr->pos) {
9690 fmtObj->error =
9691 "variable is assigned by multiple \"%n$\" conversion specifiers";
9692 return JIM_ERR;
9695 /* Try to find a width after the XPG3 specifier */
9696 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9697 descr->width = width;
9698 fmt += skip;
9700 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9701 fmtObj->maxPos = descr->pos;
9703 else {
9704 /* Number was not a XPG3, so it has to be a width */
9705 descr->width = width;
9708 /* If positioning mode was undetermined yet, fix this */
9709 if (lastPos == -1)
9710 lastPos = descr->pos;
9711 /* Handle CHARSET conversion type ... */
9712 if (*fmt == '[') {
9713 int swapped = 1, beg = i, end, j;
9715 descr->type = '[';
9716 descr->arg = &buffer[i];
9717 ++fmt;
9718 if (*fmt == '^')
9719 buffer[i++] = *fmt++;
9720 if (*fmt == ']')
9721 buffer[i++] = *fmt++;
9722 while (*fmt && *fmt != ']')
9723 buffer[i++] = *fmt++;
9724 if (*fmt != ']') {
9725 fmtObj->error = "unmatched [ in format string";
9726 return JIM_ERR;
9728 end = i;
9729 buffer[i++] = 0;
9730 /* In case a range fence was given "backwards", swap it */
9731 while (swapped) {
9732 swapped = 0;
9733 for (j = beg + 1; j < end - 1; ++j) {
9734 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9735 char tmp = buffer[j - 1];
9737 buffer[j - 1] = buffer[j + 1];
9738 buffer[j + 1] = tmp;
9739 swapped = 1;
9744 else {
9745 /* Remember any valid modifier if given */
9746 if (strchr("hlL", *fmt) != 0)
9747 descr->modifier = tolower((int)*fmt++);
9749 descr->type = *fmt;
9750 if (strchr("efgcsndoxui", *fmt) == 0) {
9751 fmtObj->error = "bad scan conversion character";
9752 return JIM_ERR;
9754 else if (*fmt == 'c' && descr->width != 0) {
9755 fmtObj->error = "field width may not be specified in %c " "conversion";
9756 return JIM_ERR;
9758 else if (*fmt == 'u' && descr->modifier == 'l') {
9759 fmtObj->error = "unsigned wide not supported";
9760 return JIM_ERR;
9763 curr++;
9765 done:
9766 return JIM_OK;
9769 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9771 #define FormatGetCnvCount(_fo_) \
9772 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9773 #define FormatGetMaxPos(_fo_) \
9774 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9775 #define FormatGetError(_fo_) \
9776 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9778 /* JimScanAString is used to scan an unspecified string that ends with
9779 * next WS, or a string that is specified via a charset.
9782 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9784 char *buffer = Jim_StrDup(str);
9785 char *p = buffer;
9787 while (*str) {
9788 int c;
9789 int n;
9791 if (!sdescr && isspace(UCHAR(*str)))
9792 break; /* EOS via WS if unspecified */
9794 n = utf8_tounicode(str, &c);
9795 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9796 break;
9797 while (n--)
9798 *p++ = *str++;
9800 *p = 0;
9801 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9804 /* ScanOneEntry will scan one entry out of the string passed as argument.
9805 * It use the sscanf() function for this task. After extracting and
9806 * converting of the value, the count of scanned characters will be
9807 * returned of -1 in case of no conversion tool place and string was
9808 * already scanned thru */
9810 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9811 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9813 const char *tok;
9814 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9815 size_t scanned = 0;
9816 size_t anchor = pos;
9817 int i;
9818 Jim_Obj *tmpObj = NULL;
9820 /* First pessimistically assume, we will not scan anything :-) */
9821 *valObjPtr = 0;
9822 if (descr->prefix) {
9823 /* There was a prefix given before the conversion, skip it and adjust
9824 * the string-to-be-parsed accordingly */
9825 /* XXX: Should be checking strLen, not str[pos] */
9826 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9827 /* If prefix require, skip WS */
9828 if (isspace(UCHAR(descr->prefix[i])))
9829 while (pos < strLen && isspace(UCHAR(str[pos])))
9830 ++pos;
9831 else if (descr->prefix[i] != str[pos])
9832 break; /* Prefix do not match here, leave the loop */
9833 else
9834 ++pos; /* Prefix matched so far, next round */
9836 if (pos >= strLen) {
9837 return -1; /* All of str consumed: EOF condition */
9839 else if (descr->prefix[i] != 0)
9840 return 0; /* Not whole prefix consumed, no conversion possible */
9842 /* For all but following conversion, skip leading WS */
9843 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9844 while (isspace(UCHAR(str[pos])))
9845 ++pos;
9846 /* Determine how much skipped/scanned so far */
9847 scanned = pos - anchor;
9849 /* %c is a special, simple case. no width */
9850 if (descr->type == 'n') {
9851 /* Return pseudo conversion means: how much scanned so far? */
9852 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9854 else if (pos >= strLen) {
9855 /* Cannot scan anything, as str is totally consumed */
9856 return -1;
9858 else if (descr->type == 'c') {
9859 int c;
9860 scanned += utf8_tounicode(&str[pos], &c);
9861 *valObjPtr = Jim_NewIntObj(interp, c);
9862 return scanned;
9864 else {
9865 /* Processing of conversions follows ... */
9866 if (descr->width > 0) {
9867 /* Do not try to scan as fas as possible but only the given width.
9868 * To ensure this, we copy the part that should be scanned. */
9869 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9870 size_t tLen = descr->width > sLen ? sLen : descr->width;
9872 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9873 tok = tmpObj->bytes;
9875 else {
9876 /* As no width was given, simply refer to the original string */
9877 tok = &str[pos];
9879 switch (descr->type) {
9880 case 'd':
9881 case 'o':
9882 case 'x':
9883 case 'u':
9884 case 'i':{
9885 char *endp; /* Position where the number finished */
9886 jim_wide w;
9888 int base = descr->type == 'o' ? 8
9889 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9891 /* Try to scan a number with the given base */
9892 if (base == 0) {
9893 w = jim_strtoull(tok, &endp);
9895 else {
9896 w = strtoull(tok, &endp, base);
9899 if (endp != tok) {
9900 /* There was some number sucessfully scanned! */
9901 *valObjPtr = Jim_NewIntObj(interp, w);
9903 /* Adjust the number-of-chars scanned so far */
9904 scanned += endp - tok;
9906 else {
9907 /* Nothing was scanned. We have to determine if this
9908 * happened due to e.g. prefix mismatch or input str
9909 * exhausted */
9910 scanned = *tok ? 0 : -1;
9912 break;
9914 case 's':
9915 case '[':{
9916 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9917 scanned += Jim_Length(*valObjPtr);
9918 break;
9920 case 'e':
9921 case 'f':
9922 case 'g':{
9923 char *endp;
9924 double value = strtod(tok, &endp);
9926 if (endp != tok) {
9927 /* There was some number sucessfully scanned! */
9928 *valObjPtr = Jim_NewDoubleObj(interp, value);
9929 /* Adjust the number-of-chars scanned so far */
9930 scanned += endp - tok;
9932 else {
9933 /* Nothing was scanned. We have to determine if this
9934 * happened due to e.g. prefix mismatch or input str
9935 * exhausted */
9936 scanned = *tok ? 0 : -1;
9938 break;
9941 /* If a substring was allocated (due to pre-defined width) do not
9942 * forget to free it */
9943 if (tmpObj) {
9944 Jim_FreeNewObj(interp, tmpObj);
9947 return scanned;
9950 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9951 * string and returns all converted (and not ignored) values in a list back
9952 * to the caller. If an error occured, a NULL pointer will be returned */
9954 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9956 size_t i, pos;
9957 int scanned = 1;
9958 const char *str = Jim_String(strObjPtr);
9959 int strLen = Jim_Utf8Length(interp, strObjPtr);
9960 Jim_Obj *resultList = 0;
9961 Jim_Obj **resultVec = 0;
9962 int resultc;
9963 Jim_Obj *emptyStr = 0;
9964 ScanFmtStringObj *fmtObj;
9966 /* This should never happen. The format object should already be of the correct type */
9967 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9969 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9970 /* Check if format specification was valid */
9971 if (fmtObj->error != 0) {
9972 if (flags & JIM_ERRMSG)
9973 Jim_SetResultString(interp, fmtObj->error, -1);
9974 return 0;
9976 /* Allocate a new "shared" empty string for all unassigned conversions */
9977 emptyStr = Jim_NewEmptyStringObj(interp);
9978 Jim_IncrRefCount(emptyStr);
9979 /* Create a list and fill it with empty strings up to max specified XPG3 */
9980 resultList = Jim_NewListObj(interp, NULL, 0);
9981 if (fmtObj->maxPos > 0) {
9982 for (i = 0; i < fmtObj->maxPos; ++i)
9983 Jim_ListAppendElement(interp, resultList, emptyStr);
9984 JimListGetElements(interp, resultList, &resultc, &resultVec);
9986 /* Now handle every partial format description */
9987 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9988 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9989 Jim_Obj *value = 0;
9991 /* Only last type may be "literal" w/o conversion - skip it! */
9992 if (descr->type == 0)
9993 continue;
9994 /* As long as any conversion could be done, we will proceed */
9995 if (scanned > 0)
9996 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9997 /* In case our first try results in EOF, we will leave */
9998 if (scanned == -1 && i == 0)
9999 goto eof;
10000 /* Advance next pos-to-be-scanned for the amount scanned already */
10001 pos += scanned;
10003 /* value == 0 means no conversion took place so take empty string */
10004 if (value == 0)
10005 value = Jim_NewEmptyStringObj(interp);
10006 /* If value is a non-assignable one, skip it */
10007 if (descr->pos == -1) {
10008 Jim_FreeNewObj(interp, value);
10010 else if (descr->pos == 0)
10011 /* Otherwise append it to the result list if no XPG3 was given */
10012 Jim_ListAppendElement(interp, resultList, value);
10013 else if (resultVec[descr->pos - 1] == emptyStr) {
10014 /* But due to given XPG3, put the value into the corr. slot */
10015 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
10016 Jim_IncrRefCount(value);
10017 resultVec[descr->pos - 1] = value;
10019 else {
10020 /* Otherwise, the slot was already used - free obj and ERROR */
10021 Jim_FreeNewObj(interp, value);
10022 goto err;
10025 Jim_DecrRefCount(interp, emptyStr);
10026 return resultList;
10027 eof:
10028 Jim_DecrRefCount(interp, emptyStr);
10029 Jim_FreeNewObj(interp, resultList);
10030 return (Jim_Obj *)EOF;
10031 err:
10032 Jim_DecrRefCount(interp, emptyStr);
10033 Jim_FreeNewObj(interp, resultList);
10034 return 0;
10037 /* -----------------------------------------------------------------------------
10038 * Pseudo Random Number Generation
10039 * ---------------------------------------------------------------------------*/
10040 /* Initialize the sbox with the numbers from 0 to 255 */
10041 static void JimPrngInit(Jim_Interp *interp)
10043 #define PRNG_SEED_SIZE 256
10044 int i;
10045 unsigned int *seed;
10046 time_t t = time(NULL);
10048 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10050 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10051 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10052 seed[i] = (rand() ^ t ^ clock());
10054 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10055 Jim_Free(seed);
10058 /* Generates N bytes of random data */
10059 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10061 Jim_PrngState *prng;
10062 unsigned char *destByte = (unsigned char *)dest;
10063 unsigned int si, sj, x;
10065 /* initialization, only needed the first time */
10066 if (interp->prngState == NULL)
10067 JimPrngInit(interp);
10068 prng = interp->prngState;
10069 /* generates 'len' bytes of pseudo-random numbers */
10070 for (x = 0; x < len; x++) {
10071 prng->i = (prng->i + 1) & 0xff;
10072 si = prng->sbox[prng->i];
10073 prng->j = (prng->j + si) & 0xff;
10074 sj = prng->sbox[prng->j];
10075 prng->sbox[prng->i] = sj;
10076 prng->sbox[prng->j] = si;
10077 *destByte++ = prng->sbox[(si + sj) & 0xff];
10081 /* Re-seed the generator with user-provided bytes */
10082 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10084 int i;
10085 Jim_PrngState *prng;
10087 /* initialization, only needed the first time */
10088 if (interp->prngState == NULL)
10089 JimPrngInit(interp);
10090 prng = interp->prngState;
10092 /* Set the sbox[i] with i */
10093 for (i = 0; i < 256; i++)
10094 prng->sbox[i] = i;
10095 /* Now use the seed to perform a random permutation of the sbox */
10096 for (i = 0; i < seedLen; i++) {
10097 unsigned char t;
10099 t = prng->sbox[i & 0xFF];
10100 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10101 prng->sbox[seed[i]] = t;
10103 prng->i = prng->j = 0;
10105 /* discard at least the first 256 bytes of stream.
10106 * borrow the seed buffer for this
10108 for (i = 0; i < 256; i += seedLen) {
10109 JimRandomBytes(interp, seed, seedLen);
10113 /* [incr] */
10114 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10116 jim_wide wideValue, increment = 1;
10117 Jim_Obj *intObjPtr;
10119 if (argc != 2 && argc != 3) {
10120 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10121 return JIM_ERR;
10123 if (argc == 3) {
10124 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10125 return JIM_ERR;
10127 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10128 if (!intObjPtr) {
10129 /* Set missing variable to 0 */
10130 wideValue = 0;
10132 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10133 return JIM_ERR;
10135 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10136 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10137 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10138 Jim_FreeNewObj(interp, intObjPtr);
10139 return JIM_ERR;
10142 else {
10143 /* Can do it the quick way */
10144 Jim_InvalidateStringRep(intObjPtr);
10145 JimWideValue(intObjPtr) = wideValue + increment;
10147 /* The following step is required in order to invalidate the
10148 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10149 if (argv[1]->typePtr != &variableObjType) {
10150 /* Note that this can't fail since GetVariable already succeeded */
10151 Jim_SetVariable(interp, argv[1], intObjPtr);
10154 Jim_SetResult(interp, intObjPtr);
10155 return JIM_OK;
10159 /* -----------------------------------------------------------------------------
10160 * Eval
10161 * ---------------------------------------------------------------------------*/
10162 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10163 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10165 /* Handle calls to the [unknown] command */
10166 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10168 int retcode;
10170 /* If JimUnknown() is recursively called too many times...
10171 * done here
10173 if (interp->unknown_called > 50) {
10174 return JIM_ERR;
10177 /* The object interp->unknown just contains
10178 * the "unknown" string, it is used in order to
10179 * avoid to lookup the unknown command every time
10180 * but instead to cache the result. */
10182 /* If the [unknown] command does not exist ... */
10183 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10184 return JIM_ERR;
10186 interp->unknown_called++;
10187 /* XXX: Are we losing fileNameObj and linenr? */
10188 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10189 interp->unknown_called--;
10191 return retcode;
10194 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10196 int retcode;
10197 Jim_Cmd *cmdPtr;
10199 if (interp->framePtr->tailcallCmd) {
10200 /* Special tailcall command was pre-resolved */
10201 cmdPtr = interp->framePtr->tailcallCmd;
10202 interp->framePtr->tailcallCmd = NULL;
10204 else {
10205 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10206 if (cmdPtr == NULL) {
10207 return JimUnknown(interp, objc, objv);
10209 JimIncrCmdRefCount(cmdPtr);
10212 if (interp->evalDepth == interp->maxEvalDepth) {
10213 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10214 retcode = JIM_ERR;
10215 goto out;
10217 interp->evalDepth++;
10219 /* Call it -- Make sure result is an empty object. */
10220 Jim_SetEmptyResult(interp);
10221 if (cmdPtr->isproc) {
10222 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10224 else {
10225 interp->cmdPrivData = cmdPtr->u.native.privData;
10226 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10228 interp->evalDepth--;
10230 out:
10231 JimDecrCmdRefCount(interp, cmdPtr);
10233 return retcode;
10236 /* Eval the object vector 'objv' composed of 'objc' elements.
10237 * Every element is used as single argument.
10238 * Jim_EvalObj() will call this function every time its object
10239 * argument is of "list" type, with no string representation.
10241 * This is possible because the string representation of a
10242 * list object generated by the UpdateStringOfList is made
10243 * in a way that ensures that every list element is a different
10244 * command argument. */
10245 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10247 int i, retcode;
10249 /* Incr refcount of arguments. */
10250 for (i = 0; i < objc; i++)
10251 Jim_IncrRefCount(objv[i]);
10253 retcode = JimInvokeCommand(interp, objc, objv);
10255 /* Decr refcount of arguments and return the retcode */
10256 for (i = 0; i < objc; i++)
10257 Jim_DecrRefCount(interp, objv[i]);
10259 return retcode;
10263 * Invokes 'prefix' as a command with the objv array as arguments.
10265 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10267 int ret;
10268 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10270 nargv[0] = prefix;
10271 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10272 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10273 Jim_Free(nargv);
10274 return ret;
10277 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, ScriptObj *script)
10279 int rc = retcode;
10281 if (rc == JIM_ERR && !interp->errorFlag) {
10282 /* This is the first error, so save the file/line information and reset the stack */
10283 interp->errorFlag = 1;
10284 Jim_IncrRefCount(script->fileNameObj);
10285 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10286 interp->errorFileNameObj = script->fileNameObj;
10287 interp->errorLine = script->linenr;
10289 JimResetStackTrace(interp);
10290 /* Always add a level where the error first occurs */
10291 interp->addStackTrace++;
10294 /* Now if this is an "interesting" level, add it to the stack trace */
10295 if (rc == JIM_ERR && interp->addStackTrace > 0) {
10296 /* Add the stack info for the current level */
10298 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10300 /* Note: if we didn't have a filename for this level,
10301 * don't clear the addStackTrace flag
10302 * so we can pick it up at the next level
10304 if (Jim_Length(script->fileNameObj)) {
10305 interp->addStackTrace = 0;
10308 Jim_DecrRefCount(interp, interp->errorProc);
10309 interp->errorProc = interp->emptyObj;
10310 Jim_IncrRefCount(interp->errorProc);
10312 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
10313 /* Propagate the addStackTrace value through 'return -code error' */
10315 else {
10316 interp->addStackTrace = 0;
10320 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10322 Jim_Obj *objPtr;
10324 switch (token->type) {
10325 case JIM_TT_STR:
10326 case JIM_TT_ESC:
10327 objPtr = token->objPtr;
10328 break;
10329 case JIM_TT_VAR:
10330 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10331 break;
10332 case JIM_TT_DICTSUGAR:
10333 objPtr = JimExpandDictSugar(interp, token->objPtr);
10334 break;
10335 case JIM_TT_EXPRSUGAR:
10336 objPtr = JimExpandExprSugar(interp, token->objPtr);
10337 break;
10338 case JIM_TT_CMD:
10339 switch (Jim_EvalObj(interp, token->objPtr)) {
10340 case JIM_OK:
10341 case JIM_RETURN:
10342 objPtr = interp->result;
10343 break;
10344 case JIM_BREAK:
10345 /* Stop substituting */
10346 return JIM_BREAK;
10347 case JIM_CONTINUE:
10348 /* just skip this one */
10349 return JIM_CONTINUE;
10350 default:
10351 return JIM_ERR;
10353 break;
10354 default:
10355 JimPanic((1,
10356 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10357 objPtr = NULL;
10358 break;
10360 if (objPtr) {
10361 *objPtrPtr = objPtr;
10362 return JIM_OK;
10364 return JIM_ERR;
10367 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10368 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10369 * The returned object has refcount = 0.
10371 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10373 int totlen = 0, i;
10374 Jim_Obj **intv;
10375 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10376 Jim_Obj *objPtr;
10377 char *s;
10379 if (tokens <= JIM_EVAL_SINTV_LEN)
10380 intv = sintv;
10381 else
10382 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10384 /* Compute every token forming the argument
10385 * in the intv objects vector. */
10386 for (i = 0; i < tokens; i++) {
10387 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10388 case JIM_OK:
10389 case JIM_RETURN:
10390 break;
10391 case JIM_BREAK:
10392 if (flags & JIM_SUBST_FLAG) {
10393 /* Stop here */
10394 tokens = i;
10395 continue;
10397 /* XXX: Should probably set an error about break outside loop */
10398 /* fall through to error */
10399 case JIM_CONTINUE:
10400 if (flags & JIM_SUBST_FLAG) {
10401 intv[i] = NULL;
10402 continue;
10404 /* XXX: Ditto continue outside loop */
10405 /* fall through to error */
10406 default:
10407 while (i--) {
10408 Jim_DecrRefCount(interp, intv[i]);
10410 if (intv != sintv) {
10411 Jim_Free(intv);
10413 return NULL;
10415 Jim_IncrRefCount(intv[i]);
10416 Jim_String(intv[i]);
10417 totlen += intv[i]->length;
10420 /* Fast path return for a single token */
10421 if (tokens == 1 && intv[0] && intv == sintv) {
10422 Jim_DecrRefCount(interp, intv[0]);
10423 return intv[0];
10426 /* Concatenate every token in an unique
10427 * object. */
10428 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10430 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10431 && token[2].type == JIM_TT_VAR) {
10432 /* May be able to do fast interpolated object -> dictSubst */
10433 objPtr->typePtr = &interpolatedObjType;
10434 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10435 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10436 Jim_IncrRefCount(intv[2]);
10439 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10440 objPtr->length = totlen;
10441 for (i = 0; i < tokens; i++) {
10442 if (intv[i]) {
10443 memcpy(s, intv[i]->bytes, intv[i]->length);
10444 s += intv[i]->length;
10445 Jim_DecrRefCount(interp, intv[i]);
10448 objPtr->bytes[totlen] = '\0';
10449 /* Free the intv vector if not static. */
10450 if (intv != sintv) {
10451 Jim_Free(intv);
10454 return objPtr;
10458 /* listPtr *must* be a list.
10459 * The contents of the list is evaluated with the first element as the command and
10460 * the remaining elements as the arguments.
10462 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10464 int retcode = JIM_OK;
10466 if (listPtr->internalRep.listValue.len) {
10467 Jim_IncrRefCount(listPtr);
10468 retcode = JimInvokeCommand(interp,
10469 listPtr->internalRep.listValue.len,
10470 listPtr->internalRep.listValue.ele);
10471 Jim_DecrRefCount(interp, listPtr);
10473 return retcode;
10476 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10478 SetListFromAny(interp, listPtr);
10479 return JimEvalObjList(interp, listPtr);
10482 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10484 int i;
10485 ScriptObj *script;
10486 ScriptToken *token;
10487 int retcode = JIM_OK;
10488 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10489 Jim_Obj *prevScriptObj;
10491 /* If the object is of type "list", with no string rep we can call
10492 * a specialized version of Jim_EvalObj() */
10493 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10494 return JimEvalObjList(interp, scriptObjPtr);
10497 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10498 script = Jim_GetScript(interp, scriptObjPtr);
10500 /* Reset the interpreter result. This is useful to
10501 * return the empty result in the case of empty program. */
10502 Jim_SetEmptyResult(interp);
10504 token = script->token;
10506 #ifdef JIM_OPTIMIZATION
10507 /* Check for one of the following common scripts used by for, while
10509 * {}
10510 * incr a
10512 if (script->len == 0) {
10513 Jim_DecrRefCount(interp, scriptObjPtr);
10514 return JIM_OK;
10516 if (script->len == 3
10517 && token[1].objPtr->typePtr == &commandObjType
10518 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10519 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10520 && token[2].objPtr->typePtr == &variableObjType) {
10522 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10524 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10525 JimWideValue(objPtr)++;
10526 Jim_InvalidateStringRep(objPtr);
10527 Jim_DecrRefCount(interp, scriptObjPtr);
10528 Jim_SetResult(interp, objPtr);
10529 return JIM_OK;
10532 #endif
10534 /* Now we have to make sure the internal repr will not be
10535 * freed on shimmering.
10537 * Think for example to this:
10539 * set x {llength $x; ... some more code ...}; eval $x
10541 * In order to preserve the internal rep, we increment the
10542 * inUse field of the script internal rep structure. */
10543 script->inUse++;
10545 /* Stash the current script */
10546 prevScriptObj = interp->currentScriptObj;
10547 interp->currentScriptObj = scriptObjPtr;
10549 interp->errorFlag = 0;
10550 argv = sargv;
10552 /* Execute every command sequentially until the end of the script
10553 * or an error occurs.
10555 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10556 int argc;
10557 int j;
10559 /* First token of the line is always JIM_TT_LINE */
10560 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10561 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10563 /* Allocate the arguments vector if required */
10564 if (argc > JIM_EVAL_SARGV_LEN)
10565 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10567 /* Skip the JIM_TT_LINE token */
10568 i++;
10570 /* Populate the arguments objects.
10571 * If an error occurs, retcode will be set and
10572 * 'j' will be set to the number of args expanded
10574 for (j = 0; j < argc; j++) {
10575 long wordtokens = 1;
10576 int expand = 0;
10577 Jim_Obj *wordObjPtr = NULL;
10579 if (token[i].type == JIM_TT_WORD) {
10580 wordtokens = JimWideValue(token[i++].objPtr);
10581 if (wordtokens < 0) {
10582 expand = 1;
10583 wordtokens = -wordtokens;
10587 if (wordtokens == 1) {
10588 /* Fast path if the token does not
10589 * need interpolation */
10591 switch (token[i].type) {
10592 case JIM_TT_ESC:
10593 case JIM_TT_STR:
10594 wordObjPtr = token[i].objPtr;
10595 break;
10596 case JIM_TT_VAR:
10597 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10598 break;
10599 case JIM_TT_EXPRSUGAR:
10600 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10601 break;
10602 case JIM_TT_DICTSUGAR:
10603 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10604 break;
10605 case JIM_TT_CMD:
10606 retcode = Jim_EvalObj(interp, token[i].objPtr);
10607 if (retcode == JIM_OK) {
10608 wordObjPtr = Jim_GetResult(interp);
10610 break;
10611 default:
10612 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10615 else {
10616 /* For interpolation we call a helper
10617 * function to do the work for us. */
10618 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10621 if (!wordObjPtr) {
10622 if (retcode == JIM_OK) {
10623 retcode = JIM_ERR;
10625 break;
10628 Jim_IncrRefCount(wordObjPtr);
10629 i += wordtokens;
10631 if (!expand) {
10632 argv[j] = wordObjPtr;
10634 else {
10635 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10636 int len = Jim_ListLength(interp, wordObjPtr);
10637 int newargc = argc + len - 1;
10638 int k;
10640 if (len > 1) {
10641 if (argv == sargv) {
10642 if (newargc > JIM_EVAL_SARGV_LEN) {
10643 argv = Jim_Alloc(sizeof(*argv) * newargc);
10644 memcpy(argv, sargv, sizeof(*argv) * j);
10647 else {
10648 /* Need to realloc to make room for (len - 1) more entries */
10649 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10653 /* Now copy in the expanded version */
10654 for (k = 0; k < len; k++) {
10655 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10656 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10659 /* The original object reference is no longer needed,
10660 * after the expansion it is no longer present on
10661 * the argument vector, but the single elements are
10662 * in its place. */
10663 Jim_DecrRefCount(interp, wordObjPtr);
10665 /* And update the indexes */
10666 j--;
10667 argc += len - 1;
10671 if (retcode == JIM_OK && argc) {
10672 /* Invoke the command */
10673 retcode = JimInvokeCommand(interp, argc, argv);
10674 /* Check for a signal after each command */
10675 if (Jim_CheckSignal(interp)) {
10676 retcode = JIM_SIGNAL;
10680 /* Finished with the command, so decrement ref counts of each argument */
10681 while (j-- > 0) {
10682 Jim_DecrRefCount(interp, argv[j]);
10685 if (argv != sargv) {
10686 Jim_Free(argv);
10687 argv = sargv;
10691 /* Possibly add to the error stack trace */
10692 JimAddErrorToStack(interp, retcode, script);
10694 /* Restore the current script */
10695 interp->currentScriptObj = prevScriptObj;
10697 /* Note that we don't have to decrement inUse, because the
10698 * following code transfers our use of the reference again to
10699 * the script object. */
10700 Jim_FreeIntRep(interp, scriptObjPtr);
10701 scriptObjPtr->typePtr = &scriptObjType;
10702 Jim_SetIntRepPtr(scriptObjPtr, script);
10703 Jim_DecrRefCount(interp, scriptObjPtr);
10705 return retcode;
10708 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10710 int retcode;
10711 /* If argObjPtr begins with '&', do an automatic upvar */
10712 const char *varname = Jim_String(argNameObj);
10713 if (*varname == '&') {
10714 /* First check that the target variable exists */
10715 Jim_Obj *objPtr;
10716 Jim_CallFrame *savedCallFrame = interp->framePtr;
10718 interp->framePtr = interp->framePtr->parent;
10719 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10720 interp->framePtr = savedCallFrame;
10721 if (!objPtr) {
10722 return JIM_ERR;
10725 /* It exists, so perform the binding. */
10726 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10727 Jim_IncrRefCount(objPtr);
10728 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10729 Jim_DecrRefCount(interp, objPtr);
10731 else {
10732 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10734 return retcode;
10738 * Sets the interp result to be an error message indicating the required proc args.
10740 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10742 /* Create a nice error message, consistent with Tcl 8.5 */
10743 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10744 int i;
10746 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10747 Jim_AppendString(interp, argmsg, " ", 1);
10749 if (i == cmd->u.proc.argsPos) {
10750 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10751 /* Renamed args */
10752 Jim_AppendString(interp, argmsg, "?", 1);
10753 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10754 Jim_AppendString(interp, argmsg, " ...?", -1);
10756 else {
10757 /* We have plain args */
10758 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10761 else {
10762 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10763 Jim_AppendString(interp, argmsg, "?", 1);
10764 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10765 Jim_AppendString(interp, argmsg, "?", 1);
10767 else {
10768 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10769 if (*arg == '&') {
10770 arg++;
10772 Jim_AppendString(interp, argmsg, arg, -1);
10776 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10777 Jim_FreeNewObj(interp, argmsg);
10780 #ifdef jim_ext_namespace
10782 * [namespace eval]
10784 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10786 Jim_CallFrame *callFramePtr;
10787 int retcode;
10789 /* Create a new callframe */
10790 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10791 callFramePtr->argv = &interp->emptyObj;
10792 callFramePtr->argc = 0;
10793 callFramePtr->procArgsObjPtr = NULL;
10794 callFramePtr->procBodyObjPtr = scriptObj;
10795 callFramePtr->staticVars = NULL;
10796 callFramePtr->fileNameObj = interp->emptyObj;
10797 callFramePtr->line = 0;
10798 Jim_IncrRefCount(scriptObj);
10799 interp->framePtr = callFramePtr;
10801 /* Check if there are too nested calls */
10802 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10803 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10804 retcode = JIM_ERR;
10806 else {
10807 /* Eval the body */
10808 retcode = Jim_EvalObj(interp, scriptObj);
10811 /* Destroy the callframe */
10812 interp->framePtr = interp->framePtr->parent;
10813 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10814 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10816 else {
10817 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10820 return retcode;
10822 #endif
10824 /* Call a procedure implemented in Tcl.
10825 * It's possible to speed-up a lot this function, currently
10826 * the callframes are not cached, but allocated and
10827 * destroied every time. What is expecially costly is
10828 * to create/destroy the local vars hash table every time.
10830 * This can be fixed just implementing callframes caching
10831 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10832 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10834 Jim_CallFrame *callFramePtr;
10835 int i, d, retcode, optargs;
10836 ScriptObj *script;
10838 /* Check arity */
10839 if (argc - 1 < cmd->u.proc.reqArity ||
10840 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10841 JimSetProcWrongArgs(interp, argv[0], cmd);
10842 return JIM_ERR;
10845 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10846 /* Optimise for procedure with no body - useful for optional debugging */
10847 return JIM_OK;
10850 /* Check if there are too nested calls */
10851 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10852 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10853 return JIM_ERR;
10856 /* Create a new callframe */
10857 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10858 callFramePtr->argv = argv;
10859 callFramePtr->argc = argc;
10860 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10861 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10862 callFramePtr->staticVars = cmd->u.proc.staticVars;
10864 /* Remember where we were called from. */
10865 script = Jim_GetScript(interp, interp->currentScriptObj);
10866 callFramePtr->fileNameObj = script->fileNameObj;
10867 callFramePtr->line = script->linenr;
10869 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10870 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10871 interp->framePtr = callFramePtr;
10873 /* How many optional args are available */
10874 optargs = (argc - 1 - cmd->u.proc.reqArity);
10876 /* Step 'i' along the actual args, and step 'd' along the formal args */
10877 i = 1;
10878 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10879 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10880 if (d == cmd->u.proc.argsPos) {
10881 /* assign $args */
10882 Jim_Obj *listObjPtr;
10883 int argsLen = 0;
10884 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10885 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10887 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10889 /* It is possible to rename args. */
10890 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10891 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10893 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10894 if (retcode != JIM_OK) {
10895 goto badargset;
10898 i += argsLen;
10899 continue;
10902 /* Optional or required? */
10903 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10904 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10906 else {
10907 /* Ran out, so use the default */
10908 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10910 if (retcode != JIM_OK) {
10911 goto badargset;
10915 /* Eval the body */
10916 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10918 badargset:
10920 /* Free the callframe */
10921 interp->framePtr = interp->framePtr->parent;
10923 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10924 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10926 else {
10927 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10930 if (interp->framePtr->tailcallObj) {
10931 /* If a tailcall is already being executed, merge this tailcall with that one */
10932 if (interp->framePtr->tailcall++ == 0) {
10933 /* No current tailcall in this frame, so invoke the tailcall command */
10934 do {
10935 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10937 interp->framePtr->tailcallObj = NULL;
10939 if (retcode == JIM_EVAL) {
10940 retcode = Jim_EvalObjList(interp, tailcallObj);
10941 if (retcode == JIM_RETURN) {
10942 /* If the result of the tailcall is 'return', push
10943 * it up to the caller
10945 interp->returnLevel++;
10948 Jim_DecrRefCount(interp, tailcallObj);
10949 } while (interp->framePtr->tailcallObj);
10951 /* If the tailcall chain finished early, may need to manually discard the command */
10952 if (interp->framePtr->tailcallCmd) {
10953 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10954 interp->framePtr->tailcallCmd = NULL;
10957 interp->framePtr->tailcall--;
10960 /* Handle the JIM_RETURN return code */
10961 if (retcode == JIM_RETURN) {
10962 if (--interp->returnLevel <= 0) {
10963 retcode = interp->returnCode;
10964 interp->returnCode = JIM_OK;
10965 interp->returnLevel = 0;
10968 else if (retcode == JIM_ERR) {
10969 interp->addStackTrace++;
10970 Jim_DecrRefCount(interp, interp->errorProc);
10971 interp->errorProc = argv[0];
10972 Jim_IncrRefCount(interp->errorProc);
10975 return retcode;
10978 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10980 int retval;
10981 Jim_Obj *scriptObjPtr;
10983 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10984 Jim_IncrRefCount(scriptObjPtr);
10986 if (filename) {
10987 Jim_Obj *prevScriptObj;
10989 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10991 prevScriptObj = interp->currentScriptObj;
10992 interp->currentScriptObj = scriptObjPtr;
10994 retval = Jim_EvalObj(interp, scriptObjPtr);
10996 interp->currentScriptObj = prevScriptObj;
10998 else {
10999 retval = Jim_EvalObj(interp, scriptObjPtr);
11001 Jim_DecrRefCount(interp, scriptObjPtr);
11002 return retval;
11005 int Jim_Eval(Jim_Interp *interp, const char *script)
11007 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
11010 /* Execute script in the scope of the global level */
11011 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
11013 int retval;
11014 Jim_CallFrame *savedFramePtr = interp->framePtr;
11016 interp->framePtr = interp->topFramePtr;
11017 retval = Jim_Eval(interp, script);
11018 interp->framePtr = savedFramePtr;
11020 return retval;
11023 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
11025 int retval;
11026 Jim_CallFrame *savedFramePtr = interp->framePtr;
11028 interp->framePtr = interp->topFramePtr;
11029 retval = Jim_EvalFile(interp, filename);
11030 interp->framePtr = savedFramePtr;
11032 return retval;
11035 #include <sys/stat.h>
11037 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11039 FILE *fp;
11040 char *buf;
11041 Jim_Obj *scriptObjPtr;
11042 Jim_Obj *prevScriptObj;
11043 struct stat sb;
11044 int retcode;
11045 int readlen;
11046 struct JimParseResult result;
11048 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11049 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11050 return JIM_ERR;
11052 if (sb.st_size == 0) {
11053 fclose(fp);
11054 return JIM_OK;
11057 buf = Jim_Alloc(sb.st_size + 1);
11058 readlen = fread(buf, 1, sb.st_size, fp);
11059 if (ferror(fp)) {
11060 fclose(fp);
11061 Jim_Free(buf);
11062 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11063 return JIM_ERR;
11065 fclose(fp);
11066 buf[readlen] = 0;
11068 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11069 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11070 Jim_IncrRefCount(scriptObjPtr);
11072 /* Now check the script for unmatched braces, etc. */
11073 if (SetScriptFromAny(interp, scriptObjPtr, &result) == JIM_ERR) {
11074 const char *msg;
11075 char linebuf[20];
11077 switch (result.missing) {
11078 case '[':
11079 msg = "unmatched \"[\"";
11080 break;
11081 case '{':
11082 msg = "missing close-brace";
11083 break;
11084 case '"':
11085 default:
11086 msg = "missing quote";
11087 break;
11090 snprintf(linebuf, sizeof(linebuf), "%d", result.line);
11092 Jim_SetResultFormatted(interp, "%s in \"%s\" at line %s",
11093 msg, filename, linebuf);
11094 Jim_DecrRefCount(interp, scriptObjPtr);
11095 return JIM_ERR;
11098 prevScriptObj = interp->currentScriptObj;
11099 interp->currentScriptObj = scriptObjPtr;
11101 retcode = Jim_EvalObj(interp, scriptObjPtr);
11103 /* Handle the JIM_RETURN return code */
11104 if (retcode == JIM_RETURN) {
11105 if (--interp->returnLevel <= 0) {
11106 retcode = interp->returnCode;
11107 interp->returnCode = JIM_OK;
11108 interp->returnLevel = 0;
11111 if (retcode == JIM_ERR) {
11112 /* EvalFile changes context, so add a stack frame here */
11113 interp->addStackTrace++;
11116 interp->currentScriptObj = prevScriptObj;
11118 Jim_DecrRefCount(interp, scriptObjPtr);
11120 return retcode;
11123 /* -----------------------------------------------------------------------------
11124 * Subst
11125 * ---------------------------------------------------------------------------*/
11126 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11128 pc->tstart = pc->p;
11129 pc->tline = pc->linenr;
11131 if (pc->len == 0) {
11132 pc->tend = pc->p;
11133 pc->tt = JIM_TT_EOL;
11134 pc->eof = 1;
11135 return;
11137 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11138 JimParseCmd(pc);
11139 return;
11141 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11142 if (JimParseVar(pc) == JIM_OK) {
11143 return;
11145 /* Not a var, so treat as a string */
11146 pc->tstart = pc->p;
11147 flags |= JIM_SUBST_NOVAR;
11149 while (pc->len) {
11150 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11151 break;
11153 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11154 break;
11156 if (*pc->p == '\\' && pc->len > 1) {
11157 pc->p++;
11158 pc->len--;
11160 pc->p++;
11161 pc->len--;
11163 pc->tend = pc->p - 1;
11164 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11167 /* The subst object type reuses most of the data structures and functions
11168 * of the script object. Script's data structures are a bit more complex
11169 * for what is needed for [subst]itution tasks, but the reuse helps to
11170 * deal with a single data structure at the cost of some more memory
11171 * usage for substitutions. */
11173 /* This method takes the string representation of an object
11174 * as a Tcl string where to perform [subst]itution, and generates
11175 * the pre-parsed internal representation. */
11176 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11178 int scriptTextLen;
11179 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11180 struct JimParserCtx parser;
11181 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11182 ParseTokenList tokenlist;
11184 /* Initially parse the subst into tokens (in tokenlist) */
11185 ScriptTokenListInit(&tokenlist);
11187 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11188 while (1) {
11189 JimParseSubst(&parser, flags);
11190 if (parser.eof) {
11191 /* Note that subst doesn't need the EOL token */
11192 break;
11194 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11195 parser.tline);
11198 /* Create the "real" subst/script tokens from the initial token list */
11199 script->inUse = 1;
11200 script->substFlags = flags;
11201 script->fileNameObj = interp->emptyObj;
11202 Jim_IncrRefCount(script->fileNameObj);
11203 SubstObjAddTokens(interp, script, &tokenlist);
11205 /* No longer need the token list */
11206 ScriptTokenListFree(&tokenlist);
11208 #ifdef DEBUG_SHOW_SUBST
11210 int i;
11212 printf("==== Subst ====\n");
11213 for (i = 0; i < script->len; i++) {
11214 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11215 Jim_String(script->token[i].objPtr));
11218 #endif
11220 /* Free the old internal rep and set the new one. */
11221 Jim_FreeIntRep(interp, objPtr);
11222 Jim_SetIntRepPtr(objPtr, script);
11223 objPtr->typePtr = &scriptObjType;
11224 return JIM_OK;
11227 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11229 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11230 SetSubstFromAny(interp, objPtr, flags);
11231 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11234 /* Performs commands,variables,blackslashes substitution,
11235 * storing the result object (with refcount 0) into
11236 * resObjPtrPtr. */
11237 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11239 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11241 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11242 /* In order to preserve the internal rep, we increment the
11243 * inUse field of the script internal rep structure. */
11244 script->inUse++;
11246 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11248 script->inUse--;
11249 Jim_DecrRefCount(interp, substObjPtr);
11250 if (*resObjPtrPtr == NULL) {
11251 return JIM_ERR;
11253 return JIM_OK;
11256 /* -----------------------------------------------------------------------------
11257 * Core commands utility functions
11258 * ---------------------------------------------------------------------------*/
11259 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11261 Jim_Obj *objPtr;
11262 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11264 if (*msg) {
11265 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11267 Jim_IncrRefCount(listObjPtr);
11268 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11269 Jim_DecrRefCount(interp, listObjPtr);
11271 Jim_IncrRefCount(objPtr);
11272 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11273 Jim_DecrRefCount(interp, objPtr);
11277 * May add the key and/or value to the list.
11279 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11280 Jim_HashEntry *he, int type);
11282 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11285 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11286 * invoke the callback to add entries to a list.
11287 * Returns the list.
11289 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11290 JimHashtableIteratorCallbackType *callback, int type)
11292 Jim_HashEntry *he;
11293 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11295 /* Check for the non-pattern case. We can do this much more efficiently. */
11296 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11297 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11298 if (he) {
11299 callback(interp, listObjPtr, he, type);
11302 else {
11303 Jim_HashTableIterator htiter;
11304 JimInitHashTableIterator(ht, &htiter);
11305 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11306 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11307 callback(interp, listObjPtr, he, type);
11311 return listObjPtr;
11314 /* Keep these in order */
11315 #define JIM_CMDLIST_COMMANDS 0
11316 #define JIM_CMDLIST_PROCS 1
11317 #define JIM_CMDLIST_CHANNELS 2
11320 * Adds matching command names (procs, channels) to the list.
11322 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11323 Jim_HashEntry *he, int type)
11325 Jim_Cmd *cmdPtr = (Jim_Cmd *)he->u.val;
11326 Jim_Obj *objPtr;
11328 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11329 /* not a proc */
11330 return;
11333 objPtr = Jim_NewStringObj(interp, he->key, -1);
11334 Jim_IncrRefCount(objPtr);
11336 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11337 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11339 Jim_DecrRefCount(interp, objPtr);
11342 /* type is JIM_CMDLIST_xxx */
11343 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11345 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11348 /* Keep these in order */
11349 #define JIM_VARLIST_GLOBALS 0
11350 #define JIM_VARLIST_LOCALS 1
11351 #define JIM_VARLIST_VARS 2
11353 #define JIM_VARLIST_VALUES 0x1000
11356 * Adds matching variable names to the list.
11358 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11359 Jim_HashEntry *he, int type)
11361 Jim_Var *varPtr = (Jim_Var *)he->u.val;
11363 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11364 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11365 if (type & JIM_VARLIST_VALUES) {
11366 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11371 /* mode is JIM_VARLIST_xxx */
11372 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11374 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11375 /* For [info locals], if we are at top level an emtpy list
11376 * is returned. I don't agree, but we aim at compatibility (SS) */
11377 return interp->emptyObj;
11379 else {
11380 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11381 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11385 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11386 Jim_Obj **objPtrPtr, int info_level_cmd)
11388 Jim_CallFrame *targetCallFrame;
11390 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11391 if (targetCallFrame == NULL) {
11392 return JIM_ERR;
11394 /* No proc call at toplevel callframe */
11395 if (targetCallFrame == interp->topFramePtr) {
11396 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11397 return JIM_ERR;
11399 if (info_level_cmd) {
11400 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11402 else {
11403 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11405 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11406 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11407 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11408 *objPtrPtr = listObj;
11410 return JIM_OK;
11413 /* -----------------------------------------------------------------------------
11414 * Core commands
11415 * ---------------------------------------------------------------------------*/
11417 /* fake [puts] -- not the real puts, just for debugging. */
11418 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11420 if (argc != 2 && argc != 3) {
11421 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11422 return JIM_ERR;
11424 if (argc == 3) {
11425 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11426 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11427 return JIM_ERR;
11429 else {
11430 fputs(Jim_String(argv[2]), stdout);
11433 else {
11434 puts(Jim_String(argv[1]));
11436 return JIM_OK;
11439 /* Helper for [+] and [*] */
11440 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11442 jim_wide wideValue, res;
11443 double doubleValue, doubleRes;
11444 int i;
11446 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11448 for (i = 1; i < argc; i++) {
11449 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11450 goto trydouble;
11451 if (op == JIM_EXPROP_ADD)
11452 res += wideValue;
11453 else
11454 res *= wideValue;
11456 Jim_SetResultInt(interp, res);
11457 return JIM_OK;
11458 trydouble:
11459 doubleRes = (double)res;
11460 for (; i < argc; i++) {
11461 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11462 return JIM_ERR;
11463 if (op == JIM_EXPROP_ADD)
11464 doubleRes += doubleValue;
11465 else
11466 doubleRes *= doubleValue;
11468 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11469 return JIM_OK;
11472 /* Helper for [-] and [/] */
11473 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11475 jim_wide wideValue, res = 0;
11476 double doubleValue, doubleRes = 0;
11477 int i = 2;
11479 if (argc < 2) {
11480 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11481 return JIM_ERR;
11483 else if (argc == 2) {
11484 /* The arity = 2 case is different. For [- x] returns -x,
11485 * while [/ x] returns 1/x. */
11486 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11487 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11488 return JIM_ERR;
11490 else {
11491 if (op == JIM_EXPROP_SUB)
11492 doubleRes = -doubleValue;
11493 else
11494 doubleRes = 1.0 / doubleValue;
11495 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11496 return JIM_OK;
11499 if (op == JIM_EXPROP_SUB) {
11500 res = -wideValue;
11501 Jim_SetResultInt(interp, res);
11503 else {
11504 doubleRes = 1.0 / wideValue;
11505 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11507 return JIM_OK;
11509 else {
11510 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11511 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11512 != JIM_OK) {
11513 return JIM_ERR;
11515 else {
11516 goto trydouble;
11520 for (i = 2; i < argc; i++) {
11521 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11522 doubleRes = (double)res;
11523 goto trydouble;
11525 if (op == JIM_EXPROP_SUB)
11526 res -= wideValue;
11527 else
11528 res /= wideValue;
11530 Jim_SetResultInt(interp, res);
11531 return JIM_OK;
11532 trydouble:
11533 for (; i < argc; i++) {
11534 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11535 return JIM_ERR;
11536 if (op == JIM_EXPROP_SUB)
11537 doubleRes -= doubleValue;
11538 else
11539 doubleRes /= doubleValue;
11541 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11542 return JIM_OK;
11546 /* [+] */
11547 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11549 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11552 /* [*] */
11553 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11555 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11558 /* [-] */
11559 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11561 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11564 /* [/] */
11565 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11567 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11570 /* [set] */
11571 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11573 if (argc != 2 && argc != 3) {
11574 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11575 return JIM_ERR;
11577 if (argc == 2) {
11578 Jim_Obj *objPtr;
11580 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11581 if (!objPtr)
11582 return JIM_ERR;
11583 Jim_SetResult(interp, objPtr);
11584 return JIM_OK;
11586 /* argc == 3 case. */
11587 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11588 return JIM_ERR;
11589 Jim_SetResult(interp, argv[2]);
11590 return JIM_OK;
11593 /* [unset]
11595 * unset ?-nocomplain? ?--? ?varName ...?
11597 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11599 int i = 1;
11600 int complain = 1;
11602 while (i < argc) {
11603 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11604 i++;
11605 break;
11607 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11608 complain = 0;
11609 i++;
11610 continue;
11612 break;
11615 while (i < argc) {
11616 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11617 && complain) {
11618 return JIM_ERR;
11620 i++;
11622 return JIM_OK;
11625 /* [while] */
11626 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11628 if (argc != 3) {
11629 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11630 return JIM_ERR;
11633 /* The general purpose implementation of while starts here */
11634 while (1) {
11635 int boolean, retval;
11637 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11638 return retval;
11639 if (!boolean)
11640 break;
11642 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11643 switch (retval) {
11644 case JIM_BREAK:
11645 goto out;
11646 break;
11647 case JIM_CONTINUE:
11648 continue;
11649 break;
11650 default:
11651 return retval;
11655 out:
11656 Jim_SetEmptyResult(interp);
11657 return JIM_OK;
11660 /* [for] */
11661 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11663 int retval;
11664 int boolean = 1;
11665 Jim_Obj *varNamePtr = NULL;
11666 Jim_Obj *stopVarNamePtr = NULL;
11668 if (argc != 5) {
11669 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11670 return JIM_ERR;
11673 /* Do the initialisation */
11674 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11675 return retval;
11678 /* And do the first test now. Better for optimisation
11679 * if we can do next/test at the bottom of the loop
11681 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11683 /* Ready to do the body as follows:
11684 * while (1) {
11685 * body // check retcode
11686 * next // check retcode
11687 * test // check retcode/test bool
11691 #ifdef JIM_OPTIMIZATION
11692 /* Check if the for is on the form:
11693 * for ... {$i < CONST} {incr i}
11694 * for ... {$i < $j} {incr i}
11696 if (retval == JIM_OK && boolean) {
11697 ScriptObj *incrScript;
11698 ExprByteCode *expr;
11699 jim_wide stop, currentVal;
11700 Jim_Obj *objPtr;
11701 int cmpOffset;
11703 /* Do it only if there aren't shared arguments */
11704 expr = JimGetExpression(interp, argv[2]);
11705 incrScript = Jim_GetScript(interp, argv[3]);
11707 /* Ensure proper lengths to start */
11708 if (incrScript->len != 3 || !expr || expr->len != 3) {
11709 goto evalstart;
11711 /* Ensure proper token types. */
11712 if (incrScript->token[1].type != JIM_TT_ESC ||
11713 expr->token[0].type != JIM_TT_VAR ||
11714 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11715 goto evalstart;
11718 if (expr->token[2].type == JIM_EXPROP_LT) {
11719 cmpOffset = 0;
11721 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11722 cmpOffset = 1;
11724 else {
11725 goto evalstart;
11728 /* Update command must be incr */
11729 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11730 goto evalstart;
11733 /* incr, expression must be about the same variable */
11734 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11735 goto evalstart;
11738 /* Get the stop condition (must be a variable or integer) */
11739 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11740 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11741 goto evalstart;
11744 else {
11745 stopVarNamePtr = expr->token[1].objPtr;
11746 Jim_IncrRefCount(stopVarNamePtr);
11747 /* Keep the compiler happy */
11748 stop = 0;
11751 /* Initialization */
11752 varNamePtr = expr->token[0].objPtr;
11753 Jim_IncrRefCount(varNamePtr);
11755 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11756 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11757 goto testcond;
11760 /* --- OPTIMIZED FOR --- */
11761 while (retval == JIM_OK) {
11762 /* === Check condition === */
11763 /* Note that currentVal is already set here */
11765 /* Immediate or Variable? get the 'stop' value if the latter. */
11766 if (stopVarNamePtr) {
11767 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11768 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11769 goto testcond;
11773 if (currentVal >= stop + cmpOffset) {
11774 break;
11777 /* Eval body */
11778 retval = Jim_EvalObj(interp, argv[4]);
11779 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11780 retval = JIM_OK;
11782 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11784 /* Increment */
11785 if (objPtr == NULL) {
11786 retval = JIM_ERR;
11787 goto out;
11789 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11790 currentVal = ++JimWideValue(objPtr);
11791 Jim_InvalidateStringRep(objPtr);
11793 else {
11794 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11795 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11796 ++currentVal)) != JIM_OK) {
11797 goto evalnext;
11802 goto out;
11804 evalstart:
11805 #endif
11807 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11808 /* Body */
11809 retval = Jim_EvalObj(interp, argv[4]);
11811 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11812 /* increment */
11813 evalnext:
11814 retval = Jim_EvalObj(interp, argv[3]);
11815 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11816 /* test */
11817 testcond:
11818 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11822 out:
11823 if (stopVarNamePtr) {
11824 Jim_DecrRefCount(interp, stopVarNamePtr);
11826 if (varNamePtr) {
11827 Jim_DecrRefCount(interp, varNamePtr);
11830 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11831 Jim_SetEmptyResult(interp);
11832 return JIM_OK;
11835 return retval;
11838 /* [loop] */
11839 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11841 int retval;
11842 jim_wide i;
11843 jim_wide limit;
11844 jim_wide incr = 1;
11845 Jim_Obj *bodyObjPtr;
11847 if (argc != 5 && argc != 6) {
11848 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11849 return JIM_ERR;
11852 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11853 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11854 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11855 return JIM_ERR;
11857 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11859 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11861 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11862 retval = Jim_EvalObj(interp, bodyObjPtr);
11863 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11864 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11866 retval = JIM_OK;
11868 /* Increment */
11869 i += incr;
11871 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11872 if (argv[1]->typePtr != &variableObjType) {
11873 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11874 return JIM_ERR;
11877 JimWideValue(objPtr) = i;
11878 Jim_InvalidateStringRep(objPtr);
11880 /* The following step is required in order to invalidate the
11881 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11882 if (argv[1]->typePtr != &variableObjType) {
11883 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11884 retval = JIM_ERR;
11885 break;
11889 else {
11890 objPtr = Jim_NewIntObj(interp, i);
11891 retval = Jim_SetVariable(interp, argv[1], objPtr);
11892 if (retval != JIM_OK) {
11893 Jim_FreeNewObj(interp, objPtr);
11899 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11900 Jim_SetEmptyResult(interp);
11901 return JIM_OK;
11903 return retval;
11906 /* List iterators make it easy to iterate over a list.
11907 * At some point iterators will be expanded to support generators.
11909 typedef struct {
11910 Jim_Obj *objPtr;
11911 int idx;
11912 } Jim_ListIter;
11915 * Initialise the iterator at the start of the list.
11917 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11919 iter->objPtr = objPtr;
11920 iter->idx = 0;
11924 * Returns the next object from the list, or NULL on end-of-list.
11926 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11928 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11929 return NULL;
11931 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11935 * Returns 1 if end-of-list has been reached.
11937 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11939 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11942 /* foreach + lmap implementation. */
11943 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11945 int result = JIM_ERR;
11946 int i, numargs;
11947 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11948 Jim_ListIter *iters;
11949 Jim_Obj *script;
11950 Jim_Obj *resultObj;
11952 if (argc < 4 || argc % 2 != 0) {
11953 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11954 return JIM_ERR;
11956 script = argv[argc - 1]; /* Last argument is a script */
11957 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11959 if (numargs == 2) {
11960 iters = twoiters;
11962 else {
11963 iters = Jim_Alloc(numargs * sizeof(*iters));
11965 for (i = 0; i < numargs; i++) {
11966 JimListIterInit(&iters[i], argv[i + 1]);
11967 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11968 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11969 return JIM_ERR;
11973 if (doMap) {
11974 resultObj = Jim_NewListObj(interp, NULL, 0);
11976 else {
11977 resultObj = interp->emptyObj;
11979 Jim_IncrRefCount(resultObj);
11981 while (1) {
11982 /* Have we expired all lists? */
11983 for (i = 0; i < numargs; i += 2) {
11984 if (!JimListIterDone(interp, &iters[i + 1])) {
11985 break;
11988 if (i == numargs) {
11989 /* All done */
11990 break;
11993 /* For each list */
11994 for (i = 0; i < numargs; i += 2) {
11995 Jim_Obj *varName;
11997 /* foreach var */
11998 JimListIterInit(&iters[i], argv[i + 1]);
11999 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
12000 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
12001 if (!valObj) {
12002 /* Ran out, so store the empty string */
12003 valObj = interp->emptyObj;
12005 /* Avoid shimmering */
12006 Jim_IncrRefCount(valObj);
12007 result = Jim_SetVariable(interp, varName, valObj);
12008 Jim_DecrRefCount(interp, valObj);
12009 if (result != JIM_OK) {
12010 goto err;
12014 switch (result = Jim_EvalObj(interp, script)) {
12015 case JIM_OK:
12016 if (doMap) {
12017 Jim_ListAppendElement(interp, resultObj, interp->result);
12019 break;
12020 case JIM_CONTINUE:
12021 break;
12022 case JIM_BREAK:
12023 goto out;
12024 default:
12025 goto err;
12028 out:
12029 result = JIM_OK;
12030 Jim_SetResult(interp, resultObj);
12031 err:
12032 Jim_DecrRefCount(interp, resultObj);
12033 if (numargs > 2) {
12034 Jim_Free(iters);
12036 return result;
12039 /* [foreach] */
12040 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12042 return JimForeachMapHelper(interp, argc, argv, 0);
12045 /* [lmap] */
12046 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12048 return JimForeachMapHelper(interp, argc, argv, 1);
12051 /* [lassign] */
12052 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12054 int result = JIM_ERR;
12055 int i;
12056 Jim_ListIter iter;
12057 Jim_Obj *resultObj;
12059 if (argc < 2) {
12060 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12061 return JIM_ERR;
12064 JimListIterInit(&iter, argv[1]);
12066 for (i = 2; i < argc; i++) {
12067 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12068 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12069 if (result != JIM_OK) {
12070 return result;
12074 resultObj = Jim_NewListObj(interp, NULL, 0);
12075 while (!JimListIterDone(interp, &iter)) {
12076 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12079 Jim_SetResult(interp, resultObj);
12081 return JIM_OK;
12084 /* [if] */
12085 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12087 int boolean, retval, current = 1, falsebody = 0;
12089 if (argc >= 3) {
12090 while (1) {
12091 /* Far not enough arguments given! */
12092 if (current >= argc)
12093 goto err;
12094 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12095 != JIM_OK)
12096 return retval;
12097 /* There lacks something, isn't it? */
12098 if (current >= argc)
12099 goto err;
12100 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12101 current++;
12102 /* Tsk tsk, no then-clause? */
12103 if (current >= argc)
12104 goto err;
12105 if (boolean)
12106 return Jim_EvalObj(interp, argv[current]);
12107 /* Ok: no else-clause follows */
12108 if (++current >= argc) {
12109 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12110 return JIM_OK;
12112 falsebody = current++;
12113 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12114 /* IIICKS - else-clause isn't last cmd? */
12115 if (current != argc - 1)
12116 goto err;
12117 return Jim_EvalObj(interp, argv[current]);
12119 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12120 /* Ok: elseif follows meaning all the stuff
12121 * again (how boring...) */
12122 continue;
12123 /* OOPS - else-clause is not last cmd? */
12124 else if (falsebody != argc - 1)
12125 goto err;
12126 return Jim_EvalObj(interp, argv[falsebody]);
12128 return JIM_OK;
12130 err:
12131 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12132 return JIM_ERR;
12136 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12137 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12138 Jim_Obj *stringObj, int nocase)
12140 Jim_Obj *parms[4];
12141 int argc = 0;
12142 long eq;
12143 int rc;
12145 parms[argc++] = commandObj;
12146 if (nocase) {
12147 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12149 parms[argc++] = patternObj;
12150 parms[argc++] = stringObj;
12152 rc = Jim_EvalObjVector(interp, argc, parms);
12154 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12155 eq = -rc;
12158 return eq;
12161 enum
12162 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12164 /* [switch] */
12165 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12167 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12168 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12169 Jim_Obj *script = 0;
12171 if (argc < 3) {
12172 wrongnumargs:
12173 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12174 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12175 return JIM_ERR;
12177 for (opt = 1; opt < argc; ++opt) {
12178 const char *option = Jim_String(argv[opt]);
12180 if (*option != '-')
12181 break;
12182 else if (strncmp(option, "--", 2) == 0) {
12183 ++opt;
12184 break;
12186 else if (strncmp(option, "-exact", 2) == 0)
12187 matchOpt = SWITCH_EXACT;
12188 else if (strncmp(option, "-glob", 2) == 0)
12189 matchOpt = SWITCH_GLOB;
12190 else if (strncmp(option, "-regexp", 2) == 0)
12191 matchOpt = SWITCH_RE;
12192 else if (strncmp(option, "-command", 2) == 0) {
12193 matchOpt = SWITCH_CMD;
12194 if ((argc - opt) < 2)
12195 goto wrongnumargs;
12196 command = argv[++opt];
12198 else {
12199 Jim_SetResultFormatted(interp,
12200 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12201 argv[opt]);
12202 return JIM_ERR;
12204 if ((argc - opt) < 2)
12205 goto wrongnumargs;
12207 strObj = argv[opt++];
12208 patCount = argc - opt;
12209 if (patCount == 1) {
12210 Jim_Obj **vector;
12212 JimListGetElements(interp, argv[opt], &patCount, &vector);
12213 caseList = vector;
12215 else
12216 caseList = &argv[opt];
12217 if (patCount == 0 || patCount % 2 != 0)
12218 goto wrongnumargs;
12219 for (i = 0; script == 0 && i < patCount; i += 2) {
12220 Jim_Obj *patObj = caseList[i];
12222 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12223 || i < (patCount - 2)) {
12224 switch (matchOpt) {
12225 case SWITCH_EXACT:
12226 if (Jim_StringEqObj(strObj, patObj))
12227 script = caseList[i + 1];
12228 break;
12229 case SWITCH_GLOB:
12230 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12231 script = caseList[i + 1];
12232 break;
12233 case SWITCH_RE:
12234 command = Jim_NewStringObj(interp, "regexp", -1);
12235 /* Fall thru intentionally */
12236 case SWITCH_CMD:{
12237 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12239 /* After the execution of a command we need to
12240 * make sure to reconvert the object into a list
12241 * again. Only for the single-list style [switch]. */
12242 if (argc - opt == 1) {
12243 Jim_Obj **vector;
12245 JimListGetElements(interp, argv[opt], &patCount, &vector);
12246 caseList = vector;
12248 /* command is here already decref'd */
12249 if (rc < 0) {
12250 return -rc;
12252 if (rc)
12253 script = caseList[i + 1];
12254 break;
12258 else {
12259 script = caseList[i + 1];
12262 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12263 script = caseList[i + 1];
12264 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12265 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12266 return JIM_ERR;
12268 Jim_SetEmptyResult(interp);
12269 if (script) {
12270 return Jim_EvalObj(interp, script);
12272 return JIM_OK;
12275 /* [list] */
12276 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12278 Jim_Obj *listObjPtr;
12280 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12281 Jim_SetResult(interp, listObjPtr);
12282 return JIM_OK;
12285 /* [lindex] */
12286 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12288 Jim_Obj *objPtr, *listObjPtr;
12289 int i;
12290 int idx;
12292 if (argc < 3) {
12293 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
12294 return JIM_ERR;
12296 objPtr = argv[1];
12297 Jim_IncrRefCount(objPtr);
12298 for (i = 2; i < argc; i++) {
12299 listObjPtr = objPtr;
12300 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12301 Jim_DecrRefCount(interp, listObjPtr);
12302 return JIM_ERR;
12304 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12305 /* Returns an empty object if the index
12306 * is out of range. */
12307 Jim_DecrRefCount(interp, listObjPtr);
12308 Jim_SetEmptyResult(interp);
12309 return JIM_OK;
12311 Jim_IncrRefCount(objPtr);
12312 Jim_DecrRefCount(interp, listObjPtr);
12314 Jim_SetResult(interp, objPtr);
12315 Jim_DecrRefCount(interp, objPtr);
12316 return JIM_OK;
12319 /* [llength] */
12320 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12322 if (argc != 2) {
12323 Jim_WrongNumArgs(interp, 1, argv, "list");
12324 return JIM_ERR;
12326 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12327 return JIM_OK;
12330 /* [lsearch] */
12331 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12333 static const char * const options[] = {
12334 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12335 NULL
12337 enum
12338 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12339 OPT_COMMAND };
12340 int i;
12341 int opt_bool = 0;
12342 int opt_not = 0;
12343 int opt_nocase = 0;
12344 int opt_all = 0;
12345 int opt_inline = 0;
12346 int opt_match = OPT_EXACT;
12347 int listlen;
12348 int rc = JIM_OK;
12349 Jim_Obj *listObjPtr = NULL;
12350 Jim_Obj *commandObj = NULL;
12352 if (argc < 3) {
12353 wrongargs:
12354 Jim_WrongNumArgs(interp, 1, argv,
12355 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12356 return JIM_ERR;
12359 for (i = 1; i < argc - 2; i++) {
12360 int option;
12362 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12363 return JIM_ERR;
12365 switch (option) {
12366 case OPT_BOOL:
12367 opt_bool = 1;
12368 opt_inline = 0;
12369 break;
12370 case OPT_NOT:
12371 opt_not = 1;
12372 break;
12373 case OPT_NOCASE:
12374 opt_nocase = 1;
12375 break;
12376 case OPT_INLINE:
12377 opt_inline = 1;
12378 opt_bool = 0;
12379 break;
12380 case OPT_ALL:
12381 opt_all = 1;
12382 break;
12383 case OPT_COMMAND:
12384 if (i >= argc - 2) {
12385 goto wrongargs;
12387 commandObj = argv[++i];
12388 /* fallthru */
12389 case OPT_EXACT:
12390 case OPT_GLOB:
12391 case OPT_REGEXP:
12392 opt_match = option;
12393 break;
12397 argv += i;
12399 if (opt_all) {
12400 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12402 if (opt_match == OPT_REGEXP) {
12403 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12405 if (commandObj) {
12406 Jim_IncrRefCount(commandObj);
12409 listlen = Jim_ListLength(interp, argv[0]);
12410 for (i = 0; i < listlen; i++) {
12411 Jim_Obj *objPtr;
12412 int eq = 0;
12414 Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
12415 switch (opt_match) {
12416 case OPT_EXACT:
12417 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12418 break;
12420 case OPT_GLOB:
12421 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12422 break;
12424 case OPT_REGEXP:
12425 case OPT_COMMAND:
12426 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12427 if (eq < 0) {
12428 if (listObjPtr) {
12429 Jim_FreeNewObj(interp, listObjPtr);
12431 rc = JIM_ERR;
12432 goto done;
12434 break;
12437 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12438 if (!eq && opt_bool && opt_not && !opt_all) {
12439 continue;
12442 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12443 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12444 Jim_Obj *resultObj;
12446 if (opt_bool) {
12447 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12449 else if (!opt_inline) {
12450 resultObj = Jim_NewIntObj(interp, i);
12452 else {
12453 resultObj = objPtr;
12456 if (opt_all) {
12457 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12459 else {
12460 Jim_SetResult(interp, resultObj);
12461 goto done;
12466 if (opt_all) {
12467 Jim_SetResult(interp, listObjPtr);
12469 else {
12470 /* No match */
12471 if (opt_bool) {
12472 Jim_SetResultBool(interp, opt_not);
12474 else if (!opt_inline) {
12475 Jim_SetResultInt(interp, -1);
12479 done:
12480 if (commandObj) {
12481 Jim_DecrRefCount(interp, commandObj);
12483 return rc;
12486 /* [lappend] */
12487 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12489 Jim_Obj *listObjPtr;
12490 int shared, i;
12492 if (argc < 2) {
12493 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12494 return JIM_ERR;
12496 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12497 if (!listObjPtr) {
12498 /* Create the list if it does not exists */
12499 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12500 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12501 Jim_FreeNewObj(interp, listObjPtr);
12502 return JIM_ERR;
12505 shared = Jim_IsShared(listObjPtr);
12506 if (shared)
12507 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12508 for (i = 2; i < argc; i++)
12509 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12510 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12511 if (shared)
12512 Jim_FreeNewObj(interp, listObjPtr);
12513 return JIM_ERR;
12515 Jim_SetResult(interp, listObjPtr);
12516 return JIM_OK;
12519 /* [linsert] */
12520 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12522 int idx, len;
12523 Jim_Obj *listPtr;
12525 if (argc < 3) {
12526 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12527 return JIM_ERR;
12529 listPtr = argv[1];
12530 if (Jim_IsShared(listPtr))
12531 listPtr = Jim_DuplicateObj(interp, listPtr);
12532 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12533 goto err;
12534 len = Jim_ListLength(interp, listPtr);
12535 if (idx >= len)
12536 idx = len;
12537 else if (idx < 0)
12538 idx = len + idx + 1;
12539 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12540 Jim_SetResult(interp, listPtr);
12541 return JIM_OK;
12542 err:
12543 if (listPtr != argv[1]) {
12544 Jim_FreeNewObj(interp, listPtr);
12546 return JIM_ERR;
12549 /* [lreplace] */
12550 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12552 int first, last, len, rangeLen;
12553 Jim_Obj *listObj;
12554 Jim_Obj *newListObj;
12556 if (argc < 4) {
12557 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12558 return JIM_ERR;
12560 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12561 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12562 return JIM_ERR;
12565 listObj = argv[1];
12566 len = Jim_ListLength(interp, listObj);
12568 first = JimRelToAbsIndex(len, first);
12569 last = JimRelToAbsIndex(len, last);
12570 JimRelToAbsRange(len, &first, &last, &rangeLen);
12572 /* Now construct a new list which consists of:
12573 * <elements before first> <supplied elements> <elements after last>
12576 /* Check to see if trying to replace past the end of the list */
12577 if (first < len) {
12578 /* OK. Not past the end */
12580 else if (len == 0) {
12581 /* Special for empty list, adjust first to 0 */
12582 first = 0;
12584 else {
12585 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12586 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12587 return JIM_ERR;
12590 /* Add the first set of elements */
12591 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12593 /* Add supplied elements */
12594 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12596 /* Add the remaining elements */
12597 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12599 Jim_SetResult(interp, newListObj);
12600 return JIM_OK;
12603 /* [lset] */
12604 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12606 if (argc < 3) {
12607 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12608 return JIM_ERR;
12610 else if (argc == 3) {
12611 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12612 return JIM_ERR;
12613 Jim_SetResult(interp, argv[2]);
12614 return JIM_OK;
12616 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1])
12617 == JIM_ERR)
12618 return JIM_ERR;
12619 return JIM_OK;
12622 /* [lsort] */
12623 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12625 static const char * const options[] = {
12626 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12628 enum
12629 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12630 Jim_Obj *resObj;
12631 int i;
12632 int retCode;
12634 struct lsort_info info;
12636 if (argc < 2) {
12637 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12638 return JIM_ERR;
12641 info.type = JIM_LSORT_ASCII;
12642 info.order = 1;
12643 info.indexed = 0;
12644 info.unique = 0;
12645 info.command = NULL;
12646 info.interp = interp;
12648 for (i = 1; i < (argc - 1); i++) {
12649 int option;
12651 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12652 != JIM_OK)
12653 return JIM_ERR;
12654 switch (option) {
12655 case OPT_ASCII:
12656 info.type = JIM_LSORT_ASCII;
12657 break;
12658 case OPT_NOCASE:
12659 info.type = JIM_LSORT_NOCASE;
12660 break;
12661 case OPT_INTEGER:
12662 info.type = JIM_LSORT_INTEGER;
12663 break;
12664 case OPT_REAL:
12665 info.type = JIM_LSORT_REAL;
12666 break;
12667 case OPT_INCREASING:
12668 info.order = 1;
12669 break;
12670 case OPT_DECREASING:
12671 info.order = -1;
12672 break;
12673 case OPT_UNIQUE:
12674 info.unique = 1;
12675 break;
12676 case OPT_COMMAND:
12677 if (i >= (argc - 2)) {
12678 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12679 return JIM_ERR;
12681 info.type = JIM_LSORT_COMMAND;
12682 info.command = argv[i + 1];
12683 i++;
12684 break;
12685 case OPT_INDEX:
12686 if (i >= (argc - 2)) {
12687 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12688 return JIM_ERR;
12690 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12691 return JIM_ERR;
12693 info.indexed = 1;
12694 i++;
12695 break;
12698 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12699 retCode = ListSortElements(interp, resObj, &info);
12700 if (retCode == JIM_OK) {
12701 Jim_SetResult(interp, resObj);
12703 else {
12704 Jim_FreeNewObj(interp, resObj);
12706 return retCode;
12709 /* [append] */
12710 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12712 Jim_Obj *stringObjPtr;
12713 int i;
12715 if (argc < 2) {
12716 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12717 return JIM_ERR;
12719 if (argc == 2) {
12720 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12721 if (!stringObjPtr)
12722 return JIM_ERR;
12724 else {
12725 int freeobj = 0;
12726 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12727 if (!stringObjPtr) {
12728 /* Create the string if it doesn't exist */
12729 stringObjPtr = Jim_NewEmptyStringObj(interp);
12730 freeobj = 1;
12732 else if (Jim_IsShared(stringObjPtr)) {
12733 freeobj = 1;
12734 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12736 for (i = 2; i < argc; i++) {
12737 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12739 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12740 if (freeobj) {
12741 Jim_FreeNewObj(interp, stringObjPtr);
12743 return JIM_ERR;
12746 Jim_SetResult(interp, stringObjPtr);
12747 return JIM_OK;
12750 /* [debug] */
12751 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12753 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12754 static const char * const options[] = {
12755 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12756 "exprbc", "show",
12757 NULL
12759 enum
12761 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12762 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12764 int option;
12766 if (argc < 2) {
12767 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12768 return JIM_ERR;
12770 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12771 return JIM_ERR;
12772 if (option == OPT_REFCOUNT) {
12773 if (argc != 3) {
12774 Jim_WrongNumArgs(interp, 2, argv, "object");
12775 return JIM_ERR;
12777 Jim_SetResultInt(interp, argv[2]->refCount);
12778 return JIM_OK;
12780 else if (option == OPT_OBJCOUNT) {
12781 int freeobj = 0, liveobj = 0;
12782 char buf[256];
12783 Jim_Obj *objPtr;
12785 if (argc != 2) {
12786 Jim_WrongNumArgs(interp, 2, argv, "");
12787 return JIM_ERR;
12789 /* Count the number of free objects. */
12790 objPtr = interp->freeList;
12791 while (objPtr) {
12792 freeobj++;
12793 objPtr = objPtr->nextObjPtr;
12795 /* Count the number of live objects. */
12796 objPtr = interp->liveList;
12797 while (objPtr) {
12798 liveobj++;
12799 objPtr = objPtr->nextObjPtr;
12801 /* Set the result string and return. */
12802 sprintf(buf, "free %d used %d", freeobj, liveobj);
12803 Jim_SetResultString(interp, buf, -1);
12804 return JIM_OK;
12806 else if (option == OPT_OBJECTS) {
12807 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12809 /* Count the number of live objects. */
12810 objPtr = interp->liveList;
12811 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12812 while (objPtr) {
12813 char buf[128];
12814 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12816 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12817 sprintf(buf, "%p", objPtr);
12818 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12819 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12820 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12821 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12822 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12823 objPtr = objPtr->nextObjPtr;
12825 Jim_SetResult(interp, listObjPtr);
12826 return JIM_OK;
12828 else if (option == OPT_INVSTR) {
12829 Jim_Obj *objPtr;
12831 if (argc != 3) {
12832 Jim_WrongNumArgs(interp, 2, argv, "object");
12833 return JIM_ERR;
12835 objPtr = argv[2];
12836 if (objPtr->typePtr != NULL)
12837 Jim_InvalidateStringRep(objPtr);
12838 Jim_SetEmptyResult(interp);
12839 return JIM_OK;
12841 else if (option == OPT_SHOW) {
12842 const char *s;
12843 int len, charlen;
12845 if (argc != 3) {
12846 Jim_WrongNumArgs(interp, 2, argv, "object");
12847 return JIM_ERR;
12849 s = Jim_GetString(argv[2], &len);
12850 #ifdef JIM_UTF8
12851 charlen = utf8_strlen(s, len);
12852 #else
12853 charlen = len;
12854 #endif
12855 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12856 printf("chars (%d): <<%s>>\n", charlen, s);
12857 printf("bytes (%d):", len);
12858 while (len--) {
12859 printf(" %02x", (unsigned char)*s++);
12861 printf("\n");
12862 return JIM_OK;
12864 else if (option == OPT_SCRIPTLEN) {
12865 ScriptObj *script;
12867 if (argc != 3) {
12868 Jim_WrongNumArgs(interp, 2, argv, "script");
12869 return JIM_ERR;
12871 script = Jim_GetScript(interp, argv[2]);
12872 Jim_SetResultInt(interp, script->len);
12873 return JIM_OK;
12875 else if (option == OPT_EXPRLEN) {
12876 ExprByteCode *expr;
12878 if (argc != 3) {
12879 Jim_WrongNumArgs(interp, 2, argv, "expression");
12880 return JIM_ERR;
12882 expr = JimGetExpression(interp, argv[2]);
12883 if (expr == NULL)
12884 return JIM_ERR;
12885 Jim_SetResultInt(interp, expr->len);
12886 return JIM_OK;
12888 else if (option == OPT_EXPRBC) {
12889 Jim_Obj *objPtr;
12890 ExprByteCode *expr;
12891 int i;
12893 if (argc != 3) {
12894 Jim_WrongNumArgs(interp, 2, argv, "expression");
12895 return JIM_ERR;
12897 expr = JimGetExpression(interp, argv[2]);
12898 if (expr == NULL)
12899 return JIM_ERR;
12900 objPtr = Jim_NewListObj(interp, NULL, 0);
12901 for (i = 0; i < expr->len; i++) {
12902 const char *type;
12903 const Jim_ExprOperator *op;
12904 Jim_Obj *obj = expr->token[i].objPtr;
12906 switch (expr->token[i].type) {
12907 case JIM_TT_EXPR_INT:
12908 type = "int";
12909 break;
12910 case JIM_TT_EXPR_DOUBLE:
12911 type = "double";
12912 break;
12913 case JIM_TT_CMD:
12914 type = "command";
12915 break;
12916 case JIM_TT_VAR:
12917 type = "variable";
12918 break;
12919 case JIM_TT_DICTSUGAR:
12920 type = "dictsugar";
12921 break;
12922 case JIM_TT_EXPRSUGAR:
12923 type = "exprsugar";
12924 break;
12925 case JIM_TT_ESC:
12926 type = "subst";
12927 break;
12928 case JIM_TT_STR:
12929 type = "string";
12930 break;
12931 default:
12932 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12933 if (op == NULL) {
12934 type = "private";
12936 else {
12937 type = "operator";
12939 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12940 break;
12942 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12943 Jim_ListAppendElement(interp, objPtr, obj);
12945 Jim_SetResult(interp, objPtr);
12946 return JIM_OK;
12948 else {
12949 Jim_SetResultString(interp,
12950 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12951 return JIM_ERR;
12953 /* unreached */
12954 #endif /* JIM_BOOTSTRAP */
12955 #if !defined(JIM_DEBUG_COMMAND)
12956 Jim_SetResultString(interp, "unsupported", -1);
12957 return JIM_ERR;
12958 #endif
12961 /* [eval] */
12962 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12964 int rc;
12966 if (argc < 2) {
12967 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12968 return JIM_ERR;
12971 if (argc == 2) {
12972 rc = Jim_EvalObj(interp, argv[1]);
12974 else {
12975 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12978 if (rc == JIM_ERR) {
12979 /* eval is "interesting", so add a stack frame here */
12980 interp->addStackTrace++;
12982 return rc;
12985 /* [uplevel] */
12986 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12988 if (argc >= 2) {
12989 int retcode;
12990 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12991 int savedTailcall;
12992 const char *str;
12994 /* Save the old callframe pointer */
12995 savedCallFrame = interp->framePtr;
12997 /* Lookup the target frame pointer */
12998 str = Jim_String(argv[1]);
12999 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
13000 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13001 argc--;
13002 argv++;
13004 else {
13005 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13007 if (targetCallFrame == NULL) {
13008 return JIM_ERR;
13010 if (argc < 2) {
13011 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
13012 return JIM_ERR;
13014 /* Eval the code in the target callframe. */
13015 interp->framePtr = targetCallFrame;
13016 /* Can't merge tailcalls across upcall */
13017 savedTailcall = interp->framePtr->tailcall;
13018 interp->framePtr->tailcall = 0;
13019 if (argc == 2) {
13020 retcode = Jim_EvalObj(interp, argv[1]);
13022 else {
13023 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13025 interp->framePtr->tailcall = savedTailcall;
13026 interp->framePtr = savedCallFrame;
13027 return retcode;
13029 else {
13030 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
13031 return JIM_ERR;
13035 /* [expr] */
13036 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13038 Jim_Obj *exprResultPtr;
13039 int retcode;
13041 if (argc == 2) {
13042 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
13044 else if (argc > 2) {
13045 Jim_Obj *objPtr;
13047 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13048 Jim_IncrRefCount(objPtr);
13049 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
13050 Jim_DecrRefCount(interp, objPtr);
13052 else {
13053 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13054 return JIM_ERR;
13056 if (retcode != JIM_OK)
13057 return retcode;
13058 Jim_SetResult(interp, exprResultPtr);
13059 Jim_DecrRefCount(interp, exprResultPtr);
13060 return JIM_OK;
13063 /* [break] */
13064 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13066 if (argc != 1) {
13067 Jim_WrongNumArgs(interp, 1, argv, "");
13068 return JIM_ERR;
13070 return JIM_BREAK;
13073 /* [continue] */
13074 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13076 if (argc != 1) {
13077 Jim_WrongNumArgs(interp, 1, argv, "");
13078 return JIM_ERR;
13080 return JIM_CONTINUE;
13083 /* [return] */
13084 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13086 int i;
13087 Jim_Obj *stackTraceObj = NULL;
13088 Jim_Obj *errorCodeObj = NULL;
13089 int returnCode = JIM_OK;
13090 long level = 1;
13092 for (i = 1; i < argc - 1; i += 2) {
13093 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13094 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13095 return JIM_ERR;
13098 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13099 stackTraceObj = argv[i + 1];
13101 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13102 errorCodeObj = argv[i + 1];
13104 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13105 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13106 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13107 return JIM_ERR;
13110 else {
13111 break;
13115 if (i != argc - 1 && i != argc) {
13116 Jim_WrongNumArgs(interp, 1, argv,
13117 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13120 /* If a stack trace is supplied and code is error, set the stack trace */
13121 if (stackTraceObj && returnCode == JIM_ERR) {
13122 JimSetStackTrace(interp, stackTraceObj);
13124 /* If an error code list is supplied, set the global $errorCode */
13125 if (errorCodeObj && returnCode == JIM_ERR) {
13126 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13128 interp->returnCode = returnCode;
13129 interp->returnLevel = level;
13131 if (i == argc - 1) {
13132 Jim_SetResult(interp, argv[i]);
13134 return JIM_RETURN;
13137 /* [tailcall] */
13138 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13140 if (interp->framePtr->level == 0) {
13141 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13142 return JIM_ERR;
13144 else if (argc >= 2) {
13145 /* Need to resolve the tailcall command in the current context */
13146 Jim_CallFrame *cf = interp->framePtr->parent;
13148 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13149 if (cmdPtr == NULL) {
13150 return JIM_ERR;
13153 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13155 /* And stash this pre-resolved command */
13156 JimIncrCmdRefCount(cmdPtr);
13157 cf->tailcallCmd = cmdPtr;
13159 /* And stash the command list */
13160 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13162 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13163 Jim_IncrRefCount(cf->tailcallObj);
13165 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13166 return JIM_EVAL;
13168 return JIM_OK;
13171 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13173 Jim_Obj *cmdList;
13174 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13176 /* prefixListObj is a list to which the args need to be appended */
13177 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13178 ListInsertElements(cmdList, -1, argc - 1, argv + 1);
13180 return JimEvalObjList(interp, cmdList);
13183 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13185 Jim_Obj *prefixListObj = privData;
13186 Jim_DecrRefCount(interp, prefixListObj);
13189 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13191 Jim_Obj *prefixListObj;
13192 const char *newname;
13194 if (argc < 3) {
13195 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13196 return JIM_ERR;
13199 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13200 Jim_IncrRefCount(prefixListObj);
13201 newname = Jim_String(argv[1]);
13202 if (newname[0] == ':' && newname[1] == ':') {
13203 while (*++newname == ':') {
13207 Jim_SetResult(interp, argv[1]);
13209 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13212 /* [proc] */
13213 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13215 Jim_Cmd *cmd;
13217 if (argc != 4 && argc != 5) {
13218 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13219 return JIM_ERR;
13222 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13223 return JIM_ERR;
13226 if (argc == 4) {
13227 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13229 else {
13230 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13233 if (cmd) {
13234 /* Add the new command */
13235 Jim_Obj *qualifiedCmdNameObj;
13236 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13238 JimCreateCommand(interp, cmdname, cmd);
13240 /* Calculate and set the namespace for this proc */
13241 JimUpdateProcNamespace(interp, cmd, cmdname);
13243 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13245 /* Unlike Tcl, set the name of the proc as the result */
13246 Jim_SetResult(interp, argv[1]);
13247 return JIM_OK;
13249 return JIM_ERR;
13252 /* [local] */
13253 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13255 int retcode;
13257 if (argc < 2) {
13258 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13259 return JIM_ERR;
13262 /* Evaluate the arguments with 'local' in force */
13263 interp->local++;
13264 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13265 interp->local--;
13268 /* If OK, and the result is a proc, add it to the list of local procs */
13269 if (retcode == 0) {
13270 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13272 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13273 return JIM_ERR;
13275 if (interp->framePtr->localCommands == NULL) {
13276 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13277 Jim_InitStack(interp->framePtr->localCommands);
13279 Jim_IncrRefCount(cmdNameObj);
13280 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13283 return retcode;
13286 /* [upcall] */
13287 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13289 if (argc < 2) {
13290 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13291 return JIM_ERR;
13293 else {
13294 int retcode;
13296 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13297 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13298 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13299 return JIM_ERR;
13301 /* OK. Mark this command as being in an upcall */
13302 cmdPtr->u.proc.upcall++;
13303 JimIncrCmdRefCount(cmdPtr);
13305 /* Invoke the command as normal */
13306 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13308 /* No longer in an upcall */
13309 cmdPtr->u.proc.upcall--;
13310 JimDecrCmdRefCount(interp, cmdPtr);
13312 return retcode;
13316 /* [apply] */
13317 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13319 if (argc < 2) {
13320 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13321 return JIM_ERR;
13323 else {
13324 int ret;
13325 Jim_Cmd *cmd;
13326 Jim_Obj *argListObjPtr;
13327 Jim_Obj *bodyObjPtr;
13328 Jim_Obj *nsObj = NULL;
13329 Jim_Obj **nargv;
13331 int len = Jim_ListLength(interp, argv[1]);
13332 if (len != 2 && len != 3) {
13333 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13334 return JIM_ERR;
13337 if (len == 3) {
13338 #ifdef jim_ext_namespace
13339 /* Need to canonicalise the given namespace. */
13340 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13341 #else
13342 Jim_SetResultString(interp, "namespaces not enabled", -1);
13343 return JIM_ERR;
13344 #endif
13346 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13347 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13349 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13351 if (cmd) {
13352 /* Create a new argv array with a dummy argv[0], for error messages */
13353 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13354 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13355 Jim_IncrRefCount(nargv[0]);
13356 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13357 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13358 Jim_DecrRefCount(interp, nargv[0]);
13359 Jim_Free(nargv);
13361 JimDecrCmdRefCount(interp, cmd);
13362 return ret;
13364 return JIM_ERR;
13369 /* [concat] */
13370 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13372 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13373 return JIM_OK;
13376 /* [upvar] */
13377 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13379 int i;
13380 Jim_CallFrame *targetCallFrame;
13382 /* Lookup the target frame pointer */
13383 if (argc > 3 && (argc % 2 == 0)) {
13384 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13385 argc--;
13386 argv++;
13388 else {
13389 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13391 if (targetCallFrame == NULL) {
13392 return JIM_ERR;
13395 /* Check for arity */
13396 if (argc < 3) {
13397 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13398 return JIM_ERR;
13401 /* Now... for every other/local couple: */
13402 for (i = 1; i < argc; i += 2) {
13403 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13404 return JIM_ERR;
13406 return JIM_OK;
13409 /* [global] */
13410 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13412 int i;
13414 if (argc < 2) {
13415 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13416 return JIM_ERR;
13418 /* Link every var to the toplevel having the same name */
13419 if (interp->framePtr->level == 0)
13420 return JIM_OK; /* global at toplevel... */
13421 for (i = 1; i < argc; i++) {
13422 /* global ::blah does nothing */
13423 const char *name = Jim_String(argv[i]);
13424 if (name[0] != ':' || name[1] != ':') {
13425 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13426 return JIM_ERR;
13429 return JIM_OK;
13432 /* does the [string map] operation. On error NULL is returned,
13433 * otherwise a new string object with the result, having refcount = 0,
13434 * is returned. */
13435 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13436 Jim_Obj *objPtr, int nocase)
13438 int numMaps;
13439 const char *str, *noMatchStart = NULL;
13440 int strLen, i;
13441 Jim_Obj *resultObjPtr;
13443 numMaps = Jim_ListLength(interp, mapListObjPtr);
13444 if (numMaps % 2) {
13445 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13446 return NULL;
13449 str = Jim_String(objPtr);
13450 strLen = Jim_Utf8Length(interp, objPtr);
13452 /* Map it */
13453 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13454 while (strLen) {
13455 for (i = 0; i < numMaps; i += 2) {
13456 Jim_Obj *objPtr;
13457 const char *k;
13458 int kl;
13460 Jim_ListIndex(interp, mapListObjPtr, i, &objPtr, JIM_NONE);
13461 k = Jim_String(objPtr);
13462 kl = Jim_Utf8Length(interp, objPtr);
13464 if (strLen >= kl && kl) {
13465 int rc;
13466 rc = JimStringCompareLen(str, k, kl, nocase);
13467 if (rc == 0) {
13468 if (noMatchStart) {
13469 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13470 noMatchStart = NULL;
13472 Jim_ListIndex(interp, mapListObjPtr, i + 1, &objPtr, JIM_NONE);
13473 Jim_AppendObj(interp, resultObjPtr, objPtr);
13474 str += utf8_index(str, kl);
13475 strLen -= kl;
13476 break;
13480 if (i == numMaps) { /* no match */
13481 int c;
13482 if (noMatchStart == NULL)
13483 noMatchStart = str;
13484 str += utf8_tounicode(str, &c);
13485 strLen--;
13488 if (noMatchStart) {
13489 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13491 return resultObjPtr;
13494 /* [string] */
13495 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13497 int len;
13498 int opt_case = 1;
13499 int option;
13500 static const char * const options[] = {
13501 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13502 "map", "repeat", "reverse", "index", "first", "last",
13503 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13505 enum
13507 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13508 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
13509 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13511 static const char * const nocase_options[] = {
13512 "-nocase", NULL
13514 static const char * const nocase_length_options[] = {
13515 "-nocase", "-length", NULL
13518 if (argc < 2) {
13519 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13520 return JIM_ERR;
13522 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13523 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13524 return JIM_ERR;
13526 switch (option) {
13527 case OPT_LENGTH:
13528 case OPT_BYTELENGTH:
13529 if (argc != 3) {
13530 Jim_WrongNumArgs(interp, 2, argv, "string");
13531 return JIM_ERR;
13533 if (option == OPT_LENGTH) {
13534 len = Jim_Utf8Length(interp, argv[2]);
13536 else {
13537 len = Jim_Length(argv[2]);
13539 Jim_SetResultInt(interp, len);
13540 return JIM_OK;
13542 case OPT_COMPARE:
13543 case OPT_EQUAL:
13545 /* n is the number of remaining option args */
13546 long opt_length = -1;
13547 int n = argc - 4;
13548 int i = 2;
13549 while (n > 0) {
13550 int subopt;
13551 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13552 JIM_ENUM_ABBREV) != JIM_OK) {
13553 badcompareargs:
13554 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13555 return JIM_ERR;
13557 if (subopt == 0) {
13558 /* -nocase */
13559 opt_case = 0;
13560 n--;
13562 else {
13563 /* -length */
13564 if (n < 2) {
13565 goto badcompareargs;
13567 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13568 return JIM_ERR;
13570 n -= 2;
13573 if (n) {
13574 goto badcompareargs;
13576 argv += argc - 2;
13577 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13578 /* Fast version - [string equal], case sensitive, no length */
13579 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13581 else {
13582 if (opt_length >= 0) {
13583 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13585 else {
13586 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13588 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13590 return JIM_OK;
13593 case OPT_MATCH:
13594 if (argc != 4 &&
13595 (argc != 5 ||
13596 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13597 JIM_ENUM_ABBREV) != JIM_OK)) {
13598 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13599 return JIM_ERR;
13601 if (opt_case == 0) {
13602 argv++;
13604 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13605 return JIM_OK;
13607 case OPT_MAP:{
13608 Jim_Obj *objPtr;
13610 if (argc != 4 &&
13611 (argc != 5 ||
13612 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13613 JIM_ENUM_ABBREV) != JIM_OK)) {
13614 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13615 return JIM_ERR;
13618 if (opt_case == 0) {
13619 argv++;
13621 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13622 if (objPtr == NULL) {
13623 return JIM_ERR;
13625 Jim_SetResult(interp, objPtr);
13626 return JIM_OK;
13629 case OPT_RANGE:
13630 case OPT_BYTERANGE:{
13631 Jim_Obj *objPtr;
13633 if (argc != 5) {
13634 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13635 return JIM_ERR;
13637 if (option == OPT_RANGE) {
13638 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13640 else
13642 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13645 if (objPtr == NULL) {
13646 return JIM_ERR;
13648 Jim_SetResult(interp, objPtr);
13649 return JIM_OK;
13652 case OPT_REPLACE:{
13653 Jim_Obj *objPtr;
13655 if (argc != 5 && argc != 6) {
13656 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13657 return JIM_ERR;
13659 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13660 if (objPtr == NULL) {
13661 return JIM_ERR;
13663 Jim_SetResult(interp, objPtr);
13664 return JIM_OK;
13668 case OPT_REPEAT:{
13669 Jim_Obj *objPtr;
13670 jim_wide count;
13672 if (argc != 4) {
13673 Jim_WrongNumArgs(interp, 2, argv, "string count");
13674 return JIM_ERR;
13676 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13677 return JIM_ERR;
13679 objPtr = Jim_NewStringObj(interp, "", 0);
13680 if (count > 0) {
13681 while (count--) {
13682 Jim_AppendObj(interp, objPtr, argv[2]);
13685 Jim_SetResult(interp, objPtr);
13686 return JIM_OK;
13689 case OPT_REVERSE:{
13690 char *buf, *p;
13691 const char *str;
13692 int len;
13693 int i;
13695 if (argc != 3) {
13696 Jim_WrongNumArgs(interp, 2, argv, "string");
13697 return JIM_ERR;
13700 str = Jim_GetString(argv[2], &len);
13701 buf = Jim_Alloc(len + 1);
13702 p = buf + len;
13703 *p = 0;
13704 for (i = 0; i < len; ) {
13705 int c;
13706 int l = utf8_tounicode(str, &c);
13707 memcpy(p - l, str, l);
13708 p -= l;
13709 i += l;
13710 str += l;
13712 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13713 return JIM_OK;
13716 case OPT_INDEX:{
13717 int idx;
13718 const char *str;
13720 if (argc != 4) {
13721 Jim_WrongNumArgs(interp, 2, argv, "string index");
13722 return JIM_ERR;
13724 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13725 return JIM_ERR;
13727 str = Jim_String(argv[2]);
13728 len = Jim_Utf8Length(interp, argv[2]);
13729 if (idx != INT_MIN && idx != INT_MAX) {
13730 idx = JimRelToAbsIndex(len, idx);
13732 if (idx < 0 || idx >= len || str == NULL) {
13733 Jim_SetResultString(interp, "", 0);
13735 else if (len == Jim_Length(argv[2])) {
13736 /* ASCII optimisation */
13737 Jim_SetResultString(interp, str + idx, 1);
13739 else {
13740 int c;
13741 int i = utf8_index(str, idx);
13742 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13744 return JIM_OK;
13747 case OPT_FIRST:
13748 case OPT_LAST:{
13749 int idx = 0, l1, l2;
13750 const char *s1, *s2;
13752 if (argc != 4 && argc != 5) {
13753 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13754 return JIM_ERR;
13756 s1 = Jim_String(argv[2]);
13757 s2 = Jim_String(argv[3]);
13758 l1 = Jim_Utf8Length(interp, argv[2]);
13759 l2 = Jim_Utf8Length(interp, argv[3]);
13760 if (argc == 5) {
13761 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13762 return JIM_ERR;
13764 idx = JimRelToAbsIndex(l2, idx);
13766 else if (option == OPT_LAST) {
13767 idx = l2;
13769 if (option == OPT_FIRST) {
13770 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13772 else {
13773 #ifdef JIM_UTF8
13774 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13775 #else
13776 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13777 #endif
13779 return JIM_OK;
13782 case OPT_TRIM:
13783 case OPT_TRIMLEFT:
13784 case OPT_TRIMRIGHT:{
13785 Jim_Obj *trimchars;
13787 if (argc != 3 && argc != 4) {
13788 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13789 return JIM_ERR;
13791 trimchars = (argc == 4 ? argv[3] : NULL);
13792 if (option == OPT_TRIM) {
13793 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13795 else if (option == OPT_TRIMLEFT) {
13796 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13798 else if (option == OPT_TRIMRIGHT) {
13799 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13801 return JIM_OK;
13804 case OPT_TOLOWER:
13805 case OPT_TOUPPER:
13806 case OPT_TOTITLE:
13807 if (argc != 3) {
13808 Jim_WrongNumArgs(interp, 2, argv, "string");
13809 return JIM_ERR;
13811 if (option == OPT_TOLOWER) {
13812 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13814 else if (option == OPT_TOUPPER) {
13815 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13817 else {
13818 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13820 return JIM_OK;
13822 case OPT_IS:
13823 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13824 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13826 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13827 return JIM_ERR;
13829 return JIM_OK;
13832 /* [time] */
13833 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13835 long i, count = 1;
13836 jim_wide start, elapsed;
13837 char buf[60];
13838 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13840 if (argc < 2) {
13841 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13842 return JIM_ERR;
13844 if (argc == 3) {
13845 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13846 return JIM_ERR;
13848 if (count < 0)
13849 return JIM_OK;
13850 i = count;
13851 start = JimClock();
13852 while (i-- > 0) {
13853 int retval;
13855 retval = Jim_EvalObj(interp, argv[1]);
13856 if (retval != JIM_OK) {
13857 return retval;
13860 elapsed = JimClock() - start;
13861 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13862 Jim_SetResultString(interp, buf, -1);
13863 return JIM_OK;
13866 /* [exit] */
13867 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13869 long exitCode = 0;
13871 if (argc > 2) {
13872 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13873 return JIM_ERR;
13875 if (argc == 2) {
13876 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13877 return JIM_ERR;
13879 interp->exitCode = exitCode;
13880 return JIM_EXIT;
13883 /* [catch] */
13884 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13886 int exitCode = 0;
13887 int i;
13888 int sig = 0;
13890 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13891 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13892 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13894 /* Reset the error code before catch.
13895 * Note that this is not strictly correct.
13897 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13899 for (i = 1; i < argc - 1; i++) {
13900 const char *arg = Jim_String(argv[i]);
13901 jim_wide option;
13902 int ignore;
13904 /* It's a pity we can't use Jim_GetEnum here :-( */
13905 if (strcmp(arg, "--") == 0) {
13906 i++;
13907 break;
13909 if (*arg != '-') {
13910 break;
13913 if (strncmp(arg, "-no", 3) == 0) {
13914 arg += 3;
13915 ignore = 1;
13917 else {
13918 arg++;
13919 ignore = 0;
13922 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13923 option = -1;
13925 if (option < 0) {
13926 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13928 if (option < 0) {
13929 goto wrongargs;
13932 if (ignore) {
13933 ignore_mask |= (1 << option);
13935 else {
13936 ignore_mask &= ~(1 << option);
13940 argc -= i;
13941 if (argc < 1 || argc > 3) {
13942 wrongargs:
13943 Jim_WrongNumArgs(interp, 1, argv,
13944 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13945 return JIM_ERR;
13947 argv += i;
13949 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13950 sig++;
13953 interp->signal_level += sig;
13954 if (Jim_CheckSignal(interp)) {
13955 /* If a signal is set, don't even try to execute the body */
13956 exitCode = JIM_SIGNAL;
13958 else {
13959 exitCode = Jim_EvalObj(interp, argv[0]);
13960 /* Don't want any caught error included in a later stack trace */
13961 interp->errorFlag = 0;
13963 interp->signal_level -= sig;
13965 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13966 if (exitCode >= 0 && exitCode < max_ignore_code && ((1 << exitCode) & ignore_mask)) {
13967 /* Not caught, pass it up */
13968 return exitCode;
13971 if (sig && exitCode == JIM_SIGNAL) {
13972 /* Catch the signal at this level */
13973 if (interp->signal_set_result) {
13974 interp->signal_set_result(interp, interp->sigmask);
13976 else {
13977 Jim_SetResultInt(interp, interp->sigmask);
13979 interp->sigmask = 0;
13982 if (argc >= 2) {
13983 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13984 return JIM_ERR;
13986 if (argc == 3) {
13987 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13989 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13990 Jim_ListAppendElement(interp, optListObj,
13991 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13992 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13993 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13994 if (exitCode == JIM_ERR) {
13995 Jim_Obj *errorCode;
13996 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13997 -1));
13998 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
14000 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
14001 if (errorCode) {
14002 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
14003 Jim_ListAppendElement(interp, optListObj, errorCode);
14006 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
14007 return JIM_ERR;
14011 Jim_SetResultInt(interp, exitCode);
14012 return JIM_OK;
14015 #ifdef JIM_REFERENCES
14017 /* [ref] */
14018 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14020 if (argc != 3 && argc != 4) {
14021 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
14022 return JIM_ERR;
14024 if (argc == 3) {
14025 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
14027 else {
14028 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
14030 return JIM_OK;
14033 /* [getref] */
14034 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14036 Jim_Reference *refPtr;
14038 if (argc != 2) {
14039 Jim_WrongNumArgs(interp, 1, argv, "reference");
14040 return JIM_ERR;
14042 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14043 return JIM_ERR;
14044 Jim_SetResult(interp, refPtr->objPtr);
14045 return JIM_OK;
14048 /* [setref] */
14049 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14051 Jim_Reference *refPtr;
14053 if (argc != 3) {
14054 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14055 return JIM_ERR;
14057 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14058 return JIM_ERR;
14059 Jim_IncrRefCount(argv[2]);
14060 Jim_DecrRefCount(interp, refPtr->objPtr);
14061 refPtr->objPtr = argv[2];
14062 Jim_SetResult(interp, argv[2]);
14063 return JIM_OK;
14066 /* [collect] */
14067 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14069 if (argc != 1) {
14070 Jim_WrongNumArgs(interp, 1, argv, "");
14071 return JIM_ERR;
14073 Jim_SetResultInt(interp, Jim_Collect(interp));
14075 /* Free all the freed objects. */
14076 while (interp->freeList) {
14077 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14078 Jim_Free(interp->freeList);
14079 interp->freeList = nextObjPtr;
14082 return JIM_OK;
14085 /* [finalize] reference ?newValue? */
14086 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14088 if (argc != 2 && argc != 3) {
14089 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14090 return JIM_ERR;
14092 if (argc == 2) {
14093 Jim_Obj *cmdNamePtr;
14095 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14096 return JIM_ERR;
14097 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14098 Jim_SetResult(interp, cmdNamePtr);
14100 else {
14101 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14102 return JIM_ERR;
14103 Jim_SetResult(interp, argv[2]);
14105 return JIM_OK;
14108 /* [info references] */
14109 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14111 Jim_Obj *listObjPtr;
14112 Jim_HashTableIterator htiter;
14113 Jim_HashEntry *he;
14115 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14117 JimInitHashTableIterator(&interp->references, &htiter);
14118 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14119 char buf[JIM_REFERENCE_SPACE + 1];
14120 Jim_Reference *refPtr = he->u.val;
14121 const unsigned long *refId = he->key;
14123 JimFormatReference(buf, refPtr, *refId);
14124 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14126 Jim_SetResult(interp, listObjPtr);
14127 return JIM_OK;
14129 #endif
14131 /* [rename] */
14132 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14134 if (argc != 3) {
14135 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14136 return JIM_ERR;
14139 if (JimValidName(interp, "new procedure", argv[2])) {
14140 return JIM_ERR;
14143 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14146 #define JIM_DICTMATCH_VALUES 0x0001
14148 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14150 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14152 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14153 if (type & JIM_DICTMATCH_VALUES) {
14154 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->u.val);
14159 * Like JimHashtablePatternMatch, but for dictionaries.
14161 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14162 JimDictMatchCallbackType *callback, int type)
14164 Jim_HashEntry *he;
14165 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14167 /* Check for the non-pattern case. We can do this much more efficiently. */
14168 Jim_HashTableIterator htiter;
14169 JimInitHashTableIterator(ht, &htiter);
14170 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14171 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14172 callback(interp, listObjPtr, he, type);
14176 return listObjPtr;
14180 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14182 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14183 return JIM_ERR;
14185 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14186 return JIM_OK;
14189 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14191 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14192 return JIM_ERR;
14194 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14195 return JIM_OK;
14198 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14200 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14201 return -1;
14203 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14206 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14208 Jim_HashTable *ht;
14209 unsigned int i;
14211 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14212 return JIM_ERR;
14215 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14217 /* Note that this uses internal knowledge of the hash table */
14218 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14220 for (i = 0; i < ht->size; i++) {
14221 Jim_HashEntry *he = he = ht->table[i];
14223 if (he) {
14224 printf("%d: ", i);
14226 while (he) {
14227 printf(" %s", Jim_String(he->key));
14228 he = he->next;
14230 printf("\n");
14233 return JIM_OK;
14236 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14238 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14240 Jim_AppendString(interp, prefixObj, " ", 1);
14241 Jim_AppendString(interp, prefixObj, subcmd, -1);
14243 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14246 /* [dict] */
14247 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14249 Jim_Obj *objPtr;
14250 int option;
14251 static const char * const options[] = {
14252 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14253 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14254 "replace", "update", NULL
14256 enum
14258 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14259 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14260 OPT_REPLACE, OPT_UPDATE,
14263 if (argc < 2) {
14264 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14265 return JIM_ERR;
14268 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14269 return JIM_ERR;
14272 switch (option) {
14273 case OPT_GET:
14274 if (argc < 3) {
14275 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14276 return JIM_ERR;
14278 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14279 JIM_ERRMSG) != JIM_OK) {
14280 return JIM_ERR;
14282 Jim_SetResult(interp, objPtr);
14283 return JIM_OK;
14285 case OPT_SET:
14286 if (argc < 5) {
14287 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14288 return JIM_ERR;
14290 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14292 case OPT_EXISTS:
14293 if (argc < 4) {
14294 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14295 return JIM_ERR;
14297 else {
14298 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14299 if (rc < 0) {
14300 return JIM_ERR;
14302 Jim_SetResultBool(interp, rc == JIM_OK);
14303 return JIM_OK;
14306 case OPT_UNSET:
14307 if (argc < 4) {
14308 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14309 return JIM_ERR;
14311 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14312 return JIM_ERR;
14314 return JIM_OK;
14316 case OPT_KEYS:
14317 if (argc != 3 && argc != 4) {
14318 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14319 return JIM_ERR;
14321 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14323 case OPT_SIZE:
14324 if (argc != 3) {
14325 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14326 return JIM_ERR;
14328 else if (Jim_DictSize(interp, argv[2]) < 0) {
14329 return JIM_ERR;
14331 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14332 return JIM_OK;
14334 case OPT_MERGE:
14335 if (argc == 2) {
14336 return JIM_OK;
14338 if (Jim_DictSize(interp, argv[2]) < 0) {
14339 return JIM_ERR;
14341 /* Handle as ensemble */
14342 break;
14344 case OPT_UPDATE:
14345 if (argc < 6 || argc % 2) {
14346 /* Better error message */
14347 argc = 2;
14349 break;
14351 case OPT_CREATE:
14352 if (argc % 2) {
14353 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14354 return JIM_ERR;
14356 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14357 Jim_SetResult(interp, objPtr);
14358 return JIM_OK;
14360 case OPT_INFO:
14361 if (argc != 3) {
14362 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14363 return JIM_ERR;
14365 return Jim_DictInfo(interp, argv[2]);
14367 /* Handle command as an ensemble */
14368 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14371 /* [subst] */
14372 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14374 static const char * const options[] = {
14375 "-nobackslashes", "-nocommands", "-novariables", NULL
14377 enum
14378 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14379 int i;
14380 int flags = JIM_SUBST_FLAG;
14381 Jim_Obj *objPtr;
14383 if (argc < 2) {
14384 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14385 return JIM_ERR;
14387 for (i = 1; i < (argc - 1); i++) {
14388 int option;
14390 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14391 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14392 return JIM_ERR;
14394 switch (option) {
14395 case OPT_NOBACKSLASHES:
14396 flags |= JIM_SUBST_NOESC;
14397 break;
14398 case OPT_NOCOMMANDS:
14399 flags |= JIM_SUBST_NOCMD;
14400 break;
14401 case OPT_NOVARIABLES:
14402 flags |= JIM_SUBST_NOVAR;
14403 break;
14406 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14407 return JIM_ERR;
14409 Jim_SetResult(interp, objPtr);
14410 return JIM_OK;
14413 /* [info] */
14414 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14416 int cmd;
14417 Jim_Obj *objPtr;
14418 int mode = 0;
14420 static const char * const commands[] = {
14421 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14422 "vars", "version", "patchlevel", "complete", "args", "hostname",
14423 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14424 "references", "alias", NULL
14426 enum
14427 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14428 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14429 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14430 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14433 #ifdef jim_ext_namespace
14434 int nons = 0;
14436 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14437 /* This is for internal use only */
14438 argc--;
14439 argv++;
14440 nons = 1;
14442 #endif
14444 if (argc < 2) {
14445 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14446 return JIM_ERR;
14448 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14449 != JIM_OK) {
14450 return JIM_ERR;
14453 /* Test for the the most common commands first, just in case it makes a difference */
14454 switch (cmd) {
14455 case INFO_EXISTS:
14456 if (argc != 3) {
14457 Jim_WrongNumArgs(interp, 2, argv, "varName");
14458 return JIM_ERR;
14460 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14461 break;
14463 case INFO_ALIAS:{
14464 Jim_Cmd *cmdPtr;
14466 if (argc != 3) {
14467 Jim_WrongNumArgs(interp, 2, argv, "command");
14468 return JIM_ERR;
14470 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14471 return JIM_ERR;
14473 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14474 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14475 return JIM_ERR;
14477 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14478 return JIM_OK;
14481 case INFO_CHANNELS:
14482 mode++; /* JIM_CMDLIST_CHANNELS */
14483 #ifndef jim_ext_aio
14484 Jim_SetResultString(interp, "aio not enabled", -1);
14485 return JIM_ERR;
14486 #endif
14487 case INFO_PROCS:
14488 mode++; /* JIM_CMDLIST_PROCS */
14489 case INFO_COMMANDS:
14490 /* mode 0 => JIM_CMDLIST_COMMANDS */
14491 if (argc != 2 && argc != 3) {
14492 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14493 return JIM_ERR;
14495 #ifdef jim_ext_namespace
14496 if (!nons) {
14497 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14498 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14501 #endif
14502 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14503 break;
14505 case INFO_VARS:
14506 mode++; /* JIM_VARLIST_VARS */
14507 case INFO_LOCALS:
14508 mode++; /* JIM_VARLIST_LOCALS */
14509 case INFO_GLOBALS:
14510 /* mode 0 => JIM_VARLIST_GLOBALS */
14511 if (argc != 2 && argc != 3) {
14512 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14513 return JIM_ERR;
14515 #ifdef jim_ext_namespace
14516 if (!nons) {
14517 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14518 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14521 #endif
14522 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14523 break;
14525 case INFO_SCRIPT:
14526 if (argc != 2) {
14527 Jim_WrongNumArgs(interp, 2, argv, "");
14528 return JIM_ERR;
14530 Jim_SetResult(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileNameObj);
14531 break;
14533 case INFO_SOURCE:{
14534 int line;
14535 Jim_Obj *resObjPtr;
14536 Jim_Obj *fileNameObj;
14538 if (argc != 3) {
14539 Jim_WrongNumArgs(interp, 2, argv, "source");
14540 return JIM_ERR;
14542 if (argv[2]->typePtr == &sourceObjType) {
14543 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14544 line = argv[2]->internalRep.sourceValue.lineNumber;
14546 else if (argv[2]->typePtr == &scriptObjType) {
14547 ScriptObj *script = Jim_GetScript(interp, argv[2]);
14548 fileNameObj = script->fileNameObj;
14549 line = script->firstline;
14551 else {
14552 fileNameObj = interp->emptyObj;
14553 line = 1;
14555 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14556 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14557 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14558 Jim_SetResult(interp, resObjPtr);
14559 break;
14562 case INFO_STACKTRACE:
14563 Jim_SetResult(interp, interp->stackTrace);
14564 break;
14566 case INFO_LEVEL:
14567 case INFO_FRAME:
14568 switch (argc) {
14569 case 2:
14570 Jim_SetResultInt(interp, interp->framePtr->level);
14571 break;
14573 case 3:
14574 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14575 return JIM_ERR;
14577 Jim_SetResult(interp, objPtr);
14578 break;
14580 default:
14581 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14582 return JIM_ERR;
14584 break;
14586 case INFO_BODY:
14587 case INFO_STATICS:
14588 case INFO_ARGS:{
14589 Jim_Cmd *cmdPtr;
14591 if (argc != 3) {
14592 Jim_WrongNumArgs(interp, 2, argv, "procname");
14593 return JIM_ERR;
14595 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14596 return JIM_ERR;
14598 if (!cmdPtr->isproc) {
14599 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14600 return JIM_ERR;
14602 switch (cmd) {
14603 case INFO_BODY:
14604 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14605 break;
14606 case INFO_ARGS:
14607 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14608 break;
14609 case INFO_STATICS:
14610 if (cmdPtr->u.proc.staticVars) {
14611 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14612 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14613 NULL, JimVariablesMatch, mode));
14615 break;
14617 break;
14620 case INFO_VERSION:
14621 case INFO_PATCHLEVEL:{
14622 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14624 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14625 Jim_SetResultString(interp, buf, -1);
14626 break;
14629 case INFO_COMPLETE:
14630 if (argc != 3 && argc != 4) {
14631 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14632 return JIM_ERR;
14634 else {
14635 int len;
14636 const char *s = Jim_GetString(argv[2], &len);
14637 char missing;
14639 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14640 if (missing != ' ' && argc == 4) {
14641 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14644 break;
14646 case INFO_HOSTNAME:
14647 /* Redirect to os.gethostname if it exists */
14648 return Jim_Eval(interp, "os.gethostname");
14650 case INFO_NAMEOFEXECUTABLE:
14651 /* Redirect to Tcl proc */
14652 return Jim_Eval(interp, "{info nameofexecutable}");
14654 case INFO_RETURNCODES:
14655 if (argc == 2) {
14656 int i;
14657 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14659 for (i = 0; jimReturnCodes[i]; i++) {
14660 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14661 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14662 jimReturnCodes[i], -1));
14665 Jim_SetResult(interp, listObjPtr);
14667 else if (argc == 3) {
14668 long code;
14669 const char *name;
14671 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14672 return JIM_ERR;
14674 name = Jim_ReturnCode(code);
14675 if (*name == '?') {
14676 Jim_SetResultInt(interp, code);
14678 else {
14679 Jim_SetResultString(interp, name, -1);
14682 else {
14683 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14684 return JIM_ERR;
14686 break;
14687 case INFO_REFERENCES:
14688 #ifdef JIM_REFERENCES
14689 return JimInfoReferences(interp, argc, argv);
14690 #else
14691 Jim_SetResultString(interp, "not supported", -1);
14692 return JIM_ERR;
14693 #endif
14695 return JIM_OK;
14698 /* [exists] */
14699 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14701 Jim_Obj *objPtr;
14702 int result = 0;
14704 static const char * const options[] = {
14705 "-command", "-proc", "-alias", "-var", NULL
14707 enum
14709 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14711 int option;
14713 if (argc == 2) {
14714 option = OPT_VAR;
14715 objPtr = argv[1];
14717 else if (argc == 3) {
14718 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14719 return JIM_ERR;
14721 objPtr = argv[2];
14723 else {
14724 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14725 return JIM_ERR;
14728 if (option == OPT_VAR) {
14729 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14731 else {
14732 /* Now different kinds of commands */
14733 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14735 if (cmd) {
14736 switch (option) {
14737 case OPT_COMMAND:
14738 result = 1;
14739 break;
14741 case OPT_ALIAS:
14742 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14743 break;
14745 case OPT_PROC:
14746 result = cmd->isproc;
14747 break;
14751 Jim_SetResultBool(interp, result);
14752 return JIM_OK;
14755 /* [split] */
14756 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14758 const char *str, *splitChars, *noMatchStart;
14759 int splitLen, strLen;
14760 Jim_Obj *resObjPtr;
14761 int c;
14762 int len;
14764 if (argc != 2 && argc != 3) {
14765 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14766 return JIM_ERR;
14769 str = Jim_GetString(argv[1], &len);
14770 if (len == 0) {
14771 return JIM_OK;
14773 strLen = Jim_Utf8Length(interp, argv[1]);
14775 /* Init */
14776 if (argc == 2) {
14777 splitChars = " \n\t\r";
14778 splitLen = 4;
14780 else {
14781 splitChars = Jim_String(argv[2]);
14782 splitLen = Jim_Utf8Length(interp, argv[2]);
14785 noMatchStart = str;
14786 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14788 /* Split */
14789 if (splitLen) {
14790 Jim_Obj *objPtr;
14791 while (strLen--) {
14792 const char *sc = splitChars;
14793 int scLen = splitLen;
14794 int sl = utf8_tounicode(str, &c);
14795 while (scLen--) {
14796 int pc;
14797 sc += utf8_tounicode(sc, &pc);
14798 if (c == pc) {
14799 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14800 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14801 noMatchStart = str + sl;
14802 break;
14805 str += sl;
14807 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14808 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14810 else {
14811 /* This handles the special case of splitchars eq {}
14812 * Optimise by sharing common (ASCII) characters
14814 Jim_Obj **commonObj = NULL;
14815 #define NUM_COMMON (128 - 9)
14816 while (strLen--) {
14817 int n = utf8_tounicode(str, &c);
14818 #ifdef JIM_OPTIMIZATION
14819 if (c >= 9 && c < 128) {
14820 /* Common ASCII char. Note that 9 is the tab character */
14821 c -= 9;
14822 if (!commonObj) {
14823 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14824 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14826 if (!commonObj[c]) {
14827 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14829 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14830 str++;
14831 continue;
14833 #endif
14834 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14835 str += n;
14837 Jim_Free(commonObj);
14840 Jim_SetResult(interp, resObjPtr);
14841 return JIM_OK;
14844 /* [join] */
14845 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14847 const char *joinStr;
14848 int joinStrLen;
14850 if (argc != 2 && argc != 3) {
14851 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14852 return JIM_ERR;
14854 /* Init */
14855 if (argc == 2) {
14856 joinStr = " ";
14857 joinStrLen = 1;
14859 else {
14860 joinStr = Jim_GetString(argv[2], &joinStrLen);
14862 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14863 return JIM_OK;
14866 /* [format] */
14867 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14869 Jim_Obj *objPtr;
14871 if (argc < 2) {
14872 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14873 return JIM_ERR;
14875 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14876 if (objPtr == NULL)
14877 return JIM_ERR;
14878 Jim_SetResult(interp, objPtr);
14879 return JIM_OK;
14882 /* [scan] */
14883 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14885 Jim_Obj *listPtr, **outVec;
14886 int outc, i;
14888 if (argc < 3) {
14889 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14890 return JIM_ERR;
14892 if (argv[2]->typePtr != &scanFmtStringObjType)
14893 SetScanFmtFromAny(interp, argv[2]);
14894 if (FormatGetError(argv[2]) != 0) {
14895 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14896 return JIM_ERR;
14898 if (argc > 3) {
14899 int maxPos = FormatGetMaxPos(argv[2]);
14900 int count = FormatGetCnvCount(argv[2]);
14902 if (maxPos > argc - 3) {
14903 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14904 return JIM_ERR;
14906 else if (count > argc - 3) {
14907 Jim_SetResultString(interp, "different numbers of variable names and "
14908 "field specifiers", -1);
14909 return JIM_ERR;
14911 else if (count < argc - 3) {
14912 Jim_SetResultString(interp, "variable is not assigned by any "
14913 "conversion specifiers", -1);
14914 return JIM_ERR;
14917 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14918 if (listPtr == 0)
14919 return JIM_ERR;
14920 if (argc > 3) {
14921 int rc = JIM_OK;
14922 int count = 0;
14924 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14925 int len = Jim_ListLength(interp, listPtr);
14927 if (len != 0) {
14928 JimListGetElements(interp, listPtr, &outc, &outVec);
14929 for (i = 0; i < outc; ++i) {
14930 if (Jim_Length(outVec[i]) > 0) {
14931 ++count;
14932 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14933 rc = JIM_ERR;
14938 Jim_FreeNewObj(interp, listPtr);
14940 else {
14941 count = -1;
14943 if (rc == JIM_OK) {
14944 Jim_SetResultInt(interp, count);
14946 return rc;
14948 else {
14949 if (listPtr == (Jim_Obj *)EOF) {
14950 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14951 return JIM_OK;
14953 Jim_SetResult(interp, listPtr);
14955 return JIM_OK;
14958 /* [error] */
14959 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14961 if (argc != 2 && argc != 3) {
14962 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14963 return JIM_ERR;
14965 Jim_SetResult(interp, argv[1]);
14966 if (argc == 3) {
14967 JimSetStackTrace(interp, argv[2]);
14968 return JIM_ERR;
14970 interp->addStackTrace++;
14971 return JIM_ERR;
14974 /* [lrange] */
14975 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14977 Jim_Obj *objPtr;
14979 if (argc != 4) {
14980 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14981 return JIM_ERR;
14983 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14984 return JIM_ERR;
14985 Jim_SetResult(interp, objPtr);
14986 return JIM_OK;
14989 /* [lrepeat] */
14990 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14992 Jim_Obj *objPtr;
14993 long count;
14995 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14996 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14997 return JIM_ERR;
15000 if (count == 0 || argc == 2) {
15001 return JIM_OK;
15004 argc -= 2;
15005 argv += 2;
15007 objPtr = Jim_NewListObj(interp, argv, argc);
15008 while (--count) {
15009 ListInsertElements(objPtr, -1, argc, argv);
15012 Jim_SetResult(interp, objPtr);
15013 return JIM_OK;
15016 char **Jim_GetEnviron(void)
15018 #if defined(HAVE__NSGETENVIRON)
15019 return *_NSGetEnviron();
15020 #else
15021 #if !defined(NO_ENVIRON_EXTERN)
15022 extern char **environ;
15023 #endif
15025 return environ;
15026 #endif
15029 void Jim_SetEnviron(char **env)
15031 #if defined(HAVE__NSGETENVIRON)
15032 *_NSGetEnviron() = env;
15033 #else
15034 #if !defined(NO_ENVIRON_EXTERN)
15035 extern char **environ;
15036 #endif
15038 environ = env;
15039 #endif
15042 /* [env] */
15043 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15045 const char *key;
15046 const char *val;
15048 if (argc == 1) {
15049 char **e = Jim_GetEnviron();
15051 int i;
15052 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15054 for (i = 0; e[i]; i++) {
15055 const char *equals = strchr(e[i], '=');
15057 if (equals) {
15058 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15059 equals - e[i]));
15060 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15064 Jim_SetResult(interp, listObjPtr);
15065 return JIM_OK;
15068 if (argc < 2) {
15069 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15070 return JIM_ERR;
15072 key = Jim_String(argv[1]);
15073 val = getenv(key);
15074 if (val == NULL) {
15075 if (argc < 3) {
15076 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15077 return JIM_ERR;
15079 val = Jim_String(argv[2]);
15081 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15082 return JIM_OK;
15085 /* [source] */
15086 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15088 int retval;
15090 if (argc != 2) {
15091 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15092 return JIM_ERR;
15094 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15095 if (retval == JIM_RETURN)
15096 return JIM_OK;
15097 return retval;
15100 /* [lreverse] */
15101 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15103 Jim_Obj *revObjPtr, **ele;
15104 int len;
15106 if (argc != 2) {
15107 Jim_WrongNumArgs(interp, 1, argv, "list");
15108 return JIM_ERR;
15110 JimListGetElements(interp, argv[1], &len, &ele);
15111 len--;
15112 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15113 while (len >= 0)
15114 ListAppendElement(revObjPtr, ele[len--]);
15115 Jim_SetResult(interp, revObjPtr);
15116 return JIM_OK;
15119 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15121 jim_wide len;
15123 if (step == 0)
15124 return -1;
15125 if (start == end)
15126 return 0;
15127 else if (step > 0 && start > end)
15128 return -1;
15129 else if (step < 0 && end > start)
15130 return -1;
15131 len = end - start;
15132 if (len < 0)
15133 len = -len; /* abs(len) */
15134 if (step < 0)
15135 step = -step; /* abs(step) */
15136 len = 1 + ((len - 1) / step);
15137 /* We can truncate safely to INT_MAX, the range command
15138 * will always return an error for a such long range
15139 * because Tcl lists can't be so long. */
15140 if (len > INT_MAX)
15141 len = INT_MAX;
15142 return (int)((len < 0) ? -1 : len);
15145 /* [range] */
15146 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15148 jim_wide start = 0, end, step = 1;
15149 int len, i;
15150 Jim_Obj *objPtr;
15152 if (argc < 2 || argc > 4) {
15153 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15154 return JIM_ERR;
15156 if (argc == 2) {
15157 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15158 return JIM_ERR;
15160 else {
15161 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15162 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15163 return JIM_ERR;
15164 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15165 return JIM_ERR;
15167 if ((len = JimRangeLen(start, end, step)) == -1) {
15168 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15169 return JIM_ERR;
15171 objPtr = Jim_NewListObj(interp, NULL, 0);
15172 for (i = 0; i < len; i++)
15173 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15174 Jim_SetResult(interp, objPtr);
15175 return JIM_OK;
15178 /* [rand] */
15179 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15181 jim_wide min = 0, max = 0, len, maxMul;
15183 if (argc < 1 || argc > 3) {
15184 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15185 return JIM_ERR;
15187 if (argc == 1) {
15188 max = JIM_WIDE_MAX;
15189 } else if (argc == 2) {
15190 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15191 return JIM_ERR;
15192 } else if (argc == 3) {
15193 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15194 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15195 return JIM_ERR;
15197 len = max-min;
15198 if (len < 0) {
15199 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15200 return JIM_ERR;
15202 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15203 while (1) {
15204 jim_wide r;
15206 JimRandomBytes(interp, &r, sizeof(jim_wide));
15207 if (r < 0 || r >= maxMul) continue;
15208 r = (len == 0) ? 0 : r%len;
15209 Jim_SetResultInt(interp, min+r);
15210 return JIM_OK;
15214 static const struct {
15215 const char *name;
15216 Jim_CmdProc cmdProc;
15217 } Jim_CoreCommandsTable[] = {
15218 {"alias", Jim_AliasCoreCommand},
15219 {"set", Jim_SetCoreCommand},
15220 {"unset", Jim_UnsetCoreCommand},
15221 {"puts", Jim_PutsCoreCommand},
15222 {"+", Jim_AddCoreCommand},
15223 {"*", Jim_MulCoreCommand},
15224 {"-", Jim_SubCoreCommand},
15225 {"/", Jim_DivCoreCommand},
15226 {"incr", Jim_IncrCoreCommand},
15227 {"while", Jim_WhileCoreCommand},
15228 {"loop", Jim_LoopCoreCommand},
15229 {"for", Jim_ForCoreCommand},
15230 {"foreach", Jim_ForeachCoreCommand},
15231 {"lmap", Jim_LmapCoreCommand},
15232 {"lassign", Jim_LassignCoreCommand},
15233 {"if", Jim_IfCoreCommand},
15234 {"switch", Jim_SwitchCoreCommand},
15235 {"list", Jim_ListCoreCommand},
15236 {"lindex", Jim_LindexCoreCommand},
15237 {"lset", Jim_LsetCoreCommand},
15238 {"lsearch", Jim_LsearchCoreCommand},
15239 {"llength", Jim_LlengthCoreCommand},
15240 {"lappend", Jim_LappendCoreCommand},
15241 {"linsert", Jim_LinsertCoreCommand},
15242 {"lreplace", Jim_LreplaceCoreCommand},
15243 {"lsort", Jim_LsortCoreCommand},
15244 {"append", Jim_AppendCoreCommand},
15245 {"debug", Jim_DebugCoreCommand},
15246 {"eval", Jim_EvalCoreCommand},
15247 {"uplevel", Jim_UplevelCoreCommand},
15248 {"expr", Jim_ExprCoreCommand},
15249 {"break", Jim_BreakCoreCommand},
15250 {"continue", Jim_ContinueCoreCommand},
15251 {"proc", Jim_ProcCoreCommand},
15252 {"concat", Jim_ConcatCoreCommand},
15253 {"return", Jim_ReturnCoreCommand},
15254 {"upvar", Jim_UpvarCoreCommand},
15255 {"global", Jim_GlobalCoreCommand},
15256 {"string", Jim_StringCoreCommand},
15257 {"time", Jim_TimeCoreCommand},
15258 {"exit", Jim_ExitCoreCommand},
15259 {"catch", Jim_CatchCoreCommand},
15260 #ifdef JIM_REFERENCES
15261 {"ref", Jim_RefCoreCommand},
15262 {"getref", Jim_GetrefCoreCommand},
15263 {"setref", Jim_SetrefCoreCommand},
15264 {"finalize", Jim_FinalizeCoreCommand},
15265 {"collect", Jim_CollectCoreCommand},
15266 #endif
15267 {"rename", Jim_RenameCoreCommand},
15268 {"dict", Jim_DictCoreCommand},
15269 {"subst", Jim_SubstCoreCommand},
15270 {"info", Jim_InfoCoreCommand},
15271 {"exists", Jim_ExistsCoreCommand},
15272 {"split", Jim_SplitCoreCommand},
15273 {"join", Jim_JoinCoreCommand},
15274 {"format", Jim_FormatCoreCommand},
15275 {"scan", Jim_ScanCoreCommand},
15276 {"error", Jim_ErrorCoreCommand},
15277 {"lrange", Jim_LrangeCoreCommand},
15278 {"lrepeat", Jim_LrepeatCoreCommand},
15279 {"env", Jim_EnvCoreCommand},
15280 {"source", Jim_SourceCoreCommand},
15281 {"lreverse", Jim_LreverseCoreCommand},
15282 {"range", Jim_RangeCoreCommand},
15283 {"rand", Jim_RandCoreCommand},
15284 {"tailcall", Jim_TailcallCoreCommand},
15285 {"local", Jim_LocalCoreCommand},
15286 {"upcall", Jim_UpcallCoreCommand},
15287 {"apply", Jim_ApplyCoreCommand},
15288 {NULL, NULL},
15291 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15293 int i = 0;
15295 while (Jim_CoreCommandsTable[i].name != NULL) {
15296 Jim_CreateCommand(interp,
15297 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15298 i++;
15302 /* -----------------------------------------------------------------------------
15303 * Interactive prompt
15304 * ---------------------------------------------------------------------------*/
15305 void Jim_MakeErrorMessage(Jim_Interp *interp)
15307 Jim_Obj *argv[2];
15309 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15310 argv[1] = interp->result;
15312 Jim_EvalObjVector(interp, 2, argv);
15315 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15316 const char *prefix, const char *const *tablePtr, const char *name)
15318 int count;
15319 char **tablePtrSorted;
15320 int i;
15322 for (count = 0; tablePtr[count]; count++) {
15325 if (name == NULL) {
15326 name = "option";
15329 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15330 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15331 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15332 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15333 for (i = 0; i < count; i++) {
15334 if (i + 1 == count && count > 1) {
15335 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15337 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15338 if (i + 1 != count) {
15339 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15342 Jim_Free(tablePtrSorted);
15345 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15346 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15348 const char *bad = "bad ";
15349 const char *const *entryPtr = NULL;
15350 int i;
15351 int match = -1;
15352 int arglen;
15353 const char *arg = Jim_GetString(objPtr, &arglen);
15355 *indexPtr = -1;
15357 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15358 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15359 /* Found an exact match */
15360 *indexPtr = i;
15361 return JIM_OK;
15363 if (flags & JIM_ENUM_ABBREV) {
15364 /* Accept an unambiguous abbreviation.
15365 * Note that '-' doesnt' consitute a valid abbreviation
15367 if (strncmp(arg, *entryPtr, arglen) == 0) {
15368 if (*arg == '-' && arglen == 1) {
15369 break;
15371 if (match >= 0) {
15372 bad = "ambiguous ";
15373 goto ambiguous;
15375 match = i;
15380 /* If we had an unambiguous partial match */
15381 if (match >= 0) {
15382 *indexPtr = match;
15383 return JIM_OK;
15386 ambiguous:
15387 if (flags & JIM_ERRMSG) {
15388 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15390 return JIM_ERR;
15393 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15395 int i;
15397 for (i = 0; i < (int)len; i++) {
15398 if (array[i] && strcmp(array[i], name) == 0) {
15399 return i;
15402 return -1;
15405 int Jim_IsDict(Jim_Obj *objPtr)
15407 return objPtr->typePtr == &dictObjType;
15410 int Jim_IsList(Jim_Obj *objPtr)
15412 return objPtr->typePtr == &listObjType;
15416 * Very simple printf-like formatting, designed for error messages.
15418 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15419 * The resulting string is created and set as the result.
15421 * Each '%s' should correspond to a regular string parameter.
15422 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15423 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15425 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15427 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15429 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15431 /* Initial space needed */
15432 int len = strlen(format);
15433 int extra = 0;
15434 int n = 0;
15435 const char *params[5];
15436 char *buf;
15437 va_list args;
15438 int i;
15440 va_start(args, format);
15442 for (i = 0; i < len && n < 5; i++) {
15443 int l;
15445 if (strncmp(format + i, "%s", 2) == 0) {
15446 params[n] = va_arg(args, char *);
15448 l = strlen(params[n]);
15450 else if (strncmp(format + i, "%#s", 3) == 0) {
15451 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15453 params[n] = Jim_GetString(objPtr, &l);
15455 else {
15456 if (format[i] == '%') {
15457 i++;
15459 continue;
15461 n++;
15462 extra += l;
15465 len += extra;
15466 buf = Jim_Alloc(len + 1);
15467 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15469 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15472 /* stubs */
15473 #ifndef jim_ext_package
15474 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15476 return JIM_OK;
15478 #endif
15479 #ifndef jim_ext_aio
15480 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15482 Jim_SetResultString(interp, "aio not enabled", -1);
15483 return NULL;
15485 #endif
15489 * Local Variables: ***
15490 * c-basic-offset: 4 ***
15491 * tab-width: 4 ***
15492 * End: ***