exec: remove duplicate code
[jimtcl.git] / jim.c
blob2b96ec668ce121c4281da5b7be6f7a6cf06f3178
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 panic_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 * Note that the lengths are byte lengths, not char lengths.
316 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
318 if (l1 < l2) {
319 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
321 else if (l2 < l1) {
322 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
324 else {
325 return JimSign(memcmp(s1, s2, l1));
330 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
331 * (or end of string if 'maxchars' is -1).
333 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
335 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
337 while (*s1 && *s2 && maxchars) {
338 int c1, c2;
339 s1 += utf8_tounicode_case(s1, &c1, nocase);
340 s2 += utf8_tounicode_case(s2, &c2, nocase);
341 if (c1 != c2) {
342 return JimSign(c1 - c2);
344 maxchars--;
346 if (!maxchars) {
347 return 0;
349 /* One string or both terminated */
350 if (*s1) {
351 return 1;
353 if (*s2) {
354 return -1;
356 return 0;
359 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
360 * The index of the first occurrence of s1 in s2 is returned.
361 * If s1 is not found inside s2, -1 is returned. */
362 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
364 int i;
365 int l1bytelen;
367 if (!l1 || !l2 || l1 > l2) {
368 return -1;
370 if (idx < 0)
371 idx = 0;
372 s2 += utf8_index(s2, idx);
374 l1bytelen = utf8_index(s1, l1);
376 for (i = idx; i <= l2 - l1; i++) {
377 int c;
378 if (memcmp(s2, s1, l1bytelen) == 0) {
379 return i;
381 s2 += utf8_tounicode(s2, &c);
383 return -1;
387 * Note: Lengths and return value are in bytes, not chars.
389 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
391 const char *p;
393 if (!l1 || !l2 || l1 > l2)
394 return -1;
396 /* Now search for the needle */
397 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
398 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
399 return p - s2;
402 return -1;
405 #ifdef JIM_UTF8
407 * Note: Lengths and return value are in chars.
409 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
411 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
412 if (n > 0) {
413 n = utf8_strlen(s2, n);
415 return n;
417 #endif
420 * After an strtol()/strtod()-like conversion,
421 * check whether something was converted and that
422 * the only thing left is white space.
424 * Returns JIM_OK or JIM_ERR.
426 static int JimCheckConversion(const char *str, const char *endptr)
428 if (str[0] == '\0' || str == endptr) {
429 return JIM_ERR;
432 if (endptr[0] != '\0') {
433 while (*endptr) {
434 if (!isspace(UCHAR(*endptr))) {
435 return JIM_ERR;
437 endptr++;
440 return JIM_OK;
443 /* Parses the front of a number to determine it's sign and base
444 * Returns the index to start parsing according to the given base
446 static int JimNumberBase(const char *str, int *base, int *sign)
448 int i = 0;
450 *base = 10;
452 while (isspace(UCHAR(str[i]))) {
453 i++;
456 if (str[i] == '-') {
457 *sign = -1;
458 i++;
460 else {
461 if (str[i] == '+') {
462 i++;
464 *sign = 1;
467 if (str[i] != '0') {
468 /* base 10 */
469 return 0;
472 /* We have 0<x>, so see if we can convert it */
473 switch (str[i + 1]) {
474 case 'x': case 'X': *base = 16; break;
475 case 'o': case 'O': *base = 8; break;
476 case 'b': case 'B': *base = 2; break;
477 default: return 0;
479 i += 2;
480 /* Ensure that (e.g.) 0x-5 fails to parse */
481 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
482 /* Parse according to this base */
483 return i;
485 /* Parse as base 10 */
486 *base = 10;
487 return 0;
490 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
491 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
493 static long jim_strtol(const char *str, char **endptr)
495 int sign;
496 int base;
497 int i = JimNumberBase(str, &base, &sign);
499 if (base != 10) {
500 long value = strtol(str + i, endptr, base);
501 if (endptr == NULL || *endptr != str + i) {
502 return value * sign;
506 /* Can just do a regular base-10 conversion */
507 return strtol(str, endptr, 10);
511 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
512 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
514 static jim_wide jim_strtoull(const char *str, char **endptr)
516 #ifdef HAVE_LONG_LONG
517 int sign;
518 int base;
519 int i = JimNumberBase(str, &base, &sign);
521 if (base != 10) {
522 jim_wide value = strtoull(str + i, endptr, base);
523 if (endptr == NULL || *endptr != str + i) {
524 return value * sign;
528 /* Can just do a regular base-10 conversion */
529 return strtoull(str, endptr, 10);
530 #else
531 return (unsigned long)jim_strtol(str, endptr);
532 #endif
535 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
537 char *endptr;
539 if (base) {
540 *widePtr = strtoull(str, &endptr, base);
542 else {
543 *widePtr = jim_strtoull(str, &endptr);
546 return JimCheckConversion(str, endptr);
549 int Jim_StringToDouble(const char *str, double *doublePtr)
551 char *endptr;
553 /* Callers can check for underflow via ERANGE */
554 errno = 0;
556 *doublePtr = strtod(str, &endptr);
558 return JimCheckConversion(str, endptr);
561 static jim_wide JimPowWide(jim_wide b, jim_wide e)
563 jim_wide i, res = 1;
565 if ((b == 0 && e != 0) || (e < 0))
566 return 0;
567 for (i = 0; i < e; i++) {
568 res *= b;
570 return res;
573 /* -----------------------------------------------------------------------------
574 * Special functions
575 * ---------------------------------------------------------------------------*/
576 #ifdef JIM_DEBUG_PANIC
577 void JimPanicDump(int condition, const char *fmt, ...)
579 va_list ap;
581 if (!condition) {
582 return;
585 va_start(ap, fmt);
587 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
588 vfprintf(stderr, fmt, ap);
589 fprintf(stderr, JIM_NL JIM_NL);
590 va_end(ap);
592 #ifdef HAVE_BACKTRACE
594 void *array[40];
595 int size, i;
596 char **strings;
598 size = backtrace(array, 40);
599 strings = backtrace_symbols(array, size);
600 for (i = 0; i < size; i++)
601 fprintf(stderr, "[backtrace] %s" JIM_NL, strings[i]);
602 fprintf(stderr, "[backtrace] Include the above lines and the output" JIM_NL);
603 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
605 #endif
607 exit(1);
609 #endif
611 /* -----------------------------------------------------------------------------
612 * Memory allocation
613 * ---------------------------------------------------------------------------*/
615 void *Jim_Alloc(int size)
617 return size ? malloc(size) : NULL;
620 void Jim_Free(void *ptr)
622 free(ptr);
625 void *Jim_Realloc(void *ptr, int size)
627 return realloc(ptr, size);
630 char *Jim_StrDup(const char *s)
632 return strdup(s);
635 char *Jim_StrDupLen(const char *s, int l)
637 char *copy = Jim_Alloc(l + 1);
639 memcpy(copy, s, l + 1);
640 copy[l] = 0; /* Just to be sure, original could be substring */
641 return copy;
644 /* -----------------------------------------------------------------------------
645 * Time related functions
646 * ---------------------------------------------------------------------------*/
648 /* Returns microseconds of CPU used since start. */
649 static jim_wide JimClock(void)
651 struct timeval tv;
653 gettimeofday(&tv, NULL);
654 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
657 /* -----------------------------------------------------------------------------
658 * Hash Tables
659 * ---------------------------------------------------------------------------*/
661 /* -------------------------- private prototypes ---------------------------- */
662 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
663 static unsigned int JimHashTableNextPower(unsigned int size);
664 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
666 /* -------------------------- hash functions -------------------------------- */
668 /* Thomas Wang's 32 bit Mix Function */
669 unsigned int Jim_IntHashFunction(unsigned int key)
671 key += ~(key << 15);
672 key ^= (key >> 10);
673 key += (key << 3);
674 key ^= (key >> 6);
675 key += ~(key << 11);
676 key ^= (key >> 16);
677 return key;
680 /* Generic hash function (we are using to multiply by 9 and add the byte
681 * as Tcl) */
682 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
684 unsigned int h = 0;
686 while (len--)
687 h += (h << 3) + *buf++;
688 return h;
691 /* ----------------------------- API implementation ------------------------- */
693 /* reset a hashtable already initialized */
694 static void JimResetHashTable(Jim_HashTable *ht)
696 ht->table = NULL;
697 ht->size = 0;
698 ht->sizemask = 0;
699 ht->used = 0;
700 ht->collisions = 0;
701 #ifdef JIM_RANDOMISE_HASH
702 /* This is initialised to a random value to avoid a hash collision attack.
703 * See: n.runs-SA-2011.004
705 ht->uniq = (rand() ^ time(NULL) ^ clock());
706 #else
707 ht->uniq = 0;
708 #endif
711 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
713 iter->ht = ht;
714 iter->index = -1;
715 iter->entry = NULL;
716 iter->nextEntry = NULL;
719 /* Initialize the hash table */
720 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
722 JimResetHashTable(ht);
723 ht->type = type;
724 ht->privdata = privDataPtr;
725 return JIM_OK;
728 /* Resize the table to the minimal size that contains all the elements,
729 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
730 void Jim_ResizeHashTable(Jim_HashTable *ht)
732 int minimal = ht->used;
734 if (minimal < JIM_HT_INITIAL_SIZE)
735 minimal = JIM_HT_INITIAL_SIZE;
736 Jim_ExpandHashTable(ht, minimal);
739 /* Expand or create the hashtable */
740 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
742 Jim_HashTable n; /* the new hashtable */
743 unsigned int realsize = JimHashTableNextPower(size), i;
745 /* the size is invalid if it is smaller than the number of
746 * elements already inside the hashtable */
747 if (size <= ht->used)
748 return;
750 Jim_InitHashTable(&n, ht->type, ht->privdata);
751 n.size = realsize;
752 n.sizemask = realsize - 1;
753 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
754 /* Keep the same 'uniq' as the original */
755 n.uniq = ht->uniq;
757 /* Initialize all the pointers to NULL */
758 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
760 /* Copy all the elements from the old to the new table:
761 * note that if the old hash table is empty ht->used is zero,
762 * so Jim_ExpandHashTable just creates an empty hash table. */
763 n.used = ht->used;
764 for (i = 0; ht->used > 0; i++) {
765 Jim_HashEntry *he, *nextHe;
767 if (ht->table[i] == NULL)
768 continue;
770 /* For each hash entry on this slot... */
771 he = ht->table[i];
772 while (he) {
773 unsigned int h;
775 nextHe = he->next;
776 /* Get the new element index */
777 h = Jim_HashKey(ht, he->key) & n.sizemask;
778 he->next = n.table[h];
779 n.table[h] = he;
780 ht->used--;
781 /* Pass to the next element */
782 he = nextHe;
785 assert(ht->used == 0);
786 Jim_Free(ht->table);
788 /* Remap the new hashtable in the old */
789 *ht = n;
792 /* Add an element to the target hash table */
793 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
795 Jim_HashEntry *entry;
797 /* Get the index of the new element, or -1 if
798 * the element already exists. */
799 entry = JimInsertHashEntry(ht, key, 0);
800 if (entry == NULL)
801 return JIM_ERR;
803 /* Set the hash entry fields. */
804 Jim_SetHashKey(ht, entry, key);
805 Jim_SetHashVal(ht, entry, val);
806 return JIM_OK;
809 /* Add an element, discarding the old if the key already exists */
810 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
812 int existed;
813 Jim_HashEntry *entry;
815 /* Get the index of the new element, or -1 if
816 * the element already exists. */
817 entry = JimInsertHashEntry(ht, key, 1);
818 if (entry->key) {
819 /* It already exists, so replace the value */
820 Jim_FreeEntryVal(ht, entry);
821 existed = 1;
823 else {
824 /* Doesn't exist, so set the key */
825 Jim_SetHashKey(ht, entry, key);
826 existed = 0;
828 Jim_SetHashVal(ht, entry, val);
830 return existed;
833 /* Search and remove an element */
834 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
836 unsigned int h;
837 Jim_HashEntry *he, *prevHe;
839 if (ht->used == 0)
840 return JIM_ERR;
841 h = Jim_HashKey(ht, key) & ht->sizemask;
842 he = ht->table[h];
844 prevHe = NULL;
845 while (he) {
846 if (Jim_CompareHashKeys(ht, key, he->key)) {
847 /* Unlink the element from the list */
848 if (prevHe)
849 prevHe->next = he->next;
850 else
851 ht->table[h] = he->next;
852 Jim_FreeEntryKey(ht, he);
853 Jim_FreeEntryVal(ht, he);
854 Jim_Free(he);
855 ht->used--;
856 return JIM_OK;
858 prevHe = he;
859 he = he->next;
861 return JIM_ERR; /* not found */
864 /* Destroy an entire hash table */
865 int Jim_FreeHashTable(Jim_HashTable *ht)
867 unsigned int i;
869 /* Free all the elements */
870 for (i = 0; ht->used > 0; i++) {
871 Jim_HashEntry *he, *nextHe;
873 if ((he = ht->table[i]) == NULL)
874 continue;
875 while (he) {
876 nextHe = he->next;
877 Jim_FreeEntryKey(ht, he);
878 Jim_FreeEntryVal(ht, he);
879 Jim_Free(he);
880 ht->used--;
881 he = nextHe;
884 /* Free the table and the allocated cache structure */
885 Jim_Free(ht->table);
886 /* Re-initialize the table */
887 JimResetHashTable(ht);
888 return JIM_OK; /* never fails */
891 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
893 Jim_HashEntry *he;
894 unsigned int h;
896 if (ht->used == 0)
897 return NULL;
898 h = Jim_HashKey(ht, key) & ht->sizemask;
899 he = ht->table[h];
900 while (he) {
901 if (Jim_CompareHashKeys(ht, key, he->key))
902 return he;
903 he = he->next;
905 return NULL;
908 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
910 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
911 JimInitHashTableIterator(ht, iter);
912 return iter;
915 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
917 while (1) {
918 if (iter->entry == NULL) {
919 iter->index++;
920 if (iter->index >= (signed)iter->ht->size)
921 break;
922 iter->entry = iter->ht->table[iter->index];
924 else {
925 iter->entry = iter->nextEntry;
927 if (iter->entry) {
928 /* We need to save the 'next' here, the iterator user
929 * may delete the entry we are returning. */
930 iter->nextEntry = iter->entry->next;
931 return iter->entry;
934 return NULL;
937 /* ------------------------- private functions ------------------------------ */
939 /* Expand the hash table if needed */
940 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
942 /* If the hash table is empty expand it to the intial size,
943 * if the table is "full" dobule its size. */
944 if (ht->size == 0)
945 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
946 if (ht->size == ht->used)
947 Jim_ExpandHashTable(ht, ht->size * 2);
950 /* Our hash table capability is a power of two */
951 static unsigned int JimHashTableNextPower(unsigned int size)
953 unsigned int i = JIM_HT_INITIAL_SIZE;
955 if (size >= 2147483648U)
956 return 2147483648U;
957 while (1) {
958 if (i >= size)
959 return i;
960 i *= 2;
964 /* Returns the index of a free slot that can be populated with
965 * an hash entry for the given 'key'.
966 * If the key already exists, -1 is returned. */
967 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
969 unsigned int h;
970 Jim_HashEntry *he;
972 /* Expand the hashtable if needed */
973 JimExpandHashTableIfNeeded(ht);
975 /* Compute the key hash value */
976 h = Jim_HashKey(ht, key) & ht->sizemask;
977 /* Search if this slot does not already contain the given key */
978 he = ht->table[h];
979 while (he) {
980 if (Jim_CompareHashKeys(ht, key, he->key))
981 return replace ? he : NULL;
982 he = he->next;
985 /* Allocates the memory and stores key */
986 he = Jim_Alloc(sizeof(*he));
987 he->next = ht->table[h];
988 ht->table[h] = he;
989 ht->used++;
990 he->key = NULL;
992 return he;
995 /* ----------------------- StringCopy Hash Table Type ------------------------*/
997 static unsigned int JimStringCopyHTHashFunction(const void *key)
999 return Jim_GenHashFunction(key, strlen(key));
1002 static void *JimStringCopyHTDup(void *privdata, const void *key)
1004 return Jim_StrDup(key);
1007 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1009 return strcmp(key1, key2) == 0;
1012 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1014 Jim_Free(key);
1017 static const Jim_HashTableType JimPackageHashTableType = {
1018 JimStringCopyHTHashFunction, /* hash function */
1019 JimStringCopyHTDup, /* key dup */
1020 NULL, /* val dup */
1021 JimStringCopyHTKeyCompare, /* key compare */
1022 JimStringCopyHTKeyDestructor, /* key destructor */
1023 NULL /* val destructor */
1026 typedef struct AssocDataValue
1028 Jim_InterpDeleteProc *delProc;
1029 void *data;
1030 } AssocDataValue;
1032 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1034 AssocDataValue *assocPtr = (AssocDataValue *) data;
1036 if (assocPtr->delProc != NULL)
1037 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1038 Jim_Free(data);
1041 static const Jim_HashTableType JimAssocDataHashTableType = {
1042 JimStringCopyHTHashFunction, /* hash function */
1043 JimStringCopyHTDup, /* key dup */
1044 NULL, /* val dup */
1045 JimStringCopyHTKeyCompare, /* key compare */
1046 JimStringCopyHTKeyDestructor, /* key destructor */
1047 JimAssocDataHashTableValueDestructor /* val destructor */
1050 /* -----------------------------------------------------------------------------
1051 * Stack - This is a simple generic stack implementation. It is used for
1052 * example in the 'expr' expression compiler.
1053 * ---------------------------------------------------------------------------*/
1054 void Jim_InitStack(Jim_Stack *stack)
1056 stack->len = 0;
1057 stack->maxlen = 0;
1058 stack->vector = NULL;
1061 void Jim_FreeStack(Jim_Stack *stack)
1063 Jim_Free(stack->vector);
1066 int Jim_StackLen(Jim_Stack *stack)
1068 return stack->len;
1071 void Jim_StackPush(Jim_Stack *stack, void *element)
1073 int neededLen = stack->len + 1;
1075 if (neededLen > stack->maxlen) {
1076 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1077 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1079 stack->vector[stack->len] = element;
1080 stack->len++;
1083 void *Jim_StackPop(Jim_Stack *stack)
1085 if (stack->len == 0)
1086 return NULL;
1087 stack->len--;
1088 return stack->vector[stack->len];
1091 void *Jim_StackPeek(Jim_Stack *stack)
1093 if (stack->len == 0)
1094 return NULL;
1095 return stack->vector[stack->len - 1];
1098 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1100 int i;
1102 for (i = 0; i < stack->len; i++)
1103 freeFunc(stack->vector[i]);
1106 /* -----------------------------------------------------------------------------
1107 * Parser
1108 * ---------------------------------------------------------------------------*/
1110 /* Token types */
1111 #define JIM_TT_NONE 0 /* No token returned */
1112 #define JIM_TT_STR 1 /* simple string */
1113 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1114 #define JIM_TT_VAR 3 /* var substitution */
1115 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1116 #define JIM_TT_CMD 5 /* command substitution */
1117 /* Note: Keep these three together for TOKEN_IS_SEP() */
1118 #define JIM_TT_SEP 6 /* word separator. arg is # of tokens. -ve if {*} */
1119 #define JIM_TT_EOL 7 /* line separator */
1120 #define JIM_TT_EOF 8 /* end of script */
1122 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1123 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1125 /* Additional token types needed for expressions */
1126 #define JIM_TT_SUBEXPR_START 11
1127 #define JIM_TT_SUBEXPR_END 12
1128 #define JIM_TT_SUBEXPR_COMMA 13
1129 #define JIM_TT_EXPR_INT 14
1130 #define JIM_TT_EXPR_DOUBLE 15
1132 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1134 /* Operator token types start here */
1135 #define JIM_TT_EXPR_OP 20
1137 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1139 /* Parser states */
1140 #define JIM_PS_DEF 0 /* Default state */
1141 #define JIM_PS_QUOTE 1 /* Inside "" */
1142 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1144 /* Parser context structure. The same context is used both to parse
1145 * Tcl scripts and lists. */
1146 struct JimParserCtx
1148 const char *p; /* Pointer to the point of the program we are parsing */
1149 int len; /* Remaining length */
1150 int linenr; /* Current line number */
1151 const char *tstart;
1152 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1153 int tline; /* Line number of the returned token */
1154 int tt; /* Token type */
1155 int eof; /* Non zero if EOF condition is true. */
1156 int state; /* Parser state */
1157 int comment; /* Non zero if the next chars may be a comment. */
1158 char missing; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1159 int missingline; /* Line number starting the missing token */
1163 * Results of missing quotes, braces, etc. from parsing.
1165 struct JimParseResult {
1166 char missing; /* From JimParserCtx.missing */
1167 int line; /* From JimParserCtx.missingline */
1170 static int JimParseScript(struct JimParserCtx *pc);
1171 static int JimParseSep(struct JimParserCtx *pc);
1172 static int JimParseEol(struct JimParserCtx *pc);
1173 static int JimParseCmd(struct JimParserCtx *pc);
1174 static int JimParseQuote(struct JimParserCtx *pc);
1175 static int JimParseVar(struct JimParserCtx *pc);
1176 static int JimParseBrace(struct JimParserCtx *pc);
1177 static int JimParseStr(struct JimParserCtx *pc);
1178 static int JimParseComment(struct JimParserCtx *pc);
1179 static void JimParseSubCmd(struct JimParserCtx *pc);
1180 static int JimParseSubQuote(struct JimParserCtx *pc);
1181 static void JimParseSubCmd(struct JimParserCtx *pc);
1182 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1184 /* Initialize a parser context.
1185 * 'prg' is a pointer to the program text, linenr is the line
1186 * number of the first line contained in the program. */
1187 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1189 pc->p = prg;
1190 pc->len = len;
1191 pc->tstart = NULL;
1192 pc->tend = NULL;
1193 pc->tline = 0;
1194 pc->tt = JIM_TT_NONE;
1195 pc->eof = 0;
1196 pc->state = JIM_PS_DEF;
1197 pc->linenr = linenr;
1198 pc->comment = 1;
1199 pc->missing = ' ';
1200 pc->missingline = linenr;
1203 static int JimParseScript(struct JimParserCtx *pc)
1205 while (1) { /* the while is used to reiterate with continue if needed */
1206 if (!pc->len) {
1207 pc->tstart = pc->p;
1208 pc->tend = pc->p - 1;
1209 pc->tline = pc->linenr;
1210 pc->tt = JIM_TT_EOL;
1211 pc->eof = 1;
1212 return JIM_OK;
1214 switch (*(pc->p)) {
1215 case '\\':
1216 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1217 return JimParseSep(pc);
1219 pc->comment = 0;
1220 return JimParseStr(pc);
1221 case ' ':
1222 case '\t':
1223 case '\r':
1224 case '\f':
1225 if (pc->state == JIM_PS_DEF)
1226 return JimParseSep(pc);
1227 pc->comment = 0;
1228 return JimParseStr(pc);
1229 case '\n':
1230 case ';':
1231 pc->comment = 1;
1232 if (pc->state == JIM_PS_DEF)
1233 return JimParseEol(pc);
1234 return JimParseStr(pc);
1235 case '[':
1236 pc->comment = 0;
1237 return JimParseCmd(pc);
1238 case '$':
1239 pc->comment = 0;
1240 if (JimParseVar(pc) == JIM_ERR) {
1241 /* An orphan $. Create as a separate token */
1242 pc->tstart = pc->tend = pc->p++;
1243 pc->len--;
1244 pc->tt = JIM_TT_ESC;
1246 return JIM_OK;
1247 case '#':
1248 if (pc->comment) {
1249 JimParseComment(pc);
1250 continue;
1252 return JimParseStr(pc);
1253 default:
1254 pc->comment = 0;
1255 return JimParseStr(pc);
1257 return JIM_OK;
1261 static int JimParseSep(struct JimParserCtx *pc)
1263 pc->tstart = pc->p;
1264 pc->tline = pc->linenr;
1265 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1266 if (*pc->p == '\n') {
1267 break;
1269 if (*pc->p == '\\') {
1270 pc->p++;
1271 pc->len--;
1272 pc->linenr++;
1274 pc->p++;
1275 pc->len--;
1277 pc->tend = pc->p - 1;
1278 pc->tt = JIM_TT_SEP;
1279 return JIM_OK;
1282 static int JimParseEol(struct JimParserCtx *pc)
1284 pc->tstart = pc->p;
1285 pc->tline = pc->linenr;
1286 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1287 if (*pc->p == '\n')
1288 pc->linenr++;
1289 pc->p++;
1290 pc->len--;
1292 pc->tend = pc->p - 1;
1293 pc->tt = JIM_TT_EOL;
1294 return JIM_OK;
1298 ** Here are the rules for parsing:
1299 ** {braced expression}
1300 ** - Count open and closing braces
1301 ** - Backslash escapes meaning of braces
1303 ** "quoted expression"
1304 ** - First double quote at start of word terminates the expression
1305 ** - Backslash escapes quote and bracket
1306 ** - [commands brackets] are counted/nested
1307 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1309 ** [command expression]
1310 ** - Count open and closing brackets
1311 ** - Backslash escapes quote, bracket and brace
1312 ** - [commands brackets] are counted/nested
1313 ** - "quoted expressions" are parsed according to quoting rules
1314 ** - {braced expressions} are parsed according to brace rules
1316 ** For everything, backslash escapes the next char, newline increments current line
1320 * Parses a braced expression starting at pc->p.
1322 * Positions the parser at the end of the braced expression,
1323 * sets pc->tend and possibly pc->missing.
1325 static void JimParseSubBrace(struct JimParserCtx *pc)
1327 int level = 1;
1329 /* Skip the brace */
1330 pc->p++;
1331 pc->len--;
1332 while (pc->len) {
1333 switch (*pc->p) {
1334 case '\\':
1335 if (pc->len > 1) {
1336 if (*++pc->p == '\n') {
1337 pc->linenr++;
1339 pc->len--;
1341 break;
1343 case '{':
1344 level++;
1345 break;
1347 case '}':
1348 if (--level == 0) {
1349 pc->tend = pc->p - 1;
1350 pc->p++;
1351 pc->len--;
1352 return;
1354 break;
1356 case '\n':
1357 pc->linenr++;
1358 break;
1360 pc->p++;
1361 pc->len--;
1363 pc->missing = '{';
1364 pc->missingline = pc->tline;
1365 pc->tend = pc->p - 1;
1369 * Parses a quoted expression starting at pc->p.
1371 * Positions the parser at the end of the quoted expression,
1372 * sets pc->tend and possibly pc->missing.
1374 * Returns the type of the token of the string,
1375 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1376 * or JIM_TT_STR.
1378 static int JimParseSubQuote(struct JimParserCtx *pc)
1380 int tt = JIM_TT_STR;
1381 int line = pc->tline;
1383 /* Skip the quote */
1384 pc->p++;
1385 pc->len--;
1386 while (pc->len) {
1387 switch (*pc->p) {
1388 case '\\':
1389 if (pc->len > 1) {
1390 if (*++pc->p == '\n') {
1391 pc->linenr++;
1393 pc->len--;
1394 tt = JIM_TT_ESC;
1396 break;
1398 case '"':
1399 pc->tend = pc->p - 1;
1400 pc->p++;
1401 pc->len--;
1402 return tt;
1404 case '[':
1405 JimParseSubCmd(pc);
1406 tt = JIM_TT_ESC;
1407 continue;
1409 case '\n':
1410 pc->linenr++;
1411 break;
1413 case '$':
1414 tt = JIM_TT_ESC;
1415 break;
1417 pc->p++;
1418 pc->len--;
1420 pc->missing = '"';
1421 pc->missingline = line;
1422 pc->tend = pc->p - 1;
1423 return tt;
1427 * Parses a [command] expression starting at pc->p.
1429 * Positions the parser at the end of the command expression,
1430 * sets pc->tend and possibly pc->missing.
1432 static void JimParseSubCmd(struct JimParserCtx *pc)
1434 int level = 1;
1435 int startofword = 1;
1436 int line = pc->tline;
1438 /* Skip the bracket */
1439 pc->p++;
1440 pc->len--;
1441 while (pc->len) {
1442 switch (*pc->p) {
1443 case '\\':
1444 if (pc->len > 1) {
1445 if (*++pc->p == '\n') {
1446 pc->linenr++;
1448 pc->len--;
1450 break;
1452 case '[':
1453 level++;
1454 break;
1456 case ']':
1457 if (--level == 0) {
1458 pc->tend = pc->p - 1;
1459 pc->p++;
1460 pc->len--;
1461 return;
1463 break;
1465 case '"':
1466 if (startofword) {
1467 JimParseSubQuote(pc);
1468 continue;
1470 break;
1472 case '{':
1473 JimParseSubBrace(pc);
1474 startofword = 0;
1475 continue;
1477 case '\n':
1478 pc->linenr++;
1479 break;
1481 startofword = isspace(UCHAR(*pc->p));
1482 pc->p++;
1483 pc->len--;
1485 pc->missing = '[';
1486 pc->missingline = line;
1487 pc->tend = pc->p - 1;
1490 static int JimParseBrace(struct JimParserCtx *pc)
1492 pc->tstart = pc->p + 1;
1493 pc->tline = pc->linenr;
1494 pc->tt = JIM_TT_STR;
1495 JimParseSubBrace(pc);
1496 return JIM_OK;
1499 static int JimParseCmd(struct JimParserCtx *pc)
1501 pc->tstart = pc->p + 1;
1502 pc->tline = pc->linenr;
1503 pc->tt = JIM_TT_CMD;
1504 JimParseSubCmd(pc);
1505 return JIM_OK;
1508 static int JimParseQuote(struct JimParserCtx *pc)
1510 pc->tstart = pc->p + 1;
1511 pc->tline = pc->linenr;
1512 pc->tt = JimParseSubQuote(pc);
1513 return JIM_OK;
1516 static int JimParseVar(struct JimParserCtx *pc)
1518 /* skip the $ */
1519 pc->p++;
1520 pc->len--;
1522 #ifdef EXPRSUGAR_BRACKET
1523 if (*pc->p == '[') {
1524 /* Parse $[...] expr shorthand syntax */
1525 JimParseCmd(pc);
1526 pc->tt = JIM_TT_EXPRSUGAR;
1527 return JIM_OK;
1529 #endif
1531 pc->tstart = pc->p;
1532 pc->tt = JIM_TT_VAR;
1533 pc->tline = pc->linenr;
1535 if (*pc->p == '{') {
1536 pc->tstart = ++pc->p;
1537 pc->len--;
1539 while (pc->len && *pc->p != '}') {
1540 if (*pc->p == '\n') {
1541 pc->linenr++;
1543 pc->p++;
1544 pc->len--;
1546 pc->tend = pc->p - 1;
1547 if (pc->len) {
1548 pc->p++;
1549 pc->len--;
1552 else {
1553 while (1) {
1554 /* Skip double colon, but not single colon! */
1555 if (pc->p[0] == ':' && pc->p[1] == ':') {
1556 while (*pc->p == ':') {
1557 pc->p++;
1558 pc->len--;
1560 continue;
1562 /* Note that any char >= 0x80 must be part of a utf-8 char.
1563 * We consider all unicode points outside of ASCII as letters
1565 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1566 pc->p++;
1567 pc->len--;
1568 continue;
1570 break;
1572 /* Parse [dict get] syntax sugar. */
1573 if (*pc->p == '(') {
1574 int count = 1;
1575 const char *paren = NULL;
1577 pc->tt = JIM_TT_DICTSUGAR;
1579 while (count && pc->len) {
1580 pc->p++;
1581 pc->len--;
1582 if (*pc->p == '\\' && pc->len >= 1) {
1583 pc->p++;
1584 pc->len--;
1586 else if (*pc->p == '(') {
1587 count++;
1589 else if (*pc->p == ')') {
1590 paren = pc->p;
1591 count--;
1594 if (count == 0) {
1595 pc->p++;
1596 pc->len--;
1598 else if (paren) {
1599 /* Did not find a matching paren. Back up */
1600 paren++;
1601 pc->len += (pc->p - paren);
1602 pc->p = paren;
1604 #ifndef EXPRSUGAR_BRACKET
1605 if (*pc->tstart == '(') {
1606 pc->tt = JIM_TT_EXPRSUGAR;
1608 #endif
1610 pc->tend = pc->p - 1;
1612 /* Check if we parsed just the '$' character.
1613 * That's not a variable so an error is returned
1614 * to tell the state machine to consider this '$' just
1615 * a string. */
1616 if (pc->tstart == pc->p) {
1617 pc->p--;
1618 pc->len++;
1619 return JIM_ERR;
1621 return JIM_OK;
1624 static int JimParseStr(struct JimParserCtx *pc)
1626 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1627 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1628 /* Starting a new word */
1629 if (*pc->p == '{') {
1630 return JimParseBrace(pc);
1632 if (*pc->p == '"') {
1633 pc->state = JIM_PS_QUOTE;
1634 pc->p++;
1635 pc->len--;
1636 /* In case the end quote is missing */
1637 pc->missingline = pc->tline;
1640 pc->tstart = pc->p;
1641 pc->tline = pc->linenr;
1642 while (1) {
1643 if (pc->len == 0) {
1644 if (pc->state == JIM_PS_QUOTE) {
1645 pc->missing = '"';
1647 pc->tend = pc->p - 1;
1648 pc->tt = JIM_TT_ESC;
1649 return JIM_OK;
1651 switch (*pc->p) {
1652 case '\\':
1653 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1654 pc->tend = pc->p - 1;
1655 pc->tt = JIM_TT_ESC;
1656 return JIM_OK;
1658 if (pc->len >= 2) {
1659 if (*(pc->p + 1) == '\n') {
1660 pc->linenr++;
1662 pc->p++;
1663 pc->len--;
1665 else if (pc->len == 1) {
1666 /* End of script with trailing backslash */
1667 pc->missing = '\\';
1669 break;
1670 case '(':
1671 /* If the following token is not '$' just keep going */
1672 if (pc->len > 1 && pc->p[1] != '$') {
1673 break;
1675 case ')':
1676 /* Only need a separate ')' token if the previous was a var */
1677 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1678 if (pc->p == pc->tstart) {
1679 /* At the start of the token, so just return this char */
1680 pc->p++;
1681 pc->len--;
1683 pc->tend = pc->p - 1;
1684 pc->tt = JIM_TT_ESC;
1685 return JIM_OK;
1687 break;
1689 case '$':
1690 case '[':
1691 pc->tend = pc->p - 1;
1692 pc->tt = JIM_TT_ESC;
1693 return JIM_OK;
1694 case ' ':
1695 case '\t':
1696 case '\n':
1697 case '\r':
1698 case '\f':
1699 case ';':
1700 if (pc->state == JIM_PS_DEF) {
1701 pc->tend = pc->p - 1;
1702 pc->tt = JIM_TT_ESC;
1703 return JIM_OK;
1705 else if (*pc->p == '\n') {
1706 pc->linenr++;
1708 break;
1709 case '"':
1710 if (pc->state == JIM_PS_QUOTE) {
1711 pc->tend = pc->p - 1;
1712 pc->tt = JIM_TT_ESC;
1713 pc->p++;
1714 pc->len--;
1715 pc->state = JIM_PS_DEF;
1716 return JIM_OK;
1718 break;
1720 pc->p++;
1721 pc->len--;
1723 return JIM_OK; /* unreached */
1726 static int JimParseComment(struct JimParserCtx *pc)
1728 while (*pc->p) {
1729 if (*pc->p == '\\') {
1730 pc->p++;
1731 pc->len--;
1732 if (pc->len == 0) {
1733 pc->missing = '\\';
1734 return JIM_OK;
1736 if (*pc->p == '\n') {
1737 pc->linenr++;
1740 else if (*pc->p == '\n') {
1741 pc->p++;
1742 pc->len--;
1743 pc->linenr++;
1744 break;
1746 pc->p++;
1747 pc->len--;
1749 return JIM_OK;
1752 /* xdigitval and odigitval are helper functions for JimEscape() */
1753 static int xdigitval(int c)
1755 if (c >= '0' && c <= '9')
1756 return c - '0';
1757 if (c >= 'a' && c <= 'f')
1758 return c - 'a' + 10;
1759 if (c >= 'A' && c <= 'F')
1760 return c - 'A' + 10;
1761 return -1;
1764 static int odigitval(int c)
1766 if (c >= '0' && c <= '7')
1767 return c - '0';
1768 return -1;
1771 /* Perform Tcl escape substitution of 's', storing the result
1772 * string into 'dest'. The escaped string is guaranteed to
1773 * be the same length or shorted than the source string.
1774 * Slen is the length of the string at 's', if it's -1 the string
1775 * length will be calculated by the function.
1777 * The function returns the length of the resulting string. */
1778 static int JimEscape(char *dest, const char *s, int slen)
1780 char *p = dest;
1781 int i, len;
1783 if (slen == -1)
1784 slen = strlen(s);
1786 for (i = 0; i < slen; i++) {
1787 switch (s[i]) {
1788 case '\\':
1789 switch (s[i + 1]) {
1790 case 'a':
1791 *p++ = 0x7;
1792 i++;
1793 break;
1794 case 'b':
1795 *p++ = 0x8;
1796 i++;
1797 break;
1798 case 'f':
1799 *p++ = 0xc;
1800 i++;
1801 break;
1802 case 'n':
1803 *p++ = 0xa;
1804 i++;
1805 break;
1806 case 'r':
1807 *p++ = 0xd;
1808 i++;
1809 break;
1810 case 't':
1811 *p++ = 0x9;
1812 i++;
1813 break;
1814 case 'u':
1815 case 'U':
1816 case 'x':
1817 /* A unicode or hex sequence.
1818 * \x Expect 1-2 hex chars and convert to hex.
1819 * \u Expect 1-4 hex chars and convert to utf-8.
1820 * \U Expect 1-8 hex chars and convert to utf-8.
1821 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1822 * An invalid sequence means simply the escaped char.
1825 unsigned val = 0;
1826 int k;
1827 int maxchars = 2;
1829 i++;
1831 if (s[i] == 'U') {
1832 maxchars = 8;
1834 else if (s[i] == 'u') {
1835 if (s[i + 1] == '{') {
1836 maxchars = 6;
1837 i++;
1839 else {
1840 maxchars = 4;
1844 for (k = 0; k < maxchars; k++) {
1845 int c = xdigitval(s[i + k + 1]);
1846 if (c == -1) {
1847 break;
1849 val = (val << 4) | c;
1851 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1852 if (s[i] == '{') {
1853 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1854 /* Back up */
1855 i--;
1856 k = 0;
1858 else {
1859 /* Skip the closing brace */
1860 k++;
1863 if (k) {
1864 /* Got a valid sequence, so convert */
1865 if (s[i] == 'x') {
1866 *p++ = val;
1868 else {
1869 p += utf8_fromunicode(p, val);
1871 i += k;
1872 break;
1874 /* Not a valid codepoint, just an escaped char */
1875 *p++ = s[i];
1877 break;
1878 case 'v':
1879 *p++ = 0xb;
1880 i++;
1881 break;
1882 case '\0':
1883 *p++ = '\\';
1884 i++;
1885 break;
1886 case '\n':
1887 /* Replace all spaces and tabs after backslash newline with a single space*/
1888 *p++ = ' ';
1889 do {
1890 i++;
1891 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1892 break;
1893 case '0':
1894 case '1':
1895 case '2':
1896 case '3':
1897 case '4':
1898 case '5':
1899 case '6':
1900 case '7':
1901 /* octal escape */
1903 int val = 0;
1904 int c = odigitval(s[i + 1]);
1906 val = c;
1907 c = odigitval(s[i + 2]);
1908 if (c == -1) {
1909 *p++ = val;
1910 i++;
1911 break;
1913 val = (val * 8) + c;
1914 c = odigitval(s[i + 3]);
1915 if (c == -1) {
1916 *p++ = val;
1917 i += 2;
1918 break;
1920 val = (val * 8) + c;
1921 *p++ = val;
1922 i += 3;
1924 break;
1925 default:
1926 *p++ = s[i + 1];
1927 i++;
1928 break;
1930 break;
1931 default:
1932 *p++ = s[i];
1933 break;
1936 len = p - dest;
1937 *p = '\0';
1938 return len;
1941 /* Returns a dynamically allocated copy of the current token in the
1942 * parser context. The function performs conversion of escapes if
1943 * the token is of type JIM_TT_ESC.
1945 * Note that after the conversion, tokens that are grouped with
1946 * braces in the source code, are always recognizable from the
1947 * identical string obtained in a different way from the type.
1949 * For example the string:
1951 * {*}$a
1953 * will return as first token "*", of type JIM_TT_STR
1955 * While the string:
1957 * *$a
1959 * will return as first token "*", of type JIM_TT_ESC
1961 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1963 const char *start, *end;
1964 char *token;
1965 int len;
1967 start = pc->tstart;
1968 end = pc->tend;
1969 if (start > end) {
1970 len = 0;
1971 token = Jim_Alloc(1);
1972 token[0] = '\0';
1974 else {
1975 len = (end - start) + 1;
1976 token = Jim_Alloc(len + 1);
1977 if (pc->tt != JIM_TT_ESC) {
1978 /* No escape conversion needed? Just copy it. */
1979 memcpy(token, start, len);
1980 token[len] = '\0';
1982 else {
1983 /* Else convert the escape chars. */
1984 len = JimEscape(token, start, len);
1988 return Jim_NewStringObjNoAlloc(interp, token, len);
1991 /* Parses the given string to determine if it represents a complete script.
1993 * This is useful for interactive shells implementation, for [info complete].
1995 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
1996 * '{' on scripts incomplete missing one or more '}' to be balanced.
1997 * '[' on scripts incomplete missing one or more ']' to be balanced.
1998 * '"' on scripts incomplete missing a '"' char.
1999 * '\\' on scripts with a trailing backslash.
2001 * If the script is complete, 1 is returned, otherwise 0.
2003 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2005 struct JimParserCtx parser;
2007 JimParserInit(&parser, s, len, 1);
2008 while (!parser.eof) {
2009 JimParseScript(&parser);
2011 if (stateCharPtr) {
2012 *stateCharPtr = parser.missing;
2014 return parser.missing == ' ';
2017 /* -----------------------------------------------------------------------------
2018 * Tcl Lists parsing
2019 * ---------------------------------------------------------------------------*/
2020 static int JimParseListSep(struct JimParserCtx *pc);
2021 static int JimParseListStr(struct JimParserCtx *pc);
2022 static int JimParseListQuote(struct JimParserCtx *pc);
2024 static int JimParseList(struct JimParserCtx *pc)
2026 if (isspace(UCHAR(*pc->p))) {
2027 return JimParseListSep(pc);
2029 switch (*pc->p) {
2030 case '"':
2031 return JimParseListQuote(pc);
2033 case '{':
2034 return JimParseBrace(pc);
2036 default:
2037 if (pc->len) {
2038 return JimParseListStr(pc);
2040 break;
2043 pc->tstart = pc->tend = pc->p;
2044 pc->tline = pc->linenr;
2045 pc->tt = JIM_TT_EOL;
2046 pc->eof = 1;
2047 return JIM_OK;
2050 static int JimParseListSep(struct JimParserCtx *pc)
2052 pc->tstart = pc->p;
2053 pc->tline = pc->linenr;
2054 while (isspace(UCHAR(*pc->p))) {
2055 if (*pc->p == '\n') {
2056 pc->linenr++;
2058 pc->p++;
2059 pc->len--;
2061 pc->tend = pc->p - 1;
2062 pc->tt = JIM_TT_SEP;
2063 return JIM_OK;
2066 static int JimParseListQuote(struct JimParserCtx *pc)
2068 pc->p++;
2069 pc->len--;
2071 pc->tstart = pc->p;
2072 pc->tline = pc->linenr;
2073 pc->tt = JIM_TT_STR;
2075 while (pc->len) {
2076 switch (*pc->p) {
2077 case '\\':
2078 pc->tt = JIM_TT_ESC;
2079 if (--pc->len == 0) {
2080 /* Trailing backslash */
2081 pc->tend = pc->p;
2082 return JIM_OK;
2084 pc->p++;
2085 break;
2086 case '\n':
2087 pc->linenr++;
2088 break;
2089 case '"':
2090 pc->tend = pc->p - 1;
2091 pc->p++;
2092 pc->len--;
2093 return JIM_OK;
2095 pc->p++;
2096 pc->len--;
2099 pc->tend = pc->p - 1;
2100 return JIM_OK;
2103 static int JimParseListStr(struct JimParserCtx *pc)
2105 pc->tstart = pc->p;
2106 pc->tline = pc->linenr;
2107 pc->tt = JIM_TT_STR;
2109 while (pc->len) {
2110 if (isspace(UCHAR(*pc->p))) {
2111 pc->tend = pc->p - 1;
2112 return JIM_OK;
2114 if (*pc->p == '\\') {
2115 if (--pc->len == 0) {
2116 /* Trailing backslash */
2117 pc->tend = pc->p;
2118 return JIM_OK;
2120 pc->tt = JIM_TT_ESC;
2121 pc->p++;
2123 pc->p++;
2124 pc->len--;
2126 pc->tend = pc->p - 1;
2127 return JIM_OK;
2130 /* -----------------------------------------------------------------------------
2131 * Jim_Obj related functions
2132 * ---------------------------------------------------------------------------*/
2134 /* Return a new initialized object. */
2135 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2137 Jim_Obj *objPtr;
2139 /* -- Check if there are objects in the free list -- */
2140 if (interp->freeList != NULL) {
2141 /* -- Unlink the object from the free list -- */
2142 objPtr = interp->freeList;
2143 interp->freeList = objPtr->nextObjPtr;
2145 else {
2146 /* -- No ready to use objects: allocate a new one -- */
2147 objPtr = Jim_Alloc(sizeof(*objPtr));
2150 /* Object is returned with refCount of 0. Every
2151 * kind of GC implemented should take care to don't try
2152 * to scan objects with refCount == 0. */
2153 objPtr->refCount = 0;
2154 /* All the other fields are left not initialized to save time.
2155 * The caller will probably want to set them to the right
2156 * value anyway. */
2158 /* -- Put the object into the live list -- */
2159 objPtr->prevObjPtr = NULL;
2160 objPtr->nextObjPtr = interp->liveList;
2161 if (interp->liveList)
2162 interp->liveList->prevObjPtr = objPtr;
2163 interp->liveList = objPtr;
2165 return objPtr;
2168 /* Free an object. Actually objects are never freed, but
2169 * just moved to the free objects list, where they will be
2170 * reused by Jim_NewObj(). */
2171 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2173 /* Check if the object was already freed, panic. */
2174 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2175 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2177 /* Free the internal representation */
2178 Jim_FreeIntRep(interp, objPtr);
2179 /* Free the string representation */
2180 if (objPtr->bytes != NULL) {
2181 if (objPtr->bytes != JimEmptyStringRep)
2182 Jim_Free(objPtr->bytes);
2184 /* Unlink the object from the live objects list */
2185 if (objPtr->prevObjPtr)
2186 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2187 if (objPtr->nextObjPtr)
2188 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2189 if (interp->liveList == objPtr)
2190 interp->liveList = objPtr->nextObjPtr;
2191 #ifdef JIM_DISABLE_OBJECT_POOL
2192 Jim_Free(objPtr);
2193 #else
2194 /* Link the object into the free objects list */
2195 objPtr->prevObjPtr = NULL;
2196 objPtr->nextObjPtr = interp->freeList;
2197 if (interp->freeList)
2198 interp->freeList->prevObjPtr = objPtr;
2199 interp->freeList = objPtr;
2200 objPtr->refCount = -1;
2201 #endif
2204 /* Invalidate the string representation of an object. */
2205 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2207 if (objPtr->bytes != NULL) {
2208 if (objPtr->bytes != JimEmptyStringRep)
2209 Jim_Free(objPtr->bytes);
2211 objPtr->bytes = NULL;
2214 /* Duplicate an object. The returned object has refcount = 0. */
2215 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2217 Jim_Obj *dupPtr;
2219 dupPtr = Jim_NewObj(interp);
2220 if (objPtr->bytes == NULL) {
2221 /* Object does not have a valid string representation. */
2222 dupPtr->bytes = NULL;
2224 else if (objPtr->length == 0) {
2225 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2226 dupPtr->bytes = JimEmptyStringRep;
2227 dupPtr->length = 0;
2228 dupPtr->typePtr = NULL;
2229 return dupPtr;
2231 else {
2232 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2233 dupPtr->length = objPtr->length;
2234 /* Copy the null byte too */
2235 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2238 /* By default, the new object has the same type as the old object */
2239 dupPtr->typePtr = objPtr->typePtr;
2240 if (objPtr->typePtr != NULL) {
2241 if (objPtr->typePtr->dupIntRepProc == NULL) {
2242 dupPtr->internalRep = objPtr->internalRep;
2244 else {
2245 /* The dup proc may set a different type, e.g. NULL */
2246 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2249 return dupPtr;
2252 /* Return the string representation for objPtr. If the object
2253 * string representation is invalid, calls the method to create
2254 * a new one starting from the internal representation of the object. */
2255 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2257 if (objPtr->bytes == NULL) {
2258 /* Invalid string repr. Generate it. */
2259 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2260 objPtr->typePtr->updateStringProc(objPtr);
2262 if (lenPtr)
2263 *lenPtr = objPtr->length;
2264 return objPtr->bytes;
2267 /* Just returns the length of the object's string rep */
2268 int Jim_Length(Jim_Obj *objPtr)
2270 if (objPtr->bytes == NULL) {
2271 /* Invalid string repr. Generate it. */
2272 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2273 objPtr->typePtr->updateStringProc(objPtr);
2275 return objPtr->length;
2278 /* Just returns the length of the object's string rep */
2279 const char *Jim_String(Jim_Obj *objPtr)
2281 if (objPtr->bytes == NULL) {
2282 /* Invalid string repr. Generate it. */
2283 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2284 objPtr->typePtr->updateStringProc(objPtr);
2286 return objPtr->bytes;
2289 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2291 objPtr->bytes = Jim_StrDup(str);
2292 objPtr->length = strlen(str);
2295 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2296 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2298 static const Jim_ObjType dictSubstObjType = {
2299 "dict-substitution",
2300 FreeDictSubstInternalRep,
2301 DupDictSubstInternalRep,
2302 NULL,
2303 JIM_TYPE_NONE,
2306 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2308 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2311 static const Jim_ObjType interpolatedObjType = {
2312 "interpolated",
2313 FreeInterpolatedInternalRep,
2314 NULL,
2315 NULL,
2316 JIM_TYPE_NONE,
2319 /* -----------------------------------------------------------------------------
2320 * String Object
2321 * ---------------------------------------------------------------------------*/
2322 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2323 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2325 static const Jim_ObjType stringObjType = {
2326 "string",
2327 NULL,
2328 DupStringInternalRep,
2329 NULL,
2330 JIM_TYPE_REFERENCES,
2333 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2335 JIM_NOTUSED(interp);
2337 /* This is a bit subtle: the only caller of this function
2338 * should be Jim_DuplicateObj(), that will copy the
2339 * string representaion. After the copy, the duplicated
2340 * object will not have more room in teh buffer than
2341 * srcPtr->length bytes. So we just set it to length. */
2342 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2344 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2347 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2349 if (objPtr->typePtr != &stringObjType) {
2350 /* Get a fresh string representation. */
2351 if (objPtr->bytes == NULL) {
2352 /* Invalid string repr. Generate it. */
2353 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2354 objPtr->typePtr->updateStringProc(objPtr);
2356 /* Free any other internal representation. */
2357 Jim_FreeIntRep(interp, objPtr);
2358 /* Set it as string, i.e. just set the maxLength field. */
2359 objPtr->typePtr = &stringObjType;
2360 objPtr->internalRep.strValue.maxLength = objPtr->length;
2361 /* Don't know the utf-8 length yet */
2362 objPtr->internalRep.strValue.charLength = -1;
2364 return JIM_OK;
2368 * Returns the length of the object string in chars, not bytes.
2370 * These may be different for a utf-8 string.
2372 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2374 #ifdef JIM_UTF8
2375 SetStringFromAny(interp, objPtr);
2377 if (objPtr->internalRep.strValue.charLength < 0) {
2378 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2380 return objPtr->internalRep.strValue.charLength;
2381 #else
2382 return Jim_Length(objPtr);
2383 #endif
2386 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2387 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2389 Jim_Obj *objPtr = Jim_NewObj(interp);
2391 /* Need to find out how many bytes the string requires */
2392 if (len == -1)
2393 len = strlen(s);
2394 /* Alloc/Set the string rep. */
2395 if (len == 0) {
2396 objPtr->bytes = JimEmptyStringRep;
2397 objPtr->length = 0;
2399 else {
2400 objPtr->bytes = Jim_Alloc(len + 1);
2401 objPtr->length = len;
2402 memcpy(objPtr->bytes, s, len);
2403 objPtr->bytes[len] = '\0';
2406 /* No typePtr field for the vanilla string object. */
2407 objPtr->typePtr = NULL;
2408 return objPtr;
2411 /* charlen is in characters -- see also Jim_NewStringObj() */
2412 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2414 #ifdef JIM_UTF8
2415 /* Need to find out how many bytes the string requires */
2416 int bytelen = utf8_index(s, charlen);
2418 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2420 /* Remember the utf8 length, so set the type */
2421 objPtr->typePtr = &stringObjType;
2422 objPtr->internalRep.strValue.maxLength = bytelen;
2423 objPtr->internalRep.strValue.charLength = charlen;
2425 return objPtr;
2426 #else
2427 return Jim_NewStringObj(interp, s, charlen);
2428 #endif
2431 /* This version does not try to duplicate the 's' pointer, but
2432 * use it directly. */
2433 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2435 Jim_Obj *objPtr = Jim_NewObj(interp);
2437 objPtr->bytes = s;
2438 objPtr->length = len == -1 ? strlen(s) : len;
2439 objPtr->typePtr = NULL;
2440 return objPtr;
2443 /* Low-level string append. Use it only against objects
2444 * of type "string". */
2445 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2447 int needlen;
2449 if (len == -1)
2450 len = strlen(str);
2451 needlen = objPtr->length + len;
2452 if (objPtr->internalRep.strValue.maxLength < needlen ||
2453 objPtr->internalRep.strValue.maxLength == 0) {
2454 needlen *= 2;
2455 /* Inefficient to malloc() for less than 8 bytes */
2456 if (needlen < 7) {
2457 needlen = 7;
2459 if (objPtr->bytes == JimEmptyStringRep) {
2460 objPtr->bytes = Jim_Alloc(needlen + 1);
2462 else {
2463 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2465 objPtr->internalRep.strValue.maxLength = needlen;
2467 memcpy(objPtr->bytes + objPtr->length, str, len);
2468 objPtr->bytes[objPtr->length + len] = '\0';
2469 if (objPtr->internalRep.strValue.charLength >= 0) {
2470 /* Update the utf-8 char length */
2471 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2473 objPtr->length += len;
2476 /* Higher level API to append strings to objects. */
2477 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2479 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2480 SetStringFromAny(interp, objPtr);
2481 StringAppendString(objPtr, str, len);
2484 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2486 int len;
2487 const char *str;
2489 str = Jim_GetString(appendObjPtr, &len);
2490 Jim_AppendString(interp, objPtr, str, len);
2493 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2495 va_list ap;
2497 SetStringFromAny(interp, objPtr);
2498 va_start(ap, objPtr);
2499 while (1) {
2500 char *s = va_arg(ap, char *);
2502 if (s == NULL)
2503 break;
2504 Jim_AppendString(interp, objPtr, s, -1);
2506 va_end(ap);
2509 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2511 const char *aStr, *bStr;
2512 int aLen, bLen;
2514 if (aObjPtr == bObjPtr)
2515 return 1;
2516 aStr = Jim_GetString(aObjPtr, &aLen);
2517 bStr = Jim_GetString(bObjPtr, &bLen);
2518 if (aLen != bLen)
2519 return 0;
2520 return JimStringCompare(aStr, aLen, bStr, bLen) == 0;
2523 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2525 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2528 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2530 int l1, l2;
2531 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2532 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2534 if (nocase) {
2535 /* Do a character compare for nocase */
2536 return JimStringCompareLen(s1, s2, -1, nocase);
2538 return JimStringCompare(s1, l1, s2, l2);
2542 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2544 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2546 const char *s1 = Jim_String(firstObjPtr);
2547 const char *s2 = Jim_String(secondObjPtr);
2549 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2552 /* Convert a range, as returned by Jim_GetRange(), into
2553 * an absolute index into an object of the specified length.
2554 * This function may return negative values, or values
2555 * bigger or equal to the length of the list if the index
2556 * is out of range. */
2557 static int JimRelToAbsIndex(int len, int idx)
2559 if (idx < 0)
2560 return len + idx;
2561 return idx;
2564 /* Convert a pair of index (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2565 * into form suitable for implementation of commands like [string range] and [lrange].
2567 * The resulting range is guaranteed to address valid elements of
2568 * the structure.
2571 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2573 int rangeLen;
2575 if (*firstPtr > *lastPtr) {
2576 rangeLen = 0;
2578 else {
2579 rangeLen = *lastPtr - *firstPtr + 1;
2580 if (rangeLen) {
2581 if (*firstPtr < 0) {
2582 rangeLen += *firstPtr;
2583 *firstPtr = 0;
2585 if (*lastPtr >= len) {
2586 rangeLen -= (*lastPtr - (len - 1));
2587 *lastPtr = len - 1;
2591 if (rangeLen < 0)
2592 rangeLen = 0;
2594 *rangeLenPtr = rangeLen;
2597 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2598 int len, int *first, int *last, int *range)
2600 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2601 return JIM_ERR;
2603 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2604 return JIM_ERR;
2606 *first = JimRelToAbsIndex(len, *first);
2607 *last = JimRelToAbsIndex(len, *last);
2608 JimRelToAbsRange(len, first, last, range);
2609 return JIM_OK;
2612 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2613 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2615 int first, last;
2616 const char *str;
2617 int rangeLen;
2618 int bytelen;
2620 str = Jim_GetString(strObjPtr, &bytelen);
2622 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2623 return NULL;
2626 if (first == 0 && rangeLen == bytelen) {
2627 return strObjPtr;
2629 return Jim_NewStringObj(interp, str + first, rangeLen);
2632 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2633 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2635 #ifdef JIM_UTF8
2636 int first, last;
2637 const char *str;
2638 int len, rangeLen;
2639 int bytelen;
2641 str = Jim_GetString(strObjPtr, &bytelen);
2642 len = Jim_Utf8Length(interp, strObjPtr);
2644 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2645 return NULL;
2648 if (first == 0 && rangeLen == len) {
2649 return strObjPtr;
2651 if (len == bytelen) {
2652 /* ASCII optimisation */
2653 return Jim_NewStringObj(interp, str + first, rangeLen);
2655 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2656 #else
2657 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2658 #endif
2661 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2662 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2664 int first, last;
2665 const char *str;
2666 int len, rangeLen;
2667 Jim_Obj *objPtr;
2669 len = Jim_Utf8Length(interp, strObjPtr);
2671 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2672 return NULL;
2675 if (last < first) {
2676 return strObjPtr;
2679 str = Jim_String(strObjPtr);
2681 /* Before part */
2682 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2684 /* Replacement */
2685 if (newStrObj) {
2686 Jim_AppendObj(interp, objPtr, newStrObj);
2689 /* After part */
2690 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2692 return objPtr;
2695 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2697 while (*str) {
2698 int c;
2699 str += utf8_tounicode(str, &c);
2700 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2702 *dest = 0;
2705 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2707 char *buf;
2708 int len;
2709 const char *str;
2711 SetStringFromAny(interp, strObjPtr);
2713 str = Jim_GetString(strObjPtr, &len);
2715 #ifdef JIM_UTF8
2716 /* Case mapping can change the utf-8 length of the string.
2717 * But at worst it will be by one extra byte per char
2719 len *= 2;
2720 #endif
2721 buf = Jim_Alloc(len + 1);
2722 JimStrCopyUpperLower(buf, str, 0);
2723 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2726 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2728 char *buf;
2729 const char *str;
2730 int len;
2732 if (strObjPtr->typePtr != &stringObjType) {
2733 SetStringFromAny(interp, strObjPtr);
2736 str = Jim_GetString(strObjPtr, &len);
2738 #ifdef JIM_UTF8
2739 /* Case mapping can change the utf-8 length of the string.
2740 * But at worst it will be by one extra byte per char
2742 len *= 2;
2743 #endif
2744 buf = Jim_Alloc(len + 1);
2745 JimStrCopyUpperLower(buf, str, 1);
2746 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2749 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2751 char *buf, *p;
2752 int len;
2753 int c;
2754 const char *str;
2756 str = Jim_GetString(strObjPtr, &len);
2757 if (len == 0) {
2758 return strObjPtr;
2760 #ifdef JIM_UTF8
2761 /* Case mapping can change the utf-8 length of the string.
2762 * But at worst it will be by one extra byte per char
2764 len *= 2;
2765 #endif
2766 buf = p = Jim_Alloc(len + 1);
2768 str += utf8_tounicode(str, &c);
2769 p += utf8_getchars(p, utf8_title(c));
2771 JimStrCopyUpperLower(p, str, 0);
2773 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2776 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2777 * for unicode character 'c'.
2778 * Returns the position if found or NULL if not
2780 static const char *utf8_memchr(const char *str, int len, int c)
2782 #ifdef JIM_UTF8
2783 while (len) {
2784 int sc;
2785 int n = utf8_tounicode(str, &sc);
2786 if (sc == c) {
2787 return str;
2789 str += n;
2790 len -= n;
2792 return NULL;
2793 #else
2794 return memchr(str, c, len);
2795 #endif
2799 * Searches for the first non-trim char in string (str, len)
2801 * If none is found, returns just past the last char.
2803 * Lengths are in bytes.
2805 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2807 while (len) {
2808 int c;
2809 int n = utf8_tounicode(str, &c);
2811 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2812 /* Not a trim char, so stop */
2813 break;
2815 str += n;
2816 len -= n;
2818 return str;
2822 * Searches backwards for a non-trim char in string (str, len).
2824 * Returns a pointer to just after the non-trim char, or NULL if not found.
2826 * Lengths are in bytes.
2828 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2830 str += len;
2832 while (len) {
2833 int c;
2834 int n = utf8_prev_len(str, len);
2836 len -= n;
2837 str -= n;
2839 n = utf8_tounicode(str, &c);
2841 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2842 return str + n;
2846 return NULL;
2849 static const char default_trim_chars[] = " \t\n\r";
2850 /* sizeof() here includes the null byte */
2851 static int default_trim_chars_len = sizeof(default_trim_chars);
2853 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2855 int len;
2856 const char *str = Jim_GetString(strObjPtr, &len);
2857 const char *trimchars = default_trim_chars;
2858 int trimcharslen = default_trim_chars_len;
2859 const char *newstr;
2861 if (trimcharsObjPtr) {
2862 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2865 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2866 if (newstr == str) {
2867 return strObjPtr;
2870 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2873 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2875 int len;
2876 const char *trimchars = default_trim_chars;
2877 int trimcharslen = default_trim_chars_len;
2878 const char *nontrim;
2880 if (trimcharsObjPtr) {
2881 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2884 SetStringFromAny(interp, strObjPtr);
2886 len = Jim_Length(strObjPtr);
2887 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2889 if (nontrim == NULL) {
2890 /* All trim, so return a zero-length string */
2891 return Jim_NewEmptyStringObj(interp);
2893 if (nontrim == strObjPtr->bytes + len) {
2894 return strObjPtr;
2897 if (Jim_IsShared(strObjPtr)) {
2898 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2900 else {
2901 /* Can modify this string in place */
2902 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2903 strObjPtr->length = (nontrim - strObjPtr->bytes);
2906 return strObjPtr;
2909 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2911 /* First trim left. */
2912 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2914 /* Now trim right */
2915 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2917 if (objPtr != strObjPtr) {
2918 /* Note that we don't want this object to be leaked */
2919 Jim_IncrRefCount(objPtr);
2920 Jim_DecrRefCount(interp, objPtr);
2923 return strObjPtr;
2926 /* Some platforms don't have isascii - need a non-macro version */
2927 #ifdef HAVE_ISASCII
2928 #define jim_isascii isascii
2929 #else
2930 static int jim_isascii(int c)
2932 return !(c & ~0x7f);
2934 #endif
2936 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2938 static const char * const strclassnames[] = {
2939 "integer", "alpha", "alnum", "ascii", "digit",
2940 "double", "lower", "upper", "space", "xdigit",
2941 "control", "print", "graph", "punct",
2942 NULL
2944 enum {
2945 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2946 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2947 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2949 int strclass;
2950 int len;
2951 int i;
2952 const char *str;
2953 int (*isclassfunc)(int c) = NULL;
2955 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2956 return JIM_ERR;
2959 str = Jim_GetString(strObjPtr, &len);
2960 if (len == 0) {
2961 Jim_SetResultInt(interp, !strict);
2962 return JIM_OK;
2965 switch (strclass) {
2966 case STR_IS_INTEGER:
2968 jim_wide w;
2969 Jim_SetResultInt(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
2970 return JIM_OK;
2973 case STR_IS_DOUBLE:
2975 double d;
2976 Jim_SetResultInt(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
2977 return JIM_OK;
2980 case STR_IS_ALPHA: isclassfunc = isalpha; break;
2981 case STR_IS_ALNUM: isclassfunc = isalnum; break;
2982 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
2983 case STR_IS_DIGIT: isclassfunc = isdigit; break;
2984 case STR_IS_LOWER: isclassfunc = islower; break;
2985 case STR_IS_UPPER: isclassfunc = isupper; break;
2986 case STR_IS_SPACE: isclassfunc = isspace; break;
2987 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
2988 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
2989 case STR_IS_PRINT: isclassfunc = isprint; break;
2990 case STR_IS_GRAPH: isclassfunc = isgraph; break;
2991 case STR_IS_PUNCT: isclassfunc = ispunct; break;
2992 default:
2993 return JIM_ERR;
2996 for (i = 0; i < len; i++) {
2997 if (!isclassfunc(str[i])) {
2998 Jim_SetResultInt(interp, 0);
2999 return JIM_OK;
3002 Jim_SetResultInt(interp, 1);
3003 return JIM_OK;
3006 /* -----------------------------------------------------------------------------
3007 * Compared String Object
3008 * ---------------------------------------------------------------------------*/
3010 /* This is strange object that allows to compare a C literal string
3011 * with a Jim object in very short time if the same comparison is done
3012 * multiple times. For example every time the [if] command is executed,
3013 * Jim has to check if a given argument is "else". This comparions if
3014 * the code has no errors are true most of the times, so we can cache
3015 * inside the object the pointer of the string of the last matching
3016 * comparison. Because most C compilers perform literal sharing,
3017 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3018 * this works pretty well even if comparisons are at different places
3019 * inside the C code. */
3021 static const Jim_ObjType comparedStringObjType = {
3022 "compared-string",
3023 NULL,
3024 NULL,
3025 NULL,
3026 JIM_TYPE_REFERENCES,
3029 /* The only way this object is exposed to the API is via the following
3030 * function. Returns true if the string and the object string repr.
3031 * are the same, otherwise zero is returned.
3033 * Note: this isn't binary safe, but it hardly needs to be.*/
3034 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3036 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str)
3037 return 1;
3038 else {
3039 const char *objStr = Jim_String(objPtr);
3041 if (strcmp(str, objStr) != 0)
3042 return 0;
3043 if (objPtr->typePtr != &comparedStringObjType) {
3044 Jim_FreeIntRep(interp, objPtr);
3045 objPtr->typePtr = &comparedStringObjType;
3047 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3048 return 1;
3052 static int qsortCompareStringPointers(const void *a, const void *b)
3054 char *const *sa = (char *const *)a;
3055 char *const *sb = (char *const *)b;
3057 return strcmp(*sa, *sb);
3061 /* -----------------------------------------------------------------------------
3062 * Source Object
3064 * This object is just a string from the language point of view, but
3065 * in the internal representation it contains the filename and line number
3066 * where this given token was read. This information is used by
3067 * Jim_EvalObj() if the object passed happens to be of type "source".
3069 * This allows to propagate the information about line numbers and file
3070 * names and give error messages with absolute line numbers.
3072 * Note that this object uses shared strings for filenames, and the
3073 * pointer to the filename together with the line number is taken into
3074 * the space for the "inline" internal representation of the Jim_Object,
3075 * so there is almost memory zero-overhead.
3077 * Also the object will be converted to something else if the given
3078 * token it represents in the source file is not something to be
3079 * evaluated (not a script), and will be specialized in some other way,
3080 * so the time overhead is also null.
3081 * ---------------------------------------------------------------------------*/
3083 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3084 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3086 static const Jim_ObjType sourceObjType = {
3087 "source",
3088 FreeSourceInternalRep,
3089 DupSourceInternalRep,
3090 NULL,
3091 JIM_TYPE_REFERENCES,
3094 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3096 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3099 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3101 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3102 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3105 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3106 Jim_Obj *fileNameObj, int lineNumber)
3108 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3109 JimPanic((objPtr->typePtr == &sourceObjType, "JimSetSourceInfo called with non-source object"));
3110 Jim_IncrRefCount(fileNameObj);
3111 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3112 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3113 objPtr->typePtr = &sourceObjType;
3116 /* -----------------------------------------------------------------------------
3117 * Script Object
3118 * ---------------------------------------------------------------------------*/
3120 static const Jim_ObjType scriptLineObjType = {
3121 "scriptline",
3122 NULL,
3123 NULL,
3124 NULL,
3128 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3130 Jim_Obj *objPtr;
3132 #ifdef DEBUG_SHOW_SCRIPT
3133 char buf[100];
3134 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3135 objPtr = Jim_NewStringObj(interp, buf, -1);
3136 #else
3137 objPtr = Jim_NewEmptyStringObj(interp);
3138 #endif
3139 objPtr->typePtr = &scriptLineObjType;
3140 objPtr->internalRep.scriptLineValue.argc = argc;
3141 objPtr->internalRep.scriptLineValue.line = line;
3143 return objPtr;
3146 #define JIM_CMDSTRUCT_EXPAND -1
3148 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3149 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3150 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result);
3152 static const Jim_ObjType scriptObjType = {
3153 "script",
3154 FreeScriptInternalRep,
3155 DupScriptInternalRep,
3156 NULL,
3157 JIM_TYPE_REFERENCES,
3160 /* The ScriptToken structure represents every token into a scriptObj.
3161 * Every token contains an associated Jim_Obj that can be specialized
3162 * by commands operating on it. */
3163 typedef struct ScriptToken
3165 int type;
3166 Jim_Obj *objPtr;
3167 } ScriptToken;
3169 /* This is the script object internal representation. An array of
3170 * ScriptToken structures, including a pre-computed representation of the
3171 * command length and arguments.
3173 * For example the script:
3175 * puts hello
3176 * set $i $x$y [foo]BAR
3178 * will produce a ScriptObj with the following Tokens:
3180 * LIN 2
3181 * ESC puts
3182 * ESC hello
3183 * LIN 4
3184 * ESC set
3185 * VAR i
3186 * WRD 2
3187 * VAR x
3188 * VAR y
3189 * WRD 2
3190 * CMD foo
3191 * ESC BAR
3193 * "puts hello" has two args (LIN 2), composed of single tokens.
3194 * (Note that the WRD token is omitted for the common case of a single token.)
3196 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3197 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3199 * The precomputation of the command structure makes Jim_Eval() faster,
3200 * and simpler because there aren't dynamic lengths / allocations.
3202 * -- {expand}/{*} handling --
3204 * Expand is handled in a special way.
3206 * If a "word" begins with {*}, the word token count is -ve.
3208 * For example the command:
3210 * list {*}{a b}
3212 * Will produce the following cmdstruct array:
3214 * LIN 2
3215 * ESC list
3216 * WRD -1
3217 * STR a b
3219 * Note that the 'LIN' token also contains the source information for the
3220 * first word of the line for error reporting purposes
3222 * -- the substFlags field of the structure --
3224 * The scriptObj structure is used to represent both "script" objects
3225 * and "subst" objects. In the second case, the there are no LIN and WRD
3226 * tokens. Instead SEP and EOL tokens are added as-is.
3227 * In addition, the field 'substFlags' is used to represent the flags used to turn
3228 * the string into the internal representation used to perform the
3229 * substitution. If this flags are not what the application requires
3230 * the scriptObj is created again. For example the script:
3232 * subst -nocommands $string
3233 * subst -novariables $string
3235 * Will recreate the internal representation of the $string object
3236 * two times.
3238 typedef struct ScriptObj
3240 int len; /* Length as number of tokens. */
3241 ScriptToken *token; /* Tokens array. */
3242 int substFlags; /* flags used for the compilation of "subst" objects */
3243 int inUse; /* Used to share a ScriptObj. Currently
3244 only used by Jim_EvalObj() as protection against
3245 shimmering of the currently evaluated object. */
3246 Jim_Obj *fileNameObj;
3247 int firstline; /* Line number of the first line */
3248 int linenr; /* Line number of the current line */
3249 } ScriptObj;
3251 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3253 int i;
3254 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3256 script->inUse--;
3257 if (script->inUse != 0)
3258 return;
3259 for (i = 0; i < script->len; i++) {
3260 Jim_DecrRefCount(interp, script->token[i].objPtr);
3262 Jim_Free(script->token);
3263 Jim_DecrRefCount(interp, script->fileNameObj);
3264 Jim_Free(script);
3267 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3269 JIM_NOTUSED(interp);
3270 JIM_NOTUSED(srcPtr);
3272 /* Just returns an simple string. */
3273 dupPtr->typePtr = NULL;
3276 /* A simple parser token.
3277 * All the simple tokens for the script point into the same script string rep.
3279 typedef struct
3281 const char *token; /* Pointer to the start of the token */
3282 int len; /* Length of this token */
3283 int type; /* Token type */
3284 int line; /* Line number */
3285 } ParseToken;
3287 /* A list of parsed tokens representing a script.
3288 * Tokens are added to this list as the script is parsed.
3289 * It grows as needed.
3291 typedef struct
3293 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3294 ParseToken *list; /* Array of tokens */
3295 int size; /* Current size of the list */
3296 int count; /* Number of entries used */
3297 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3298 } ParseTokenList;
3300 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3302 tokenlist->list = tokenlist->static_list;
3303 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3304 tokenlist->count = 0;
3307 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3309 if (tokenlist->list != tokenlist->static_list) {
3310 Jim_Free(tokenlist->list);
3315 * Adds the new token to the tokenlist.
3316 * The token has the given length, type and line number.
3317 * The token list is resized as necessary.
3319 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3320 int line)
3322 ParseToken *t;
3324 if (tokenlist->count == tokenlist->size) {
3325 /* Resize the list */
3326 tokenlist->size *= 2;
3327 if (tokenlist->list != tokenlist->static_list) {
3328 tokenlist->list =
3329 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3331 else {
3332 /* The list needs to become allocated */
3333 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3334 memcpy(tokenlist->list, tokenlist->static_list,
3335 tokenlist->count * sizeof(*tokenlist->list));
3338 t = &tokenlist->list[tokenlist->count++];
3339 t->token = token;
3340 t->len = len;
3341 t->type = type;
3342 t->line = line;
3345 /* Counts the number of adjoining non-separator.
3347 * Returns -ve if the first token is the expansion
3348 * operator (in which case the count doesn't include
3349 * that token).
3351 static int JimCountWordTokens(ParseToken *t)
3353 int expand = 1;
3354 int count = 0;
3356 /* Is the first word {*} or {expand}? */
3357 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3358 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3359 /* Create an expand token */
3360 expand = -1;
3361 t++;
3365 /* Now count non-separator words */
3366 while (!TOKEN_IS_SEP(t->type)) {
3367 t++;
3368 count++;
3371 return count * expand;
3375 * Create a script/subst object from the given token.
3377 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3379 Jim_Obj *objPtr;
3381 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3382 /* Convert the backlash escapes . */
3383 int len = t->len;
3384 char *str = Jim_Alloc(len + 1);
3385 len = JimEscape(str, t->token, len);
3386 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3388 else {
3389 /* REVIST: Strictly, JIM_TT_STR should replace <backslash><newline><whitespace>
3390 * with a single space. This is currently not done.
3392 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3394 return objPtr;
3398 * Takes a tokenlist and creates the allocated list of script tokens
3399 * in script->token, of length script->len.
3401 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3402 * as required.
3404 * Also sets script->line to the line number of the first token
3406 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3407 ParseTokenList *tokenlist)
3409 int i;
3410 struct ScriptToken *token;
3411 /* Number of tokens so far for the current command */
3412 int lineargs = 0;
3413 /* This is the first token for the current command */
3414 ScriptToken *linefirst;
3415 int count;
3416 int linenr;
3418 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3419 printf("==== Tokens ====\n");
3420 for (i = 0; i < tokenlist->count; i++) {
3421 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3422 tokenlist->list[i].len, tokenlist->list[i].token);
3424 #endif
3426 /* May need up to one extra script token for each EOL in the worst case */
3427 count = tokenlist->count;
3428 for (i = 0; i < tokenlist->count; i++) {
3429 if (tokenlist->list[i].type == JIM_TT_EOL) {
3430 count++;
3433 linenr = script->firstline = tokenlist->list[0].line;
3435 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3437 /* This is the first token for the current command */
3438 linefirst = token++;
3440 for (i = 0; i < tokenlist->count; ) {
3441 /* Look ahead to find out how many tokens make up the next word */
3442 int wordtokens;
3444 /* Skip any leading separators */
3445 while (tokenlist->list[i].type == JIM_TT_SEP) {
3446 i++;
3449 wordtokens = JimCountWordTokens(tokenlist->list + i);
3451 if (wordtokens == 0) {
3452 /* None, so at end of line */
3453 if (lineargs) {
3454 linefirst->type = JIM_TT_LINE;
3455 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3456 Jim_IncrRefCount(linefirst->objPtr);
3458 /* Reset for new line */
3459 lineargs = 0;
3460 linefirst = token++;
3462 i++;
3463 continue;
3465 else if (wordtokens != 1) {
3466 /* More than 1, or {expand}, so insert a WORD token */
3467 token->type = JIM_TT_WORD;
3468 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3469 Jim_IncrRefCount(token->objPtr);
3470 token++;
3471 if (wordtokens < 0) {
3472 /* Skip the expand token */
3473 i++;
3474 wordtokens = -wordtokens - 1;
3475 lineargs--;
3479 if (lineargs == 0) {
3480 /* First real token on the line, so record the line number */
3481 linenr = tokenlist->list[i].line;
3483 lineargs++;
3485 /* Add each non-separator word token to the line */
3486 while (wordtokens--) {
3487 const ParseToken *t = &tokenlist->list[i++];
3489 token->type = t->type;
3490 token->objPtr = JimMakeScriptObj(interp, t);
3491 Jim_IncrRefCount(token->objPtr);
3493 /* Every object is initially a string, but the
3494 * internal type may be specialized during execution of the
3495 * script. */
3496 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3497 token++;
3501 if (lineargs == 0) {
3502 token--;
3505 script->len = token - script->token;
3507 assert(script->len < count);
3509 #ifdef DEBUG_SHOW_SCRIPT
3510 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3511 for (i = 0; i < script->len; i++) {
3512 const ScriptToken *t = &script->token[i];
3513 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3515 #endif
3520 * Similar to ScriptObjAddTokens(), but for subst objects.
3522 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3523 ParseTokenList *tokenlist)
3525 int i;
3526 struct ScriptToken *token;
3528 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3530 for (i = 0; i < tokenlist->count; i++) {
3531 const ParseToken *t = &tokenlist->list[i];
3533 /* Create a token for 't' */
3534 token->type = t->type;
3535 token->objPtr = JimMakeScriptObj(interp, t);
3536 Jim_IncrRefCount(token->objPtr);
3537 token++;
3540 script->len = i;
3543 /* This method takes the string representation of an object
3544 * as a Tcl script, and generates the pre-parsed internal representation
3545 * of the script. */
3546 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result)
3548 int scriptTextLen;
3549 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3550 struct JimParserCtx parser;
3551 struct ScriptObj *script;
3552 ParseTokenList tokenlist;
3553 int line = 1;
3555 /* Try to get information about filename / line number */
3556 if (objPtr->typePtr == &sourceObjType) {
3557 line = objPtr->internalRep.sourceValue.lineNumber;
3560 /* Initially parse the script into tokens (in tokenlist) */
3561 ScriptTokenListInit(&tokenlist);
3563 JimParserInit(&parser, scriptText, scriptTextLen, line);
3564 while (!parser.eof) {
3565 JimParseScript(&parser);
3566 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3567 parser.tline);
3569 /* Note that we accept a trailing backslash without error */
3570 if (result && parser.missing != ' ' && parser.missing != '\\') {
3571 ScriptTokenListFree(&tokenlist);
3572 result->missing = parser.missing;
3573 result->line = parser.missingline;
3574 return JIM_ERR;
3577 /* Add a final EOF token */
3578 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3580 /* Create the "real" script tokens from the initial token list */
3581 script = Jim_Alloc(sizeof(*script));
3582 memset(script, 0, sizeof(*script));
3583 script->inUse = 1;
3584 if (objPtr->typePtr == &sourceObjType) {
3585 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3587 else {
3588 script->fileNameObj = interp->emptyObj;
3590 Jim_IncrRefCount(script->fileNameObj);
3592 ScriptObjAddTokens(interp, script, &tokenlist);
3594 /* No longer need the token list */
3595 ScriptTokenListFree(&tokenlist);
3597 /* Free the old internal rep and set the new one. */
3598 Jim_FreeIntRep(interp, objPtr);
3599 Jim_SetIntRepPtr(objPtr, script);
3600 objPtr->typePtr = &scriptObjType;
3602 return JIM_OK;
3605 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3607 if (objPtr == interp->emptyObj) {
3608 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3609 objPtr = interp->nullScriptObj;
3612 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3613 SetScriptFromAny(interp, objPtr, NULL);
3615 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3618 /* -----------------------------------------------------------------------------
3619 * Commands
3620 * ---------------------------------------------------------------------------*/
3621 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3623 cmdPtr->inUse++;
3626 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3628 if (--cmdPtr->inUse == 0) {
3629 if (cmdPtr->isproc) {
3630 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3631 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3632 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3633 if (cmdPtr->u.proc.staticVars) {
3634 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3635 Jim_Free(cmdPtr->u.proc.staticVars);
3638 else {
3639 /* native (C) */
3640 if (cmdPtr->u.native.delProc) {
3641 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3644 if (cmdPtr->prevCmd) {
3645 /* Delete any pushed command too */
3646 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3648 Jim_Free(cmdPtr);
3652 /* Variables HashTable Type.
3654 * Keys are dynamic allocated strings, Values are Jim_Var structures.
3657 /* Variables HashTable Type.
3659 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3660 static void JimVariablesHTValDestructor(void *interp, void *val)
3662 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3663 Jim_Free(val);
3666 static const Jim_HashTableType JimVariablesHashTableType = {
3667 JimStringCopyHTHashFunction, /* hash function */
3668 JimStringCopyHTDup, /* key dup */
3669 NULL, /* val dup */
3670 JimStringCopyHTKeyCompare, /* key compare */
3671 JimStringCopyHTKeyDestructor, /* key destructor */
3672 JimVariablesHTValDestructor /* val destructor */
3675 /* Commands HashTable Type.
3677 * Keys are dynamic allocated strings, Values are Jim_Cmd structures. */
3678 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3680 JimDecrCmdRefCount(interp, val);
3683 static const Jim_HashTableType JimCommandsHashTableType = {
3684 JimStringCopyHTHashFunction, /* hash function */
3685 JimStringCopyHTDup, /* key dup */
3686 NULL, /* val dup */
3687 JimStringCopyHTKeyCompare, /* key compare */
3688 JimStringCopyHTKeyDestructor, /* key destructor */
3689 JimCommandsHT_ValDestructor /* val destructor */
3692 /* ------------------------- Commands related functions --------------------- */
3694 #ifdef jim_ext_namespace
3696 * Returns the "unscoped" version of the given namespace.
3697 * That is, the fully qualfied name without the leading ::
3698 * The returned value is either nsObj, or an object with a zero ref count.
3700 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3702 const char *name = Jim_String(nsObj);
3703 if (name[0] == ':' && name[1] == ':') {
3704 /* This command is being defined in the global namespace */
3705 while (*++name == ':') {
3707 nsObj = Jim_NewStringObj(interp, name, -1);
3709 else if (Jim_Length(interp->framePtr->nsObj)) {
3710 /* This command is being defined in a non-global namespace */
3711 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3712 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3714 return nsObj;
3717 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3719 Jim_Obj *resultObj;
3721 const char *name = Jim_String(nameObjPtr);
3722 if (name[0] == ':' && name[1] == ':') {
3723 return nameObjPtr;
3725 Jim_IncrRefCount(nameObjPtr);
3726 resultObj = Jim_NewStringObj(interp, "::", -1);
3727 Jim_AppendObj(interp, resultObj, nameObjPtr);
3728 Jim_DecrRefCount(interp, nameObjPtr);
3730 return resultObj;
3734 * An efficient version of JimQualifyNameObj() where the name is
3735 * available (and needed) as a 'const char *'.
3736 * Avoids creating an object if not necessary.
3737 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3739 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3741 Jim_Obj *objPtr = interp->emptyObj;
3743 if (name[0] == ':' && name[1] == ':') {
3744 /* This command is being defined in the global namespace */
3745 while (*++name == ':') {
3748 else if (Jim_Length(interp->framePtr->nsObj)) {
3749 /* This command is being defined in a non-global namespace */
3750 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3751 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3752 name = Jim_String(objPtr);
3754 Jim_IncrRefCount(objPtr);
3755 *objPtrPtr = objPtr;
3756 return name;
3759 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3761 #else
3762 /* We can be more efficient in the no-namespace case */
3763 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3764 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3766 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3768 return nameObjPtr;
3770 #endif
3772 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3774 /* It may already exist, so we try to delete the old one.
3775 * Note that reference count means that it won't be deleted yet if
3776 * it exists in the call stack.
3778 * BUT, if 'local' is in force, instead of deleting the existing
3779 * proc, we stash a reference to the old proc here.
3781 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3782 if (he) {
3783 /* There was an old cmd with the same name,
3784 * so this requires a 'proc epoch' update. */
3786 /* If a procedure with the same name didn't exist there is no need
3787 * to increment the 'proc epoch' because creation of a new procedure
3788 * can never affect existing cached commands. We don't do
3789 * negative caching. */
3790 Jim_InterpIncrProcEpoch(interp);
3793 if (he && interp->local) {
3794 /* Push this command over the top of the previous one */
3795 cmd->prevCmd = he->u.val;
3796 he->u.val = cmd;
3798 else {
3799 if (he) {
3800 /* Replace the existing command */
3801 Jim_DeleteHashEntry(&interp->commands, name);
3804 Jim_AddHashEntry(&interp->commands, name, cmd);
3806 return JIM_OK;
3810 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3811 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3813 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3815 /* Store the new details for this command */
3816 memset(cmdPtr, 0, sizeof(*cmdPtr));
3817 cmdPtr->inUse = 1;
3818 cmdPtr->u.native.delProc = delProc;
3819 cmdPtr->u.native.cmdProc = cmdProc;
3820 cmdPtr->u.native.privData = privData;
3822 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3824 return JIM_OK;
3827 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3829 int len, i;
3831 len = Jim_ListLength(interp, staticsListObjPtr);
3832 if (len == 0) {
3833 return JIM_OK;
3836 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3837 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3838 for (i = 0; i < len; i++) {
3839 Jim_Obj *objPtr = NULL, *initObjPtr = NULL, *nameObjPtr = NULL;
3840 Jim_Var *varPtr;
3841 int subLen;
3843 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3844 /* Check if it's composed of two elements. */
3845 subLen = Jim_ListLength(interp, objPtr);
3846 if (subLen == 1 || subLen == 2) {
3847 /* Try to get the variable value from the current
3848 * environment. */
3849 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3850 if (subLen == 1) {
3851 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3852 if (initObjPtr == NULL) {
3853 Jim_SetResultFormatted(interp,
3854 "variable for initialization of static \"%#s\" not found in the local context",
3855 nameObjPtr);
3856 return JIM_ERR;
3859 else {
3860 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3862 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3863 return JIM_ERR;
3866 varPtr = Jim_Alloc(sizeof(*varPtr));
3867 varPtr->objPtr = initObjPtr;
3868 Jim_IncrRefCount(initObjPtr);
3869 varPtr->linkFramePtr = NULL;
3870 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3871 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3872 Jim_SetResultFormatted(interp,
3873 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3874 Jim_DecrRefCount(interp, initObjPtr);
3875 Jim_Free(varPtr);
3876 return JIM_ERR;
3879 else {
3880 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3881 objPtr);
3882 return JIM_ERR;
3885 return JIM_OK;
3888 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3890 #ifdef jim_ext_namespace
3891 if (cmdPtr->isproc) {
3892 /* XXX: Really need JimNamespaceSplit() */
3893 const char *pt = strrchr(cmdname, ':');
3894 if (pt && pt != cmdname && pt[-1] == ':') {
3895 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3896 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3897 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3899 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3900 /* This commands shadows a global command, so a proc epoch update is required */
3901 Jim_InterpIncrProcEpoch(interp);
3905 #endif
3908 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
3909 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
3911 Jim_Cmd *cmdPtr;
3912 int argListLen;
3913 int i;
3915 argListLen = Jim_ListLength(interp, argListObjPtr);
3917 /* Allocate space for both the command pointer and the arg list */
3918 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
3919 memset(cmdPtr, 0, sizeof(*cmdPtr));
3920 cmdPtr->inUse = 1;
3921 cmdPtr->isproc = 1;
3922 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
3923 cmdPtr->u.proc.argListLen = argListLen;
3924 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
3925 cmdPtr->u.proc.argsPos = -1;
3926 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
3927 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
3928 Jim_IncrRefCount(argListObjPtr);
3929 Jim_IncrRefCount(bodyObjPtr);
3930 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3932 /* Create the statics hash table. */
3933 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
3934 goto err;
3937 /* Parse the args out into arglist, validating as we go */
3938 /* Examine the argument list for default parameters and 'args' */
3939 for (i = 0; i < argListLen; i++) {
3940 Jim_Obj *argPtr;
3941 Jim_Obj *nameObjPtr;
3942 Jim_Obj *defaultObjPtr;
3943 int len;
3945 /* Examine a parameter */
3946 Jim_ListIndex(interp, argListObjPtr, i, &argPtr, JIM_NONE);
3947 len = Jim_ListLength(interp, argPtr);
3948 if (len == 0) {
3949 Jim_SetResultString(interp, "argument with no name", -1);
3950 err:
3951 JimDecrCmdRefCount(interp, cmdPtr);
3952 return NULL;
3954 if (len > 2) {
3955 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
3956 goto err;
3959 if (len == 2) {
3960 /* Optional parameter */
3961 Jim_ListIndex(interp, argPtr, 0, &nameObjPtr, JIM_NONE);
3962 Jim_ListIndex(interp, argPtr, 1, &defaultObjPtr, JIM_NONE);
3964 else {
3965 /* Required parameter */
3966 nameObjPtr = argPtr;
3967 defaultObjPtr = NULL;
3971 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
3972 if (cmdPtr->u.proc.argsPos >= 0) {
3973 Jim_SetResultString(interp, "'args' specified more than once", -1);
3974 goto err;
3976 cmdPtr->u.proc.argsPos = i;
3978 else {
3979 if (len == 2) {
3980 cmdPtr->u.proc.optArity++;
3982 else {
3983 cmdPtr->u.proc.reqArity++;
3987 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
3988 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
3991 return cmdPtr;
3994 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
3996 int ret = JIM_OK;
3997 Jim_Obj *qualifiedNameObj;
3998 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4000 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4001 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4002 ret = JIM_ERR;
4004 else {
4005 Jim_InterpIncrProcEpoch(interp);
4008 JimFreeQualifiedName(interp, qualifiedNameObj);
4010 return ret;
4013 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4015 int ret = JIM_ERR;
4016 Jim_HashEntry *he;
4017 Jim_Cmd *cmdPtr;
4018 Jim_Obj *qualifiedOldNameObj;
4019 Jim_Obj *qualifiedNewNameObj;
4020 const char *fqold;
4021 const char *fqnew;
4023 if (newName[0] == 0) {
4024 return Jim_DeleteCommand(interp, oldName);
4027 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4028 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4030 /* Does it exist? */
4031 he = Jim_FindHashEntry(&interp->commands, fqold);
4032 if (he == NULL) {
4033 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4035 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4036 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4038 else {
4039 /* Add the new name first */
4040 cmdPtr = he->u.val;
4041 JimIncrCmdRefCount(cmdPtr);
4042 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4043 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4045 /* Now remove the old name */
4046 Jim_DeleteHashEntry(&interp->commands, fqold);
4048 /* Increment the epoch */
4049 Jim_InterpIncrProcEpoch(interp);
4051 ret = JIM_OK;
4054 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4055 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4057 return ret;
4060 /* -----------------------------------------------------------------------------
4061 * Command object
4062 * ---------------------------------------------------------------------------*/
4064 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4066 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4069 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4071 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4072 dupPtr->typePtr = srcPtr->typePtr;
4073 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4076 static const Jim_ObjType commandObjType = {
4077 "command",
4078 FreeCommandInternalRep,
4079 DupCommandInternalRep,
4080 NULL,
4081 JIM_TYPE_REFERENCES,
4084 /* This function returns the command structure for the command name
4085 * stored in objPtr. It tries to specialize the objPtr to contain
4086 * a cached info instead to perform the lookup into the hash table
4087 * every time. The information cached may not be uptodate, in such
4088 * a case the lookup is performed and the cache updated.
4090 * Respects the 'upcall' setting
4092 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4094 Jim_Cmd *cmd;
4096 /* In order to be valid, the proc epoch must match and
4097 * the lookup must have occurred in the same namespace
4099 if (objPtr->typePtr != &commandObjType ||
4100 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4101 #ifdef jim_ext_namespace
4102 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4103 #endif
4105 /* Not cached or out of date, so lookup */
4107 /* Do we need to try the local namespace? */
4108 const char *name = Jim_String(objPtr);
4109 Jim_HashEntry *he;
4111 if (name[0] == ':' && name[1] == ':') {
4112 while (*++name == ':') {
4115 #ifdef jim_ext_namespace
4116 else if (Jim_Length(interp->framePtr->nsObj)) {
4117 /* This command is being defined in a non-global namespace */
4118 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4119 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4120 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4121 Jim_FreeNewObj(interp, nameObj);
4122 if (he) {
4123 goto found;
4126 #endif
4128 /* Lookup in the global namespace */
4129 he = Jim_FindHashEntry(&interp->commands, name);
4130 if (he == NULL) {
4131 if (flags & JIM_ERRMSG) {
4132 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4134 return NULL;
4136 #ifdef jim_ext_namespace
4137 found:
4138 #endif
4139 cmd = (Jim_Cmd *)he->u.val;
4141 /* Free the old internal repr and set the new one. */
4142 Jim_FreeIntRep(interp, objPtr);
4143 objPtr->typePtr = &commandObjType;
4144 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4145 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4146 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4147 Jim_IncrRefCount(interp->framePtr->nsObj);
4149 else {
4150 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4152 while (cmd->u.proc.upcall) {
4153 cmd = cmd->prevCmd;
4155 return cmd;
4158 /* -----------------------------------------------------------------------------
4159 * Variables
4160 * ---------------------------------------------------------------------------*/
4162 /* -----------------------------------------------------------------------------
4163 * Variable object
4164 * ---------------------------------------------------------------------------*/
4166 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4168 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4170 static const Jim_ObjType variableObjType = {
4171 "variable",
4172 NULL,
4173 NULL,
4174 NULL,
4175 JIM_TYPE_REFERENCES,
4179 * Check that the name does not contain embedded nulls.
4181 * Variable and procedure names are maniplated as null terminated strings, so
4182 * don't allow names with embedded nulls.
4184 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4186 /* Variable names and proc names can't contain embedded nulls */
4187 if (nameObjPtr->typePtr != &variableObjType) {
4188 int len;
4189 const char *str = Jim_GetString(nameObjPtr, &len);
4190 if (memchr(str, '\0', len)) {
4191 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4192 return JIM_ERR;
4195 return JIM_OK;
4198 /* This method should be called only by the variable API.
4199 * It returns JIM_OK on success (variable already exists),
4200 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4201 * a variable name, but syntax glue for [dict] i.e. the last
4202 * character is ')' */
4203 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4205 const char *varName;
4206 Jim_CallFrame *framePtr;
4207 Jim_HashEntry *he;
4208 int global;
4209 int len;
4211 /* Check if the object is already an uptodate variable */
4212 if (objPtr->typePtr == &variableObjType) {
4213 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4214 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4215 /* nothing to do */
4216 return JIM_OK;
4218 /* Need to re-resolve the variable in the updated callframe */
4220 else if (objPtr->typePtr == &dictSubstObjType) {
4221 return JIM_DICT_SUGAR;
4223 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4224 return JIM_ERR;
4228 varName = Jim_GetString(objPtr, &len);
4230 /* Make sure it's not syntax glue to get/set dict. */
4231 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4232 return JIM_DICT_SUGAR;
4235 if (varName[0] == ':' && varName[1] == ':') {
4236 while (*++varName == ':') {
4238 global = 1;
4239 framePtr = interp->topFramePtr;
4241 else {
4242 global = 0;
4243 framePtr = interp->framePtr;
4246 /* Resolve this name in the variables hash table */
4247 he = Jim_FindHashEntry(&framePtr->vars, varName);
4248 if (he == NULL) {
4249 if (!global && framePtr->staticVars) {
4250 /* Try with static vars. */
4251 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4253 if (he == NULL) {
4254 return JIM_ERR;
4258 /* Free the old internal repr and set the new one. */
4259 Jim_FreeIntRep(interp, objPtr);
4260 objPtr->typePtr = &variableObjType;
4261 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4262 objPtr->internalRep.varValue.varPtr = he->u.val;
4263 objPtr->internalRep.varValue.global = global;
4264 return JIM_OK;
4267 /* -------------------- Variables related functions ------------------------- */
4268 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4269 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4271 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4273 const char *name;
4274 Jim_CallFrame *framePtr;
4275 int global;
4277 /* New variable to create */
4278 Jim_Var *var = Jim_Alloc(sizeof(*var));
4280 var->objPtr = valObjPtr;
4281 Jim_IncrRefCount(valObjPtr);
4282 var->linkFramePtr = NULL;
4284 name = Jim_String(nameObjPtr);
4285 if (name[0] == ':' && name[1] == ':') {
4286 while (*++name == ':') {
4288 framePtr = interp->topFramePtr;
4289 global = 1;
4291 else {
4292 framePtr = interp->framePtr;
4293 global = 0;
4296 /* Insert the new variable */
4297 Jim_AddHashEntry(&framePtr->vars, name, var);
4299 /* Make the object int rep a variable */
4300 Jim_FreeIntRep(interp, nameObjPtr);
4301 nameObjPtr->typePtr = &variableObjType;
4302 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4303 nameObjPtr->internalRep.varValue.varPtr = var;
4304 nameObjPtr->internalRep.varValue.global = global;
4306 return var;
4309 /* For now that's dummy. Variables lookup should be optimized
4310 * in many ways, with caching of lookups, and possibly with
4311 * a table of pre-allocated vars in every CallFrame for local vars.
4312 * All the caching should also have an 'epoch' mechanism similar
4313 * to the one used by Tcl for procedures lookup caching. */
4315 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4317 int err;
4318 Jim_Var *var;
4320 switch (SetVariableFromAny(interp, nameObjPtr)) {
4321 case JIM_DICT_SUGAR:
4322 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4324 case JIM_ERR:
4325 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4326 return JIM_ERR;
4328 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4329 break;
4331 case JIM_OK:
4332 var = nameObjPtr->internalRep.varValue.varPtr;
4333 if (var->linkFramePtr == NULL) {
4334 Jim_IncrRefCount(valObjPtr);
4335 Jim_DecrRefCount(interp, var->objPtr);
4336 var->objPtr = valObjPtr;
4338 else { /* Else handle the link */
4339 Jim_CallFrame *savedCallFrame;
4341 savedCallFrame = interp->framePtr;
4342 interp->framePtr = var->linkFramePtr;
4343 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4344 interp->framePtr = savedCallFrame;
4345 if (err != JIM_OK)
4346 return err;
4349 return JIM_OK;
4352 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4354 Jim_Obj *nameObjPtr;
4355 int result;
4357 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4358 Jim_IncrRefCount(nameObjPtr);
4359 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4360 Jim_DecrRefCount(interp, nameObjPtr);
4361 return result;
4364 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4366 Jim_CallFrame *savedFramePtr;
4367 int result;
4369 savedFramePtr = interp->framePtr;
4370 interp->framePtr = interp->topFramePtr;
4371 result = Jim_SetVariableStr(interp, name, objPtr);
4372 interp->framePtr = savedFramePtr;
4373 return result;
4376 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4378 Jim_Obj *nameObjPtr, *valObjPtr;
4379 int result;
4381 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4382 valObjPtr = Jim_NewStringObj(interp, val, -1);
4383 Jim_IncrRefCount(nameObjPtr);
4384 Jim_IncrRefCount(valObjPtr);
4385 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4386 Jim_DecrRefCount(interp, nameObjPtr);
4387 Jim_DecrRefCount(interp, valObjPtr);
4388 return result;
4391 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4392 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4394 const char *varName;
4395 const char *targetName;
4396 Jim_CallFrame *framePtr;
4397 Jim_Var *varPtr;
4399 /* Check for an existing variable or link */
4400 switch (SetVariableFromAny(interp, nameObjPtr)) {
4401 case JIM_DICT_SUGAR:
4402 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4403 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4404 return JIM_ERR;
4406 case JIM_OK:
4407 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4409 if (varPtr->linkFramePtr == NULL) {
4410 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4411 return JIM_ERR;
4414 /* It exists, but is a link, so first delete the link */
4415 varPtr->linkFramePtr = NULL;
4416 break;
4419 /* Resolve the call frames for both variables */
4420 /* XXX: SetVariableFromAny() already did this! */
4421 varName = Jim_String(nameObjPtr);
4423 if (varName[0] == ':' && varName[1] == ':') {
4424 while (*++varName == ':') {
4426 /* Linking a global var does nothing */
4427 framePtr = interp->topFramePtr;
4429 else {
4430 framePtr = interp->framePtr;
4433 targetName = Jim_String(targetNameObjPtr);
4434 if (targetName[0] == ':' && targetName[1] == ':') {
4435 while (*++targetName == ':') {
4437 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4438 targetCallFrame = interp->topFramePtr;
4440 Jim_IncrRefCount(targetNameObjPtr);
4442 if (framePtr->level < targetCallFrame->level) {
4443 Jim_SetResultFormatted(interp,
4444 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4445 nameObjPtr);
4446 Jim_DecrRefCount(interp, targetNameObjPtr);
4447 return JIM_ERR;
4450 /* Check for cycles. */
4451 if (framePtr == targetCallFrame) {
4452 Jim_Obj *objPtr = targetNameObjPtr;
4454 /* Cycles are only possible with 'uplevel 0' */
4455 while (1) {
4456 if (strcmp(Jim_String(objPtr), varName) == 0) {
4457 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4458 Jim_DecrRefCount(interp, targetNameObjPtr);
4459 return JIM_ERR;
4461 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4462 break;
4463 varPtr = objPtr->internalRep.varValue.varPtr;
4464 if (varPtr->linkFramePtr != targetCallFrame)
4465 break;
4466 objPtr = varPtr->objPtr;
4470 /* Perform the binding */
4471 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4472 /* We are now sure 'nameObjPtr' type is variableObjType */
4473 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4474 Jim_DecrRefCount(interp, targetNameObjPtr);
4475 return JIM_OK;
4478 /* Return the Jim_Obj pointer associated with a variable name,
4479 * or NULL if the variable was not found in the current context.
4480 * The same optimization discussed in the comment to the
4481 * 'SetVariable' function should apply here.
4483 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4484 * in a dictionary which is shared, the array variable value is duplicated first.
4485 * This allows the array element to be updated (e.g. append, lappend) without
4486 * affecting other references to the dictionary.
4488 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4490 switch (SetVariableFromAny(interp, nameObjPtr)) {
4491 case JIM_OK:{
4492 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4494 if (varPtr->linkFramePtr == NULL) {
4495 return varPtr->objPtr;
4497 else {
4498 Jim_Obj *objPtr;
4500 /* The variable is a link? Resolve it. */
4501 Jim_CallFrame *savedCallFrame = interp->framePtr;
4503 interp->framePtr = varPtr->linkFramePtr;
4504 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4505 interp->framePtr = savedCallFrame;
4506 if (objPtr) {
4507 return objPtr;
4509 /* Error, so fall through to the error message */
4512 break;
4514 case JIM_DICT_SUGAR:
4515 /* [dict] syntax sugar. */
4516 return JimDictSugarGet(interp, nameObjPtr, flags);
4518 if (flags & JIM_ERRMSG) {
4519 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4521 return NULL;
4524 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4526 Jim_CallFrame *savedFramePtr;
4527 Jim_Obj *objPtr;
4529 savedFramePtr = interp->framePtr;
4530 interp->framePtr = interp->topFramePtr;
4531 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4532 interp->framePtr = savedFramePtr;
4534 return objPtr;
4537 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4539 Jim_Obj *nameObjPtr, *varObjPtr;
4541 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4542 Jim_IncrRefCount(nameObjPtr);
4543 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4544 Jim_DecrRefCount(interp, nameObjPtr);
4545 return varObjPtr;
4548 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4550 Jim_CallFrame *savedFramePtr;
4551 Jim_Obj *objPtr;
4553 savedFramePtr = interp->framePtr;
4554 interp->framePtr = interp->topFramePtr;
4555 objPtr = Jim_GetVariableStr(interp, name, flags);
4556 interp->framePtr = savedFramePtr;
4558 return objPtr;
4561 /* Unset a variable.
4562 * Note: On success unset invalidates all the variable objects created
4563 * in the current call frame incrementing. */
4564 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4566 Jim_Var *varPtr;
4567 int retval;
4568 Jim_CallFrame *framePtr;
4570 retval = SetVariableFromAny(interp, nameObjPtr);
4571 if (retval == JIM_DICT_SUGAR) {
4572 /* [dict] syntax sugar. */
4573 return JimDictSugarSet(interp, nameObjPtr, NULL);
4575 else if (retval == JIM_OK) {
4576 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4578 /* If it's a link call UnsetVariable recursively */
4579 if (varPtr->linkFramePtr) {
4580 framePtr = interp->framePtr;
4581 interp->framePtr = varPtr->linkFramePtr;
4582 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4583 interp->framePtr = framePtr;
4585 else {
4586 const char *name = Jim_String(nameObjPtr);
4587 if (nameObjPtr->internalRep.varValue.global) {
4588 name += 2;
4589 framePtr = interp->topFramePtr;
4591 else {
4592 framePtr = interp->framePtr;
4595 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4596 if (retval == JIM_OK) {
4597 /* Change the callframe id, invalidating var lookup caching */
4598 JimChangeCallFrameId(interp, framePtr);
4602 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4603 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4605 return retval;
4608 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4610 /* Given a variable name for [dict] operation syntax sugar,
4611 * this function returns two objects, the first with the name
4612 * of the variable to set, and the second with the rispective key.
4613 * For example "foo(bar)" will return objects with string repr. of
4614 * "foo" and "bar".
4616 * The returned objects have refcount = 1. The function can't fail. */
4617 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4618 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4620 const char *str, *p;
4621 int len, keyLen;
4622 Jim_Obj *varObjPtr, *keyObjPtr;
4624 str = Jim_GetString(objPtr, &len);
4626 p = strchr(str, '(');
4627 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4629 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4631 p++;
4632 keyLen = (str + len) - p;
4633 if (str[len - 1] == ')') {
4634 keyLen--;
4637 /* Create the objects with the variable name and key. */
4638 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4640 Jim_IncrRefCount(varObjPtr);
4641 Jim_IncrRefCount(keyObjPtr);
4642 *varPtrPtr = varObjPtr;
4643 *keyPtrPtr = keyObjPtr;
4646 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4647 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4648 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4650 int err;
4652 SetDictSubstFromAny(interp, objPtr);
4654 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4655 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4657 if (err == JIM_OK) {
4658 /* Don't keep an extra ref to the result */
4659 Jim_SetEmptyResult(interp);
4661 else {
4662 if (!valObjPtr) {
4663 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4664 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4665 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4666 objPtr);
4667 return err;
4670 /* Make the error more informative and Tcl-compatible */
4671 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4672 (valObjPtr ? "set" : "unset"), objPtr);
4674 return err;
4678 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4680 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4681 * and stored back to the variable before expansion.
4683 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4684 Jim_Obj *keyObjPtr, int flags)
4686 Jim_Obj *dictObjPtr;
4687 Jim_Obj *resObjPtr = NULL;
4688 int ret;
4690 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4691 if (!dictObjPtr) {
4692 return NULL;
4695 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4696 if (ret != JIM_OK) {
4697 resObjPtr = NULL;
4698 if (ret < 0) {
4699 Jim_SetResultFormatted(interp,
4700 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr, keyObjPtr);
4702 else {
4703 Jim_SetResultFormatted(interp,
4704 "can't read \"%#s(%#s)\": no such element in array", varObjPtr, keyObjPtr);
4707 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4708 dictObjPtr = Jim_DuplicateObj(interp, dictObjPtr);
4709 if (Jim_SetVariable(interp, varObjPtr, dictObjPtr) != JIM_OK) {
4710 /* This can probably never happen */
4711 JimPanic((1, "SetVariable failed for JIM_UNSHARED"));
4713 /* We know that the key exists. Get the result in the now-unshared dictionary */
4714 Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4717 return resObjPtr;
4720 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4721 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4723 SetDictSubstFromAny(interp, objPtr);
4725 return JimDictExpandArrayVariable(interp,
4726 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4727 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4730 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4732 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4734 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4735 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4738 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4740 JIM_NOTUSED(interp);
4742 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4743 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4744 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4745 dupPtr->typePtr = &dictSubstObjType;
4748 /* Note: The object *must* be in dict-sugar format */
4749 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4751 if (objPtr->typePtr != &dictSubstObjType) {
4752 Jim_Obj *varObjPtr, *keyObjPtr;
4754 if (objPtr->typePtr == &interpolatedObjType) {
4755 /* An interpolated object in dict-sugar form */
4757 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4758 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4760 Jim_IncrRefCount(varObjPtr);
4761 Jim_IncrRefCount(keyObjPtr);
4763 else {
4764 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4767 Jim_FreeIntRep(interp, objPtr);
4768 objPtr->typePtr = &dictSubstObjType;
4769 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4770 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4774 /* This function is used to expand [dict get] sugar in the form
4775 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4776 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4777 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4778 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4779 * the [dict]ionary contained in variable VARNAME. */
4780 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4782 Jim_Obj *resObjPtr = NULL;
4783 Jim_Obj *substKeyObjPtr = NULL;
4785 SetDictSubstFromAny(interp, objPtr);
4787 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4788 &substKeyObjPtr, JIM_NONE)
4789 != JIM_OK) {
4790 return NULL;
4792 Jim_IncrRefCount(substKeyObjPtr);
4793 resObjPtr =
4794 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4795 substKeyObjPtr, 0);
4796 Jim_DecrRefCount(interp, substKeyObjPtr);
4798 return resObjPtr;
4801 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4803 Jim_Obj *resultObjPtr;
4805 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4806 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4807 resultObjPtr->refCount--;
4808 return resultObjPtr;
4810 return NULL;
4813 /* -----------------------------------------------------------------------------
4814 * CallFrame
4815 * ---------------------------------------------------------------------------*/
4817 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4819 Jim_CallFrame *cf;
4821 if (interp->freeFramesList) {
4822 cf = interp->freeFramesList;
4823 interp->freeFramesList = cf->next;
4825 else {
4826 cf = Jim_Alloc(sizeof(*cf));
4827 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4830 cf->id = interp->callFrameEpoch++;
4831 cf->parent = parent;
4832 cf->level = parent ? parent->level + 1 : 0;
4833 cf->argv = NULL;
4834 cf->argc = 0;
4835 cf->procArgsObjPtr = NULL;
4836 cf->procBodyObjPtr = NULL;
4837 cf->next = NULL;
4838 cf->staticVars = NULL;
4839 cf->localCommands = NULL;
4840 cf->tailcall = 0;
4841 cf->tailcallObj = NULL;
4842 cf->tailcallCmd = NULL;
4843 cf->nsObj = nsObj;
4844 Jim_IncrRefCount(nsObj);
4846 return cf;
4849 /* Used to invalidate every caching related to callframe stability. */
4850 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
4852 cf->id = interp->callFrameEpoch++;
4855 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4857 /* Delete any local procs */
4858 if (localCommands) {
4859 Jim_Obj *cmdNameObj;
4861 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4862 Jim_HashEntry *he;
4863 Jim_Obj *fqObjName;
4865 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4867 he = Jim_FindHashEntry(&interp->commands, fqname);
4869 if (he) {
4870 Jim_Cmd *cmd = he->u.val;
4871 if (cmd->prevCmd) {
4872 Jim_Cmd *prevCmd = cmd->prevCmd;
4873 cmd->prevCmd = NULL;
4875 /* Delete the old command */
4876 JimDecrCmdRefCount(interp, cmd);
4878 /* And restore the original */
4879 he->u.val = prevCmd;
4881 else {
4882 Jim_DeleteHashEntry(&interp->commands, fqname);
4883 Jim_InterpIncrProcEpoch(interp);
4886 Jim_DecrRefCount(interp, cmdNameObj);
4887 JimFreeQualifiedName(interp, fqObjName);
4889 Jim_FreeStack(localCommands);
4890 Jim_Free(localCommands);
4892 return JIM_OK;
4896 #define JIM_FCF_NONE 0 /* no flags */
4897 #define JIM_FCF_NOHT 1 /* don't free the hash table */
4898 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags)
4900 if (cf->procArgsObjPtr)
4901 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4902 if (cf->procBodyObjPtr)
4903 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4904 Jim_DecrRefCount(interp, cf->nsObj);
4905 if (!(flags & JIM_FCF_NOHT))
4906 Jim_FreeHashTable(&cf->vars);
4907 else {
4908 int i;
4909 Jim_HashEntry **table = cf->vars.table, *he;
4911 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4912 he = table[i];
4913 while (he != NULL) {
4914 Jim_HashEntry *nextEntry = he->next;
4915 Jim_Var *varPtr = (void *)he->u.val;
4917 Jim_DecrRefCount(interp, varPtr->objPtr);
4918 Jim_Free(he->u.val);
4919 Jim_Free((void *)he->key); /* ATTENTION: const cast */
4920 Jim_Free(he);
4921 table[i] = NULL;
4922 he = nextEntry;
4925 cf->vars.used = 0;
4928 JimDeleteLocalProcs(interp, cf->localCommands);
4930 cf->next = interp->freeFramesList;
4931 interp->freeFramesList = cf;
4936 /* -----------------------------------------------------------------------------
4937 * References
4938 * ---------------------------------------------------------------------------*/
4939 #ifdef JIM_REFERENCES
4941 /* References HashTable Type.
4943 * Keys are unsigned long integers, dynamically allocated for now but in the
4944 * future it's worth to cache this 4 bytes objects. Values are pointers
4945 * to Jim_References. */
4946 static void JimReferencesHTValDestructor(void *interp, void *val)
4948 Jim_Reference *refPtr = (void *)val;
4950 Jim_DecrRefCount(interp, refPtr->objPtr);
4951 if (refPtr->finalizerCmdNamePtr != NULL) {
4952 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4954 Jim_Free(val);
4957 static unsigned int JimReferencesHTHashFunction(const void *key)
4959 /* Only the least significant bits are used. */
4960 const unsigned long *widePtr = key;
4961 unsigned int intValue = (unsigned int)*widePtr;
4963 return Jim_IntHashFunction(intValue);
4966 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
4968 void *copy = Jim_Alloc(sizeof(unsigned long));
4970 JIM_NOTUSED(privdata);
4972 memcpy(copy, key, sizeof(unsigned long));
4973 return copy;
4976 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
4978 JIM_NOTUSED(privdata);
4980 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
4983 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
4985 JIM_NOTUSED(privdata);
4987 Jim_Free(key);
4990 static const Jim_HashTableType JimReferencesHashTableType = {
4991 JimReferencesHTHashFunction, /* hash function */
4992 JimReferencesHTKeyDup, /* key dup */
4993 NULL, /* val dup */
4994 JimReferencesHTKeyCompare, /* key compare */
4995 JimReferencesHTKeyDestructor, /* key destructor */
4996 JimReferencesHTValDestructor /* val destructor */
4999 /* -----------------------------------------------------------------------------
5000 * Reference object type and References API
5001 * ---------------------------------------------------------------------------*/
5003 /* The string representation of references has two features in order
5004 * to make the GC faster. The first is that every reference starts
5005 * with a non common character '<', in order to make the string matching
5006 * faster. The second is that the reference string rep is 42 characters
5007 * in length, this allows to avoid to check every object with a string
5008 * repr < 42, and usually there aren't many of these objects. */
5010 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5012 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5014 const char *fmt = "<reference.<%s>.%020lu>";
5016 sprintf(buf, fmt, refPtr->tag, id);
5017 return JIM_REFERENCE_SPACE;
5020 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5022 static const Jim_ObjType referenceObjType = {
5023 "reference",
5024 NULL,
5025 NULL,
5026 UpdateStringOfReference,
5027 JIM_TYPE_REFERENCES,
5030 void UpdateStringOfReference(struct Jim_Obj *objPtr)
5032 char buf[JIM_REFERENCE_SPACE + 1];
5034 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5035 JimSetStringBytes(objPtr, buf);
5038 /* returns true if 'c' is a valid reference tag character.
5039 * i.e. inside the range [_a-zA-Z0-9] */
5040 static int isrefchar(int c)
5042 return (c == '_' || isalnum(c));
5045 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5047 unsigned long value;
5048 int i, len;
5049 const char *str, *start, *end;
5050 char refId[21];
5051 Jim_Reference *refPtr;
5052 Jim_HashEntry *he;
5053 char *endptr;
5055 /* Get the string representation */
5056 str = Jim_GetString(objPtr, &len);
5057 /* Check if it looks like a reference */
5058 if (len < JIM_REFERENCE_SPACE)
5059 goto badformat;
5060 /* Trim spaces */
5061 start = str;
5062 end = str + len - 1;
5063 while (*start == ' ')
5064 start++;
5065 while (*end == ' ' && end > start)
5066 end--;
5067 if (end - start + 1 != JIM_REFERENCE_SPACE)
5068 goto badformat;
5069 /* <reference.<1234567>.%020> */
5070 if (memcmp(start, "<reference.<", 12) != 0)
5071 goto badformat;
5072 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5073 goto badformat;
5074 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5075 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5076 if (!isrefchar(start[12 + i]))
5077 goto badformat;
5079 /* Extract info from the reference. */
5080 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5081 refId[20] = '\0';
5082 /* Try to convert the ID into an unsigned long */
5083 value = strtoul(refId, &endptr, 10);
5084 if (JimCheckConversion(refId, endptr) != JIM_OK)
5085 goto badformat;
5086 /* Check if the reference really exists! */
5087 he = Jim_FindHashEntry(&interp->references, &value);
5088 if (he == NULL) {
5089 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5090 return JIM_ERR;
5092 refPtr = he->u.val;
5093 /* Free the old internal repr and set the new one. */
5094 Jim_FreeIntRep(interp, objPtr);
5095 objPtr->typePtr = &referenceObjType;
5096 objPtr->internalRep.refValue.id = value;
5097 objPtr->internalRep.refValue.refPtr = refPtr;
5098 return JIM_OK;
5100 badformat:
5101 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5102 return JIM_ERR;
5105 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5106 * as finalizer command (or NULL if there is no finalizer).
5107 * The returned reference object has refcount = 0. */
5108 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5110 struct Jim_Reference *refPtr;
5111 unsigned long id;
5112 Jim_Obj *refObjPtr;
5113 const char *tag;
5114 int tagLen, i;
5116 /* Perform the Garbage Collection if needed. */
5117 Jim_CollectIfNeeded(interp);
5119 refPtr = Jim_Alloc(sizeof(*refPtr));
5120 refPtr->objPtr = objPtr;
5121 Jim_IncrRefCount(objPtr);
5122 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5123 if (cmdNamePtr)
5124 Jim_IncrRefCount(cmdNamePtr);
5125 id = interp->referenceNextId++;
5126 Jim_AddHashEntry(&interp->references, &id, refPtr);
5127 refObjPtr = Jim_NewObj(interp);
5128 refObjPtr->typePtr = &referenceObjType;
5129 refObjPtr->bytes = NULL;
5130 refObjPtr->internalRep.refValue.id = id;
5131 refObjPtr->internalRep.refValue.refPtr = refPtr;
5132 interp->referenceNextId++;
5133 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5134 * that does not pass the 'isrefchar' test is replaced with '_' */
5135 tag = Jim_GetString(tagPtr, &tagLen);
5136 if (tagLen > JIM_REFERENCE_TAGLEN)
5137 tagLen = JIM_REFERENCE_TAGLEN;
5138 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5139 if (i < tagLen && isrefchar(tag[i]))
5140 refPtr->tag[i] = tag[i];
5141 else
5142 refPtr->tag[i] = '_';
5144 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5145 return refObjPtr;
5148 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5150 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5151 return NULL;
5152 return objPtr->internalRep.refValue.refPtr;
5155 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5157 Jim_Reference *refPtr;
5159 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5160 return JIM_ERR;
5161 Jim_IncrRefCount(cmdNamePtr);
5162 if (refPtr->finalizerCmdNamePtr)
5163 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5164 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5165 return JIM_OK;
5168 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5170 Jim_Reference *refPtr;
5172 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5173 return JIM_ERR;
5174 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5175 return JIM_OK;
5178 /* -----------------------------------------------------------------------------
5179 * References Garbage Collection
5180 * ---------------------------------------------------------------------------*/
5182 /* This the hash table type for the "MARK" phase of the GC */
5183 static const Jim_HashTableType JimRefMarkHashTableType = {
5184 JimReferencesHTHashFunction, /* hash function */
5185 JimReferencesHTKeyDup, /* key dup */
5186 NULL, /* val dup */
5187 JimReferencesHTKeyCompare, /* key compare */
5188 JimReferencesHTKeyDestructor, /* key destructor */
5189 NULL /* val destructor */
5192 /* Performs the garbage collection. */
5193 int Jim_Collect(Jim_Interp *interp)
5195 int collected = 0;
5196 #ifndef JIM_BOOTSTRAP
5197 Jim_HashTable marks;
5198 Jim_HashTableIterator htiter;
5199 Jim_HashEntry *he;
5200 Jim_Obj *objPtr;
5202 /* Avoid recursive calls */
5203 if (interp->lastCollectId == -1) {
5204 /* Jim_Collect() already running. Return just now. */
5205 return 0;
5207 interp->lastCollectId = -1;
5209 /* Mark all the references found into the 'mark' hash table.
5210 * The references are searched in every live object that
5211 * is of a type that can contain references. */
5212 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5213 objPtr = interp->liveList;
5214 while (objPtr) {
5215 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5216 const char *str, *p;
5217 int len;
5219 /* If the object is of type reference, to get the
5220 * Id is simple... */
5221 if (objPtr->typePtr == &referenceObjType) {
5222 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5223 #ifdef JIM_DEBUG_GC
5224 printf("MARK (reference): %d refcount: %d" JIM_NL,
5225 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5226 #endif
5227 objPtr = objPtr->nextObjPtr;
5228 continue;
5230 /* Get the string repr of the object we want
5231 * to scan for references. */
5232 p = str = Jim_GetString(objPtr, &len);
5233 /* Skip objects too little to contain references. */
5234 if (len < JIM_REFERENCE_SPACE) {
5235 objPtr = objPtr->nextObjPtr;
5236 continue;
5238 /* Extract references from the object string repr. */
5239 while (1) {
5240 int i;
5241 unsigned long id;
5243 if ((p = strstr(p, "<reference.<")) == NULL)
5244 break;
5245 /* Check if it's a valid reference. */
5246 if (len - (p - str) < JIM_REFERENCE_SPACE)
5247 break;
5248 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5249 break;
5250 for (i = 21; i <= 40; i++)
5251 if (!isdigit(UCHAR(p[i])))
5252 break;
5253 /* Get the ID */
5254 id = strtoul(p + 21, NULL, 10);
5256 /* Ok, a reference for the given ID
5257 * was found. Mark it. */
5258 Jim_AddHashEntry(&marks, &id, NULL);
5259 #ifdef JIM_DEBUG_GC
5260 printf("MARK: %d" JIM_NL, (int)id);
5261 #endif
5262 p += JIM_REFERENCE_SPACE;
5265 objPtr = objPtr->nextObjPtr;
5268 /* Run the references hash table to destroy every reference that
5269 * is not referenced outside (not present in the mark HT). */
5270 JimInitHashTableIterator(&interp->references, &htiter);
5271 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5272 const unsigned long *refId;
5273 Jim_Reference *refPtr;
5275 refId = he->key;
5276 /* Check if in the mark phase we encountered
5277 * this reference. */
5278 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5279 #ifdef JIM_DEBUG_GC
5280 printf("COLLECTING %d" JIM_NL, (int)*refId);
5281 #endif
5282 collected++;
5283 /* Drop the reference, but call the
5284 * finalizer first if registered. */
5285 refPtr = he->u.val;
5286 if (refPtr->finalizerCmdNamePtr) {
5287 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5288 Jim_Obj *objv[3], *oldResult;
5290 JimFormatReference(refstr, refPtr, *refId);
5292 objv[0] = refPtr->finalizerCmdNamePtr;
5293 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5294 objv[2] = refPtr->objPtr;
5296 /* Drop the reference itself */
5297 /* Avoid the finaliser being freed here */
5298 Jim_IncrRefCount(objv[0]);
5299 /* Don't remove the reference from the hash table just yet
5300 * since that will free refPtr, and hence refPtr->objPtr
5303 /* Call the finalizer. Errors ignored. */
5304 oldResult = interp->result;
5305 Jim_IncrRefCount(oldResult);
5306 Jim_EvalObjVector(interp, 3, objv);
5307 Jim_SetResult(interp, oldResult);
5308 Jim_DecrRefCount(interp, oldResult);
5309 Jim_DeleteHashEntry(&interp->references, refId);
5311 Jim_DecrRefCount(interp, objv[0]);
5313 else {
5314 Jim_DeleteHashEntry(&interp->references, refId);
5318 Jim_FreeHashTable(&marks);
5319 interp->lastCollectId = interp->referenceNextId;
5320 interp->lastCollectTime = time(NULL);
5321 #endif /* JIM_BOOTSTRAP */
5322 return collected;
5325 #define JIM_COLLECT_ID_PERIOD 5000
5326 #define JIM_COLLECT_TIME_PERIOD 300
5328 void Jim_CollectIfNeeded(Jim_Interp *interp)
5330 unsigned long elapsedId;
5331 int elapsedTime;
5333 elapsedId = interp->referenceNextId - interp->lastCollectId;
5334 elapsedTime = time(NULL) - interp->lastCollectTime;
5337 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5338 Jim_Collect(interp);
5341 #endif
5343 int Jim_IsBigEndian(void)
5345 union {
5346 unsigned short s;
5347 unsigned char c[2];
5348 } uval = {0x0102};
5350 return uval.c[0] == 1;
5353 /* -----------------------------------------------------------------------------
5354 * Interpreter related functions
5355 * ---------------------------------------------------------------------------*/
5357 Jim_Interp *Jim_CreateInterp(void)
5359 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5361 memset(i, 0, sizeof(*i));
5363 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5364 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5365 i->lastCollectTime = time(NULL);
5367 /* Note that we can create objects only after the
5368 * interpreter liveList and freeList pointers are
5369 * initialized to NULL. */
5370 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5371 #ifdef JIM_REFERENCES
5372 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5373 #endif
5374 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5375 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5376 i->emptyObj = Jim_NewEmptyStringObj(i);
5377 i->trueObj = Jim_NewIntObj(i, 1);
5378 i->falseObj = Jim_NewIntObj(i, 0);
5379 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5380 i->errorFileNameObj = i->emptyObj;
5381 i->result = i->emptyObj;
5382 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5383 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5384 i->errorProc = i->emptyObj;
5385 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5386 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5387 Jim_IncrRefCount(i->emptyObj);
5388 Jim_IncrRefCount(i->errorFileNameObj);
5389 Jim_IncrRefCount(i->result);
5390 Jim_IncrRefCount(i->stackTrace);
5391 Jim_IncrRefCount(i->unknown);
5392 Jim_IncrRefCount(i->currentScriptObj);
5393 Jim_IncrRefCount(i->nullScriptObj);
5394 Jim_IncrRefCount(i->errorProc);
5395 Jim_IncrRefCount(i->trueObj);
5396 Jim_IncrRefCount(i->falseObj);
5398 /* Initialize key variables every interpreter should contain */
5399 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5400 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5402 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5403 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5404 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5405 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5406 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5407 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5408 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5410 return i;
5413 void Jim_FreeInterp(Jim_Interp *i)
5415 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
5416 Jim_Obj *objPtr, *nextObjPtr;
5418 /* Free the call frames list - must be done before i->commands is destroyed */
5419 while (cf) {
5420 prevcf = cf->parent;
5421 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
5422 cf = prevcf;
5425 Jim_DecrRefCount(i, i->emptyObj);
5426 Jim_DecrRefCount(i, i->trueObj);
5427 Jim_DecrRefCount(i, i->falseObj);
5428 Jim_DecrRefCount(i, i->result);
5429 Jim_DecrRefCount(i, i->stackTrace);
5430 Jim_DecrRefCount(i, i->errorProc);
5431 Jim_DecrRefCount(i, i->unknown);
5432 Jim_DecrRefCount(i, i->errorFileNameObj);
5433 Jim_DecrRefCount(i, i->currentScriptObj);
5434 Jim_DecrRefCount(i, i->nullScriptObj);
5435 Jim_FreeHashTable(&i->commands);
5436 #ifdef JIM_REFERENCES
5437 Jim_FreeHashTable(&i->references);
5438 #endif
5439 Jim_FreeHashTable(&i->packages);
5440 Jim_Free(i->prngState);
5441 Jim_FreeHashTable(&i->assocData);
5443 /* Check that the live object list is empty, otherwise
5444 * there is a memory leak. */
5445 if (i->liveList != NULL) {
5446 objPtr = i->liveList;
5448 printf(JIM_NL "-------------------------------------" JIM_NL);
5449 printf("Objects still in the free list:" JIM_NL);
5450 while (objPtr) {
5451 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5453 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5454 printf("%p (%d) %-10s: '%.20s...'" JIM_NL,
5455 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5457 else {
5458 printf("%p (%d) %-10s: '%s'" JIM_NL,
5459 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5461 if (objPtr->typePtr == &sourceObjType) {
5462 printf("FILE %s LINE %d" JIM_NL,
5463 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5464 objPtr->internalRep.sourceValue.lineNumber);
5466 objPtr = objPtr->nextObjPtr;
5468 printf("-------------------------------------" JIM_NL JIM_NL);
5469 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5471 /* Free all the freed objects. */
5472 objPtr = i->freeList;
5473 while (objPtr) {
5474 nextObjPtr = objPtr->nextObjPtr;
5475 Jim_Free(objPtr);
5476 objPtr = nextObjPtr;
5478 /* Free cached CallFrame structures */
5479 cf = i->freeFramesList;
5480 while (cf) {
5481 nextcf = cf->next;
5482 if (cf->vars.table != NULL)
5483 Jim_Free(cf->vars.table);
5484 Jim_Free(cf);
5485 cf = nextcf;
5488 /* Free the interpreter structure. */
5489 Jim_Free(i);
5492 /* Returns the call frame relative to the level represented by
5493 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
5495 * This function accepts the 'level' argument in the form
5496 * of the commands [uplevel] and [upvar].
5498 * For a function accepting a relative integer as level suitable
5499 * for implementation of [info level ?level?] check the
5500 * JimGetCallFrameByInteger() function.
5502 * Returns NULL on error.
5504 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5506 long level;
5507 const char *str;
5508 Jim_CallFrame *framePtr;
5510 if (levelObjPtr) {
5511 str = Jim_String(levelObjPtr);
5512 if (str[0] == '#') {
5513 char *endptr;
5515 level = jim_strtol(str + 1, &endptr);
5516 if (str[1] == '\0' || endptr[0] != '\0') {
5517 level = -1;
5520 else {
5521 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5522 level = -1;
5524 else {
5525 /* Convert from a relative to an absolute level */
5526 level = interp->framePtr->level - level;
5530 else {
5531 str = "1"; /* Needed to format the error message. */
5532 level = interp->framePtr->level - 1;
5535 if (level == 0) {
5536 return interp->topFramePtr;
5538 if (level > 0) {
5539 /* Lookup */
5540 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5541 if (framePtr->level == level) {
5542 return framePtr;
5547 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5548 return NULL;
5551 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5552 * as a relative integer like in the [info level ?level?] command.
5554 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5556 long level;
5557 Jim_CallFrame *framePtr;
5559 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5560 if (level <= 0) {
5561 /* Convert from a relative to an absolute level */
5562 level = interp->framePtr->level + level;
5565 if (level == 0) {
5566 return interp->topFramePtr;
5569 /* Lookup */
5570 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5571 if (framePtr->level == level) {
5572 return framePtr;
5577 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5578 return NULL;
5581 static void JimResetStackTrace(Jim_Interp *interp)
5583 Jim_DecrRefCount(interp, interp->stackTrace);
5584 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5585 Jim_IncrRefCount(interp->stackTrace);
5588 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5590 int len;
5592 /* Increment reference first in case these are the same object */
5593 Jim_IncrRefCount(stackTraceObj);
5594 Jim_DecrRefCount(interp, interp->stackTrace);
5595 interp->stackTrace = stackTraceObj;
5596 interp->errorFlag = 1;
5598 /* This is a bit ugly.
5599 * If the filename of the last entry of the stack trace is empty,
5600 * the next stack level should be added.
5602 len = Jim_ListLength(interp, interp->stackTrace);
5603 if (len >= 3) {
5604 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5605 interp->addStackTrace = 1;
5610 /* Returns 1 if the stack trace information was used or 0 if not */
5611 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5612 Jim_Obj *fileNameObj, int linenr)
5614 if (strcmp(procname, "unknown") == 0) {
5615 procname = "";
5617 if (!*procname && !Jim_Length(fileNameObj)) {
5618 /* No useful info here */
5619 return;
5622 if (Jim_IsShared(interp->stackTrace)) {
5623 Jim_DecrRefCount(interp, interp->stackTrace);
5624 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5625 Jim_IncrRefCount(interp->stackTrace);
5628 /* If we have no procname but the previous element did, merge with that frame */
5629 if (!*procname && Jim_Length(fileNameObj)) {
5630 /* Just a filename. Check the previous entry */
5631 int len = Jim_ListLength(interp, interp->stackTrace);
5633 if (len >= 3) {
5634 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5635 if (Jim_Length(objPtr)) {
5636 /* Yes, the previous level had procname */
5637 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5638 if (Jim_Length(objPtr) == 0) {
5639 /* But no filename, so merge the new info with that frame */
5640 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5641 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5642 return;
5648 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5649 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5650 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5653 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5654 void *data)
5656 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5658 assocEntryPtr->delProc = delProc;
5659 assocEntryPtr->data = data;
5660 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5663 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5665 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5667 if (entryPtr != NULL) {
5668 AssocDataValue *assocEntryPtr = (AssocDataValue *) entryPtr->u.val;
5670 return assocEntryPtr->data;
5672 return NULL;
5675 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5677 return Jim_DeleteHashEntry(&interp->assocData, key);
5680 int Jim_GetExitCode(Jim_Interp *interp)
5682 return interp->exitCode;
5685 /* -----------------------------------------------------------------------------
5686 * Integer object
5687 * ---------------------------------------------------------------------------*/
5688 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5689 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5691 static const Jim_ObjType intObjType = {
5692 "int",
5693 NULL,
5694 NULL,
5695 UpdateStringOfInt,
5696 JIM_TYPE_NONE,
5699 /* A coerced double is closer to an int than a double.
5700 * It is an int value temporarily masquerading as a double value.
5701 * i.e. it has the same string value as an int and Jim_GetWide()
5702 * succeeds, but also Jim_GetDouble() returns the value directly.
5704 static const Jim_ObjType coercedDoubleObjType = {
5705 "coerced-double",
5706 NULL,
5707 NULL,
5708 UpdateStringOfInt,
5709 JIM_TYPE_NONE,
5713 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5715 char buf[JIM_INTEGER_SPACE + 1];
5716 jim_wide wideValue = JimWideValue(objPtr);
5717 int pos = 0;
5719 if (wideValue == 0) {
5720 buf[pos++] = '0';
5722 else {
5723 char tmp[JIM_INTEGER_SPACE];
5724 int num = 0;
5725 int i;
5727 if (wideValue < 0) {
5728 buf[pos++] = '-';
5729 /* -106 % 10 may be -6 or 4! */
5730 i = wideValue % 10;
5731 tmp[num++] = (i > 0) ? (10 - i) : -i;
5732 wideValue /= -10;
5735 while (wideValue) {
5736 tmp[num++] = wideValue % 10;
5737 wideValue /= 10;
5740 for (i = 0; i < num; i++) {
5741 buf[pos++] = '0' + tmp[num - i - 1];
5744 buf[pos] = 0;
5746 JimSetStringBytes(objPtr, buf);
5749 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5751 jim_wide wideValue;
5752 const char *str;
5754 if (objPtr->typePtr == &coercedDoubleObjType) {
5755 /* Simple switcheroo */
5756 objPtr->typePtr = &intObjType;
5757 return JIM_OK;
5760 /* Get the string representation */
5761 str = Jim_String(objPtr);
5762 /* Try to convert into a jim_wide */
5763 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5764 if (flags & JIM_ERRMSG) {
5765 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5767 return JIM_ERR;
5769 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5770 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5771 return JIM_ERR;
5773 /* Free the old internal repr and set the new one. */
5774 Jim_FreeIntRep(interp, objPtr);
5775 objPtr->typePtr = &intObjType;
5776 objPtr->internalRep.wideValue = wideValue;
5777 return JIM_OK;
5780 #ifdef JIM_OPTIMIZATION
5781 static int JimIsWide(Jim_Obj *objPtr)
5783 return objPtr->typePtr == &intObjType;
5785 #endif
5787 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5789 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5790 return JIM_ERR;
5791 *widePtr = JimWideValue(objPtr);
5792 return JIM_OK;
5795 /* Get a wide but does not set an error if the format is bad. */
5796 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5798 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5799 return JIM_ERR;
5800 *widePtr = JimWideValue(objPtr);
5801 return JIM_OK;
5804 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5806 jim_wide wideValue;
5807 int retval;
5809 retval = Jim_GetWide(interp, objPtr, &wideValue);
5810 if (retval == JIM_OK) {
5811 *longPtr = (long)wideValue;
5812 return JIM_OK;
5814 return JIM_ERR;
5817 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5819 Jim_Obj *objPtr;
5821 objPtr = Jim_NewObj(interp);
5822 objPtr->typePtr = &intObjType;
5823 objPtr->bytes = NULL;
5824 objPtr->internalRep.wideValue = wideValue;
5825 return objPtr;
5828 /* -----------------------------------------------------------------------------
5829 * Double object
5830 * ---------------------------------------------------------------------------*/
5831 #define JIM_DOUBLE_SPACE 30
5833 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5834 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5836 static const Jim_ObjType doubleObjType = {
5837 "double",
5838 NULL,
5839 NULL,
5840 UpdateStringOfDouble,
5841 JIM_TYPE_NONE,
5844 #ifndef HAVE_ISNAN
5845 #undef isnan
5846 #define isnan(X) ((X) != (X))
5847 #endif
5848 #ifndef HAVE_ISINF
5849 #undef isinf
5850 #define isinf(X) (1.0 / (X) == 0.0)
5851 #endif
5853 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5855 double value = objPtr->internalRep.doubleValue;
5857 if (isnan(value)) {
5858 JimSetStringBytes(objPtr, "NaN");
5859 return;
5861 if (isinf(value)) {
5862 if (value < 0) {
5863 JimSetStringBytes(objPtr, "-Inf");
5865 else {
5866 JimSetStringBytes(objPtr, "Inf");
5868 return;
5871 char buf[JIM_DOUBLE_SPACE + 1];
5872 int i;
5873 int len = sprintf(buf, "%.12g", value);
5875 /* Add a final ".0" if necessary */
5876 for (i = 0; i < len; i++) {
5877 if (buf[i] == '.' || buf[i] == 'e') {
5878 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5879 /* If 'buf' ends in e-0nn or e+0nn, remove
5880 * the 0 after the + or - and reduce the length by 1
5882 char *e = strchr(buf, 'e');
5883 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5884 /* Move it up */
5885 e += 2;
5886 memmove(e, e + 1, len - (e - buf));
5888 #endif
5889 break;
5892 if (buf[i] == '\0') {
5893 buf[i++] = '.';
5894 buf[i++] = '0';
5895 buf[i] = '\0';
5897 JimSetStringBytes(objPtr, buf);
5901 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5903 double doubleValue;
5904 jim_wide wideValue;
5905 const char *str;
5907 /* Preserve the string representation.
5908 * Needed so we can convert back to int without loss
5910 str = Jim_String(objPtr);
5912 #ifdef HAVE_LONG_LONG
5913 /* Assume a 53 bit mantissa */
5914 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5915 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5917 if (objPtr->typePtr == &intObjType
5918 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5919 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5921 /* Direct conversion to coerced double */
5922 objPtr->typePtr = &coercedDoubleObjType;
5923 return JIM_OK;
5925 else
5926 #endif
5927 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5928 /* Managed to convert to an int, so we can use this as a cooerced double */
5929 Jim_FreeIntRep(interp, objPtr);
5930 objPtr->typePtr = &coercedDoubleObjType;
5931 objPtr->internalRep.wideValue = wideValue;
5932 return JIM_OK;
5934 else {
5935 /* Try to convert into a double */
5936 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
5937 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
5938 return JIM_ERR;
5940 /* Free the old internal repr and set the new one. */
5941 Jim_FreeIntRep(interp, objPtr);
5943 objPtr->typePtr = &doubleObjType;
5944 objPtr->internalRep.doubleValue = doubleValue;
5945 return JIM_OK;
5948 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
5950 if (objPtr->typePtr == &coercedDoubleObjType) {
5951 *doublePtr = JimWideValue(objPtr);
5952 return JIM_OK;
5954 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
5955 return JIM_ERR;
5957 if (objPtr->typePtr == &coercedDoubleObjType) {
5958 *doublePtr = JimWideValue(objPtr);
5960 else {
5961 *doublePtr = objPtr->internalRep.doubleValue;
5963 return JIM_OK;
5966 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
5968 Jim_Obj *objPtr;
5970 objPtr = Jim_NewObj(interp);
5971 objPtr->typePtr = &doubleObjType;
5972 objPtr->bytes = NULL;
5973 objPtr->internalRep.doubleValue = doubleValue;
5974 return objPtr;
5977 /* -----------------------------------------------------------------------------
5978 * List object
5979 * ---------------------------------------------------------------------------*/
5980 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
5981 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
5982 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
5983 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
5984 static void UpdateStringOfList(struct Jim_Obj *objPtr);
5985 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
5987 /* Note that while the elements of the list may contain references,
5988 * the list object itself can't. This basically means that the
5989 * list object string representation as a whole can't contain references
5990 * that are not presents in the single elements. */
5991 static const Jim_ObjType listObjType = {
5992 "list",
5993 FreeListInternalRep,
5994 DupListInternalRep,
5995 UpdateStringOfList,
5996 JIM_TYPE_NONE,
5999 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6001 int i;
6003 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6004 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6006 Jim_Free(objPtr->internalRep.listValue.ele);
6009 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6011 int i;
6013 JIM_NOTUSED(interp);
6015 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6016 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6017 dupPtr->internalRep.listValue.ele =
6018 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6019 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6020 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6021 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6022 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6024 dupPtr->typePtr = &listObjType;
6027 /* The following function checks if a given string can be encoded
6028 * into a list element without any kind of quoting, surrounded by braces,
6029 * or using escapes to quote. */
6030 #define JIM_ELESTR_SIMPLE 0
6031 #define JIM_ELESTR_BRACE 1
6032 #define JIM_ELESTR_QUOTE 2
6033 static unsigned char ListElementQuotingType(const char *s, int len)
6035 int i, level, blevel, trySimple = 1;
6037 /* Try with the SIMPLE case */
6038 if (len == 0)
6039 return JIM_ELESTR_BRACE;
6040 if (s[0] == '"' || s[0] == '{') {
6041 trySimple = 0;
6042 goto testbrace;
6044 for (i = 0; i < len; i++) {
6045 switch (s[i]) {
6046 case ' ':
6047 case '$':
6048 case '"':
6049 case '[':
6050 case ']':
6051 case ';':
6052 case '\\':
6053 case '\r':
6054 case '\n':
6055 case '\t':
6056 case '\f':
6057 case '\v':
6058 trySimple = 0;
6059 case '{':
6060 case '}':
6061 goto testbrace;
6064 return JIM_ELESTR_SIMPLE;
6066 testbrace:
6067 /* Test if it's possible to do with braces */
6068 if (s[len - 1] == '\\')
6069 return JIM_ELESTR_QUOTE;
6070 level = 0;
6071 blevel = 0;
6072 for (i = 0; i < len; i++) {
6073 switch (s[i]) {
6074 case '{':
6075 level++;
6076 break;
6077 case '}':
6078 level--;
6079 if (level < 0)
6080 return JIM_ELESTR_QUOTE;
6081 break;
6082 case '[':
6083 blevel++;
6084 break;
6085 case ']':
6086 blevel--;
6087 break;
6088 case '\\':
6089 if (s[i + 1] == '\n')
6090 return JIM_ELESTR_QUOTE;
6091 else if (s[i + 1] != '\0')
6092 i++;
6093 break;
6096 if (blevel < 0) {
6097 return JIM_ELESTR_QUOTE;
6100 if (level == 0) {
6101 if (!trySimple)
6102 return JIM_ELESTR_BRACE;
6103 for (i = 0; i < len; i++) {
6104 switch (s[i]) {
6105 case ' ':
6106 case '$':
6107 case '"':
6108 case '[':
6109 case ']':
6110 case ';':
6111 case '\\':
6112 case '\r':
6113 case '\n':
6114 case '\t':
6115 case '\f':
6116 case '\v':
6117 return JIM_ELESTR_BRACE;
6118 break;
6121 return JIM_ELESTR_SIMPLE;
6123 return JIM_ELESTR_QUOTE;
6126 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6127 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6128 * scenario.
6129 * Returns the length of the result.
6131 static int BackslashQuoteString(const char *s, int len, char *q)
6133 char *p = q;
6135 while (len--) {
6136 switch (*s) {
6137 case ' ':
6138 case '$':
6139 case '"':
6140 case '[':
6141 case ']':
6142 case '{':
6143 case '}':
6144 case ';':
6145 case '\\':
6146 *p++ = '\\';
6147 *p++ = *s++;
6148 break;
6149 case '\n':
6150 *p++ = '\\';
6151 *p++ = 'n';
6152 s++;
6153 break;
6154 case '\r':
6155 *p++ = '\\';
6156 *p++ = 'r';
6157 s++;
6158 break;
6159 case '\t':
6160 *p++ = '\\';
6161 *p++ = 't';
6162 s++;
6163 break;
6164 case '\f':
6165 *p++ = '\\';
6166 *p++ = 'f';
6167 s++;
6168 break;
6169 case '\v':
6170 *p++ = '\\';
6171 *p++ = 'v';
6172 s++;
6173 break;
6174 default:
6175 *p++ = *s++;
6176 break;
6179 *p = '\0';
6181 return p - q;
6184 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6186 #define STATIC_QUOTING_LEN 32
6187 int i, bufLen, realLength;
6188 const char *strRep;
6189 char *p;
6190 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6192 /* Estimate the space needed. */
6193 if (objc > STATIC_QUOTING_LEN) {
6194 quotingType = Jim_Alloc(objc);
6196 else {
6197 quotingType = staticQuoting;
6199 bufLen = 0;
6200 for (i = 0; i < objc; i++) {
6201 int len;
6203 strRep = Jim_GetString(objv[i], &len);
6204 quotingType[i] = ListElementQuotingType(strRep, len);
6205 switch (quotingType[i]) {
6206 case JIM_ELESTR_SIMPLE:
6207 if (i != 0 || strRep[0] != '#') {
6208 bufLen += len;
6209 break;
6211 /* Special case '#' on first element needs braces */
6212 quotingType[i] = JIM_ELESTR_BRACE;
6213 /* fall through */
6214 case JIM_ELESTR_BRACE:
6215 bufLen += len + 2;
6216 break;
6217 case JIM_ELESTR_QUOTE:
6218 bufLen += len * 2;
6219 break;
6221 bufLen++; /* elements separator. */
6223 bufLen++;
6225 /* Generate the string rep. */
6226 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6227 realLength = 0;
6228 for (i = 0; i < objc; i++) {
6229 int len, qlen;
6231 strRep = Jim_GetString(objv[i], &len);
6233 switch (quotingType[i]) {
6234 case JIM_ELESTR_SIMPLE:
6235 memcpy(p, strRep, len);
6236 p += len;
6237 realLength += len;
6238 break;
6239 case JIM_ELESTR_BRACE:
6240 *p++ = '{';
6241 memcpy(p, strRep, len);
6242 p += len;
6243 *p++ = '}';
6244 realLength += len + 2;
6245 break;
6246 case JIM_ELESTR_QUOTE:
6247 if (i == 0 && strRep[0] == '#') {
6248 *p++ = '\\';
6249 realLength++;
6251 qlen = BackslashQuoteString(strRep, len, p);
6252 p += qlen;
6253 realLength += qlen;
6254 break;
6256 /* Add a separating space */
6257 if (i + 1 != objc) {
6258 *p++ = ' ';
6259 realLength++;
6262 *p = '\0'; /* nul term. */
6263 objPtr->length = realLength;
6265 if (quotingType != staticQuoting) {
6266 Jim_Free(quotingType);
6270 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6272 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6275 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6277 struct JimParserCtx parser;
6278 const char *str;
6279 int strLen;
6280 Jim_Obj *fileNameObj;
6281 int linenr;
6283 if (objPtr->typePtr == &listObjType) {
6284 return JIM_OK;
6287 /* Optimise dict -> list for unshared object. Note that this may only save a little time, but
6288 * it also preserves any source location of the dict elements
6289 * which can be very useful
6291 if (Jim_IsDict(objPtr) && !Jim_IsShared(objPtr)) {
6292 Jim_Obj **listObjPtrPtr;
6293 int len;
6294 int i;
6296 listObjPtrPtr = JimDictPairs(objPtr, &len);
6297 for (i = 0; i < len; i++) {
6298 Jim_IncrRefCount(listObjPtrPtr[i]);
6301 /* Now just switch the internal rep */
6302 Jim_FreeIntRep(interp, objPtr);
6303 objPtr->typePtr = &listObjType;
6304 objPtr->internalRep.listValue.len = len;
6305 objPtr->internalRep.listValue.maxLen = len;
6306 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6308 return JIM_OK;
6311 /* Try to preserve information about filename / line number */
6312 if (objPtr->typePtr == &sourceObjType) {
6313 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6314 linenr = objPtr->internalRep.sourceValue.lineNumber;
6316 else {
6317 fileNameObj = interp->emptyObj;
6318 linenr = 1;
6320 Jim_IncrRefCount(fileNameObj);
6322 /* Get the string representation */
6323 str = Jim_GetString(objPtr, &strLen);
6325 /* Free the old internal repr just now and initialize the
6326 * new one just now. The string->list conversion can't fail. */
6327 Jim_FreeIntRep(interp, objPtr);
6328 objPtr->typePtr = &listObjType;
6329 objPtr->internalRep.listValue.len = 0;
6330 objPtr->internalRep.listValue.maxLen = 0;
6331 objPtr->internalRep.listValue.ele = NULL;
6333 /* Convert into a list */
6334 if (strLen) {
6335 JimParserInit(&parser, str, strLen, linenr);
6336 while (!parser.eof) {
6337 Jim_Obj *elementPtr;
6339 JimParseList(&parser);
6340 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6341 continue;
6342 elementPtr = JimParserGetTokenObj(interp, &parser);
6343 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6344 ListAppendElement(objPtr, elementPtr);
6347 Jim_DecrRefCount(interp, fileNameObj);
6348 return JIM_OK;
6351 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6353 Jim_Obj *objPtr;
6355 objPtr = Jim_NewObj(interp);
6356 objPtr->typePtr = &listObjType;
6357 objPtr->bytes = NULL;
6358 objPtr->internalRep.listValue.ele = NULL;
6359 objPtr->internalRep.listValue.len = 0;
6360 objPtr->internalRep.listValue.maxLen = 0;
6362 if (len) {
6363 ListInsertElements(objPtr, 0, len, elements);
6366 return objPtr;
6369 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6370 * length of the vector. Note that the user of this function should make
6371 * sure that the list object can't shimmer while the vector returned
6372 * is in use, this vector is the one stored inside the internal representation
6373 * of the list object. This function is not exported, extensions should
6374 * always access to the List object elements using Jim_ListIndex(). */
6375 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6376 Jim_Obj ***listVec)
6378 *listLen = Jim_ListLength(interp, listObj);
6379 *listVec = listObj->internalRep.listValue.ele;
6382 /* Sorting uses ints, but commands may return wide */
6383 static int JimSign(jim_wide w)
6385 if (w == 0) {
6386 return 0;
6388 else if (w < 0) {
6389 return -1;
6391 return 1;
6394 /* ListSortElements type values */
6395 struct lsort_info {
6396 jmp_buf jmpbuf;
6397 Jim_Obj *command;
6398 Jim_Interp *interp;
6399 enum {
6400 JIM_LSORT_ASCII,
6401 JIM_LSORT_NOCASE,
6402 JIM_LSORT_INTEGER,
6403 JIM_LSORT_REAL,
6404 JIM_LSORT_COMMAND
6405 } type;
6406 int order;
6407 int index;
6408 int indexed;
6409 int unique;
6410 int (*subfn)(Jim_Obj **, Jim_Obj **);
6413 static struct lsort_info *sort_info;
6415 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6417 Jim_Obj *lObj, *rObj;
6419 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6420 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6421 longjmp(sort_info->jmpbuf, JIM_ERR);
6423 return sort_info->subfn(&lObj, &rObj);
6426 /* Sort the internal rep of a list. */
6427 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6429 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6432 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6434 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6437 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6439 jim_wide lhs = 0, rhs = 0;
6441 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6442 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6443 longjmp(sort_info->jmpbuf, JIM_ERR);
6446 return JimSign(lhs - rhs) * sort_info->order;
6449 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6451 double lhs = 0, rhs = 0;
6453 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6454 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6455 longjmp(sort_info->jmpbuf, JIM_ERR);
6457 if (lhs == rhs) {
6458 return 0;
6460 if (lhs > rhs) {
6461 return sort_info->order;
6463 return -sort_info->order;
6466 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6468 Jim_Obj *compare_script;
6469 int rc;
6471 jim_wide ret = 0;
6473 /* This must be a valid list */
6474 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6475 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6476 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6478 rc = Jim_EvalObj(sort_info->interp, compare_script);
6480 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6481 longjmp(sort_info->jmpbuf, rc);
6484 return JimSign(ret) * sort_info->order;
6487 /* Remove duplicate elements from the (sorted) list in-place, according to the
6488 * comparison function, comp.
6490 * Note that the last unique value is kept, not the first
6492 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6494 int src;
6495 int dst = 0;
6496 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6498 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6499 if (comp(&ele[dst], &ele[src]) == 0) {
6500 /* Match, so replace the dest with the current source */
6501 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6503 else {
6504 /* No match, so keep the current source and move to the next destination */
6505 dst++;
6507 ele[dst] = ele[src];
6509 /* At end of list, keep the final element */
6510 ele[++dst] = ele[src];
6512 /* Set the new length */
6513 listObjPtr->internalRep.listValue.len = dst;
6516 /* Sort a list *in place*. MUST be called with non-shared objects. */
6517 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6519 struct lsort_info *prev_info;
6521 typedef int (qsort_comparator) (const void *, const void *);
6522 int (*fn) (Jim_Obj **, Jim_Obj **);
6523 Jim_Obj **vector;
6524 int len;
6525 int rc;
6527 JimPanic((Jim_IsShared(listObjPtr), "Jim_ListSortElements called with shared object"));
6528 SetListFromAny(interp, listObjPtr);
6530 /* Allow lsort to be called reentrantly */
6531 prev_info = sort_info;
6532 sort_info = info;
6534 vector = listObjPtr->internalRep.listValue.ele;
6535 len = listObjPtr->internalRep.listValue.len;
6536 switch (info->type) {
6537 case JIM_LSORT_ASCII:
6538 fn = ListSortString;
6539 break;
6540 case JIM_LSORT_NOCASE:
6541 fn = ListSortStringNoCase;
6542 break;
6543 case JIM_LSORT_INTEGER:
6544 fn = ListSortInteger;
6545 break;
6546 case JIM_LSORT_REAL:
6547 fn = ListSortReal;
6548 break;
6549 case JIM_LSORT_COMMAND:
6550 fn = ListSortCommand;
6551 break;
6552 default:
6553 fn = NULL; /* avoid warning */
6554 JimPanic((1, "ListSort called with invalid sort type"));
6557 if (info->indexed) {
6558 /* Need to interpose a "list index" function */
6559 info->subfn = fn;
6560 fn = ListSortIndexHelper;
6563 if ((rc = setjmp(info->jmpbuf)) == 0) {
6564 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6566 if (info->unique && len > 1) {
6567 ListRemoveDuplicates(listObjPtr, fn);
6570 Jim_InvalidateStringRep(listObjPtr);
6572 sort_info = prev_info;
6574 return rc;
6577 /* This is the low-level function to insert elements into a list.
6578 * The higher-level Jim_ListInsertElements() performs shared object
6579 * check and invalidate the string repr. This version is used
6580 * in the internals of the List Object and is not exported.
6582 * NOTE: this function can be called only against objects
6583 * with internal type of List.
6585 * An insertion point (idx) of -1 means end-of-list.
6587 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6589 int currentLen = listPtr->internalRep.listValue.len;
6590 int requiredLen = currentLen + elemc;
6591 int i;
6592 Jim_Obj **point;
6594 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6595 if (requiredLen < 2) {
6596 /* Don't do allocations of under 4 pointers. */
6597 requiredLen = 4;
6599 else {
6600 requiredLen *= 2;
6603 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6604 sizeof(Jim_Obj *) * requiredLen);
6606 listPtr->internalRep.listValue.maxLen = requiredLen;
6608 if (idx < 0) {
6609 idx = currentLen;
6611 point = listPtr->internalRep.listValue.ele + idx;
6612 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6613 for (i = 0; i < elemc; ++i) {
6614 point[i] = elemVec[i];
6615 Jim_IncrRefCount(point[i]);
6617 listPtr->internalRep.listValue.len += elemc;
6620 /* Convenience call to ListInsertElements() to append a single element.
6622 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6624 ListInsertElements(listPtr, -1, 1, &objPtr);
6627 /* Appends every element of appendListPtr into listPtr.
6628 * Both have to be of the list type.
6629 * Convenience call to ListInsertElements()
6631 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6633 ListInsertElements(listPtr, -1,
6634 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6637 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6639 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6640 SetListFromAny(interp, listPtr);
6641 Jim_InvalidateStringRep(listPtr);
6642 ListAppendElement(listPtr, objPtr);
6645 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6647 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6648 SetListFromAny(interp, listPtr);
6649 SetListFromAny(interp, appendListPtr);
6650 Jim_InvalidateStringRep(listPtr);
6651 ListAppendList(listPtr, appendListPtr);
6654 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6656 SetListFromAny(interp, objPtr);
6657 return objPtr->internalRep.listValue.len;
6660 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6661 int objc, Jim_Obj *const *objVec)
6663 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6664 SetListFromAny(interp, listPtr);
6665 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6666 idx = listPtr->internalRep.listValue.len;
6667 else if (idx < 0)
6668 idx = 0;
6669 Jim_InvalidateStringRep(listPtr);
6670 ListInsertElements(listPtr, idx, objc, objVec);
6673 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6675 SetListFromAny(interp, listPtr);
6676 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6677 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6678 return NULL;
6680 if (idx < 0)
6681 idx = listPtr->internalRep.listValue.len + idx;
6682 return listPtr->internalRep.listValue.ele[idx];
6685 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6687 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6688 if (*objPtrPtr == NULL) {
6689 if (flags & JIM_ERRMSG) {
6690 Jim_SetResultString(interp, "list index out of range", -1);
6692 return JIM_ERR;
6694 return JIM_OK;
6697 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6698 Jim_Obj *newObjPtr, int flags)
6700 SetListFromAny(interp, listPtr);
6701 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6702 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6703 if (flags & JIM_ERRMSG) {
6704 Jim_SetResultString(interp, "list index out of range", -1);
6706 return JIM_ERR;
6708 if (idx < 0)
6709 idx = listPtr->internalRep.listValue.len + idx;
6710 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6711 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6712 Jim_IncrRefCount(newObjPtr);
6713 return JIM_OK;
6716 /* Modify the list stored into the variable named 'varNamePtr'
6717 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6718 * with the new element 'newObjptr'. */
6719 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6720 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6722 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6723 int shared, i, idx;
6725 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6726 if (objPtr == NULL)
6727 return JIM_ERR;
6728 if ((shared = Jim_IsShared(objPtr)))
6729 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6730 for (i = 0; i < indexc - 1; i++) {
6731 listObjPtr = objPtr;
6732 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6733 goto err;
6734 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6735 goto err;
6737 if (Jim_IsShared(objPtr)) {
6738 objPtr = Jim_DuplicateObj(interp, objPtr);
6739 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6741 Jim_InvalidateStringRep(listObjPtr);
6743 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6744 goto err;
6745 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6746 goto err;
6747 Jim_InvalidateStringRep(objPtr);
6748 Jim_InvalidateStringRep(varObjPtr);
6749 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6750 goto err;
6751 Jim_SetResult(interp, varObjPtr);
6752 return JIM_OK;
6753 err:
6754 if (shared) {
6755 Jim_FreeNewObj(interp, varObjPtr);
6757 return JIM_ERR;
6760 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6762 int i;
6763 int listLen = Jim_ListLength(interp, listObjPtr);
6764 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6766 for (i = 0; i < listLen; ) {
6767 Jim_Obj *objPtr;
6769 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
6770 Jim_AppendObj(interp, resObjPtr, objPtr);
6771 if (++i != listLen) {
6772 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6775 return resObjPtr;
6778 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6780 int i;
6782 /* If all the objects in objv are lists,
6783 * it's possible to return a list as result, that's the
6784 * concatenation of all the lists. */
6785 for (i = 0; i < objc; i++) {
6786 if (!Jim_IsList(objv[i]))
6787 break;
6789 if (i == objc) {
6790 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6792 for (i = 0; i < objc; i++)
6793 ListAppendList(objPtr, objv[i]);
6794 return objPtr;
6796 else {
6797 /* Else... we have to glue strings together */
6798 int len = 0, objLen;
6799 char *bytes, *p;
6801 /* Compute the length */
6802 for (i = 0; i < objc; i++) {
6803 Jim_GetString(objv[i], &objLen);
6804 len += objLen;
6806 if (objc)
6807 len += objc - 1;
6808 /* Create the string rep, and a string object holding it. */
6809 p = bytes = Jim_Alloc(len + 1);
6810 for (i = 0; i < objc; i++) {
6811 const char *s = Jim_GetString(objv[i], &objLen);
6813 /* Remove leading space */
6814 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n')) {
6815 s++;
6816 objLen--;
6817 len--;
6819 /* And trailing space */
6820 while (objLen && (s[objLen - 1] == ' ' ||
6821 s[objLen - 1] == '\n' || s[objLen - 1] == '\t')) {
6822 /* Handle trailing backslash-space case */
6823 if (objLen > 1 && s[objLen - 2] == '\\') {
6824 break;
6826 objLen--;
6827 len--;
6829 memcpy(p, s, objLen);
6830 p += objLen;
6831 if (objLen && i + 1 != objc) {
6832 *p++ = ' ';
6834 else if (i + 1 != objc) {
6835 /* Drop the space calcuated for this
6836 * element that is instead null. */
6837 len--;
6840 *p = '\0';
6841 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6845 /* Returns a list composed of the elements in the specified range.
6846 * first and start are directly accepted as Jim_Objects and
6847 * processed for the end?-index? case. */
6848 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6849 Jim_Obj *lastObjPtr)
6851 int first, last;
6852 int len, rangeLen;
6854 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6855 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6856 return NULL;
6857 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6858 first = JimRelToAbsIndex(len, first);
6859 last = JimRelToAbsIndex(len, last);
6860 JimRelToAbsRange(len, &first, &last, &rangeLen);
6861 if (first == 0 && last == len) {
6862 return listObjPtr;
6864 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6867 /* -----------------------------------------------------------------------------
6868 * Dict object
6869 * ---------------------------------------------------------------------------*/
6870 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6871 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6872 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6873 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6875 /* Dict HashTable Type.
6877 * Keys and Values are Jim objects. */
6879 static unsigned int JimObjectHTHashFunction(const void *key)
6881 int len;
6882 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6883 return Jim_GenHashFunction((const unsigned char *)str, len);
6886 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6888 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6891 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6893 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6896 static const Jim_HashTableType JimDictHashTableType = {
6897 JimObjectHTHashFunction, /* hash function */
6898 NULL, /* key dup */
6899 NULL, /* val dup */
6900 JimObjectHTKeyCompare, /* key compare */
6901 JimObjectHTKeyValDestructor, /* key destructor */
6902 JimObjectHTKeyValDestructor /* val destructor */
6905 /* Note that while the elements of the dict may contain references,
6906 * the list object itself can't. This basically means that the
6907 * dict object string representation as a whole can't contain references
6908 * that are not presents in the single elements. */
6909 static const Jim_ObjType dictObjType = {
6910 "dict",
6911 FreeDictInternalRep,
6912 DupDictInternalRep,
6913 UpdateStringOfDict,
6914 JIM_TYPE_NONE,
6917 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6919 JIM_NOTUSED(interp);
6921 Jim_FreeHashTable(objPtr->internalRep.ptr);
6922 Jim_Free(objPtr->internalRep.ptr);
6925 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6927 Jim_HashTable *ht, *dupHt;
6928 Jim_HashTableIterator htiter;
6929 Jim_HashEntry *he;
6931 /* Create a new hash table */
6932 ht = srcPtr->internalRep.ptr;
6933 dupHt = Jim_Alloc(sizeof(*dupHt));
6934 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
6935 if (ht->size != 0)
6936 Jim_ExpandHashTable(dupHt, ht->size);
6937 /* Copy every element from the source to the dup hash table */
6938 JimInitHashTableIterator(ht, &htiter);
6939 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6940 const Jim_Obj *keyObjPtr = he->key;
6941 Jim_Obj *valObjPtr = he->u.val;
6943 Jim_IncrRefCount((Jim_Obj *)keyObjPtr); /* ATTENTION: const cast */
6944 Jim_IncrRefCount(valObjPtr);
6945 Jim_AddHashEntry(dupHt, keyObjPtr, valObjPtr);
6948 dupPtr->internalRep.ptr = dupHt;
6949 dupPtr->typePtr = &dictObjType;
6952 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
6954 Jim_HashTable *ht;
6955 Jim_HashTableIterator htiter;
6956 Jim_HashEntry *he;
6957 Jim_Obj **objv;
6958 int i;
6960 ht = dictPtr->internalRep.ptr;
6962 /* Turn the hash table into a flat vector of Jim_Objects. */
6963 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
6964 JimInitHashTableIterator(ht, &htiter);
6965 i = 0;
6966 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6967 objv[i++] = (Jim_Obj *)he->key;
6968 objv[i++] = he->u.val;
6970 *len = i;
6971 return objv;
6974 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
6976 /* Turn the hash table into a flat vector of Jim_Objects. */
6977 int len;
6978 Jim_Obj **objv = JimDictPairs(objPtr, &len);
6980 JimMakeListStringRep(objPtr, objv, len);
6982 Jim_Free(objv);
6985 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6987 int listlen;
6989 if (objPtr->typePtr == &dictObjType) {
6990 return JIM_OK;
6993 /* Get the string representation. Do this first so we don't
6994 * change order in case of fast conversion to dict.
6996 Jim_String(objPtr);
6998 /* For simplicity, convert a non-list object to a list and then to a dict */
6999 listlen = Jim_ListLength(interp, objPtr);
7000 if (listlen % 2) {
7001 Jim_SetResultString(interp, "missing value to go with key", -1);
7002 return JIM_ERR;
7004 else {
7005 /* Now it is easy to convert to a dict from a list, and it can't fail */
7006 Jim_HashTable *ht;
7007 int i;
7009 ht = Jim_Alloc(sizeof(*ht));
7010 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7012 for (i = 0; i < listlen; i += 2) {
7013 Jim_Obj *keyObjPtr;
7014 Jim_Obj *valObjPtr;
7016 Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
7017 Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
7019 Jim_IncrRefCount(keyObjPtr);
7020 Jim_IncrRefCount(valObjPtr);
7022 if (Jim_AddHashEntry(ht, keyObjPtr, valObjPtr) != JIM_OK) {
7023 Jim_HashEntry *he;
7025 he = Jim_FindHashEntry(ht, keyObjPtr);
7026 Jim_DecrRefCount(interp, keyObjPtr);
7027 /* ATTENTION: const cast */
7028 Jim_DecrRefCount(interp, (Jim_Obj *)he->u.val);
7029 he->u.val = valObjPtr;
7033 Jim_FreeIntRep(interp, objPtr);
7034 objPtr->typePtr = &dictObjType;
7035 objPtr->internalRep.ptr = ht;
7037 return JIM_OK;
7041 /* Dict object API */
7043 /* Add an element to a dict. objPtr must be of the "dict" type.
7044 * The higer-level exported function is Jim_DictAddElement().
7045 * If an element with the specified key already exists, the value
7046 * associated is replaced with the new one.
7048 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7049 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7050 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7052 Jim_HashTable *ht = objPtr->internalRep.ptr;
7054 if (valueObjPtr == NULL) { /* unset */
7055 return Jim_DeleteHashEntry(ht, keyObjPtr);
7057 Jim_IncrRefCount(keyObjPtr);
7058 Jim_IncrRefCount(valueObjPtr);
7059 if (Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr)) {
7060 /* Value existed, so need to decrement key ref count */
7061 Jim_DecrRefCount(interp, keyObjPtr);
7063 return JIM_OK;
7066 /* Add an element, higher-level interface for DictAddElement().
7067 * If valueObjPtr == NULL, the key is removed if it exists. */
7068 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7069 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7071 int retcode;
7073 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7074 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7075 return JIM_ERR;
7077 retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7078 Jim_InvalidateStringRep(objPtr);
7079 return retcode;
7082 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7084 Jim_Obj *objPtr;
7085 int i;
7087 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7089 objPtr = Jim_NewObj(interp);
7090 objPtr->typePtr = &dictObjType;
7091 objPtr->bytes = NULL;
7092 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7093 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7094 for (i = 0; i < len; i += 2)
7095 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7096 return objPtr;
7099 /* Return the value associated to the specified dict key
7100 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7102 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7103 Jim_Obj **objPtrPtr, int flags)
7105 Jim_HashEntry *he;
7106 Jim_HashTable *ht;
7108 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7109 return -1;
7111 ht = dictPtr->internalRep.ptr;
7112 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7113 if (flags & JIM_ERRMSG) {
7114 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7116 return JIM_ERR;
7118 *objPtrPtr = he->u.val;
7119 return JIM_OK;
7122 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7123 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7125 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7126 return JIM_ERR;
7128 *objPtrPtr = JimDictPairs(dictPtr, len);
7130 return JIM_OK;
7134 /* Return the value associated to the specified dict keys */
7135 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7136 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7138 int i;
7140 if (keyc == 0) {
7141 *objPtrPtr = dictPtr;
7142 return JIM_OK;
7145 for (i = 0; i < keyc; i++) {
7146 Jim_Obj *objPtr;
7148 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7149 if (rc != JIM_OK) {
7150 return rc;
7152 dictPtr = objPtr;
7154 *objPtrPtr = dictPtr;
7155 return JIM_OK;
7158 /* Modify the dict stored into the variable named 'varNamePtr'
7159 * setting the element specified by the 'keyc' keys objects in 'keyv',
7160 * with the new value of the element 'newObjPtr'.
7162 * If newObjPtr == NULL the operation is to remove the given key
7163 * from the dictionary.
7165 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7166 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7168 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7169 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7171 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7172 int shared, i;
7174 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7175 if (objPtr == NULL) {
7176 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7177 /* Cannot remove a key from non existing var */
7178 return JIM_ERR;
7180 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7181 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7182 Jim_FreeNewObj(interp, varObjPtr);
7183 return JIM_ERR;
7186 if ((shared = Jim_IsShared(objPtr)))
7187 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7188 for (i = 0; i < keyc; i++) {
7189 dictObjPtr = objPtr;
7191 /* Check if it's a valid dictionary */
7192 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7193 goto err;
7196 if (i == keyc - 1) {
7197 /* Last key: Note that error on unset with missing last key is OK */
7198 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7199 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7200 goto err;
7203 break;
7206 /* Check if the given key exists. */
7207 Jim_InvalidateStringRep(dictObjPtr);
7208 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7209 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7210 /* This key exists at the current level.
7211 * Make sure it's not shared!. */
7212 if (Jim_IsShared(objPtr)) {
7213 objPtr = Jim_DuplicateObj(interp, objPtr);
7214 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7217 else {
7218 /* Key not found. If it's an [unset] operation
7219 * this is an error. Only the last key may not
7220 * exist. */
7221 if (newObjPtr == NULL) {
7222 goto err;
7224 /* Otherwise set an empty dictionary
7225 * as key's value. */
7226 objPtr = Jim_NewDictObj(interp, NULL, 0);
7227 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7230 Jim_InvalidateStringRep(objPtr);
7231 Jim_InvalidateStringRep(varObjPtr);
7232 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7233 goto err;
7235 Jim_SetResult(interp, varObjPtr);
7236 return JIM_OK;
7237 err:
7238 if (shared) {
7239 Jim_FreeNewObj(interp, varObjPtr);
7241 return JIM_ERR;
7244 /* -----------------------------------------------------------------------------
7245 * Index object
7246 * ---------------------------------------------------------------------------*/
7247 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7248 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7250 static const Jim_ObjType indexObjType = {
7251 "index",
7252 NULL,
7253 NULL,
7254 UpdateStringOfIndex,
7255 JIM_TYPE_NONE,
7258 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7260 if (objPtr->internalRep.intValue == -1) {
7261 JimSetStringBytes(objPtr, "end");
7263 else {
7264 char buf[JIM_INTEGER_SPACE + 1];
7265 if (objPtr->internalRep.intValue >= 0) {
7266 sprintf(buf, "%d", objPtr->internalRep.intValue);
7268 else {
7269 /* Must be <= -2 */
7270 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7272 JimSetStringBytes(objPtr, buf);
7276 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7278 int idx, end = 0;
7279 const char *str;
7280 char *endptr;
7282 /* Get the string representation */
7283 str = Jim_String(objPtr);
7285 /* Try to convert into an index */
7286 if (strncmp(str, "end", 3) == 0) {
7287 end = 1;
7288 str += 3;
7289 idx = 0;
7291 else {
7292 idx = jim_strtol(str, &endptr);
7294 if (endptr == str) {
7295 goto badindex;
7297 str = endptr;
7300 /* Now str may include or +<num> or -<num> */
7301 if (*str == '+' || *str == '-') {
7302 int sign = (*str == '+' ? 1 : -1);
7304 idx += sign * jim_strtol(++str, &endptr);
7305 if (str == endptr || *endptr) {
7306 goto badindex;
7308 str = endptr;
7310 /* The only thing left should be spaces */
7311 while (isspace(UCHAR(*str))) {
7312 str++;
7314 if (*str) {
7315 goto badindex;
7317 if (end) {
7318 if (idx > 0) {
7319 idx = INT_MAX;
7321 else {
7322 /* end-1 is repesented as -2 */
7323 idx--;
7326 else if (idx < 0) {
7327 idx = -INT_MAX;
7330 /* Free the old internal repr and set the new one. */
7331 Jim_FreeIntRep(interp, objPtr);
7332 objPtr->typePtr = &indexObjType;
7333 objPtr->internalRep.intValue = idx;
7334 return JIM_OK;
7336 badindex:
7337 Jim_SetResultFormatted(interp,
7338 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7339 return JIM_ERR;
7342 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7344 /* Avoid shimmering if the object is an integer. */
7345 if (objPtr->typePtr == &intObjType) {
7346 jim_wide val = JimWideValue(objPtr);
7348 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
7349 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
7350 return JIM_OK;
7353 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7354 return JIM_ERR;
7355 *indexPtr = objPtr->internalRep.intValue;
7356 return JIM_OK;
7359 /* -----------------------------------------------------------------------------
7360 * Return Code Object.
7361 * ---------------------------------------------------------------------------*/
7363 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7364 static const char * const jimReturnCodes[] = {
7365 "ok",
7366 "error",
7367 "return",
7368 "break",
7369 "continue",
7370 "signal",
7371 "exit",
7372 "eval",
7373 NULL
7376 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7378 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
7380 static const Jim_ObjType returnCodeObjType = {
7381 "return-code",
7382 NULL,
7383 NULL,
7384 NULL,
7385 JIM_TYPE_NONE,
7388 /* Converts a (standard) return code to a string. Returns "?" for
7389 * non-standard return codes.
7391 const char *Jim_ReturnCode(int code)
7393 if (code < 0 || code >= (int)jimReturnCodesSize) {
7394 return "?";
7396 else {
7397 return jimReturnCodes[code];
7401 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7403 int returnCode;
7404 jim_wide wideValue;
7406 /* Try to convert into an integer */
7407 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7408 returnCode = (int)wideValue;
7409 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7410 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7411 return JIM_ERR;
7413 /* Free the old internal repr and set the new one. */
7414 Jim_FreeIntRep(interp, objPtr);
7415 objPtr->typePtr = &returnCodeObjType;
7416 objPtr->internalRep.intValue = returnCode;
7417 return JIM_OK;
7420 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7422 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7423 return JIM_ERR;
7424 *intPtr = objPtr->internalRep.intValue;
7425 return JIM_OK;
7428 /* -----------------------------------------------------------------------------
7429 * Expression Parsing
7430 * ---------------------------------------------------------------------------*/
7431 static int JimParseExprOperator(struct JimParserCtx *pc);
7432 static int JimParseExprNumber(struct JimParserCtx *pc);
7433 static int JimParseExprIrrational(struct JimParserCtx *pc);
7435 /* Exrp's Stack machine operators opcodes. */
7437 /* Binary operators (numbers) */
7438 enum
7440 /* Continues on from the JIM_TT_ space */
7441 /* Operations */
7442 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7443 JIM_EXPROP_DIV,
7444 JIM_EXPROP_MOD,
7445 JIM_EXPROP_SUB,
7446 JIM_EXPROP_ADD,
7447 JIM_EXPROP_LSHIFT,
7448 JIM_EXPROP_RSHIFT,
7449 JIM_EXPROP_ROTL,
7450 JIM_EXPROP_ROTR,
7451 JIM_EXPROP_LT,
7452 JIM_EXPROP_GT,
7453 JIM_EXPROP_LTE,
7454 JIM_EXPROP_GTE,
7455 JIM_EXPROP_NUMEQ,
7456 JIM_EXPROP_NUMNE,
7457 JIM_EXPROP_BITAND, /* 35 */
7458 JIM_EXPROP_BITXOR,
7459 JIM_EXPROP_BITOR,
7461 /* Note must keep these together */
7462 JIM_EXPROP_LOGICAND, /* 38 */
7463 JIM_EXPROP_LOGICAND_LEFT,
7464 JIM_EXPROP_LOGICAND_RIGHT,
7466 /* and these */
7467 JIM_EXPROP_LOGICOR, /* 41 */
7468 JIM_EXPROP_LOGICOR_LEFT,
7469 JIM_EXPROP_LOGICOR_RIGHT,
7471 /* and these */
7472 /* Ternary operators */
7473 JIM_EXPROP_TERNARY, /* 44 */
7474 JIM_EXPROP_TERNARY_LEFT,
7475 JIM_EXPROP_TERNARY_RIGHT,
7477 /* and these */
7478 JIM_EXPROP_COLON, /* 47 */
7479 JIM_EXPROP_COLON_LEFT,
7480 JIM_EXPROP_COLON_RIGHT,
7482 JIM_EXPROP_POW, /* 50 */
7484 /* Binary operators (strings) */
7485 JIM_EXPROP_STREQ, /* 51 */
7486 JIM_EXPROP_STRNE,
7487 JIM_EXPROP_STRIN,
7488 JIM_EXPROP_STRNI,
7490 /* Unary operators (numbers) */
7491 JIM_EXPROP_NOT, /* 55 */
7492 JIM_EXPROP_BITNOT,
7493 JIM_EXPROP_UNARYMINUS,
7494 JIM_EXPROP_UNARYPLUS,
7496 /* Functions */
7497 JIM_EXPROP_FUNC_FIRST, /* 59 */
7498 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7499 JIM_EXPROP_FUNC_ABS,
7500 JIM_EXPROP_FUNC_DOUBLE,
7501 JIM_EXPROP_FUNC_ROUND,
7502 JIM_EXPROP_FUNC_RAND,
7503 JIM_EXPROP_FUNC_SRAND,
7505 /* math functions from libm */
7506 JIM_EXPROP_FUNC_SIN, /* 64 */
7507 JIM_EXPROP_FUNC_COS,
7508 JIM_EXPROP_FUNC_TAN,
7509 JIM_EXPROP_FUNC_ASIN,
7510 JIM_EXPROP_FUNC_ACOS,
7511 JIM_EXPROP_FUNC_ATAN,
7512 JIM_EXPROP_FUNC_SINH,
7513 JIM_EXPROP_FUNC_COSH,
7514 JIM_EXPROP_FUNC_TANH,
7515 JIM_EXPROP_FUNC_CEIL,
7516 JIM_EXPROP_FUNC_FLOOR,
7517 JIM_EXPROP_FUNC_EXP,
7518 JIM_EXPROP_FUNC_LOG,
7519 JIM_EXPROP_FUNC_LOG10,
7520 JIM_EXPROP_FUNC_SQRT,
7521 JIM_EXPROP_FUNC_POW,
7524 struct JimExprState
7526 Jim_Obj **stack;
7527 int stacklen;
7528 int opcode;
7529 int skip;
7532 /* Operators table */
7533 typedef struct Jim_ExprOperator
7535 const char *name;
7536 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7537 unsigned char precedence;
7538 unsigned char arity;
7539 unsigned char lazy;
7540 unsigned char namelen;
7541 } Jim_ExprOperator;
7543 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7545 Jim_IncrRefCount(obj);
7546 e->stack[e->stacklen++] = obj;
7549 static Jim_Obj *ExprPop(struct JimExprState *e)
7551 return e->stack[--e->stacklen];
7554 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7556 int intresult = 0;
7557 int rc = JIM_OK;
7558 Jim_Obj *A = ExprPop(e);
7559 double dA, dC = 0;
7560 jim_wide wA, wC = 0;
7562 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7563 intresult = 1;
7565 switch (e->opcode) {
7566 case JIM_EXPROP_FUNC_INT:
7567 wC = wA;
7568 break;
7569 case JIM_EXPROP_FUNC_ROUND:
7570 wC = wA;
7571 break;
7572 case JIM_EXPROP_FUNC_DOUBLE:
7573 dC = wA;
7574 intresult = 0;
7575 break;
7576 case JIM_EXPROP_FUNC_ABS:
7577 wC = wA >= 0 ? wA : -wA;
7578 break;
7579 case JIM_EXPROP_UNARYMINUS:
7580 wC = -wA;
7581 break;
7582 case JIM_EXPROP_UNARYPLUS:
7583 wC = wA;
7584 break;
7585 case JIM_EXPROP_NOT:
7586 wC = !wA;
7587 break;
7588 default:
7589 abort();
7592 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7593 switch (e->opcode) {
7594 case JIM_EXPROP_FUNC_INT:
7595 wC = dA;
7596 intresult = 1;
7597 break;
7598 case JIM_EXPROP_FUNC_ROUND:
7599 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7600 intresult = 1;
7601 break;
7602 case JIM_EXPROP_FUNC_DOUBLE:
7603 dC = dA;
7604 break;
7605 case JIM_EXPROP_FUNC_ABS:
7606 dC = dA >= 0 ? dA : -dA;
7607 break;
7608 case JIM_EXPROP_UNARYMINUS:
7609 dC = -dA;
7610 break;
7611 case JIM_EXPROP_UNARYPLUS:
7612 dC = dA;
7613 break;
7614 case JIM_EXPROP_NOT:
7615 wC = !dA;
7616 intresult = 1;
7617 break;
7618 default:
7619 abort();
7623 if (rc == JIM_OK) {
7624 if (intresult) {
7625 ExprPush(e, Jim_NewIntObj(interp, wC));
7627 else {
7628 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7632 Jim_DecrRefCount(interp, A);
7634 return rc;
7637 static double JimRandDouble(Jim_Interp *interp)
7639 unsigned long x;
7640 JimRandomBytes(interp, &x, sizeof(x));
7642 return (double)x / (unsigned long)~0;
7645 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7647 Jim_Obj *A = ExprPop(e);
7648 jim_wide wA;
7650 int rc = Jim_GetWide(interp, A, &wA);
7651 if (rc == JIM_OK) {
7652 switch (e->opcode) {
7653 case JIM_EXPROP_BITNOT:
7654 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7655 break;
7656 case JIM_EXPROP_FUNC_SRAND:
7657 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7658 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7659 break;
7660 default:
7661 abort();
7665 Jim_DecrRefCount(interp, A);
7667 return rc;
7670 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7672 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7674 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7676 return JIM_OK;
7679 #ifdef JIM_MATH_FUNCTIONS
7680 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7682 int rc;
7683 Jim_Obj *A = ExprPop(e);
7684 double dA, dC;
7686 rc = Jim_GetDouble(interp, A, &dA);
7687 if (rc == JIM_OK) {
7688 switch (e->opcode) {
7689 case JIM_EXPROP_FUNC_SIN:
7690 dC = sin(dA);
7691 break;
7692 case JIM_EXPROP_FUNC_COS:
7693 dC = cos(dA);
7694 break;
7695 case JIM_EXPROP_FUNC_TAN:
7696 dC = tan(dA);
7697 break;
7698 case JIM_EXPROP_FUNC_ASIN:
7699 dC = asin(dA);
7700 break;
7701 case JIM_EXPROP_FUNC_ACOS:
7702 dC = acos(dA);
7703 break;
7704 case JIM_EXPROP_FUNC_ATAN:
7705 dC = atan(dA);
7706 break;
7707 case JIM_EXPROP_FUNC_SINH:
7708 dC = sinh(dA);
7709 break;
7710 case JIM_EXPROP_FUNC_COSH:
7711 dC = cosh(dA);
7712 break;
7713 case JIM_EXPROP_FUNC_TANH:
7714 dC = tanh(dA);
7715 break;
7716 case JIM_EXPROP_FUNC_CEIL:
7717 dC = ceil(dA);
7718 break;
7719 case JIM_EXPROP_FUNC_FLOOR:
7720 dC = floor(dA);
7721 break;
7722 case JIM_EXPROP_FUNC_EXP:
7723 dC = exp(dA);
7724 break;
7725 case JIM_EXPROP_FUNC_LOG:
7726 dC = log(dA);
7727 break;
7728 case JIM_EXPROP_FUNC_LOG10:
7729 dC = log10(dA);
7730 break;
7731 case JIM_EXPROP_FUNC_SQRT:
7732 dC = sqrt(dA);
7733 break;
7734 default:
7735 abort();
7737 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7740 Jim_DecrRefCount(interp, A);
7742 return rc;
7744 #endif
7746 /* A binary operation on two ints */
7747 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7749 Jim_Obj *B = ExprPop(e);
7750 Jim_Obj *A = ExprPop(e);
7751 jim_wide wA, wB;
7752 int rc = JIM_ERR;
7754 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7755 jim_wide wC;
7757 rc = JIM_OK;
7759 switch (e->opcode) {
7760 case JIM_EXPROP_LSHIFT:
7761 wC = wA << wB;
7762 break;
7763 case JIM_EXPROP_RSHIFT:
7764 wC = wA >> wB;
7765 break;
7766 case JIM_EXPROP_BITAND:
7767 wC = wA & wB;
7768 break;
7769 case JIM_EXPROP_BITXOR:
7770 wC = wA ^ wB;
7771 break;
7772 case JIM_EXPROP_BITOR:
7773 wC = wA | wB;
7774 break;
7775 case JIM_EXPROP_MOD:
7776 if (wB == 0) {
7777 wC = 0;
7778 Jim_SetResultString(interp, "Division by zero", -1);
7779 rc = JIM_ERR;
7781 else {
7783 * From Tcl 8.x
7785 * This code is tricky: C doesn't guarantee much
7786 * about the quotient or remainder, but Tcl does.
7787 * The remainder always has the same sign as the
7788 * divisor and a smaller absolute value.
7790 int negative = 0;
7792 if (wB < 0) {
7793 wB = -wB;
7794 wA = -wA;
7795 negative = 1;
7797 wC = wA % wB;
7798 if (wC < 0) {
7799 wC += wB;
7801 if (negative) {
7802 wC = -wC;
7805 break;
7806 case JIM_EXPROP_ROTL:
7807 case JIM_EXPROP_ROTR:{
7808 /* uint32_t would be better. But not everyone has inttypes.h? */
7809 unsigned long uA = (unsigned long)wA;
7810 unsigned long uB = (unsigned long)wB;
7811 const unsigned int S = sizeof(unsigned long) * 8;
7813 /* Shift left by the word size or more is undefined. */
7814 uB %= S;
7816 if (e->opcode == JIM_EXPROP_ROTR) {
7817 uB = S - uB;
7819 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7820 break;
7822 default:
7823 abort();
7825 ExprPush(e, Jim_NewIntObj(interp, wC));
7829 Jim_DecrRefCount(interp, A);
7830 Jim_DecrRefCount(interp, B);
7832 return rc;
7836 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7837 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7839 int intresult = 0;
7840 int rc = JIM_OK;
7841 double dA, dB, dC = 0;
7842 jim_wide wA, wB, wC = 0;
7844 Jim_Obj *B = ExprPop(e);
7845 Jim_Obj *A = ExprPop(e);
7847 if ((A->typePtr != &doubleObjType || A->bytes) &&
7848 (B->typePtr != &doubleObjType || B->bytes) &&
7849 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7851 /* Both are ints */
7853 intresult = 1;
7855 switch (e->opcode) {
7856 case JIM_EXPROP_POW:
7857 case JIM_EXPROP_FUNC_POW:
7858 wC = JimPowWide(wA, wB);
7859 break;
7860 case JIM_EXPROP_ADD:
7861 wC = wA + wB;
7862 break;
7863 case JIM_EXPROP_SUB:
7864 wC = wA - wB;
7865 break;
7866 case JIM_EXPROP_MUL:
7867 wC = wA * wB;
7868 break;
7869 case JIM_EXPROP_DIV:
7870 if (wB == 0) {
7871 Jim_SetResultString(interp, "Division by zero", -1);
7872 rc = JIM_ERR;
7874 else {
7876 * From Tcl 8.x
7878 * This code is tricky: C doesn't guarantee much
7879 * about the quotient or remainder, but Tcl does.
7880 * The remainder always has the same sign as the
7881 * divisor and a smaller absolute value.
7883 if (wB < 0) {
7884 wB = -wB;
7885 wA = -wA;
7887 wC = wA / wB;
7888 if (wA % wB < 0) {
7889 wC--;
7892 break;
7893 case JIM_EXPROP_LT:
7894 wC = wA < wB;
7895 break;
7896 case JIM_EXPROP_GT:
7897 wC = wA > wB;
7898 break;
7899 case JIM_EXPROP_LTE:
7900 wC = wA <= wB;
7901 break;
7902 case JIM_EXPROP_GTE:
7903 wC = wA >= wB;
7904 break;
7905 case JIM_EXPROP_NUMEQ:
7906 wC = wA == wB;
7907 break;
7908 case JIM_EXPROP_NUMNE:
7909 wC = wA != wB;
7910 break;
7911 default:
7912 abort();
7915 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7916 switch (e->opcode) {
7917 case JIM_EXPROP_POW:
7918 case JIM_EXPROP_FUNC_POW:
7919 #ifdef JIM_MATH_FUNCTIONS
7920 dC = pow(dA, dB);
7921 #else
7922 Jim_SetResultString(interp, "unsupported", -1);
7923 rc = JIM_ERR;
7924 #endif
7925 break;
7926 case JIM_EXPROP_ADD:
7927 dC = dA + dB;
7928 break;
7929 case JIM_EXPROP_SUB:
7930 dC = dA - dB;
7931 break;
7932 case JIM_EXPROP_MUL:
7933 dC = dA * dB;
7934 break;
7935 case JIM_EXPROP_DIV:
7936 if (dB == 0) {
7937 #ifdef INFINITY
7938 dC = dA < 0 ? -INFINITY : INFINITY;
7939 #else
7940 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7941 #endif
7943 else {
7944 dC = dA / dB;
7946 break;
7947 case JIM_EXPROP_LT:
7948 wC = dA < dB;
7949 intresult = 1;
7950 break;
7951 case JIM_EXPROP_GT:
7952 wC = dA > dB;
7953 intresult = 1;
7954 break;
7955 case JIM_EXPROP_LTE:
7956 wC = dA <= dB;
7957 intresult = 1;
7958 break;
7959 case JIM_EXPROP_GTE:
7960 wC = dA >= dB;
7961 intresult = 1;
7962 break;
7963 case JIM_EXPROP_NUMEQ:
7964 wC = dA == dB;
7965 intresult = 1;
7966 break;
7967 case JIM_EXPROP_NUMNE:
7968 wC = dA != dB;
7969 intresult = 1;
7970 break;
7971 default:
7972 abort();
7975 else {
7976 /* Handle the string case */
7978 /* REVISIT: Could optimise the eq/ne case by checking lengths */
7979 int i = Jim_StringCompareObj(interp, A, B, 0);
7981 intresult = 1;
7983 switch (e->opcode) {
7984 case JIM_EXPROP_LT:
7985 wC = i < 0;
7986 break;
7987 case JIM_EXPROP_GT:
7988 wC = i > 0;
7989 break;
7990 case JIM_EXPROP_LTE:
7991 wC = i <= 0;
7992 break;
7993 case JIM_EXPROP_GTE:
7994 wC = i >= 0;
7995 break;
7996 case JIM_EXPROP_NUMEQ:
7997 wC = i == 0;
7998 break;
7999 case JIM_EXPROP_NUMNE:
8000 wC = i != 0;
8001 break;
8002 default:
8003 rc = JIM_ERR;
8004 break;
8008 if (rc == JIM_OK) {
8009 if (intresult) {
8010 ExprPush(e, Jim_NewIntObj(interp, wC));
8012 else {
8013 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8017 Jim_DecrRefCount(interp, A);
8018 Jim_DecrRefCount(interp, B);
8020 return rc;
8023 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8025 int listlen;
8026 int i;
8028 listlen = Jim_ListLength(interp, listObjPtr);
8029 for (i = 0; i < listlen; i++) {
8030 Jim_Obj *objPtr;
8032 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
8034 if (Jim_StringEqObj(objPtr, valObj)) {
8035 return 1;
8038 return 0;
8041 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8043 Jim_Obj *B = ExprPop(e);
8044 Jim_Obj *A = ExprPop(e);
8046 jim_wide wC;
8048 switch (e->opcode) {
8049 case JIM_EXPROP_STREQ:
8050 case JIM_EXPROP_STRNE: {
8051 int Alen, Blen;
8052 const char *sA = Jim_GetString(A, &Alen);
8053 const char *sB = Jim_GetString(B, &Blen);
8055 if (e->opcode == JIM_EXPROP_STREQ) {
8056 wC = (Alen == Blen && memcmp(sA, sB, Alen) == 0);
8058 else {
8059 wC = (Alen != Blen || memcmp(sA, sB, Alen) != 0);
8061 break;
8063 case JIM_EXPROP_STRIN:
8064 wC = JimSearchList(interp, B, A);
8065 break;
8066 case JIM_EXPROP_STRNI:
8067 wC = !JimSearchList(interp, B, A);
8068 break;
8069 default:
8070 abort();
8072 ExprPush(e, Jim_NewIntObj(interp, wC));
8074 Jim_DecrRefCount(interp, A);
8075 Jim_DecrRefCount(interp, B);
8077 return JIM_OK;
8080 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8082 long l;
8083 double d;
8085 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8086 return l != 0;
8088 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8089 return d != 0;
8091 return -1;
8094 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8096 Jim_Obj *skip = ExprPop(e);
8097 Jim_Obj *A = ExprPop(e);
8098 int rc = JIM_OK;
8100 switch (ExprBool(interp, A)) {
8101 case 0:
8102 /* false, so skip RHS opcodes with a 0 result */
8103 e->skip = JimWideValue(skip);
8104 ExprPush(e, Jim_NewIntObj(interp, 0));
8105 break;
8107 case 1:
8108 /* true so continue */
8109 break;
8111 case -1:
8112 /* Invalid */
8113 rc = JIM_ERR;
8115 Jim_DecrRefCount(interp, A);
8116 Jim_DecrRefCount(interp, skip);
8118 return rc;
8121 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8123 Jim_Obj *skip = ExprPop(e);
8124 Jim_Obj *A = ExprPop(e);
8125 int rc = JIM_OK;
8127 switch (ExprBool(interp, A)) {
8128 case 0:
8129 /* false, so do nothing */
8130 break;
8132 case 1:
8133 /* true so skip RHS opcodes with a 1 result */
8134 e->skip = JimWideValue(skip);
8135 ExprPush(e, Jim_NewIntObj(interp, 1));
8136 break;
8138 case -1:
8139 /* Invalid */
8140 rc = JIM_ERR;
8141 break;
8143 Jim_DecrRefCount(interp, A);
8144 Jim_DecrRefCount(interp, skip);
8146 return rc;
8149 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8151 Jim_Obj *A = ExprPop(e);
8152 int rc = JIM_OK;
8154 switch (ExprBool(interp, A)) {
8155 case 0:
8156 ExprPush(e, Jim_NewIntObj(interp, 0));
8157 break;
8159 case 1:
8160 ExprPush(e, Jim_NewIntObj(interp, 1));
8161 break;
8163 case -1:
8164 /* Invalid */
8165 rc = JIM_ERR;
8166 break;
8168 Jim_DecrRefCount(interp, A);
8170 return rc;
8173 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8175 Jim_Obj *skip = ExprPop(e);
8176 Jim_Obj *A = ExprPop(e);
8177 int rc = JIM_OK;
8179 /* Repush A */
8180 ExprPush(e, A);
8182 switch (ExprBool(interp, A)) {
8183 case 0:
8184 /* false, skip RHS opcodes */
8185 e->skip = JimWideValue(skip);
8186 /* Push a dummy value */
8187 ExprPush(e, Jim_NewIntObj(interp, 0));
8188 break;
8190 case 1:
8191 /* true so do nothing */
8192 break;
8194 case -1:
8195 /* Invalid */
8196 rc = JIM_ERR;
8197 break;
8199 Jim_DecrRefCount(interp, A);
8200 Jim_DecrRefCount(interp, skip);
8202 return rc;
8205 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8207 Jim_Obj *skip = ExprPop(e);
8208 Jim_Obj *B = ExprPop(e);
8209 Jim_Obj *A = ExprPop(e);
8211 /* No need to check for A as non-boolean */
8212 if (ExprBool(interp, A)) {
8213 /* true, so skip RHS opcodes */
8214 e->skip = JimWideValue(skip);
8215 /* Repush B as the answer */
8216 ExprPush(e, B);
8219 Jim_DecrRefCount(interp, skip);
8220 Jim_DecrRefCount(interp, A);
8221 Jim_DecrRefCount(interp, B);
8222 return JIM_OK;
8225 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8227 return JIM_OK;
8230 enum
8232 LAZY_NONE,
8233 LAZY_OP,
8234 LAZY_LEFT,
8235 LAZY_RIGHT
8238 /* name - precedence - arity - opcode
8240 * This array *must* be kept in sync with the JIM_EXPROP enum.
8242 * The following macro pre-computes the string length at compile time.
8244 #define OPRINIT(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8246 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8247 OPRINIT("*", 110, 2, JimExprOpBin, LAZY_NONE),
8248 OPRINIT("/", 110, 2, JimExprOpBin, LAZY_NONE),
8249 OPRINIT("%", 110, 2, JimExprOpIntBin, LAZY_NONE),
8251 OPRINIT("-", 100, 2, JimExprOpBin, LAZY_NONE),
8252 OPRINIT("+", 100, 2, JimExprOpBin, LAZY_NONE),
8254 OPRINIT("<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8255 OPRINIT(">>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8257 OPRINIT("<<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8258 OPRINIT(">>>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8260 OPRINIT("<", 80, 2, JimExprOpBin, LAZY_NONE),
8261 OPRINIT(">", 80, 2, JimExprOpBin, LAZY_NONE),
8262 OPRINIT("<=", 80, 2, JimExprOpBin, LAZY_NONE),
8263 OPRINIT(">=", 80, 2, JimExprOpBin, LAZY_NONE),
8265 OPRINIT("==", 70, 2, JimExprOpBin, LAZY_NONE),
8266 OPRINIT("!=", 70, 2, JimExprOpBin, LAZY_NONE),
8268 OPRINIT("&", 50, 2, JimExprOpIntBin, LAZY_NONE),
8269 OPRINIT("^", 49, 2, JimExprOpIntBin, LAZY_NONE),
8270 OPRINIT("|", 48, 2, JimExprOpIntBin, LAZY_NONE),
8272 OPRINIT("&&", 10, 2, NULL, LAZY_OP),
8273 OPRINIT(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8274 OPRINIT(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8276 OPRINIT("||", 9, 2, NULL, LAZY_OP),
8277 OPRINIT(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8278 OPRINIT(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8280 OPRINIT("?", 5, 2, JimExprOpNull, LAZY_OP),
8281 OPRINIT(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8282 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8284 OPRINIT(":", 5, 2, JimExprOpNull, LAZY_OP),
8285 OPRINIT(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8286 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8288 OPRINIT("**", 250, 2, JimExprOpBin, LAZY_NONE),
8290 OPRINIT("eq", 60, 2, JimExprOpStrBin, LAZY_NONE),
8291 OPRINIT("ne", 60, 2, JimExprOpStrBin, LAZY_NONE),
8293 OPRINIT("in", 55, 2, JimExprOpStrBin, LAZY_NONE),
8294 OPRINIT("ni", 55, 2, JimExprOpStrBin, LAZY_NONE),
8296 OPRINIT("!", 150, 1, JimExprOpNumUnary, LAZY_NONE),
8297 OPRINIT("~", 150, 1, JimExprOpIntUnary, LAZY_NONE),
8298 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8299 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8303 OPRINIT("int", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8304 OPRINIT("abs", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8305 OPRINIT("double", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8306 OPRINIT("round", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8307 OPRINIT("rand", 200, 0, JimExprOpNone, LAZY_NONE),
8308 OPRINIT("srand", 200, 1, JimExprOpIntUnary, LAZY_NONE),
8310 #ifdef JIM_MATH_FUNCTIONS
8311 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8312 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8313 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8314 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8315 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8316 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8317 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8318 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8319 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8320 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8321 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8322 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8323 OPRINIT("log", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8324 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8325 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8326 OPRINIT("pow", 200, 2, JimExprOpBin, LAZY_NONE),
8327 #endif
8329 #undef OPRINIT
8331 #define JIM_EXPR_OPERATORS_NUM \
8332 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8334 static int JimParseExpression(struct JimParserCtx *pc)
8336 /* Discard spaces and quoted newline */
8337 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8338 if (*pc->p == '\n') {
8339 pc->linenr++;
8341 pc->p++;
8342 pc->len--;
8345 if (pc->len == 0) {
8346 pc->tstart = pc->tend = pc->p;
8347 pc->tline = pc->linenr;
8348 pc->tt = JIM_TT_EOL;
8349 pc->eof = 1;
8350 return JIM_OK;
8352 switch (*(pc->p)) {
8353 case '(':
8354 pc->tt = JIM_TT_SUBEXPR_START;
8355 goto singlechar;
8356 case ')':
8357 pc->tt = JIM_TT_SUBEXPR_END;
8358 goto singlechar;
8359 case ',':
8360 pc->tt = JIM_TT_SUBEXPR_COMMA;
8361 singlechar:
8362 pc->tstart = pc->tend = pc->p;
8363 pc->tline = pc->linenr;
8364 pc->p++;
8365 pc->len--;
8366 break;
8367 case '[':
8368 return JimParseCmd(pc);
8369 case '$':
8370 if (JimParseVar(pc) == JIM_ERR)
8371 return JimParseExprOperator(pc);
8372 else {
8373 /* Don't allow expr sugar in expressions */
8374 if (pc->tt == JIM_TT_EXPRSUGAR) {
8375 return JIM_ERR;
8377 return JIM_OK;
8379 break;
8380 case '0':
8381 case '1':
8382 case '2':
8383 case '3':
8384 case '4':
8385 case '5':
8386 case '6':
8387 case '7':
8388 case '8':
8389 case '9':
8390 case '.':
8391 return JimParseExprNumber(pc);
8392 case '"':
8393 return JimParseQuote(pc);
8394 case '{':
8395 return JimParseBrace(pc);
8397 case 'N':
8398 case 'I':
8399 case 'n':
8400 case 'i':
8401 if (JimParseExprIrrational(pc) == JIM_ERR)
8402 return JimParseExprOperator(pc);
8403 break;
8404 default:
8405 return JimParseExprOperator(pc);
8406 break;
8408 return JIM_OK;
8411 static int JimParseExprNumber(struct JimParserCtx *pc)
8413 int allowdot = 1;
8414 int base = 10;
8416 /* Assume an integer for now */
8417 pc->tt = JIM_TT_EXPR_INT;
8418 pc->tstart = pc->p;
8419 pc->tline = pc->linenr;
8421 /* Parse initial 0<x> */
8422 if (pc->p[0] == '0') {
8423 switch (pc->p[1]) {
8424 case 'x':
8425 case 'X':
8426 base = 16;
8427 allowdot = 0;
8428 pc->p += 2;
8429 pc->len -= 2;
8430 break;
8431 case 'o':
8432 case 'O':
8433 base = 8;
8434 allowdot = 0;
8435 pc->p += 2;
8436 pc->len -= 2;
8437 break;
8438 case 'b':
8439 case 'B':
8440 base = 2;
8441 allowdot = 0;
8442 pc->p += 2;
8443 pc->len -= 2;
8444 break;
8448 while (isdigit(UCHAR(*pc->p))
8449 || (base == 16 && isxdigit(UCHAR(*pc->p)))
8450 || (base == 8 && *pc->p >= '0' && *pc->p <= '7')
8451 || (base == 2 && (*pc->p == '0' || *pc->p == '1'))
8452 || (allowdot && *pc->p == '.')
8454 if (*pc->p == '.') {
8455 allowdot = 0;
8456 pc->tt = JIM_TT_EXPR_DOUBLE;
8458 pc->p++;
8459 pc->len--;
8460 if (base == 10 && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
8461 || isdigit(UCHAR(pc->p[1])))) {
8462 pc->p += 2;
8463 pc->len -= 2;
8464 pc->tt = JIM_TT_EXPR_DOUBLE;
8467 pc->tend = pc->p - 1;
8468 return JIM_OK;
8471 static int JimParseExprIrrational(struct JimParserCtx *pc)
8473 const char *Tokens[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8474 const char **token;
8476 for (token = Tokens; *token != NULL; token++) {
8477 int len = strlen(*token);
8479 if (strncmp(*token, pc->p, len) == 0) {
8480 pc->tstart = pc->p;
8481 pc->tend = pc->p + len - 1;
8482 pc->p += len;
8483 pc->len -= len;
8484 pc->tline = pc->linenr;
8485 pc->tt = JIM_TT_EXPR_DOUBLE;
8486 return JIM_OK;
8489 return JIM_ERR;
8492 static int JimParseExprOperator(struct JimParserCtx *pc)
8494 int i;
8495 int bestIdx = -1, bestLen = 0;
8497 /* Try to get the longest match. */
8498 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8499 const char * const opname = Jim_ExprOperators[i].name;
8500 const int oplen = Jim_ExprOperators[i].namelen;
8502 if (opname == NULL || opname[0] != pc->p[0]) {
8503 continue;
8506 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8507 bestIdx = i + JIM_TT_EXPR_OP;
8508 bestLen = oplen;
8511 if (bestIdx == -1) {
8512 return JIM_ERR;
8515 /* Validate paretheses around function arguments */
8516 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8517 const char *p = pc->p + bestLen;
8518 int len = pc->len - bestLen;
8520 while (len && isspace(UCHAR(*p))) {
8521 len--;
8522 p++;
8524 if (*p != '(') {
8525 return JIM_ERR;
8528 pc->tstart = pc->p;
8529 pc->tend = pc->p + bestLen - 1;
8530 pc->p += bestLen;
8531 pc->len -= bestLen;
8532 pc->tline = pc->linenr;
8534 pc->tt = bestIdx;
8535 return JIM_OK;
8538 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8540 static Jim_ExprOperator dummy_op;
8541 if (opcode < JIM_TT_EXPR_OP) {
8542 return &dummy_op;
8544 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8547 const char *jim_tt_name(int type)
8549 static const char * const tt_names[JIM_TT_EXPR_OP] =
8550 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8551 "DBL", "$()" };
8552 if (type < JIM_TT_EXPR_OP) {
8553 return tt_names[type];
8555 else {
8556 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8557 static char buf[20];
8559 if (op->name) {
8560 return op->name;
8562 sprintf(buf, "(%d)", type);
8563 return buf;
8567 /* -----------------------------------------------------------------------------
8568 * Expression Object
8569 * ---------------------------------------------------------------------------*/
8570 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8571 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8572 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8574 static const Jim_ObjType exprObjType = {
8575 "expression",
8576 FreeExprInternalRep,
8577 DupExprInternalRep,
8578 NULL,
8579 JIM_TYPE_REFERENCES,
8582 /* Expr bytecode structure */
8583 typedef struct ExprByteCode
8585 ScriptToken *token; /* Tokens array. */
8586 int len; /* Length as number of tokens. */
8587 int inUse; /* Used for sharing. */
8588 } ExprByteCode;
8590 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8592 int i;
8594 for (i = 0; i < expr->len; i++) {
8595 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8597 Jim_Free(expr->token);
8598 Jim_Free(expr);
8601 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8603 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8605 if (expr) {
8606 if (--expr->inUse != 0) {
8607 return;
8610 ExprFreeByteCode(interp, expr);
8614 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8616 JIM_NOTUSED(interp);
8617 JIM_NOTUSED(srcPtr);
8619 /* Just returns an simple string. */
8620 dupPtr->typePtr = NULL;
8623 /* Check if an expr program looks correct. */
8624 static int ExprCheckCorrectness(ExprByteCode * expr)
8626 int i;
8627 int stacklen = 0;
8628 int ternary = 0;
8630 /* Try to check if there are stack underflows,
8631 * and make sure at the end of the program there is
8632 * a single result on the stack. */
8633 for (i = 0; i < expr->len; i++) {
8634 ScriptToken *t = &expr->token[i];
8635 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8637 stacklen -= op->arity;
8638 if (stacklen < 0) {
8639 break;
8641 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8642 ternary++;
8644 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8645 ternary--;
8648 /* All operations and operands add one to the stack */
8649 stacklen++;
8651 if (stacklen != 1 || ternary != 0) {
8652 return JIM_ERR;
8654 return JIM_OK;
8657 /* This procedure converts every occurrence of || and && opereators
8658 * in lazy unary versions.
8660 * a b || is converted into:
8662 * a <offset> |L b |R
8664 * a b && is converted into:
8666 * a <offset> &L b &R
8668 * "|L" checks if 'a' is true:
8669 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8670 * the opcode just after |R.
8671 * 2) if it is false does nothing.
8672 * "|R" checks if 'b' is true:
8673 * 1) if it is true pushes 1, otherwise pushes 0.
8675 * "&L" checks if 'a' is true:
8676 * 1) if it is true does nothing.
8677 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8678 * the opcode just after &R
8679 * "&R" checks if 'a' is true:
8680 * if it is true pushes 1, otherwise pushes 0.
8682 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8684 int i;
8686 int leftindex, arity, offset;
8688 /* Search for the end of the first operator */
8689 leftindex = expr->len - 1;
8691 arity = 1;
8692 while (arity) {
8693 ScriptToken *tt = &expr->token[leftindex];
8695 if (tt->type >= JIM_TT_EXPR_OP) {
8696 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8698 arity--;
8699 if (--leftindex < 0) {
8700 return JIM_ERR;
8703 leftindex++;
8705 /* Move them up */
8706 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8707 sizeof(*expr->token) * (expr->len - leftindex));
8708 expr->len += 2;
8709 offset = (expr->len - leftindex) - 1;
8711 /* Now we rely on the fact the the left and right version have opcodes
8712 * 1 and 2 after the main opcode respectively
8714 expr->token[leftindex + 1].type = t->type + 1;
8715 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8717 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8718 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8720 /* Now add the 'R' operator */
8721 expr->token[expr->len].objPtr = interp->emptyObj;
8722 expr->token[expr->len].type = t->type + 2;
8723 expr->len++;
8725 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8726 for (i = leftindex - 1; i > 0; i--) {
8727 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8728 if (op->lazy == LAZY_LEFT) {
8729 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8730 JimWideValue(expr->token[i - 1].objPtr) += 2;
8734 return JIM_OK;
8737 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8739 struct ScriptToken *token = &expr->token[expr->len];
8740 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8742 if (op->lazy == LAZY_OP) {
8743 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8744 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8745 return JIM_ERR;
8748 else {
8749 token->objPtr = interp->emptyObj;
8750 token->type = t->type;
8751 expr->len++;
8753 return JIM_OK;
8757 * Returns the index of the COLON_LEFT to the left of 'right_index'
8758 * taking into account nesting.
8760 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8762 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8764 int ternary_count = 1;
8766 right_index--;
8768 while (right_index > 1) {
8769 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8770 ternary_count--;
8772 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8773 ternary_count++;
8775 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8776 return right_index;
8778 right_index--;
8781 /*notreached*/
8782 return -1;
8786 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8788 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8789 * Otherwise returns 0.
8791 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8793 int i = right_index - 1;
8794 int ternary_count = 1;
8796 while (i > 1) {
8797 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8798 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8799 *prev_right_index = i - 2;
8800 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8801 return 1;
8804 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8805 if (ternary_count == 0) {
8806 return 0;
8808 ternary_count++;
8810 i--;
8812 return 0;
8816 * ExprTernaryReorderExpression description
8817 * ========================================
8819 * ?: is right-to-left associative which doesn't work with the stack-based
8820 * expression engine. The fix is to reorder the bytecode.
8822 * The expression:
8824 * expr 1?2:0?3:4
8826 * Has initial bytecode:
8828 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8829 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8831 * The fix involves simulating this expression instead:
8833 * expr 1?2:(0?3:4)
8835 * With the following bytecode:
8837 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8838 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8840 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8841 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8842 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8843 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8845 * ExprTernaryReorderExpression works thus as follows :
8846 * - start from the end of the stack
8847 * - while walking towards the beginning of the stack
8848 * if token=JIM_EXPROP_COLON_RIGHT then
8849 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8850 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8851 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8852 * if all found then
8853 * perform the rotation
8854 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8855 * end if
8856 * end if
8858 * Note: care has to be taken for nested ternary constructs!!!
8860 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8862 int i;
8864 for (i = expr->len - 1; i > 1; i--) {
8865 int prev_right_index;
8866 int prev_left_index;
8867 int j;
8868 ScriptToken tmp;
8870 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8871 continue;
8874 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8875 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8876 continue;
8880 ** rotate tokens down
8882 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8883 ** | | |
8884 ** | V V
8885 ** | [...] : ...
8886 ** | | |
8887 ** | V V
8888 ** | [...] : ...
8889 ** | | |
8890 ** | V V
8891 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8893 tmp = expr->token[prev_right_index];
8894 for (j = prev_right_index; j < i; j++) {
8895 expr->token[j] = expr->token[j + 1];
8897 expr->token[i] = tmp;
8899 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8901 * This is 'colon left increment' = i - prev_right_index
8903 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8904 * [prev_left_index-1] : skip_count
8907 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8909 /* Adjust for i-- in the loop */
8910 i++;
8914 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8916 Jim_Stack stack;
8917 ExprByteCode *expr;
8918 int ok = 1;
8919 int i;
8920 int prevtt = JIM_TT_NONE;
8921 int have_ternary = 0;
8923 /* -1 for EOL */
8924 int count = tokenlist->count - 1;
8926 expr = Jim_Alloc(sizeof(*expr));
8927 expr->inUse = 1;
8928 expr->len = 0;
8930 Jim_InitStack(&stack);
8932 /* Need extra bytecodes for lazy operators.
8933 * Also check for the ternary operator
8935 for (i = 0; i < tokenlist->count; i++) {
8936 ParseToken *t = &tokenlist->list[i];
8937 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8939 if (op->lazy == LAZY_OP) {
8940 count += 2;
8941 /* Ternary is a lazy op but also needs reordering */
8942 if (t->type == JIM_EXPROP_TERNARY) {
8943 have_ternary = 1;
8948 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8950 for (i = 0; i < tokenlist->count && ok; i++) {
8951 ParseToken *t = &tokenlist->list[i];
8953 /* Next token will be stored here */
8954 struct ScriptToken *token = &expr->token[expr->len];
8956 if (t->type == JIM_TT_EOL) {
8957 break;
8960 switch (t->type) {
8961 case JIM_TT_STR:
8962 case JIM_TT_ESC:
8963 case JIM_TT_VAR:
8964 case JIM_TT_DICTSUGAR:
8965 case JIM_TT_EXPRSUGAR:
8966 case JIM_TT_CMD:
8967 token->type = t->type;
8968 strexpr:
8969 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8970 if (t->type == JIM_TT_CMD) {
8971 /* Only commands need source info */
8972 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8974 expr->len++;
8975 break;
8977 case JIM_TT_EXPR_INT:
8978 case JIM_TT_EXPR_DOUBLE:
8980 char *endptr;
8981 if (t->type == JIM_TT_EXPR_INT) {
8982 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8984 else {
8985 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8987 if (endptr != t->token + t->len) {
8988 /* Conversion failed, so just store it as a string */
8989 Jim_FreeNewObj(interp, token->objPtr);
8990 token->type = JIM_TT_STR;
8991 goto strexpr;
8993 token->type = t->type;
8994 expr->len++;
8996 break;
8998 case JIM_TT_SUBEXPR_START:
8999 Jim_StackPush(&stack, t);
9000 prevtt = JIM_TT_NONE;
9001 continue;
9003 case JIM_TT_SUBEXPR_COMMA:
9004 /* Simple approach. Comma is simply ignored */
9005 continue;
9007 case JIM_TT_SUBEXPR_END:
9008 ok = 0;
9009 while (Jim_StackLen(&stack)) {
9010 ParseToken *tt = Jim_StackPop(&stack);
9012 if (tt->type == JIM_TT_SUBEXPR_START) {
9013 ok = 1;
9014 break;
9017 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9018 goto err;
9021 if (!ok) {
9022 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9023 goto err;
9025 break;
9028 default:{
9029 /* Must be an operator */
9030 const struct Jim_ExprOperator *op;
9031 ParseToken *tt;
9033 /* Convert -/+ to unary minus or unary plus if necessary */
9034 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9035 if (t->type == JIM_EXPROP_SUB) {
9036 t->type = JIM_EXPROP_UNARYMINUS;
9038 else if (t->type == JIM_EXPROP_ADD) {
9039 t->type = JIM_EXPROP_UNARYPLUS;
9043 op = JimExprOperatorInfoByOpcode(t->type);
9045 /* Now handle precedence */
9046 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9047 const struct Jim_ExprOperator *tt_op =
9048 JimExprOperatorInfoByOpcode(tt->type);
9050 /* Note that right-to-left associativity of ?: operator is handled later */
9052 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9053 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9054 ok = 0;
9055 goto err;
9057 Jim_StackPop(&stack);
9059 else {
9060 break;
9063 Jim_StackPush(&stack, t);
9064 break;
9067 prevtt = t->type;
9070 /* Reduce any remaining subexpr */
9071 while (Jim_StackLen(&stack)) {
9072 ParseToken *tt = Jim_StackPop(&stack);
9074 if (tt->type == JIM_TT_SUBEXPR_START) {
9075 ok = 0;
9076 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9077 goto err;
9079 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9080 ok = 0;
9081 goto err;
9085 if (have_ternary) {
9086 ExprTernaryReorderExpression(interp, expr);
9089 err:
9090 /* Free the stack used for the compilation. */
9091 Jim_FreeStack(&stack);
9093 for (i = 0; i < expr->len; i++) {
9094 Jim_IncrRefCount(expr->token[i].objPtr);
9097 if (!ok) {
9098 ExprFreeByteCode(interp, expr);
9099 return NULL;
9102 return expr;
9106 /* This method takes the string representation of an expression
9107 * and generates a program for the Expr's stack-based VM. */
9108 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9110 int exprTextLen;
9111 const char *exprText;
9112 struct JimParserCtx parser;
9113 struct ExprByteCode *expr;
9114 ParseTokenList tokenlist;
9115 int line;
9116 Jim_Obj *fileNameObj;
9117 int rc = JIM_ERR;
9119 /* Try to get information about filename / line number */
9120 if (objPtr->typePtr == &sourceObjType) {
9121 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9122 line = objPtr->internalRep.sourceValue.lineNumber;
9124 else {
9125 fileNameObj = interp->emptyObj;
9126 line = 1;
9128 Jim_IncrRefCount(fileNameObj);
9130 exprText = Jim_GetString(objPtr, &exprTextLen);
9132 /* Initially tokenise the expression into tokenlist */
9133 ScriptTokenListInit(&tokenlist);
9135 JimParserInit(&parser, exprText, exprTextLen, line);
9136 while (!parser.eof) {
9137 if (JimParseExpression(&parser) != JIM_OK) {
9138 ScriptTokenListFree(&tokenlist);
9139 invalidexpr:
9140 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9141 expr = NULL;
9142 goto err;
9145 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9146 parser.tline);
9149 #ifdef DEBUG_SHOW_EXPR_TOKENS
9151 int i;
9152 printf("==== Expr Tokens ====\n");
9153 for (i = 0; i < tokenlist.count; i++) {
9154 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9155 tokenlist.list[i].len, tokenlist.list[i].token);
9158 #endif
9160 /* Now create the expression bytecode from the tokenlist */
9161 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9163 /* No longer need the token list */
9164 ScriptTokenListFree(&tokenlist);
9166 if (!expr) {
9167 goto err;
9170 #ifdef DEBUG_SHOW_EXPR
9172 int i;
9174 printf("==== Expr ====\n");
9175 for (i = 0; i < expr->len; i++) {
9176 ScriptToken *t = &expr->token[i];
9178 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9181 #endif
9183 /* Check program correctness. */
9184 if (ExprCheckCorrectness(expr) != JIM_OK) {
9185 ExprFreeByteCode(interp, expr);
9186 goto invalidexpr;
9189 rc = JIM_OK;
9191 err:
9192 /* Free the old internal rep and set the new one. */
9193 Jim_DecrRefCount(interp, fileNameObj);
9194 Jim_FreeIntRep(interp, objPtr);
9195 Jim_SetIntRepPtr(objPtr, expr);
9196 objPtr->typePtr = &exprObjType;
9197 return rc;
9200 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9202 if (objPtr->typePtr != &exprObjType) {
9203 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9204 return NULL;
9207 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9210 /* -----------------------------------------------------------------------------
9211 * Expressions evaluation.
9212 * Jim uses a specialized stack-based virtual machine for expressions,
9213 * that takes advantage of the fact that expr's operators
9214 * can't be redefined.
9216 * Jim_EvalExpression() uses the bytecode compiled by
9217 * SetExprFromAny() method of the "expression" object.
9219 * On success a Tcl Object containing the result of the evaluation
9220 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9221 * returned.
9222 * On error the function returns a retcode != to JIM_OK and set a suitable
9223 * error on the interp.
9224 * ---------------------------------------------------------------------------*/
9225 #define JIM_EE_STATICSTACK_LEN 10
9227 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9229 ExprByteCode *expr;
9230 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9231 int i;
9232 int retcode = JIM_OK;
9233 struct JimExprState e;
9235 expr = JimGetExpression(interp, exprObjPtr);
9236 if (!expr) {
9237 return JIM_ERR; /* error in expression. */
9240 #ifdef JIM_OPTIMIZATION
9241 /* Check for one of the following common expressions used by while/for
9243 * CONST
9244 * $a
9245 * !$a
9246 * $a < CONST, $a < $b
9247 * $a <= CONST, $a <= $b
9248 * $a > CONST, $a > $b
9249 * $a >= CONST, $a >= $b
9250 * $a != CONST, $a != $b
9251 * $a == CONST, $a == $b
9254 Jim_Obj *objPtr;
9256 /* STEP 1 -- Check if there are the conditions to run the specialized
9257 * version of while */
9259 switch (expr->len) {
9260 case 1:
9261 if (expr->token[0].type == JIM_TT_EXPR_INT) {
9262 *exprResultPtrPtr = expr->token[0].objPtr;
9263 Jim_IncrRefCount(*exprResultPtrPtr);
9264 return JIM_OK;
9266 if (expr->token[0].type == JIM_TT_VAR) {
9267 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_ERRMSG);
9268 if (objPtr) {
9269 *exprResultPtrPtr = objPtr;
9270 Jim_IncrRefCount(*exprResultPtrPtr);
9271 return JIM_OK;
9274 break;
9276 case 2:
9277 if (expr->token[1].type == JIM_EXPROP_NOT && expr->token[0].type == JIM_TT_VAR) {
9278 jim_wide wideValue;
9280 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
9281 if (objPtr && JimIsWide(objPtr)
9282 && Jim_GetWide(interp, objPtr, &wideValue) == JIM_OK) {
9283 *exprResultPtrPtr = wideValue ? interp->falseObj : interp->trueObj;
9284 Jim_IncrRefCount(*exprResultPtrPtr);
9285 return JIM_OK;
9288 break;
9290 case 3:
9291 if (expr->token[0].type == JIM_TT_VAR && (expr->token[1].type == JIM_TT_EXPR_INT
9292 || expr->token[1].type == JIM_TT_VAR)) {
9293 switch (expr->token[2].type) {
9294 case JIM_EXPROP_LT:
9295 case JIM_EXPROP_LTE:
9296 case JIM_EXPROP_GT:
9297 case JIM_EXPROP_GTE:
9298 case JIM_EXPROP_NUMEQ:
9299 case JIM_EXPROP_NUMNE:{
9300 /* optimise ok */
9301 jim_wide wideValueA;
9302 jim_wide wideValueB;
9304 objPtr = Jim_GetVariable(interp, expr->token[0].objPtr, JIM_NONE);
9305 if (objPtr && JimIsWide(objPtr)
9306 && Jim_GetWide(interp, objPtr, &wideValueA) == JIM_OK) {
9307 if (expr->token[1].type == JIM_TT_VAR) {
9308 objPtr =
9309 Jim_GetVariable(interp, expr->token[1].objPtr,
9310 JIM_NONE);
9312 else {
9313 objPtr = expr->token[1].objPtr;
9315 if (objPtr && JimIsWide(objPtr)
9316 && Jim_GetWide(interp, objPtr, &wideValueB) == JIM_OK) {
9317 int cmpRes;
9319 switch (expr->token[2].type) {
9320 case JIM_EXPROP_LT:
9321 cmpRes = wideValueA < wideValueB;
9322 break;
9323 case JIM_EXPROP_LTE:
9324 cmpRes = wideValueA <= wideValueB;
9325 break;
9326 case JIM_EXPROP_GT:
9327 cmpRes = wideValueA > wideValueB;
9328 break;
9329 case JIM_EXPROP_GTE:
9330 cmpRes = wideValueA >= wideValueB;
9331 break;
9332 case JIM_EXPROP_NUMEQ:
9333 cmpRes = wideValueA == wideValueB;
9334 break;
9335 case JIM_EXPROP_NUMNE:
9336 cmpRes = wideValueA != wideValueB;
9337 break;
9338 default: /*notreached */
9339 cmpRes = 0;
9341 *exprResultPtrPtr =
9342 cmpRes ? interp->trueObj : interp->falseObj;
9343 Jim_IncrRefCount(*exprResultPtrPtr);
9344 return JIM_OK;
9350 break;
9353 #endif
9355 /* In order to avoid that the internal repr gets freed due to
9356 * shimmering of the exprObjPtr's object, we make the internal rep
9357 * shared. */
9358 expr->inUse++;
9360 /* The stack-based expr VM itself */
9362 /* Stack allocation. Expr programs have the feature that
9363 * a program of length N can't require a stack longer than
9364 * N. */
9365 if (expr->len > JIM_EE_STATICSTACK_LEN)
9366 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9367 else
9368 e.stack = staticStack;
9370 e.stacklen = 0;
9372 /* Execute every instruction */
9373 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9374 Jim_Obj *objPtr;
9376 switch (expr->token[i].type) {
9377 case JIM_TT_EXPR_INT:
9378 case JIM_TT_EXPR_DOUBLE:
9379 case JIM_TT_STR:
9380 ExprPush(&e, expr->token[i].objPtr);
9381 break;
9383 case JIM_TT_VAR:
9384 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9385 if (objPtr) {
9386 ExprPush(&e, objPtr);
9388 else {
9389 retcode = JIM_ERR;
9391 break;
9393 case JIM_TT_DICTSUGAR:
9394 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9395 if (objPtr) {
9396 ExprPush(&e, objPtr);
9398 else {
9399 retcode = JIM_ERR;
9401 break;
9403 case JIM_TT_ESC:
9404 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9405 if (retcode == JIM_OK) {
9406 ExprPush(&e, objPtr);
9408 break;
9410 case JIM_TT_CMD:
9411 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9412 if (retcode == JIM_OK) {
9413 ExprPush(&e, Jim_GetResult(interp));
9415 break;
9417 default:{
9418 /* Find and execute the operation */
9419 e.skip = 0;
9420 e.opcode = expr->token[i].type;
9422 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9423 /* Skip some opcodes if necessary */
9424 i += e.skip;
9425 continue;
9430 expr->inUse--;
9432 if (retcode == JIM_OK) {
9433 *exprResultPtrPtr = ExprPop(&e);
9435 else {
9436 for (i = 0; i < e.stacklen; i++) {
9437 Jim_DecrRefCount(interp, e.stack[i]);
9440 if (e.stack != staticStack) {
9441 Jim_Free(e.stack);
9443 return retcode;
9446 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9448 int retcode;
9449 jim_wide wideValue;
9450 double doubleValue;
9451 Jim_Obj *exprResultPtr;
9453 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9454 if (retcode != JIM_OK)
9455 return retcode;
9457 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9458 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9459 Jim_DecrRefCount(interp, exprResultPtr);
9460 return JIM_ERR;
9462 else {
9463 Jim_DecrRefCount(interp, exprResultPtr);
9464 *boolPtr = doubleValue != 0;
9465 return JIM_OK;
9468 *boolPtr = wideValue != 0;
9470 Jim_DecrRefCount(interp, exprResultPtr);
9471 return JIM_OK;
9474 /* -----------------------------------------------------------------------------
9475 * ScanFormat String Object
9476 * ---------------------------------------------------------------------------*/
9478 /* This Jim_Obj will held a parsed representation of a format string passed to
9479 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9480 * to be parsed in its entirely first and then, if correct, can be used for
9481 * scanning. To avoid endless re-parsing, the parsed representation will be
9482 * stored in an internal representation and re-used for performance reason. */
9484 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9485 * scanformat string. This part will later be used to extract information
9486 * out from the string to be parsed by Jim_ScanString */
9488 typedef struct ScanFmtPartDescr
9490 char *arg; /* Specification of a CHARSET conversion */
9491 char *prefix; /* Prefix to be scanned literally before conversion */
9492 size_t width; /* Maximal width of input to be converted */
9493 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9494 char type; /* Type of conversion (e.g. c, d, f) */
9495 char modifier; /* Modify type (e.g. l - long, h - short */
9496 } ScanFmtPartDescr;
9498 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9499 * string parsed and separated in part descriptions. Furthermore it contains
9500 * the original string representation of the scanformat string to allow for
9501 * fast update of the Jim_Obj's string representation part.
9503 * As an add-on the internal object representation adds some scratch pad area
9504 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9505 * memory for purpose of string scanning.
9507 * The error member points to a static allocated string in case of a mal-
9508 * formed scanformat string or it contains '0' (NULL) in case of a valid
9509 * parse representation.
9511 * The whole memory of the internal representation is allocated as a single
9512 * area of memory that will be internally separated. So freeing and duplicating
9513 * of such an object is cheap */
9515 typedef struct ScanFmtStringObj
9517 jim_wide size; /* Size of internal repr in bytes */
9518 char *stringRep; /* Original string representation */
9519 size_t count; /* Number of ScanFmtPartDescr contained */
9520 size_t convCount; /* Number of conversions that will assign */
9521 size_t maxPos; /* Max position index if XPG3 is used */
9522 const char *error; /* Ptr to error text (NULL if no error */
9523 char *scratch; /* Some scratch pad used by Jim_ScanString */
9524 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9525 } ScanFmtStringObj;
9528 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9529 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9530 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9532 static const Jim_ObjType scanFmtStringObjType = {
9533 "scanformatstring",
9534 FreeScanFmtInternalRep,
9535 DupScanFmtInternalRep,
9536 UpdateStringOfScanFmt,
9537 JIM_TYPE_NONE,
9540 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9542 JIM_NOTUSED(interp);
9543 Jim_Free((char *)objPtr->internalRep.ptr);
9544 objPtr->internalRep.ptr = 0;
9547 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9549 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9550 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9552 JIM_NOTUSED(interp);
9553 memcpy(newVec, srcPtr->internalRep.ptr, size);
9554 dupPtr->internalRep.ptr = newVec;
9555 dupPtr->typePtr = &scanFmtStringObjType;
9558 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9560 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9563 /* SetScanFmtFromAny will parse a given string and create the internal
9564 * representation of the format specification. In case of an error
9565 * the error data member of the internal representation will be set
9566 * to an descriptive error text and the function will be left with
9567 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9568 * specification */
9570 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9572 ScanFmtStringObj *fmtObj;
9573 char *buffer;
9574 int maxCount, i, approxSize, lastPos = -1;
9575 const char *fmt = objPtr->bytes;
9576 int maxFmtLen = objPtr->length;
9577 const char *fmtEnd = fmt + maxFmtLen;
9578 int curr;
9580 Jim_FreeIntRep(interp, objPtr);
9581 /* Count how many conversions could take place maximally */
9582 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9583 if (fmt[i] == '%')
9584 ++maxCount;
9585 /* Calculate an approximation of the memory necessary */
9586 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9587 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9588 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9589 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9590 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9591 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9592 +1; /* safety byte */
9593 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9594 memset(fmtObj, 0, approxSize);
9595 fmtObj->size = approxSize;
9596 fmtObj->maxPos = 0;
9597 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9598 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9599 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9600 buffer = fmtObj->stringRep + maxFmtLen + 1;
9601 objPtr->internalRep.ptr = fmtObj;
9602 objPtr->typePtr = &scanFmtStringObjType;
9603 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9604 int width = 0, skip;
9605 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9607 fmtObj->count++;
9608 descr->width = 0; /* Assume width unspecified */
9609 /* Overread and store any "literal" prefix */
9610 if (*fmt != '%' || fmt[1] == '%') {
9611 descr->type = 0;
9612 descr->prefix = &buffer[i];
9613 for (; fmt < fmtEnd; ++fmt) {
9614 if (*fmt == '%') {
9615 if (fmt[1] != '%')
9616 break;
9617 ++fmt;
9619 buffer[i++] = *fmt;
9621 buffer[i++] = 0;
9623 /* Skip the conversion introducing '%' sign */
9624 ++fmt;
9625 /* End reached due to non-conversion literal only? */
9626 if (fmt >= fmtEnd)
9627 goto done;
9628 descr->pos = 0; /* Assume "natural" positioning */
9629 if (*fmt == '*') {
9630 descr->pos = -1; /* Okay, conversion will not be assigned */
9631 ++fmt;
9633 else
9634 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9635 /* Check if next token is a number (could be width or pos */
9636 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9637 fmt += skip;
9638 /* Was the number a XPG3 position specifier? */
9639 if (descr->pos != -1 && *fmt == '$') {
9640 int prev;
9642 ++fmt;
9643 descr->pos = width;
9644 width = 0;
9645 /* Look if "natural" postioning and XPG3 one was mixed */
9646 if ((lastPos == 0 && descr->pos > 0)
9647 || (lastPos > 0 && descr->pos == 0)) {
9648 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9649 return JIM_ERR;
9651 /* Look if this position was already used */
9652 for (prev = 0; prev < curr; ++prev) {
9653 if (fmtObj->descr[prev].pos == -1)
9654 continue;
9655 if (fmtObj->descr[prev].pos == descr->pos) {
9656 fmtObj->error =
9657 "variable is assigned by multiple \"%n$\" conversion specifiers";
9658 return JIM_ERR;
9661 /* Try to find a width after the XPG3 specifier */
9662 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9663 descr->width = width;
9664 fmt += skip;
9666 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9667 fmtObj->maxPos = descr->pos;
9669 else {
9670 /* Number was not a XPG3, so it has to be a width */
9671 descr->width = width;
9674 /* If positioning mode was undetermined yet, fix this */
9675 if (lastPos == -1)
9676 lastPos = descr->pos;
9677 /* Handle CHARSET conversion type ... */
9678 if (*fmt == '[') {
9679 int swapped = 1, beg = i, end, j;
9681 descr->type = '[';
9682 descr->arg = &buffer[i];
9683 ++fmt;
9684 if (*fmt == '^')
9685 buffer[i++] = *fmt++;
9686 if (*fmt == ']')
9687 buffer[i++] = *fmt++;
9688 while (*fmt && *fmt != ']')
9689 buffer[i++] = *fmt++;
9690 if (*fmt != ']') {
9691 fmtObj->error = "unmatched [ in format string";
9692 return JIM_ERR;
9694 end = i;
9695 buffer[i++] = 0;
9696 /* In case a range fence was given "backwards", swap it */
9697 while (swapped) {
9698 swapped = 0;
9699 for (j = beg + 1; j < end - 1; ++j) {
9700 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9701 char tmp = buffer[j - 1];
9703 buffer[j - 1] = buffer[j + 1];
9704 buffer[j + 1] = tmp;
9705 swapped = 1;
9710 else {
9711 /* Remember any valid modifier if given */
9712 if (strchr("hlL", *fmt) != 0)
9713 descr->modifier = tolower((int)*fmt++);
9715 descr->type = *fmt;
9716 if (strchr("efgcsndoxui", *fmt) == 0) {
9717 fmtObj->error = "bad scan conversion character";
9718 return JIM_ERR;
9720 else if (*fmt == 'c' && descr->width != 0) {
9721 fmtObj->error = "field width may not be specified in %c " "conversion";
9722 return JIM_ERR;
9724 else if (*fmt == 'u' && descr->modifier == 'l') {
9725 fmtObj->error = "unsigned wide not supported";
9726 return JIM_ERR;
9729 curr++;
9731 done:
9732 return JIM_OK;
9735 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9737 #define FormatGetCnvCount(_fo_) \
9738 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9739 #define FormatGetMaxPos(_fo_) \
9740 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9741 #define FormatGetError(_fo_) \
9742 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9744 /* JimScanAString is used to scan an unspecified string that ends with
9745 * next WS, or a string that is specified via a charset.
9748 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9750 char *buffer = Jim_StrDup(str);
9751 char *p = buffer;
9753 while (*str) {
9754 int c;
9755 int n;
9757 if (!sdescr && isspace(UCHAR(*str)))
9758 break; /* EOS via WS if unspecified */
9760 n = utf8_tounicode(str, &c);
9761 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9762 break;
9763 while (n--)
9764 *p++ = *str++;
9766 *p = 0;
9767 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9770 /* ScanOneEntry will scan one entry out of the string passed as argument.
9771 * It use the sscanf() function for this task. After extracting and
9772 * converting of the value, the count of scanned characters will be
9773 * returned of -1 in case of no conversion tool place and string was
9774 * already scanned thru */
9776 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9777 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9779 const char *tok;
9780 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9781 size_t scanned = 0;
9782 size_t anchor = pos;
9783 int i;
9784 Jim_Obj *tmpObj = NULL;
9786 /* First pessimistically assume, we will not scan anything :-) */
9787 *valObjPtr = 0;
9788 if (descr->prefix) {
9789 /* There was a prefix given before the conversion, skip it and adjust
9790 * the string-to-be-parsed accordingly */
9791 /* XXX: Should be checking strLen, not str[pos] */
9792 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9793 /* If prefix require, skip WS */
9794 if (isspace(UCHAR(descr->prefix[i])))
9795 while (pos < strLen && isspace(UCHAR(str[pos])))
9796 ++pos;
9797 else if (descr->prefix[i] != str[pos])
9798 break; /* Prefix do not match here, leave the loop */
9799 else
9800 ++pos; /* Prefix matched so far, next round */
9802 if (pos >= strLen) {
9803 return -1; /* All of str consumed: EOF condition */
9805 else if (descr->prefix[i] != 0)
9806 return 0; /* Not whole prefix consumed, no conversion possible */
9808 /* For all but following conversion, skip leading WS */
9809 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9810 while (isspace(UCHAR(str[pos])))
9811 ++pos;
9812 /* Determine how much skipped/scanned so far */
9813 scanned = pos - anchor;
9815 /* %c is a special, simple case. no width */
9816 if (descr->type == 'n') {
9817 /* Return pseudo conversion means: how much scanned so far? */
9818 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9820 else if (pos >= strLen) {
9821 /* Cannot scan anything, as str is totally consumed */
9822 return -1;
9824 else if (descr->type == 'c') {
9825 int c;
9826 scanned += utf8_tounicode(&str[pos], &c);
9827 *valObjPtr = Jim_NewIntObj(interp, c);
9828 return scanned;
9830 else {
9831 /* Processing of conversions follows ... */
9832 if (descr->width > 0) {
9833 /* Do not try to scan as fas as possible but only the given width.
9834 * To ensure this, we copy the part that should be scanned. */
9835 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9836 size_t tLen = descr->width > sLen ? sLen : descr->width;
9838 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9839 tok = tmpObj->bytes;
9841 else {
9842 /* As no width was given, simply refer to the original string */
9843 tok = &str[pos];
9845 switch (descr->type) {
9846 case 'd':
9847 case 'o':
9848 case 'x':
9849 case 'u':
9850 case 'i':{
9851 char *endp; /* Position where the number finished */
9852 jim_wide w;
9854 int base = descr->type == 'o' ? 8
9855 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9857 /* Try to scan a number with the given base */
9858 if (base == 0) {
9859 w = jim_strtoull(tok, &endp);
9861 else {
9862 w = strtoull(tok, &endp, base);
9865 if (endp != tok) {
9866 /* There was some number sucessfully scanned! */
9867 *valObjPtr = Jim_NewIntObj(interp, w);
9869 /* Adjust the number-of-chars scanned so far */
9870 scanned += endp - tok;
9872 else {
9873 /* Nothing was scanned. We have to determine if this
9874 * happened due to e.g. prefix mismatch or input str
9875 * exhausted */
9876 scanned = *tok ? 0 : -1;
9878 break;
9880 case 's':
9881 case '[':{
9882 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9883 scanned += Jim_Length(*valObjPtr);
9884 break;
9886 case 'e':
9887 case 'f':
9888 case 'g':{
9889 char *endp;
9890 double value = strtod(tok, &endp);
9892 if (endp != tok) {
9893 /* There was some number sucessfully scanned! */
9894 *valObjPtr = Jim_NewDoubleObj(interp, value);
9895 /* Adjust the number-of-chars scanned so far */
9896 scanned += endp - tok;
9898 else {
9899 /* Nothing was scanned. We have to determine if this
9900 * happened due to e.g. prefix mismatch or input str
9901 * exhausted */
9902 scanned = *tok ? 0 : -1;
9904 break;
9907 /* If a substring was allocated (due to pre-defined width) do not
9908 * forget to free it */
9909 if (tmpObj) {
9910 Jim_FreeNewObj(interp, tmpObj);
9913 return scanned;
9916 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9917 * string and returns all converted (and not ignored) values in a list back
9918 * to the caller. If an error occured, a NULL pointer will be returned */
9920 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9922 size_t i, pos;
9923 int scanned = 1;
9924 const char *str = Jim_String(strObjPtr);
9925 int strLen = Jim_Utf8Length(interp, strObjPtr);
9926 Jim_Obj *resultList = 0;
9927 Jim_Obj **resultVec = 0;
9928 int resultc;
9929 Jim_Obj *emptyStr = 0;
9930 ScanFmtStringObj *fmtObj;
9932 /* This should never happen. The format object should already be of the correct type */
9933 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9935 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9936 /* Check if format specification was valid */
9937 if (fmtObj->error != 0) {
9938 if (flags & JIM_ERRMSG)
9939 Jim_SetResultString(interp, fmtObj->error, -1);
9940 return 0;
9942 /* Allocate a new "shared" empty string for all unassigned conversions */
9943 emptyStr = Jim_NewEmptyStringObj(interp);
9944 Jim_IncrRefCount(emptyStr);
9945 /* Create a list and fill it with empty strings up to max specified XPG3 */
9946 resultList = Jim_NewListObj(interp, NULL, 0);
9947 if (fmtObj->maxPos > 0) {
9948 for (i = 0; i < fmtObj->maxPos; ++i)
9949 Jim_ListAppendElement(interp, resultList, emptyStr);
9950 JimListGetElements(interp, resultList, &resultc, &resultVec);
9952 /* Now handle every partial format description */
9953 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9954 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9955 Jim_Obj *value = 0;
9957 /* Only last type may be "literal" w/o conversion - skip it! */
9958 if (descr->type == 0)
9959 continue;
9960 /* As long as any conversion could be done, we will proceed */
9961 if (scanned > 0)
9962 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9963 /* In case our first try results in EOF, we will leave */
9964 if (scanned == -1 && i == 0)
9965 goto eof;
9966 /* Advance next pos-to-be-scanned for the amount scanned already */
9967 pos += scanned;
9969 /* value == 0 means no conversion took place so take empty string */
9970 if (value == 0)
9971 value = Jim_NewEmptyStringObj(interp);
9972 /* If value is a non-assignable one, skip it */
9973 if (descr->pos == -1) {
9974 Jim_FreeNewObj(interp, value);
9976 else if (descr->pos == 0)
9977 /* Otherwise append it to the result list if no XPG3 was given */
9978 Jim_ListAppendElement(interp, resultList, value);
9979 else if (resultVec[descr->pos - 1] == emptyStr) {
9980 /* But due to given XPG3, put the value into the corr. slot */
9981 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9982 Jim_IncrRefCount(value);
9983 resultVec[descr->pos - 1] = value;
9985 else {
9986 /* Otherwise, the slot was already used - free obj and ERROR */
9987 Jim_FreeNewObj(interp, value);
9988 goto err;
9991 Jim_DecrRefCount(interp, emptyStr);
9992 return resultList;
9993 eof:
9994 Jim_DecrRefCount(interp, emptyStr);
9995 Jim_FreeNewObj(interp, resultList);
9996 return (Jim_Obj *)EOF;
9997 err:
9998 Jim_DecrRefCount(interp, emptyStr);
9999 Jim_FreeNewObj(interp, resultList);
10000 return 0;
10003 /* -----------------------------------------------------------------------------
10004 * Pseudo Random Number Generation
10005 * ---------------------------------------------------------------------------*/
10006 /* Initialize the sbox with the numbers from 0 to 255 */
10007 static void JimPrngInit(Jim_Interp *interp)
10009 #define PRNG_SEED_SIZE 256
10010 int i;
10011 unsigned int *seed;
10012 time_t t = time(NULL);
10014 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10016 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10017 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10018 seed[i] = (rand() ^ t ^ clock());
10020 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10021 Jim_Free(seed);
10024 /* Generates N bytes of random data */
10025 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10027 Jim_PrngState *prng;
10028 unsigned char *destByte = (unsigned char *)dest;
10029 unsigned int si, sj, x;
10031 /* initialization, only needed the first time */
10032 if (interp->prngState == NULL)
10033 JimPrngInit(interp);
10034 prng = interp->prngState;
10035 /* generates 'len' bytes of pseudo-random numbers */
10036 for (x = 0; x < len; x++) {
10037 prng->i = (prng->i + 1) & 0xff;
10038 si = prng->sbox[prng->i];
10039 prng->j = (prng->j + si) & 0xff;
10040 sj = prng->sbox[prng->j];
10041 prng->sbox[prng->i] = sj;
10042 prng->sbox[prng->j] = si;
10043 *destByte++ = prng->sbox[(si + sj) & 0xff];
10047 /* Re-seed the generator with user-provided bytes */
10048 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10050 int i;
10051 Jim_PrngState *prng;
10053 /* initialization, only needed the first time */
10054 if (interp->prngState == NULL)
10055 JimPrngInit(interp);
10056 prng = interp->prngState;
10058 /* Set the sbox[i] with i */
10059 for (i = 0; i < 256; i++)
10060 prng->sbox[i] = i;
10061 /* Now use the seed to perform a random permutation of the sbox */
10062 for (i = 0; i < seedLen; i++) {
10063 unsigned char t;
10065 t = prng->sbox[i & 0xFF];
10066 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10067 prng->sbox[seed[i]] = t;
10069 prng->i = prng->j = 0;
10071 /* discard at least the first 256 bytes of stream.
10072 * borrow the seed buffer for this
10074 for (i = 0; i < 256; i += seedLen) {
10075 JimRandomBytes(interp, seed, seedLen);
10079 /* [incr] */
10080 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10082 jim_wide wideValue, increment = 1;
10083 Jim_Obj *intObjPtr;
10085 if (argc != 2 && argc != 3) {
10086 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10087 return JIM_ERR;
10089 if (argc == 3) {
10090 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10091 return JIM_ERR;
10093 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10094 if (!intObjPtr) {
10095 /* Set missing variable to 0 */
10096 wideValue = 0;
10098 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10099 return JIM_ERR;
10101 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10102 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10103 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10104 Jim_FreeNewObj(interp, intObjPtr);
10105 return JIM_ERR;
10108 else {
10109 /* Can do it the quick way */
10110 Jim_InvalidateStringRep(intObjPtr);
10111 JimWideValue(intObjPtr) = wideValue + increment;
10113 /* The following step is required in order to invalidate the
10114 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10115 if (argv[1]->typePtr != &variableObjType) {
10116 /* Note that this can't fail since GetVariable already succeeded */
10117 Jim_SetVariable(interp, argv[1], intObjPtr);
10120 Jim_SetResult(interp, intObjPtr);
10121 return JIM_OK;
10125 /* -----------------------------------------------------------------------------
10126 * Eval
10127 * ---------------------------------------------------------------------------*/
10128 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10129 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10131 /* Handle calls to the [unknown] command */
10132 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10134 int retcode;
10136 /* If JimUnknown() is recursively called too many times...
10137 * done here
10139 if (interp->unknown_called > 50) {
10140 return JIM_ERR;
10143 /* The object interp->unknown just contains
10144 * the "unknown" string, it is used in order to
10145 * avoid to lookup the unknown command every time
10146 * but instead to cache the result. */
10148 /* If the [unknown] command does not exist ... */
10149 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10150 return JIM_ERR;
10152 interp->unknown_called++;
10153 /* XXX: Are we losing fileNameObj and linenr? */
10154 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10155 interp->unknown_called--;
10157 return retcode;
10160 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10162 int retcode;
10163 Jim_Cmd *cmdPtr;
10165 if (interp->framePtr->tailcallCmd) {
10166 /* Special tailcall command was pre-resolved */
10167 cmdPtr = interp->framePtr->tailcallCmd;
10168 interp->framePtr->tailcallCmd = NULL;
10170 else {
10171 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10172 if (cmdPtr == NULL) {
10173 return JimUnknown(interp, objc, objv);
10175 JimIncrCmdRefCount(cmdPtr);
10178 if (interp->evalDepth == interp->maxEvalDepth) {
10179 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10180 retcode = JIM_ERR;
10181 goto out;
10183 interp->evalDepth++;
10185 /* Call it -- Make sure result is an empty object. */
10186 Jim_SetEmptyResult(interp);
10187 if (cmdPtr->isproc) {
10188 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10190 else {
10191 interp->cmdPrivData = cmdPtr->u.native.privData;
10192 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10194 interp->evalDepth--;
10196 out:
10197 JimDecrCmdRefCount(interp, cmdPtr);
10199 return retcode;
10202 /* Eval the object vector 'objv' composed of 'objc' elements.
10203 * Every element is used as single argument.
10204 * Jim_EvalObj() will call this function every time its object
10205 * argument is of "list" type, with no string representation.
10207 * This is possible because the string representation of a
10208 * list object generated by the UpdateStringOfList is made
10209 * in a way that ensures that every list element is a different
10210 * command argument. */
10211 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10213 int i, retcode;
10215 /* Incr refcount of arguments. */
10216 for (i = 0; i < objc; i++)
10217 Jim_IncrRefCount(objv[i]);
10219 retcode = JimInvokeCommand(interp, objc, objv);
10221 /* Decr refcount of arguments and return the retcode */
10222 for (i = 0; i < objc; i++)
10223 Jim_DecrRefCount(interp, objv[i]);
10225 return retcode;
10229 * Invokes 'prefix' as a command with the objv array as arguments.
10231 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10233 int ret;
10234 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10236 nargv[0] = prefix;
10237 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10238 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10239 Jim_Free(nargv);
10240 return ret;
10243 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, ScriptObj *script)
10245 int rc = retcode;
10247 if (rc == JIM_ERR && !interp->errorFlag) {
10248 /* This is the first error, so save the file/line information and reset the stack */
10249 interp->errorFlag = 1;
10250 Jim_IncrRefCount(script->fileNameObj);
10251 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10252 interp->errorFileNameObj = script->fileNameObj;
10253 interp->errorLine = script->linenr;
10255 JimResetStackTrace(interp);
10256 /* Always add a level where the error first occurs */
10257 interp->addStackTrace++;
10260 /* Now if this is an "interesting" level, add it to the stack trace */
10261 if (rc == JIM_ERR && interp->addStackTrace > 0) {
10262 /* Add the stack info for the current level */
10264 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10266 /* Note: if we didn't have a filename for this level,
10267 * don't clear the addStackTrace flag
10268 * so we can pick it up at the next level
10270 if (Jim_Length(script->fileNameObj)) {
10271 interp->addStackTrace = 0;
10274 Jim_DecrRefCount(interp, interp->errorProc);
10275 interp->errorProc = interp->emptyObj;
10276 Jim_IncrRefCount(interp->errorProc);
10278 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
10279 /* Propagate the addStackTrace value through 'return -code error' */
10281 else {
10282 interp->addStackTrace = 0;
10286 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10288 Jim_Obj *objPtr;
10290 switch (token->type) {
10291 case JIM_TT_STR:
10292 case JIM_TT_ESC:
10293 objPtr = token->objPtr;
10294 break;
10295 case JIM_TT_VAR:
10296 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10297 break;
10298 case JIM_TT_DICTSUGAR:
10299 objPtr = JimExpandDictSugar(interp, token->objPtr);
10300 break;
10301 case JIM_TT_EXPRSUGAR:
10302 objPtr = JimExpandExprSugar(interp, token->objPtr);
10303 break;
10304 case JIM_TT_CMD:
10305 switch (Jim_EvalObj(interp, token->objPtr)) {
10306 case JIM_OK:
10307 case JIM_RETURN:
10308 objPtr = interp->result;
10309 break;
10310 case JIM_BREAK:
10311 /* Stop substituting */
10312 return JIM_BREAK;
10313 case JIM_CONTINUE:
10314 /* just skip this one */
10315 return JIM_CONTINUE;
10316 default:
10317 return JIM_ERR;
10319 break;
10320 default:
10321 JimPanic((1,
10322 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10323 objPtr = NULL;
10324 break;
10326 if (objPtr) {
10327 *objPtrPtr = objPtr;
10328 return JIM_OK;
10330 return JIM_ERR;
10333 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10334 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10335 * The returned object has refcount = 0.
10337 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10339 int totlen = 0, i;
10340 Jim_Obj **intv;
10341 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10342 Jim_Obj *objPtr;
10343 char *s;
10345 if (tokens <= JIM_EVAL_SINTV_LEN)
10346 intv = sintv;
10347 else
10348 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10350 /* Compute every token forming the argument
10351 * in the intv objects vector. */
10352 for (i = 0; i < tokens; i++) {
10353 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10354 case JIM_OK:
10355 case JIM_RETURN:
10356 break;
10357 case JIM_BREAK:
10358 if (flags & JIM_SUBST_FLAG) {
10359 /* Stop here */
10360 tokens = i;
10361 continue;
10363 /* XXX: Should probably set an error about break outside loop */
10364 /* fall through to error */
10365 case JIM_CONTINUE:
10366 if (flags & JIM_SUBST_FLAG) {
10367 intv[i] = NULL;
10368 continue;
10370 /* XXX: Ditto continue outside loop */
10371 /* fall through to error */
10372 default:
10373 while (i--) {
10374 Jim_DecrRefCount(interp, intv[i]);
10376 if (intv != sintv) {
10377 Jim_Free(intv);
10379 return NULL;
10381 Jim_IncrRefCount(intv[i]);
10382 Jim_String(intv[i]);
10383 totlen += intv[i]->length;
10386 /* Fast path return for a single token */
10387 if (tokens == 1 && intv[0] && intv == sintv) {
10388 Jim_DecrRefCount(interp, intv[0]);
10389 return intv[0];
10392 /* Concatenate every token in an unique
10393 * object. */
10394 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10396 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10397 && token[2].type == JIM_TT_VAR) {
10398 /* May be able to do fast interpolated object -> dictSubst */
10399 objPtr->typePtr = &interpolatedObjType;
10400 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10401 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10402 Jim_IncrRefCount(intv[2]);
10405 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10406 objPtr->length = totlen;
10407 for (i = 0; i < tokens; i++) {
10408 if (intv[i]) {
10409 memcpy(s, intv[i]->bytes, intv[i]->length);
10410 s += intv[i]->length;
10411 Jim_DecrRefCount(interp, intv[i]);
10414 objPtr->bytes[totlen] = '\0';
10415 /* Free the intv vector if not static. */
10416 if (intv != sintv) {
10417 Jim_Free(intv);
10420 return objPtr;
10424 /* listPtr *must* be a list.
10425 * The contents of the list is evaluated with the first element as the command and
10426 * the remaining elements as the arguments.
10428 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10430 int retcode = JIM_OK;
10432 if (listPtr->internalRep.listValue.len) {
10433 Jim_IncrRefCount(listPtr);
10434 retcode = JimInvokeCommand(interp,
10435 listPtr->internalRep.listValue.len,
10436 listPtr->internalRep.listValue.ele);
10437 Jim_DecrRefCount(interp, listPtr);
10439 return retcode;
10442 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10444 SetListFromAny(interp, listPtr);
10445 return JimEvalObjList(interp, listPtr);
10448 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10450 int i;
10451 ScriptObj *script;
10452 ScriptToken *token;
10453 int retcode = JIM_OK;
10454 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10455 Jim_Obj *prevScriptObj;
10457 /* If the object is of type "list", with no string rep we can call
10458 * a specialized version of Jim_EvalObj() */
10459 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10460 return JimEvalObjList(interp, scriptObjPtr);
10463 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10464 script = Jim_GetScript(interp, scriptObjPtr);
10466 /* Reset the interpreter result. This is useful to
10467 * return the empty result in the case of empty program. */
10468 Jim_SetEmptyResult(interp);
10470 token = script->token;
10472 #ifdef JIM_OPTIMIZATION
10473 /* Check for one of the following common scripts used by for, while
10475 * {}
10476 * incr a
10478 if (script->len == 0) {
10479 Jim_DecrRefCount(interp, scriptObjPtr);
10480 return JIM_OK;
10482 if (script->len == 3
10483 && token[1].objPtr->typePtr == &commandObjType
10484 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10485 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10486 && token[2].objPtr->typePtr == &variableObjType) {
10488 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10490 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10491 JimWideValue(objPtr)++;
10492 Jim_InvalidateStringRep(objPtr);
10493 Jim_DecrRefCount(interp, scriptObjPtr);
10494 Jim_SetResult(interp, objPtr);
10495 return JIM_OK;
10498 #endif
10500 /* Now we have to make sure the internal repr will not be
10501 * freed on shimmering.
10503 * Think for example to this:
10505 * set x {llength $x; ... some more code ...}; eval $x
10507 * In order to preserve the internal rep, we increment the
10508 * inUse field of the script internal rep structure. */
10509 script->inUse++;
10511 /* Stash the current script */
10512 prevScriptObj = interp->currentScriptObj;
10513 interp->currentScriptObj = scriptObjPtr;
10515 interp->errorFlag = 0;
10516 argv = sargv;
10518 /* Execute every command sequentially until the end of the script
10519 * or an error occurs.
10521 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10522 int argc;
10523 int j;
10525 /* First token of the line is always JIM_TT_LINE */
10526 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10527 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10529 /* Allocate the arguments vector if required */
10530 if (argc > JIM_EVAL_SARGV_LEN)
10531 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10533 /* Skip the JIM_TT_LINE token */
10534 i++;
10536 /* Populate the arguments objects.
10537 * If an error occurs, retcode will be set and
10538 * 'j' will be set to the number of args expanded
10540 for (j = 0; j < argc; j++) {
10541 long wordtokens = 1;
10542 int expand = 0;
10543 Jim_Obj *wordObjPtr = NULL;
10545 if (token[i].type == JIM_TT_WORD) {
10546 wordtokens = JimWideValue(token[i++].objPtr);
10547 if (wordtokens < 0) {
10548 expand = 1;
10549 wordtokens = -wordtokens;
10553 if (wordtokens == 1) {
10554 /* Fast path if the token does not
10555 * need interpolation */
10557 switch (token[i].type) {
10558 case JIM_TT_ESC:
10559 case JIM_TT_STR:
10560 wordObjPtr = token[i].objPtr;
10561 break;
10562 case JIM_TT_VAR:
10563 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10564 break;
10565 case JIM_TT_EXPRSUGAR:
10566 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10567 break;
10568 case JIM_TT_DICTSUGAR:
10569 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10570 break;
10571 case JIM_TT_CMD:
10572 retcode = Jim_EvalObj(interp, token[i].objPtr);
10573 if (retcode == JIM_OK) {
10574 wordObjPtr = Jim_GetResult(interp);
10576 break;
10577 default:
10578 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10581 else {
10582 /* For interpolation we call a helper
10583 * function to do the work for us. */
10584 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10587 if (!wordObjPtr) {
10588 if (retcode == JIM_OK) {
10589 retcode = JIM_ERR;
10591 break;
10594 Jim_IncrRefCount(wordObjPtr);
10595 i += wordtokens;
10597 if (!expand) {
10598 argv[j] = wordObjPtr;
10600 else {
10601 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10602 int len = Jim_ListLength(interp, wordObjPtr);
10603 int newargc = argc + len - 1;
10604 int k;
10606 if (len > 1) {
10607 if (argv == sargv) {
10608 if (newargc > JIM_EVAL_SARGV_LEN) {
10609 argv = Jim_Alloc(sizeof(*argv) * newargc);
10610 memcpy(argv, sargv, sizeof(*argv) * j);
10613 else {
10614 /* Need to realloc to make room for (len - 1) more entries */
10615 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10619 /* Now copy in the expanded version */
10620 for (k = 0; k < len; k++) {
10621 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10622 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10625 /* The original object reference is no longer needed,
10626 * after the expansion it is no longer present on
10627 * the argument vector, but the single elements are
10628 * in its place. */
10629 Jim_DecrRefCount(interp, wordObjPtr);
10631 /* And update the indexes */
10632 j--;
10633 argc += len - 1;
10637 if (retcode == JIM_OK && argc) {
10638 /* Invoke the command */
10639 retcode = JimInvokeCommand(interp, argc, argv);
10640 /* Check for a signal after each command */
10641 if (Jim_CheckSignal(interp)) {
10642 retcode = JIM_SIGNAL;
10646 /* Finished with the command, so decrement ref counts of each argument */
10647 while (j-- > 0) {
10648 Jim_DecrRefCount(interp, argv[j]);
10651 if (argv != sargv) {
10652 Jim_Free(argv);
10653 argv = sargv;
10657 /* Possibly add to the error stack trace */
10658 JimAddErrorToStack(interp, retcode, script);
10660 /* Restore the current script */
10661 interp->currentScriptObj = prevScriptObj;
10663 /* Note that we don't have to decrement inUse, because the
10664 * following code transfers our use of the reference again to
10665 * the script object. */
10666 Jim_FreeIntRep(interp, scriptObjPtr);
10667 scriptObjPtr->typePtr = &scriptObjType;
10668 Jim_SetIntRepPtr(scriptObjPtr, script);
10669 Jim_DecrRefCount(interp, scriptObjPtr);
10671 return retcode;
10674 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10676 int retcode;
10677 /* If argObjPtr begins with '&', do an automatic upvar */
10678 const char *varname = Jim_String(argNameObj);
10679 if (*varname == '&') {
10680 /* First check that the target variable exists */
10681 Jim_Obj *objPtr;
10682 Jim_CallFrame *savedCallFrame = interp->framePtr;
10684 interp->framePtr = interp->framePtr->parent;
10685 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10686 interp->framePtr = savedCallFrame;
10687 if (!objPtr) {
10688 return JIM_ERR;
10691 /* It exists, so perform the binding. */
10692 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10693 Jim_IncrRefCount(objPtr);
10694 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10695 Jim_DecrRefCount(interp, objPtr);
10697 else {
10698 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10700 return retcode;
10704 * Sets the interp result to be an error message indicating the required proc args.
10706 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10708 /* Create a nice error message, consistent with Tcl 8.5 */
10709 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10710 int i;
10712 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10713 Jim_AppendString(interp, argmsg, " ", 1);
10715 if (i == cmd->u.proc.argsPos) {
10716 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10717 /* Renamed args */
10718 Jim_AppendString(interp, argmsg, "?", 1);
10719 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10720 Jim_AppendString(interp, argmsg, " ...?", -1);
10722 else {
10723 /* We have plain args */
10724 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10727 else {
10728 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10729 Jim_AppendString(interp, argmsg, "?", 1);
10730 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10731 Jim_AppendString(interp, argmsg, "?", 1);
10733 else {
10734 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10735 if (*arg == '&') {
10736 arg++;
10738 Jim_AppendString(interp, argmsg, arg, -1);
10742 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10743 Jim_FreeNewObj(interp, argmsg);
10746 #ifdef jim_ext_namespace
10748 * [namespace eval]
10750 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10752 Jim_CallFrame *callFramePtr;
10753 int retcode;
10755 /* Create a new callframe */
10756 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10757 callFramePtr->argv = &interp->emptyObj;
10758 callFramePtr->argc = 0;
10759 callFramePtr->procArgsObjPtr = NULL;
10760 callFramePtr->procBodyObjPtr = scriptObj;
10761 callFramePtr->staticVars = NULL;
10762 callFramePtr->fileNameObj = interp->emptyObj;
10763 callFramePtr->line = 0;
10764 Jim_IncrRefCount(scriptObj);
10765 interp->framePtr = callFramePtr;
10767 /* Check if there are too nested calls */
10768 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10769 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10770 retcode = JIM_ERR;
10772 else {
10773 /* Eval the body */
10774 retcode = Jim_EvalObj(interp, scriptObj);
10777 /* Destroy the callframe */
10778 interp->framePtr = interp->framePtr->parent;
10779 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10780 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10782 else {
10783 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10786 return retcode;
10788 #endif
10790 /* Call a procedure implemented in Tcl.
10791 * It's possible to speed-up a lot this function, currently
10792 * the callframes are not cached, but allocated and
10793 * destroied every time. What is expecially costly is
10794 * to create/destroy the local vars hash table every time.
10796 * This can be fixed just implementing callframes caching
10797 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10798 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10800 Jim_CallFrame *callFramePtr;
10801 int i, d, retcode, optargs;
10802 ScriptObj *script;
10804 /* Check arity */
10805 if (argc - 1 < cmd->u.proc.reqArity ||
10806 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10807 JimSetProcWrongArgs(interp, argv[0], cmd);
10808 return JIM_ERR;
10811 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10812 /* Optimise for procedure with no body - useful for optional debugging */
10813 return JIM_OK;
10816 /* Check if there are too nested calls */
10817 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10818 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10819 return JIM_ERR;
10822 /* Create a new callframe */
10823 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10824 callFramePtr->argv = argv;
10825 callFramePtr->argc = argc;
10826 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10827 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10828 callFramePtr->staticVars = cmd->u.proc.staticVars;
10830 /* Remember where we were called from. */
10831 script = Jim_GetScript(interp, interp->currentScriptObj);
10832 callFramePtr->fileNameObj = script->fileNameObj;
10833 callFramePtr->line = script->linenr;
10835 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10836 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10837 interp->framePtr = callFramePtr;
10839 /* How many optional args are available */
10840 optargs = (argc - 1 - cmd->u.proc.reqArity);
10842 /* Step 'i' along the actual args, and step 'd' along the formal args */
10843 i = 1;
10844 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10845 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10846 if (d == cmd->u.proc.argsPos) {
10847 /* assign $args */
10848 Jim_Obj *listObjPtr;
10849 int argsLen = 0;
10850 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10851 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10853 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10855 /* It is possible to rename args. */
10856 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10857 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10859 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10860 if (retcode != JIM_OK) {
10861 goto badargset;
10864 i += argsLen;
10865 continue;
10868 /* Optional or required? */
10869 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10870 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10872 else {
10873 /* Ran out, so use the default */
10874 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10876 if (retcode != JIM_OK) {
10877 goto badargset;
10881 /* Eval the body */
10882 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10884 badargset:
10886 /* Free the callframe */
10887 interp->framePtr = interp->framePtr->parent;
10889 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10890 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10892 else {
10893 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10896 if (interp->framePtr->tailcallObj) {
10897 /* If a tailcall is already being executed, merge this tailcall with that one */
10898 if (interp->framePtr->tailcall++ == 0) {
10899 /* No current tailcall in this frame, so invoke the tailcall command */
10900 do {
10901 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10903 interp->framePtr->tailcallObj = NULL;
10905 if (retcode == JIM_EVAL) {
10906 retcode = Jim_EvalObjList(interp, tailcallObj);
10907 if (retcode == JIM_RETURN) {
10908 /* If the result of the tailcall is 'return', push
10909 * it up to the caller
10911 interp->returnLevel++;
10914 Jim_DecrRefCount(interp, tailcallObj);
10915 } while (interp->framePtr->tailcallObj);
10917 /* If the tailcall chain finished early, may need to manually discard the command */
10918 if (interp->framePtr->tailcallCmd) {
10919 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10920 interp->framePtr->tailcallCmd = NULL;
10923 interp->framePtr->tailcall--;
10926 /* Handle the JIM_RETURN return code */
10927 if (retcode == JIM_RETURN) {
10928 if (--interp->returnLevel <= 0) {
10929 retcode = interp->returnCode;
10930 interp->returnCode = JIM_OK;
10931 interp->returnLevel = 0;
10934 else if (retcode == JIM_ERR) {
10935 interp->addStackTrace++;
10936 Jim_DecrRefCount(interp, interp->errorProc);
10937 interp->errorProc = argv[0];
10938 Jim_IncrRefCount(interp->errorProc);
10941 return retcode;
10944 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10946 int retval;
10947 Jim_Obj *scriptObjPtr;
10949 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10950 Jim_IncrRefCount(scriptObjPtr);
10952 if (filename) {
10953 Jim_Obj *prevScriptObj;
10955 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10957 prevScriptObj = interp->currentScriptObj;
10958 interp->currentScriptObj = scriptObjPtr;
10960 retval = Jim_EvalObj(interp, scriptObjPtr);
10962 interp->currentScriptObj = prevScriptObj;
10964 else {
10965 retval = Jim_EvalObj(interp, scriptObjPtr);
10967 Jim_DecrRefCount(interp, scriptObjPtr);
10968 return retval;
10971 int Jim_Eval(Jim_Interp *interp, const char *script)
10973 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10976 /* Execute script in the scope of the global level */
10977 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10979 int retval;
10980 Jim_CallFrame *savedFramePtr = interp->framePtr;
10982 interp->framePtr = interp->topFramePtr;
10983 retval = Jim_Eval(interp, script);
10984 interp->framePtr = savedFramePtr;
10986 return retval;
10989 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10991 int retval;
10992 Jim_CallFrame *savedFramePtr = interp->framePtr;
10994 interp->framePtr = interp->topFramePtr;
10995 retval = Jim_EvalFile(interp, filename);
10996 interp->framePtr = savedFramePtr;
10998 return retval;
11001 #include <sys/stat.h>
11003 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11005 FILE *fp;
11006 char *buf;
11007 Jim_Obj *scriptObjPtr;
11008 Jim_Obj *prevScriptObj;
11009 struct stat sb;
11010 int retcode;
11011 int readlen;
11012 struct JimParseResult result;
11014 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11015 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11016 return JIM_ERR;
11018 if (sb.st_size == 0) {
11019 fclose(fp);
11020 return JIM_OK;
11023 buf = Jim_Alloc(sb.st_size + 1);
11024 readlen = fread(buf, 1, sb.st_size, fp);
11025 if (ferror(fp)) {
11026 fclose(fp);
11027 Jim_Free(buf);
11028 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11029 return JIM_ERR;
11031 fclose(fp);
11032 buf[readlen] = 0;
11034 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11035 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11036 Jim_IncrRefCount(scriptObjPtr);
11038 /* Now check the script for unmatched braces, etc. */
11039 if (SetScriptFromAny(interp, scriptObjPtr, &result) == JIM_ERR) {
11040 const char *msg;
11041 char linebuf[20];
11043 switch (result.missing) {
11044 case '[':
11045 msg = "unmatched \"[\"";
11046 break;
11047 case '{':
11048 msg = "missing close-brace";
11049 break;
11050 case '"':
11051 default:
11052 msg = "missing quote";
11053 break;
11056 snprintf(linebuf, sizeof(linebuf), "%d", result.line);
11058 Jim_SetResultFormatted(interp, "%s in \"%s\" at line %s",
11059 msg, filename, linebuf);
11060 Jim_DecrRefCount(interp, scriptObjPtr);
11061 return JIM_ERR;
11064 prevScriptObj = interp->currentScriptObj;
11065 interp->currentScriptObj = scriptObjPtr;
11067 retcode = Jim_EvalObj(interp, scriptObjPtr);
11069 /* Handle the JIM_RETURN return code */
11070 if (retcode == JIM_RETURN) {
11071 if (--interp->returnLevel <= 0) {
11072 retcode = interp->returnCode;
11073 interp->returnCode = JIM_OK;
11074 interp->returnLevel = 0;
11077 if (retcode == JIM_ERR) {
11078 /* EvalFile changes context, so add a stack frame here */
11079 interp->addStackTrace++;
11082 interp->currentScriptObj = prevScriptObj;
11084 Jim_DecrRefCount(interp, scriptObjPtr);
11086 return retcode;
11089 /* -----------------------------------------------------------------------------
11090 * Subst
11091 * ---------------------------------------------------------------------------*/
11092 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11094 pc->tstart = pc->p;
11095 pc->tline = pc->linenr;
11097 if (pc->len == 0) {
11098 pc->tend = pc->p;
11099 pc->tt = JIM_TT_EOL;
11100 pc->eof = 1;
11101 return;
11103 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11104 JimParseCmd(pc);
11105 return;
11107 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11108 if (JimParseVar(pc) == JIM_OK) {
11109 return;
11111 /* Not a var, so treat as a string */
11112 pc->tstart = pc->p;
11113 flags |= JIM_SUBST_NOVAR;
11115 while (pc->len) {
11116 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11117 break;
11119 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11120 break;
11122 if (*pc->p == '\\' && pc->len > 1) {
11123 pc->p++;
11124 pc->len--;
11126 pc->p++;
11127 pc->len--;
11129 pc->tend = pc->p - 1;
11130 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11133 /* The subst object type reuses most of the data structures and functions
11134 * of the script object. Script's data structures are a bit more complex
11135 * for what is needed for [subst]itution tasks, but the reuse helps to
11136 * deal with a single data structure at the cost of some more memory
11137 * usage for substitutions. */
11139 /* This method takes the string representation of an object
11140 * as a Tcl string where to perform [subst]itution, and generates
11141 * the pre-parsed internal representation. */
11142 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11144 int scriptTextLen;
11145 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11146 struct JimParserCtx parser;
11147 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11148 ParseTokenList tokenlist;
11150 /* Initially parse the subst into tokens (in tokenlist) */
11151 ScriptTokenListInit(&tokenlist);
11153 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11154 while (1) {
11155 JimParseSubst(&parser, flags);
11156 if (parser.eof) {
11157 /* Note that subst doesn't need the EOL token */
11158 break;
11160 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11161 parser.tline);
11164 /* Create the "real" subst/script tokens from the initial token list */
11165 script->inUse = 1;
11166 script->substFlags = flags;
11167 script->fileNameObj = interp->emptyObj;
11168 Jim_IncrRefCount(script->fileNameObj);
11169 SubstObjAddTokens(interp, script, &tokenlist);
11171 /* No longer need the token list */
11172 ScriptTokenListFree(&tokenlist);
11174 #ifdef DEBUG_SHOW_SUBST
11176 int i;
11178 printf("==== Subst ====\n");
11179 for (i = 0; i < script->len; i++) {
11180 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11181 Jim_String(script->token[i].objPtr));
11184 #endif
11186 /* Free the old internal rep and set the new one. */
11187 Jim_FreeIntRep(interp, objPtr);
11188 Jim_SetIntRepPtr(objPtr, script);
11189 objPtr->typePtr = &scriptObjType;
11190 return JIM_OK;
11193 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11195 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11196 SetSubstFromAny(interp, objPtr, flags);
11197 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11200 /* Performs commands,variables,blackslashes substitution,
11201 * storing the result object (with refcount 0) into
11202 * resObjPtrPtr. */
11203 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11205 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11207 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11208 /* In order to preserve the internal rep, we increment the
11209 * inUse field of the script internal rep structure. */
11210 script->inUse++;
11212 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11214 script->inUse--;
11215 Jim_DecrRefCount(interp, substObjPtr);
11216 if (*resObjPtrPtr == NULL) {
11217 return JIM_ERR;
11219 return JIM_OK;
11222 /* -----------------------------------------------------------------------------
11223 * Core commands utility functions
11224 * ---------------------------------------------------------------------------*/
11225 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11227 Jim_Obj *objPtr;
11228 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11230 if (*msg) {
11231 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11233 Jim_IncrRefCount(listObjPtr);
11234 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11235 Jim_DecrRefCount(interp, listObjPtr);
11237 Jim_IncrRefCount(objPtr);
11238 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11239 Jim_DecrRefCount(interp, objPtr);
11243 * May add the key and/or value to the list.
11245 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11246 Jim_HashEntry *he, int type);
11248 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11251 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11252 * invoke the callback to add entries to a list.
11253 * Returns the list.
11255 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11256 JimHashtableIteratorCallbackType *callback, int type)
11258 Jim_HashEntry *he;
11259 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11261 /* Check for the non-pattern case. We can do this much more efficiently. */
11262 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11263 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11264 if (he) {
11265 callback(interp, listObjPtr, he, type);
11268 else {
11269 Jim_HashTableIterator htiter;
11270 JimInitHashTableIterator(ht, &htiter);
11271 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11272 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11273 callback(interp, listObjPtr, he, type);
11277 return listObjPtr;
11280 /* Keep these in order */
11281 #define JIM_CMDLIST_COMMANDS 0
11282 #define JIM_CMDLIST_PROCS 1
11283 #define JIM_CMDLIST_CHANNELS 2
11286 * Adds matching command names (procs, channels) to the list.
11288 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11289 Jim_HashEntry *he, int type)
11291 Jim_Cmd *cmdPtr = (Jim_Cmd *)he->u.val;
11292 Jim_Obj *objPtr;
11294 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11295 /* not a proc */
11296 return;
11299 objPtr = Jim_NewStringObj(interp, he->key, -1);
11300 Jim_IncrRefCount(objPtr);
11302 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11303 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11305 Jim_DecrRefCount(interp, objPtr);
11308 /* type is JIM_CMDLIST_xxx */
11309 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11311 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11314 /* Keep these in order */
11315 #define JIM_VARLIST_GLOBALS 0
11316 #define JIM_VARLIST_LOCALS 1
11317 #define JIM_VARLIST_VARS 2
11319 #define JIM_VARLIST_VALUES 0x1000
11322 * Adds matching variable names to the list.
11324 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11325 Jim_HashEntry *he, int type)
11327 Jim_Var *varPtr = (Jim_Var *)he->u.val;
11329 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11330 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11331 if (type & JIM_VARLIST_VALUES) {
11332 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11337 /* mode is JIM_VARLIST_xxx */
11338 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11340 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11341 /* For [info locals], if we are at top level an emtpy list
11342 * is returned. I don't agree, but we aim at compatibility (SS) */
11343 return interp->emptyObj;
11345 else {
11346 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11347 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11351 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11352 Jim_Obj **objPtrPtr, int info_level_cmd)
11354 Jim_CallFrame *targetCallFrame;
11356 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11357 if (targetCallFrame == NULL) {
11358 return JIM_ERR;
11360 /* No proc call at toplevel callframe */
11361 if (targetCallFrame == interp->topFramePtr) {
11362 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11363 return JIM_ERR;
11365 if (info_level_cmd) {
11366 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11368 else {
11369 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11371 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11372 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11373 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11374 *objPtrPtr = listObj;
11376 return JIM_OK;
11379 /* -----------------------------------------------------------------------------
11380 * Core commands
11381 * ---------------------------------------------------------------------------*/
11383 /* fake [puts] -- not the real puts, just for debugging. */
11384 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11386 if (argc != 2 && argc != 3) {
11387 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11388 return JIM_ERR;
11390 if (argc == 3) {
11391 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11392 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11393 return JIM_ERR;
11395 else {
11396 fputs(Jim_String(argv[2]), stdout);
11399 else {
11400 puts(Jim_String(argv[1]));
11402 return JIM_OK;
11405 /* Helper for [+] and [*] */
11406 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11408 jim_wide wideValue, res;
11409 double doubleValue, doubleRes;
11410 int i;
11412 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11414 for (i = 1; i < argc; i++) {
11415 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11416 goto trydouble;
11417 if (op == JIM_EXPROP_ADD)
11418 res += wideValue;
11419 else
11420 res *= wideValue;
11422 Jim_SetResultInt(interp, res);
11423 return JIM_OK;
11424 trydouble:
11425 doubleRes = (double)res;
11426 for (; i < argc; i++) {
11427 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11428 return JIM_ERR;
11429 if (op == JIM_EXPROP_ADD)
11430 doubleRes += doubleValue;
11431 else
11432 doubleRes *= doubleValue;
11434 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11435 return JIM_OK;
11438 /* Helper for [-] and [/] */
11439 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11441 jim_wide wideValue, res = 0;
11442 double doubleValue, doubleRes = 0;
11443 int i = 2;
11445 if (argc < 2) {
11446 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11447 return JIM_ERR;
11449 else if (argc == 2) {
11450 /* The arity = 2 case is different. For [- x] returns -x,
11451 * while [/ x] returns 1/x. */
11452 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11453 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11454 return JIM_ERR;
11456 else {
11457 if (op == JIM_EXPROP_SUB)
11458 doubleRes = -doubleValue;
11459 else
11460 doubleRes = 1.0 / doubleValue;
11461 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11462 return JIM_OK;
11465 if (op == JIM_EXPROP_SUB) {
11466 res = -wideValue;
11467 Jim_SetResultInt(interp, res);
11469 else {
11470 doubleRes = 1.0 / wideValue;
11471 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11473 return JIM_OK;
11475 else {
11476 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11477 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11478 != JIM_OK) {
11479 return JIM_ERR;
11481 else {
11482 goto trydouble;
11486 for (i = 2; i < argc; i++) {
11487 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11488 doubleRes = (double)res;
11489 goto trydouble;
11491 if (op == JIM_EXPROP_SUB)
11492 res -= wideValue;
11493 else
11494 res /= wideValue;
11496 Jim_SetResultInt(interp, res);
11497 return JIM_OK;
11498 trydouble:
11499 for (; i < argc; i++) {
11500 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11501 return JIM_ERR;
11502 if (op == JIM_EXPROP_SUB)
11503 doubleRes -= doubleValue;
11504 else
11505 doubleRes /= doubleValue;
11507 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11508 return JIM_OK;
11512 /* [+] */
11513 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11515 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11518 /* [*] */
11519 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11521 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11524 /* [-] */
11525 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11527 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11530 /* [/] */
11531 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11533 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11536 /* [set] */
11537 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11539 if (argc != 2 && argc != 3) {
11540 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11541 return JIM_ERR;
11543 if (argc == 2) {
11544 Jim_Obj *objPtr;
11546 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11547 if (!objPtr)
11548 return JIM_ERR;
11549 Jim_SetResult(interp, objPtr);
11550 return JIM_OK;
11552 /* argc == 3 case. */
11553 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11554 return JIM_ERR;
11555 Jim_SetResult(interp, argv[2]);
11556 return JIM_OK;
11559 /* [unset]
11561 * unset ?-nocomplain? ?--? ?varName ...?
11563 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11565 int i = 1;
11566 int complain = 1;
11568 while (i < argc) {
11569 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11570 i++;
11571 break;
11573 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11574 complain = 0;
11575 i++;
11576 continue;
11578 break;
11581 while (i < argc) {
11582 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11583 && complain) {
11584 return JIM_ERR;
11586 i++;
11588 return JIM_OK;
11591 /* [while] */
11592 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11594 if (argc != 3) {
11595 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11596 return JIM_ERR;
11599 /* The general purpose implementation of while starts here */
11600 while (1) {
11601 int boolean, retval;
11603 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11604 return retval;
11605 if (!boolean)
11606 break;
11608 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11609 switch (retval) {
11610 case JIM_BREAK:
11611 goto out;
11612 break;
11613 case JIM_CONTINUE:
11614 continue;
11615 break;
11616 default:
11617 return retval;
11621 out:
11622 Jim_SetEmptyResult(interp);
11623 return JIM_OK;
11626 /* [for] */
11627 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11629 int retval;
11630 int boolean = 1;
11631 Jim_Obj *varNamePtr = NULL;
11632 Jim_Obj *stopVarNamePtr = NULL;
11634 if (argc != 5) {
11635 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11636 return JIM_ERR;
11639 /* Do the initialisation */
11640 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11641 return retval;
11644 /* And do the first test now. Better for optimisation
11645 * if we can do next/test at the bottom of the loop
11647 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11649 /* Ready to do the body as follows:
11650 * while (1) {
11651 * body // check retcode
11652 * next // check retcode
11653 * test // check retcode/test bool
11657 #ifdef JIM_OPTIMIZATION
11658 /* Check if the for is on the form:
11659 * for ... {$i < CONST} {incr i}
11660 * for ... {$i < $j} {incr i}
11662 if (retval == JIM_OK && boolean) {
11663 ScriptObj *incrScript;
11664 ExprByteCode *expr;
11665 jim_wide stop, currentVal;
11666 Jim_Obj *objPtr;
11667 int cmpOffset;
11669 /* Do it only if there aren't shared arguments */
11670 expr = JimGetExpression(interp, argv[2]);
11671 incrScript = Jim_GetScript(interp, argv[3]);
11673 /* Ensure proper lengths to start */
11674 if (incrScript->len != 3 || !expr || expr->len != 3) {
11675 goto evalstart;
11677 /* Ensure proper token types. */
11678 if (incrScript->token[1].type != JIM_TT_ESC ||
11679 expr->token[0].type != JIM_TT_VAR ||
11680 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11681 goto evalstart;
11684 if (expr->token[2].type == JIM_EXPROP_LT) {
11685 cmpOffset = 0;
11687 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11688 cmpOffset = 1;
11690 else {
11691 goto evalstart;
11694 /* Update command must be incr */
11695 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11696 goto evalstart;
11699 /* incr, expression must be about the same variable */
11700 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11701 goto evalstart;
11704 /* Get the stop condition (must be a variable or integer) */
11705 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11706 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11707 goto evalstart;
11710 else {
11711 stopVarNamePtr = expr->token[1].objPtr;
11712 Jim_IncrRefCount(stopVarNamePtr);
11713 /* Keep the compiler happy */
11714 stop = 0;
11717 /* Initialization */
11718 varNamePtr = expr->token[0].objPtr;
11719 Jim_IncrRefCount(varNamePtr);
11721 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11722 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11723 goto testcond;
11726 /* --- OPTIMIZED FOR --- */
11727 while (retval == JIM_OK) {
11728 /* === Check condition === */
11729 /* Note that currentVal is already set here */
11731 /* Immediate or Variable? get the 'stop' value if the latter. */
11732 if (stopVarNamePtr) {
11733 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11734 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11735 goto testcond;
11739 if (currentVal >= stop + cmpOffset) {
11740 break;
11743 /* Eval body */
11744 retval = Jim_EvalObj(interp, argv[4]);
11745 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11746 retval = JIM_OK;
11748 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11750 /* Increment */
11751 if (objPtr == NULL) {
11752 retval = JIM_ERR;
11753 goto out;
11755 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11756 currentVal = ++JimWideValue(objPtr);
11757 Jim_InvalidateStringRep(objPtr);
11759 else {
11760 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11761 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11762 ++currentVal)) != JIM_OK) {
11763 goto evalnext;
11768 goto out;
11770 evalstart:
11771 #endif
11773 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11774 /* Body */
11775 retval = Jim_EvalObj(interp, argv[4]);
11777 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11778 /* increment */
11779 evalnext:
11780 retval = Jim_EvalObj(interp, argv[3]);
11781 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11782 /* test */
11783 testcond:
11784 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11788 out:
11789 if (stopVarNamePtr) {
11790 Jim_DecrRefCount(interp, stopVarNamePtr);
11792 if (varNamePtr) {
11793 Jim_DecrRefCount(interp, varNamePtr);
11796 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11797 Jim_SetEmptyResult(interp);
11798 return JIM_OK;
11801 return retval;
11804 /* [loop] */
11805 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11807 int retval;
11808 jim_wide i;
11809 jim_wide limit;
11810 jim_wide incr = 1;
11811 Jim_Obj *bodyObjPtr;
11813 if (argc != 5 && argc != 6) {
11814 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11815 return JIM_ERR;
11818 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11819 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11820 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11821 return JIM_ERR;
11823 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11825 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11827 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11828 retval = Jim_EvalObj(interp, bodyObjPtr);
11829 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11830 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11832 retval = JIM_OK;
11834 /* Increment */
11835 i += incr;
11837 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11838 if (argv[1]->typePtr != &variableObjType) {
11839 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11840 return JIM_ERR;
11843 JimWideValue(objPtr) = i;
11844 Jim_InvalidateStringRep(objPtr);
11846 /* The following step is required in order to invalidate the
11847 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11848 if (argv[1]->typePtr != &variableObjType) {
11849 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11850 retval = JIM_ERR;
11851 break;
11855 else {
11856 objPtr = Jim_NewIntObj(interp, i);
11857 retval = Jim_SetVariable(interp, argv[1], objPtr);
11858 if (retval != JIM_OK) {
11859 Jim_FreeNewObj(interp, objPtr);
11865 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11866 Jim_SetEmptyResult(interp);
11867 return JIM_OK;
11869 return retval;
11872 /* List iterators make it easy to iterate over a list.
11873 * At some point iterators will be expanded to support generators.
11875 typedef struct {
11876 Jim_Obj *objPtr;
11877 int idx;
11878 } Jim_ListIter;
11881 * Initialise the iterator at the start of the list.
11883 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11885 iter->objPtr = objPtr;
11886 iter->idx = 0;
11890 * Returns the next object from the list, or NULL on end-of-list.
11892 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11894 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11895 return NULL;
11897 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11901 * Returns 1 if end-of-list has been reached.
11903 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11905 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11908 /* foreach + lmap implementation. */
11909 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11911 int result = JIM_ERR;
11912 int i, numargs;
11913 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11914 Jim_ListIter *iters;
11915 Jim_Obj *script;
11916 Jim_Obj *resultObj;
11918 if (argc < 4 || argc % 2 != 0) {
11919 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11920 return JIM_ERR;
11922 script = argv[argc - 1]; /* Last argument is a script */
11923 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11925 if (numargs == 2) {
11926 iters = twoiters;
11928 else {
11929 iters = Jim_Alloc(numargs * sizeof(*iters));
11931 for (i = 0; i < numargs; i++) {
11932 JimListIterInit(&iters[i], argv[i + 1]);
11933 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11934 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11935 return JIM_ERR;
11939 if (doMap) {
11940 resultObj = Jim_NewListObj(interp, NULL, 0);
11942 else {
11943 resultObj = interp->emptyObj;
11945 Jim_IncrRefCount(resultObj);
11947 while (1) {
11948 /* Have we expired all lists? */
11949 for (i = 0; i < numargs; i += 2) {
11950 if (!JimListIterDone(interp, &iters[i + 1])) {
11951 break;
11954 if (i == numargs) {
11955 /* All done */
11956 break;
11959 /* For each list */
11960 for (i = 0; i < numargs; i += 2) {
11961 Jim_Obj *varName;
11963 /* foreach var */
11964 JimListIterInit(&iters[i], argv[i + 1]);
11965 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11966 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11967 if (!valObj) {
11968 /* Ran out, so store the empty string */
11969 valObj = interp->emptyObj;
11971 /* Avoid shimmering */
11972 Jim_IncrRefCount(valObj);
11973 result = Jim_SetVariable(interp, varName, valObj);
11974 Jim_DecrRefCount(interp, valObj);
11975 if (result != JIM_OK) {
11976 goto err;
11980 switch (result = Jim_EvalObj(interp, script)) {
11981 case JIM_OK:
11982 if (doMap) {
11983 Jim_ListAppendElement(interp, resultObj, interp->result);
11985 break;
11986 case JIM_CONTINUE:
11987 break;
11988 case JIM_BREAK:
11989 goto out;
11990 default:
11991 goto err;
11994 out:
11995 result = JIM_OK;
11996 Jim_SetResult(interp, resultObj);
11997 err:
11998 Jim_DecrRefCount(interp, resultObj);
11999 if (numargs > 2) {
12000 Jim_Free(iters);
12002 return result;
12005 /* [foreach] */
12006 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12008 return JimForeachMapHelper(interp, argc, argv, 0);
12011 /* [lmap] */
12012 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12014 return JimForeachMapHelper(interp, argc, argv, 1);
12017 /* [lassign] */
12018 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12020 int result = JIM_ERR;
12021 int i;
12022 Jim_ListIter iter;
12023 Jim_Obj *resultObj;
12025 if (argc < 2) {
12026 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12027 return JIM_ERR;
12030 JimListIterInit(&iter, argv[1]);
12032 for (i = 2; i < argc; i++) {
12033 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12034 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12035 if (result != JIM_OK) {
12036 return result;
12040 resultObj = Jim_NewListObj(interp, NULL, 0);
12041 while (!JimListIterDone(interp, &iter)) {
12042 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12045 Jim_SetResult(interp, resultObj);
12047 return JIM_OK;
12050 /* [if] */
12051 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12053 int boolean, retval, current = 1, falsebody = 0;
12055 if (argc >= 3) {
12056 while (1) {
12057 /* Far not enough arguments given! */
12058 if (current >= argc)
12059 goto err;
12060 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12061 != JIM_OK)
12062 return retval;
12063 /* There lacks something, isn't it? */
12064 if (current >= argc)
12065 goto err;
12066 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12067 current++;
12068 /* Tsk tsk, no then-clause? */
12069 if (current >= argc)
12070 goto err;
12071 if (boolean)
12072 return Jim_EvalObj(interp, argv[current]);
12073 /* Ok: no else-clause follows */
12074 if (++current >= argc) {
12075 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12076 return JIM_OK;
12078 falsebody = current++;
12079 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12080 /* IIICKS - else-clause isn't last cmd? */
12081 if (current != argc - 1)
12082 goto err;
12083 return Jim_EvalObj(interp, argv[current]);
12085 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12086 /* Ok: elseif follows meaning all the stuff
12087 * again (how boring...) */
12088 continue;
12089 /* OOPS - else-clause is not last cmd? */
12090 else if (falsebody != argc - 1)
12091 goto err;
12092 return Jim_EvalObj(interp, argv[falsebody]);
12094 return JIM_OK;
12096 err:
12097 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12098 return JIM_ERR;
12102 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12103 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12104 Jim_Obj *stringObj, int nocase)
12106 Jim_Obj *parms[4];
12107 int argc = 0;
12108 long eq;
12109 int rc;
12111 parms[argc++] = commandObj;
12112 if (nocase) {
12113 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12115 parms[argc++] = patternObj;
12116 parms[argc++] = stringObj;
12118 rc = Jim_EvalObjVector(interp, argc, parms);
12120 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12121 eq = -rc;
12124 return eq;
12127 enum
12128 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12130 /* [switch] */
12131 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12133 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12134 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12135 Jim_Obj *script = 0;
12137 if (argc < 3) {
12138 wrongnumargs:
12139 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12140 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12141 return JIM_ERR;
12143 for (opt = 1; opt < argc; ++opt) {
12144 const char *option = Jim_String(argv[opt]);
12146 if (*option != '-')
12147 break;
12148 else if (strncmp(option, "--", 2) == 0) {
12149 ++opt;
12150 break;
12152 else if (strncmp(option, "-exact", 2) == 0)
12153 matchOpt = SWITCH_EXACT;
12154 else if (strncmp(option, "-glob", 2) == 0)
12155 matchOpt = SWITCH_GLOB;
12156 else if (strncmp(option, "-regexp", 2) == 0)
12157 matchOpt = SWITCH_RE;
12158 else if (strncmp(option, "-command", 2) == 0) {
12159 matchOpt = SWITCH_CMD;
12160 if ((argc - opt) < 2)
12161 goto wrongnumargs;
12162 command = argv[++opt];
12164 else {
12165 Jim_SetResultFormatted(interp,
12166 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12167 argv[opt]);
12168 return JIM_ERR;
12170 if ((argc - opt) < 2)
12171 goto wrongnumargs;
12173 strObj = argv[opt++];
12174 patCount = argc - opt;
12175 if (patCount == 1) {
12176 Jim_Obj **vector;
12178 JimListGetElements(interp, argv[opt], &patCount, &vector);
12179 caseList = vector;
12181 else
12182 caseList = &argv[opt];
12183 if (patCount == 0 || patCount % 2 != 0)
12184 goto wrongnumargs;
12185 for (i = 0; script == 0 && i < patCount; i += 2) {
12186 Jim_Obj *patObj = caseList[i];
12188 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12189 || i < (patCount - 2)) {
12190 switch (matchOpt) {
12191 case SWITCH_EXACT:
12192 if (Jim_StringEqObj(strObj, patObj))
12193 script = caseList[i + 1];
12194 break;
12195 case SWITCH_GLOB:
12196 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12197 script = caseList[i + 1];
12198 break;
12199 case SWITCH_RE:
12200 command = Jim_NewStringObj(interp, "regexp", -1);
12201 /* Fall thru intentionally */
12202 case SWITCH_CMD:{
12203 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12205 /* After the execution of a command we need to
12206 * make sure to reconvert the object into a list
12207 * again. Only for the single-list style [switch]. */
12208 if (argc - opt == 1) {
12209 Jim_Obj **vector;
12211 JimListGetElements(interp, argv[opt], &patCount, &vector);
12212 caseList = vector;
12214 /* command is here already decref'd */
12215 if (rc < 0) {
12216 return -rc;
12218 if (rc)
12219 script = caseList[i + 1];
12220 break;
12224 else {
12225 script = caseList[i + 1];
12228 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12229 script = caseList[i + 1];
12230 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12231 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12232 return JIM_ERR;
12234 Jim_SetEmptyResult(interp);
12235 if (script) {
12236 return Jim_EvalObj(interp, script);
12238 return JIM_OK;
12241 /* [list] */
12242 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12244 Jim_Obj *listObjPtr;
12246 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12247 Jim_SetResult(interp, listObjPtr);
12248 return JIM_OK;
12251 /* [lindex] */
12252 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12254 Jim_Obj *objPtr, *listObjPtr;
12255 int i;
12256 int idx;
12258 if (argc < 3) {
12259 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
12260 return JIM_ERR;
12262 objPtr = argv[1];
12263 Jim_IncrRefCount(objPtr);
12264 for (i = 2; i < argc; i++) {
12265 listObjPtr = objPtr;
12266 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12267 Jim_DecrRefCount(interp, listObjPtr);
12268 return JIM_ERR;
12270 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12271 /* Returns an empty object if the index
12272 * is out of range. */
12273 Jim_DecrRefCount(interp, listObjPtr);
12274 Jim_SetEmptyResult(interp);
12275 return JIM_OK;
12277 Jim_IncrRefCount(objPtr);
12278 Jim_DecrRefCount(interp, listObjPtr);
12280 Jim_SetResult(interp, objPtr);
12281 Jim_DecrRefCount(interp, objPtr);
12282 return JIM_OK;
12285 /* [llength] */
12286 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12288 if (argc != 2) {
12289 Jim_WrongNumArgs(interp, 1, argv, "list");
12290 return JIM_ERR;
12292 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12293 return JIM_OK;
12296 /* [lsearch] */
12297 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12299 static const char * const options[] = {
12300 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12301 NULL
12303 enum
12304 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12305 OPT_COMMAND };
12306 int i;
12307 int opt_bool = 0;
12308 int opt_not = 0;
12309 int opt_nocase = 0;
12310 int opt_all = 0;
12311 int opt_inline = 0;
12312 int opt_match = OPT_EXACT;
12313 int listlen;
12314 int rc = JIM_OK;
12315 Jim_Obj *listObjPtr = NULL;
12316 Jim_Obj *commandObj = NULL;
12318 if (argc < 3) {
12319 wrongargs:
12320 Jim_WrongNumArgs(interp, 1, argv,
12321 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12322 return JIM_ERR;
12325 for (i = 1; i < argc - 2; i++) {
12326 int option;
12328 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12329 return JIM_ERR;
12331 switch (option) {
12332 case OPT_BOOL:
12333 opt_bool = 1;
12334 opt_inline = 0;
12335 break;
12336 case OPT_NOT:
12337 opt_not = 1;
12338 break;
12339 case OPT_NOCASE:
12340 opt_nocase = 1;
12341 break;
12342 case OPT_INLINE:
12343 opt_inline = 1;
12344 opt_bool = 0;
12345 break;
12346 case OPT_ALL:
12347 opt_all = 1;
12348 break;
12349 case OPT_COMMAND:
12350 if (i >= argc - 2) {
12351 goto wrongargs;
12353 commandObj = argv[++i];
12354 /* fallthru */
12355 case OPT_EXACT:
12356 case OPT_GLOB:
12357 case OPT_REGEXP:
12358 opt_match = option;
12359 break;
12363 argv += i;
12365 if (opt_all) {
12366 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12368 if (opt_match == OPT_REGEXP) {
12369 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12371 if (commandObj) {
12372 Jim_IncrRefCount(commandObj);
12375 listlen = Jim_ListLength(interp, argv[0]);
12376 for (i = 0; i < listlen; i++) {
12377 Jim_Obj *objPtr;
12378 int eq = 0;
12380 Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
12381 switch (opt_match) {
12382 case OPT_EXACT:
12383 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12384 break;
12386 case OPT_GLOB:
12387 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12388 break;
12390 case OPT_REGEXP:
12391 case OPT_COMMAND:
12392 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12393 if (eq < 0) {
12394 if (listObjPtr) {
12395 Jim_FreeNewObj(interp, listObjPtr);
12397 rc = JIM_ERR;
12398 goto done;
12400 break;
12403 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12404 if (!eq && opt_bool && opt_not && !opt_all) {
12405 continue;
12408 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12409 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12410 Jim_Obj *resultObj;
12412 if (opt_bool) {
12413 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12415 else if (!opt_inline) {
12416 resultObj = Jim_NewIntObj(interp, i);
12418 else {
12419 resultObj = objPtr;
12422 if (opt_all) {
12423 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12425 else {
12426 Jim_SetResult(interp, resultObj);
12427 goto done;
12432 if (opt_all) {
12433 Jim_SetResult(interp, listObjPtr);
12435 else {
12436 /* No match */
12437 if (opt_bool) {
12438 Jim_SetResultBool(interp, opt_not);
12440 else if (!opt_inline) {
12441 Jim_SetResultInt(interp, -1);
12445 done:
12446 if (commandObj) {
12447 Jim_DecrRefCount(interp, commandObj);
12449 return rc;
12452 /* [lappend] */
12453 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12455 Jim_Obj *listObjPtr;
12456 int shared, i;
12458 if (argc < 2) {
12459 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12460 return JIM_ERR;
12462 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12463 if (!listObjPtr) {
12464 /* Create the list if it does not exists */
12465 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12466 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12467 Jim_FreeNewObj(interp, listObjPtr);
12468 return JIM_ERR;
12471 shared = Jim_IsShared(listObjPtr);
12472 if (shared)
12473 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12474 for (i = 2; i < argc; i++)
12475 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12476 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12477 if (shared)
12478 Jim_FreeNewObj(interp, listObjPtr);
12479 return JIM_ERR;
12481 Jim_SetResult(interp, listObjPtr);
12482 return JIM_OK;
12485 /* [linsert] */
12486 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12488 int idx, len;
12489 Jim_Obj *listPtr;
12491 if (argc < 3) {
12492 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12493 return JIM_ERR;
12495 listPtr = argv[1];
12496 if (Jim_IsShared(listPtr))
12497 listPtr = Jim_DuplicateObj(interp, listPtr);
12498 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12499 goto err;
12500 len = Jim_ListLength(interp, listPtr);
12501 if (idx >= len)
12502 idx = len;
12503 else if (idx < 0)
12504 idx = len + idx + 1;
12505 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12506 Jim_SetResult(interp, listPtr);
12507 return JIM_OK;
12508 err:
12509 if (listPtr != argv[1]) {
12510 Jim_FreeNewObj(interp, listPtr);
12512 return JIM_ERR;
12515 /* [lreplace] */
12516 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12518 int first, last, len, rangeLen;
12519 Jim_Obj *listObj;
12520 Jim_Obj *newListObj;
12522 if (argc < 4) {
12523 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12524 return JIM_ERR;
12526 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12527 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12528 return JIM_ERR;
12531 listObj = argv[1];
12532 len = Jim_ListLength(interp, listObj);
12534 first = JimRelToAbsIndex(len, first);
12535 last = JimRelToAbsIndex(len, last);
12536 JimRelToAbsRange(len, &first, &last, &rangeLen);
12538 /* Now construct a new list which consists of:
12539 * <elements before first> <supplied elements> <elements after last>
12542 /* Check to see if trying to replace past the end of the list */
12543 if (first < len) {
12544 /* OK. Not past the end */
12546 else if (len == 0) {
12547 /* Special for empty list, adjust first to 0 */
12548 first = 0;
12550 else {
12551 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12552 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12553 return JIM_ERR;
12556 /* Add the first set of elements */
12557 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12559 /* Add supplied elements */
12560 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12562 /* Add the remaining elements */
12563 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12565 Jim_SetResult(interp, newListObj);
12566 return JIM_OK;
12569 /* [lset] */
12570 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12572 if (argc < 3) {
12573 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12574 return JIM_ERR;
12576 else if (argc == 3) {
12577 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12578 return JIM_ERR;
12579 Jim_SetResult(interp, argv[2]);
12580 return JIM_OK;
12582 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1])
12583 == JIM_ERR)
12584 return JIM_ERR;
12585 return JIM_OK;
12588 /* [lsort] */
12589 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12591 static const char * const options[] = {
12592 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12594 enum
12595 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12596 Jim_Obj *resObj;
12597 int i;
12598 int retCode;
12600 struct lsort_info info;
12602 if (argc < 2) {
12603 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12604 return JIM_ERR;
12607 info.type = JIM_LSORT_ASCII;
12608 info.order = 1;
12609 info.indexed = 0;
12610 info.unique = 0;
12611 info.command = NULL;
12612 info.interp = interp;
12614 for (i = 1; i < (argc - 1); i++) {
12615 int option;
12617 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12618 != JIM_OK)
12619 return JIM_ERR;
12620 switch (option) {
12621 case OPT_ASCII:
12622 info.type = JIM_LSORT_ASCII;
12623 break;
12624 case OPT_NOCASE:
12625 info.type = JIM_LSORT_NOCASE;
12626 break;
12627 case OPT_INTEGER:
12628 info.type = JIM_LSORT_INTEGER;
12629 break;
12630 case OPT_REAL:
12631 info.type = JIM_LSORT_REAL;
12632 break;
12633 case OPT_INCREASING:
12634 info.order = 1;
12635 break;
12636 case OPT_DECREASING:
12637 info.order = -1;
12638 break;
12639 case OPT_UNIQUE:
12640 info.unique = 1;
12641 break;
12642 case OPT_COMMAND:
12643 if (i >= (argc - 2)) {
12644 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12645 return JIM_ERR;
12647 info.type = JIM_LSORT_COMMAND;
12648 info.command = argv[i + 1];
12649 i++;
12650 break;
12651 case OPT_INDEX:
12652 if (i >= (argc - 2)) {
12653 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12654 return JIM_ERR;
12656 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12657 return JIM_ERR;
12659 info.indexed = 1;
12660 i++;
12661 break;
12664 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12665 retCode = ListSortElements(interp, resObj, &info);
12666 if (retCode == JIM_OK) {
12667 Jim_SetResult(interp, resObj);
12669 else {
12670 Jim_FreeNewObj(interp, resObj);
12672 return retCode;
12675 /* [append] */
12676 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12678 Jim_Obj *stringObjPtr;
12679 int i;
12681 if (argc < 2) {
12682 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12683 return JIM_ERR;
12685 if (argc == 2) {
12686 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12687 if (!stringObjPtr)
12688 return JIM_ERR;
12690 else {
12691 int freeobj = 0;
12692 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12693 if (!stringObjPtr) {
12694 /* Create the string if it doesn't exist */
12695 stringObjPtr = Jim_NewEmptyStringObj(interp);
12696 freeobj = 1;
12698 else if (Jim_IsShared(stringObjPtr)) {
12699 freeobj = 1;
12700 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12702 for (i = 2; i < argc; i++) {
12703 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12705 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12706 if (freeobj) {
12707 Jim_FreeNewObj(interp, stringObjPtr);
12709 return JIM_ERR;
12712 Jim_SetResult(interp, stringObjPtr);
12713 return JIM_OK;
12716 /* [debug] */
12717 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12719 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12720 static const char * const options[] = {
12721 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12722 "exprbc", "show",
12723 NULL
12725 enum
12727 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12728 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12730 int option;
12732 if (argc < 2) {
12733 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12734 return JIM_ERR;
12736 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12737 return JIM_ERR;
12738 if (option == OPT_REFCOUNT) {
12739 if (argc != 3) {
12740 Jim_WrongNumArgs(interp, 2, argv, "object");
12741 return JIM_ERR;
12743 Jim_SetResultInt(interp, argv[2]->refCount);
12744 return JIM_OK;
12746 else if (option == OPT_OBJCOUNT) {
12747 int freeobj = 0, liveobj = 0;
12748 char buf[256];
12749 Jim_Obj *objPtr;
12751 if (argc != 2) {
12752 Jim_WrongNumArgs(interp, 2, argv, "");
12753 return JIM_ERR;
12755 /* Count the number of free objects. */
12756 objPtr = interp->freeList;
12757 while (objPtr) {
12758 freeobj++;
12759 objPtr = objPtr->nextObjPtr;
12761 /* Count the number of live objects. */
12762 objPtr = interp->liveList;
12763 while (objPtr) {
12764 liveobj++;
12765 objPtr = objPtr->nextObjPtr;
12767 /* Set the result string and return. */
12768 sprintf(buf, "free %d used %d", freeobj, liveobj);
12769 Jim_SetResultString(interp, buf, -1);
12770 return JIM_OK;
12772 else if (option == OPT_OBJECTS) {
12773 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12775 /* Count the number of live objects. */
12776 objPtr = interp->liveList;
12777 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12778 while (objPtr) {
12779 char buf[128];
12780 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12782 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12783 sprintf(buf, "%p", objPtr);
12784 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12785 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12786 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12787 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12788 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12789 objPtr = objPtr->nextObjPtr;
12791 Jim_SetResult(interp, listObjPtr);
12792 return JIM_OK;
12794 else if (option == OPT_INVSTR) {
12795 Jim_Obj *objPtr;
12797 if (argc != 3) {
12798 Jim_WrongNumArgs(interp, 2, argv, "object");
12799 return JIM_ERR;
12801 objPtr = argv[2];
12802 if (objPtr->typePtr != NULL)
12803 Jim_InvalidateStringRep(objPtr);
12804 Jim_SetEmptyResult(interp);
12805 return JIM_OK;
12807 else if (option == OPT_SHOW) {
12808 const char *s;
12809 int len, charlen;
12811 if (argc != 3) {
12812 Jim_WrongNumArgs(interp, 2, argv, "object");
12813 return JIM_ERR;
12815 s = Jim_GetString(argv[2], &len);
12816 #ifdef JIM_UTF8
12817 charlen = utf8_strlen(s, len);
12818 #else
12819 charlen = len;
12820 #endif
12821 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12822 printf("chars (%d): <<%s>>\n", charlen, s);
12823 printf("bytes (%d):", len);
12824 while (len--) {
12825 printf(" %02x", (unsigned char)*s++);
12827 printf("\n");
12828 return JIM_OK;
12830 else if (option == OPT_SCRIPTLEN) {
12831 ScriptObj *script;
12833 if (argc != 3) {
12834 Jim_WrongNumArgs(interp, 2, argv, "script");
12835 return JIM_ERR;
12837 script = Jim_GetScript(interp, argv[2]);
12838 Jim_SetResultInt(interp, script->len);
12839 return JIM_OK;
12841 else if (option == OPT_EXPRLEN) {
12842 ExprByteCode *expr;
12844 if (argc != 3) {
12845 Jim_WrongNumArgs(interp, 2, argv, "expression");
12846 return JIM_ERR;
12848 expr = JimGetExpression(interp, argv[2]);
12849 if (expr == NULL)
12850 return JIM_ERR;
12851 Jim_SetResultInt(interp, expr->len);
12852 return JIM_OK;
12854 else if (option == OPT_EXPRBC) {
12855 Jim_Obj *objPtr;
12856 ExprByteCode *expr;
12857 int i;
12859 if (argc != 3) {
12860 Jim_WrongNumArgs(interp, 2, argv, "expression");
12861 return JIM_ERR;
12863 expr = JimGetExpression(interp, argv[2]);
12864 if (expr == NULL)
12865 return JIM_ERR;
12866 objPtr = Jim_NewListObj(interp, NULL, 0);
12867 for (i = 0; i < expr->len; i++) {
12868 const char *type;
12869 const Jim_ExprOperator *op;
12870 Jim_Obj *obj = expr->token[i].objPtr;
12872 switch (expr->token[i].type) {
12873 case JIM_TT_EXPR_INT:
12874 type = "int";
12875 break;
12876 case JIM_TT_EXPR_DOUBLE:
12877 type = "double";
12878 break;
12879 case JIM_TT_CMD:
12880 type = "command";
12881 break;
12882 case JIM_TT_VAR:
12883 type = "variable";
12884 break;
12885 case JIM_TT_DICTSUGAR:
12886 type = "dictsugar";
12887 break;
12888 case JIM_TT_EXPRSUGAR:
12889 type = "exprsugar";
12890 break;
12891 case JIM_TT_ESC:
12892 type = "subst";
12893 break;
12894 case JIM_TT_STR:
12895 type = "string";
12896 break;
12897 default:
12898 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12899 if (op == NULL) {
12900 type = "private";
12902 else {
12903 type = "operator";
12905 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12906 break;
12908 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12909 Jim_ListAppendElement(interp, objPtr, obj);
12911 Jim_SetResult(interp, objPtr);
12912 return JIM_OK;
12914 else {
12915 Jim_SetResultString(interp,
12916 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12917 return JIM_ERR;
12919 /* unreached */
12920 #endif /* JIM_BOOTSTRAP */
12921 #if !defined(JIM_DEBUG_COMMAND)
12922 Jim_SetResultString(interp, "unsupported", -1);
12923 return JIM_ERR;
12924 #endif
12927 /* [eval] */
12928 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12930 int rc;
12932 if (argc < 2) {
12933 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12934 return JIM_ERR;
12937 if (argc == 2) {
12938 rc = Jim_EvalObj(interp, argv[1]);
12940 else {
12941 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12944 if (rc == JIM_ERR) {
12945 /* eval is "interesting", so add a stack frame here */
12946 interp->addStackTrace++;
12948 return rc;
12951 /* [uplevel] */
12952 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12954 if (argc >= 2) {
12955 int retcode;
12956 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12957 int savedTailcall;
12958 const char *str;
12960 /* Save the old callframe pointer */
12961 savedCallFrame = interp->framePtr;
12963 /* Lookup the target frame pointer */
12964 str = Jim_String(argv[1]);
12965 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12966 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12967 argc--;
12968 argv++;
12970 else {
12971 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12973 if (targetCallFrame == NULL) {
12974 return JIM_ERR;
12976 if (argc < 2) {
12977 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12978 return JIM_ERR;
12980 /* Eval the code in the target callframe. */
12981 interp->framePtr = targetCallFrame;
12982 /* Can't merge tailcalls across upcall */
12983 savedTailcall = interp->framePtr->tailcall;
12984 interp->framePtr->tailcall = 0;
12985 if (argc == 2) {
12986 retcode = Jim_EvalObj(interp, argv[1]);
12988 else {
12989 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12991 interp->framePtr->tailcall = savedTailcall;
12992 interp->framePtr = savedCallFrame;
12993 return retcode;
12995 else {
12996 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12997 return JIM_ERR;
13001 /* [expr] */
13002 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13004 Jim_Obj *exprResultPtr;
13005 int retcode;
13007 if (argc == 2) {
13008 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
13010 else if (argc > 2) {
13011 Jim_Obj *objPtr;
13013 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13014 Jim_IncrRefCount(objPtr);
13015 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
13016 Jim_DecrRefCount(interp, objPtr);
13018 else {
13019 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13020 return JIM_ERR;
13022 if (retcode != JIM_OK)
13023 return retcode;
13024 Jim_SetResult(interp, exprResultPtr);
13025 Jim_DecrRefCount(interp, exprResultPtr);
13026 return JIM_OK;
13029 /* [break] */
13030 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13032 if (argc != 1) {
13033 Jim_WrongNumArgs(interp, 1, argv, "");
13034 return JIM_ERR;
13036 return JIM_BREAK;
13039 /* [continue] */
13040 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13042 if (argc != 1) {
13043 Jim_WrongNumArgs(interp, 1, argv, "");
13044 return JIM_ERR;
13046 return JIM_CONTINUE;
13049 /* [return] */
13050 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13052 int i;
13053 Jim_Obj *stackTraceObj = NULL;
13054 Jim_Obj *errorCodeObj = NULL;
13055 int returnCode = JIM_OK;
13056 long level = 1;
13058 for (i = 1; i < argc - 1; i += 2) {
13059 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13060 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13061 return JIM_ERR;
13064 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13065 stackTraceObj = argv[i + 1];
13067 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13068 errorCodeObj = argv[i + 1];
13070 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13071 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13072 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13073 return JIM_ERR;
13076 else {
13077 break;
13081 if (i != argc - 1 && i != argc) {
13082 Jim_WrongNumArgs(interp, 1, argv,
13083 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13086 /* If a stack trace is supplied and code is error, set the stack trace */
13087 if (stackTraceObj && returnCode == JIM_ERR) {
13088 JimSetStackTrace(interp, stackTraceObj);
13090 /* If an error code list is supplied, set the global $errorCode */
13091 if (errorCodeObj && returnCode == JIM_ERR) {
13092 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13094 interp->returnCode = returnCode;
13095 interp->returnLevel = level;
13097 if (i == argc - 1) {
13098 Jim_SetResult(interp, argv[i]);
13100 return JIM_RETURN;
13103 /* [tailcall] */
13104 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13106 if (interp->framePtr->level == 0) {
13107 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13108 return JIM_ERR;
13110 else if (argc >= 2) {
13111 /* Need to resolve the tailcall command in the current context */
13112 Jim_CallFrame *cf = interp->framePtr->parent;
13114 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13115 if (cmdPtr == NULL) {
13116 return JIM_ERR;
13119 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13121 /* And stash this pre-resolved command */
13122 JimIncrCmdRefCount(cmdPtr);
13123 cf->tailcallCmd = cmdPtr;
13125 /* And stash the command list */
13126 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13128 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13129 Jim_IncrRefCount(cf->tailcallObj);
13131 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13132 return JIM_EVAL;
13134 return JIM_OK;
13137 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13139 Jim_Obj *cmdList;
13140 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13142 /* prefixListObj is a list to which the args need to be appended */
13143 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13144 ListInsertElements(cmdList, -1, argc - 1, argv + 1);
13146 return JimEvalObjList(interp, cmdList);
13149 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13151 Jim_Obj *prefixListObj = privData;
13152 Jim_DecrRefCount(interp, prefixListObj);
13155 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13157 Jim_Obj *prefixListObj;
13158 const char *newname;
13160 if (argc < 3) {
13161 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13162 return JIM_ERR;
13165 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13166 Jim_IncrRefCount(prefixListObj);
13167 newname = Jim_String(argv[1]);
13168 if (newname[0] == ':' && newname[1] == ':') {
13169 while (*++newname == ':') {
13173 Jim_SetResult(interp, argv[1]);
13175 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13178 /* [proc] */
13179 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13181 Jim_Cmd *cmd;
13183 if (argc != 4 && argc != 5) {
13184 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13185 return JIM_ERR;
13188 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13189 return JIM_ERR;
13192 if (argc == 4) {
13193 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13195 else {
13196 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13199 if (cmd) {
13200 /* Add the new command */
13201 Jim_Obj *qualifiedCmdNameObj;
13202 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13204 JimCreateCommand(interp, cmdname, cmd);
13206 /* Calculate and set the namespace for this proc */
13207 JimUpdateProcNamespace(interp, cmd, cmdname);
13209 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13211 /* Unlike Tcl, set the name of the proc as the result */
13212 Jim_SetResult(interp, argv[1]);
13213 return JIM_OK;
13215 return JIM_ERR;
13218 /* [local] */
13219 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13221 int retcode;
13223 if (argc < 2) {
13224 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13225 return JIM_ERR;
13228 /* Evaluate the arguments with 'local' in force */
13229 interp->local++;
13230 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13231 interp->local--;
13234 /* If OK, and the result is a proc, add it to the list of local procs */
13235 if (retcode == 0) {
13236 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13238 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13239 return JIM_ERR;
13241 if (interp->framePtr->localCommands == NULL) {
13242 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13243 Jim_InitStack(interp->framePtr->localCommands);
13245 Jim_IncrRefCount(cmdNameObj);
13246 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13249 return retcode;
13252 /* [upcall] */
13253 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13255 if (argc < 2) {
13256 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13257 return JIM_ERR;
13259 else {
13260 int retcode;
13262 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13263 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13264 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13265 return JIM_ERR;
13267 /* OK. Mark this command as being in an upcall */
13268 cmdPtr->u.proc.upcall++;
13269 JimIncrCmdRefCount(cmdPtr);
13271 /* Invoke the command as normal */
13272 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13274 /* No longer in an upcall */
13275 cmdPtr->u.proc.upcall--;
13276 JimDecrCmdRefCount(interp, cmdPtr);
13278 return retcode;
13282 /* [apply] */
13283 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13285 if (argc < 2) {
13286 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13287 return JIM_ERR;
13289 else {
13290 int ret;
13291 Jim_Cmd *cmd;
13292 Jim_Obj *argListObjPtr;
13293 Jim_Obj *bodyObjPtr;
13294 Jim_Obj *nsObj = NULL;
13295 Jim_Obj **nargv;
13297 int len = Jim_ListLength(interp, argv[1]);
13298 if (len != 2 && len != 3) {
13299 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13300 return JIM_ERR;
13303 if (len == 3) {
13304 #ifdef jim_ext_namespace
13305 /* Need to canonicalise the given namespace. */
13306 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13307 #else
13308 Jim_SetResultString(interp, "namespaces not enabled", -1);
13309 return JIM_ERR;
13310 #endif
13312 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13313 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13315 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13317 if (cmd) {
13318 /* Create a new argv array with a dummy argv[0], for error messages */
13319 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13320 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13321 Jim_IncrRefCount(nargv[0]);
13322 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13323 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13324 Jim_DecrRefCount(interp, nargv[0]);
13325 Jim_Free(nargv);
13327 JimDecrCmdRefCount(interp, cmd);
13328 return ret;
13330 return JIM_ERR;
13335 /* [concat] */
13336 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13338 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13339 return JIM_OK;
13342 /* [upvar] */
13343 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13345 int i;
13346 Jim_CallFrame *targetCallFrame;
13348 /* Lookup the target frame pointer */
13349 if (argc > 3 && (argc % 2 == 0)) {
13350 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13351 argc--;
13352 argv++;
13354 else {
13355 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13357 if (targetCallFrame == NULL) {
13358 return JIM_ERR;
13361 /* Check for arity */
13362 if (argc < 3) {
13363 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13364 return JIM_ERR;
13367 /* Now... for every other/local couple: */
13368 for (i = 1; i < argc; i += 2) {
13369 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13370 return JIM_ERR;
13372 return JIM_OK;
13375 /* [global] */
13376 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13378 int i;
13380 if (argc < 2) {
13381 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13382 return JIM_ERR;
13384 /* Link every var to the toplevel having the same name */
13385 if (interp->framePtr->level == 0)
13386 return JIM_OK; /* global at toplevel... */
13387 for (i = 1; i < argc; i++) {
13388 /* global ::blah does nothing */
13389 const char *name = Jim_String(argv[i]);
13390 if (name[0] != ':' || name[1] != ':') {
13391 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13392 return JIM_ERR;
13395 return JIM_OK;
13398 /* does the [string map] operation. On error NULL is returned,
13399 * otherwise a new string object with the result, having refcount = 0,
13400 * is returned. */
13401 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13402 Jim_Obj *objPtr, int nocase)
13404 int numMaps;
13405 const char *str, *noMatchStart = NULL;
13406 int strLen, i;
13407 Jim_Obj *resultObjPtr;
13409 numMaps = Jim_ListLength(interp, mapListObjPtr);
13410 if (numMaps % 2) {
13411 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13412 return NULL;
13415 str = Jim_String(objPtr);
13416 strLen = Jim_Utf8Length(interp, objPtr);
13418 /* Map it */
13419 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13420 while (strLen) {
13421 for (i = 0; i < numMaps; i += 2) {
13422 Jim_Obj *objPtr;
13423 const char *k;
13424 int kl;
13426 Jim_ListIndex(interp, mapListObjPtr, i, &objPtr, JIM_NONE);
13427 k = Jim_String(objPtr);
13428 kl = Jim_Utf8Length(interp, objPtr);
13430 if (strLen >= kl && kl) {
13431 int rc;
13432 rc = JimStringCompareLen(str, k, kl, nocase);
13433 if (rc == 0) {
13434 if (noMatchStart) {
13435 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13436 noMatchStart = NULL;
13438 Jim_ListIndex(interp, mapListObjPtr, i + 1, &objPtr, JIM_NONE);
13439 Jim_AppendObj(interp, resultObjPtr, objPtr);
13440 str += utf8_index(str, kl);
13441 strLen -= kl;
13442 break;
13446 if (i == numMaps) { /* no match */
13447 int c;
13448 if (noMatchStart == NULL)
13449 noMatchStart = str;
13450 str += utf8_tounicode(str, &c);
13451 strLen--;
13454 if (noMatchStart) {
13455 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13457 return resultObjPtr;
13460 /* [string] */
13461 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13463 int len;
13464 int opt_case = 1;
13465 int option;
13466 static const char * const options[] = {
13467 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13468 "map", "repeat", "reverse", "index", "first", "last",
13469 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13471 enum
13473 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13474 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
13475 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13477 static const char * const nocase_options[] = {
13478 "-nocase", NULL
13480 static const char * const nocase_length_options[] = {
13481 "-nocase", "-length", NULL
13484 if (argc < 2) {
13485 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13486 return JIM_ERR;
13488 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13489 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13490 return JIM_ERR;
13492 switch (option) {
13493 case OPT_LENGTH:
13494 case OPT_BYTELENGTH:
13495 if (argc != 3) {
13496 Jim_WrongNumArgs(interp, 2, argv, "string");
13497 return JIM_ERR;
13499 if (option == OPT_LENGTH) {
13500 len = Jim_Utf8Length(interp, argv[2]);
13502 else {
13503 len = Jim_Length(argv[2]);
13505 Jim_SetResultInt(interp, len);
13506 return JIM_OK;
13508 case OPT_COMPARE:
13509 case OPT_EQUAL:
13511 /* n is the number of remaining option args */
13512 long opt_length = -1;
13513 int n = argc - 4;
13514 int i = 2;
13515 while (n > 0) {
13516 int subopt;
13517 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13518 JIM_ENUM_ABBREV) != JIM_OK) {
13519 badcompareargs:
13520 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13521 return JIM_ERR;
13523 if (subopt == 0) {
13524 /* -nocase */
13525 opt_case = 0;
13526 n--;
13528 else {
13529 /* -length */
13530 if (n < 2) {
13531 goto badcompareargs;
13533 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13534 return JIM_ERR;
13536 n -= 2;
13539 if (n) {
13540 goto badcompareargs;
13542 argv += argc - 2;
13543 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13544 /* Fast version - [string equal], case sensitive, no length */
13545 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13547 else {
13548 if (opt_length >= 0) {
13549 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13551 else {
13552 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13554 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13556 return JIM_OK;
13559 case OPT_MATCH:
13560 if (argc != 4 &&
13561 (argc != 5 ||
13562 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13563 JIM_ENUM_ABBREV) != JIM_OK)) {
13564 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13565 return JIM_ERR;
13567 if (opt_case == 0) {
13568 argv++;
13570 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13571 return JIM_OK;
13573 case OPT_MAP:{
13574 Jim_Obj *objPtr;
13576 if (argc != 4 &&
13577 (argc != 5 ||
13578 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13579 JIM_ENUM_ABBREV) != JIM_OK)) {
13580 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13581 return JIM_ERR;
13584 if (opt_case == 0) {
13585 argv++;
13587 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13588 if (objPtr == NULL) {
13589 return JIM_ERR;
13591 Jim_SetResult(interp, objPtr);
13592 return JIM_OK;
13595 case OPT_RANGE:
13596 case OPT_BYTERANGE:{
13597 Jim_Obj *objPtr;
13599 if (argc != 5) {
13600 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13601 return JIM_ERR;
13603 if (option == OPT_RANGE) {
13604 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13606 else
13608 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13611 if (objPtr == NULL) {
13612 return JIM_ERR;
13614 Jim_SetResult(interp, objPtr);
13615 return JIM_OK;
13618 case OPT_REPLACE:{
13619 Jim_Obj *objPtr;
13621 if (argc != 5 && argc != 6) {
13622 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13623 return JIM_ERR;
13625 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13626 if (objPtr == NULL) {
13627 return JIM_ERR;
13629 Jim_SetResult(interp, objPtr);
13630 return JIM_OK;
13634 case OPT_REPEAT:{
13635 Jim_Obj *objPtr;
13636 jim_wide count;
13638 if (argc != 4) {
13639 Jim_WrongNumArgs(interp, 2, argv, "string count");
13640 return JIM_ERR;
13642 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13643 return JIM_ERR;
13645 objPtr = Jim_NewStringObj(interp, "", 0);
13646 if (count > 0) {
13647 while (count--) {
13648 Jim_AppendObj(interp, objPtr, argv[2]);
13651 Jim_SetResult(interp, objPtr);
13652 return JIM_OK;
13655 case OPT_REVERSE:{
13656 char *buf, *p;
13657 const char *str;
13658 int len;
13659 int i;
13661 if (argc != 3) {
13662 Jim_WrongNumArgs(interp, 2, argv, "string");
13663 return JIM_ERR;
13666 str = Jim_GetString(argv[2], &len);
13667 buf = Jim_Alloc(len + 1);
13668 p = buf + len;
13669 *p = 0;
13670 for (i = 0; i < len; ) {
13671 int c;
13672 int l = utf8_tounicode(str, &c);
13673 memcpy(p - l, str, l);
13674 p -= l;
13675 i += l;
13676 str += l;
13678 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13679 return JIM_OK;
13682 case OPT_INDEX:{
13683 int idx;
13684 const char *str;
13686 if (argc != 4) {
13687 Jim_WrongNumArgs(interp, 2, argv, "string index");
13688 return JIM_ERR;
13690 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13691 return JIM_ERR;
13693 str = Jim_String(argv[2]);
13694 len = Jim_Utf8Length(interp, argv[2]);
13695 if (idx != INT_MIN && idx != INT_MAX) {
13696 idx = JimRelToAbsIndex(len, idx);
13698 if (idx < 0 || idx >= len || str == NULL) {
13699 Jim_SetResultString(interp, "", 0);
13701 else if (len == Jim_Length(argv[2])) {
13702 /* ASCII optimisation */
13703 Jim_SetResultString(interp, str + idx, 1);
13705 else {
13706 int c;
13707 int i = utf8_index(str, idx);
13708 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13710 return JIM_OK;
13713 case OPT_FIRST:
13714 case OPT_LAST:{
13715 int idx = 0, l1, l2;
13716 const char *s1, *s2;
13718 if (argc != 4 && argc != 5) {
13719 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13720 return JIM_ERR;
13722 s1 = Jim_String(argv[2]);
13723 s2 = Jim_String(argv[3]);
13724 l1 = Jim_Utf8Length(interp, argv[2]);
13725 l2 = Jim_Utf8Length(interp, argv[3]);
13726 if (argc == 5) {
13727 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13728 return JIM_ERR;
13730 idx = JimRelToAbsIndex(l2, idx);
13732 else if (option == OPT_LAST) {
13733 idx = l2;
13735 if (option == OPT_FIRST) {
13736 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13738 else {
13739 #ifdef JIM_UTF8
13740 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13741 #else
13742 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13743 #endif
13745 return JIM_OK;
13748 case OPT_TRIM:
13749 case OPT_TRIMLEFT:
13750 case OPT_TRIMRIGHT:{
13751 Jim_Obj *trimchars;
13753 if (argc != 3 && argc != 4) {
13754 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13755 return JIM_ERR;
13757 trimchars = (argc == 4 ? argv[3] : NULL);
13758 if (option == OPT_TRIM) {
13759 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13761 else if (option == OPT_TRIMLEFT) {
13762 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13764 else if (option == OPT_TRIMRIGHT) {
13765 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13767 return JIM_OK;
13770 case OPT_TOLOWER:
13771 case OPT_TOUPPER:
13772 case OPT_TOTITLE:
13773 if (argc != 3) {
13774 Jim_WrongNumArgs(interp, 2, argv, "string");
13775 return JIM_ERR;
13777 if (option == OPT_TOLOWER) {
13778 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13780 else if (option == OPT_TOUPPER) {
13781 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13783 else {
13784 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13786 return JIM_OK;
13788 case OPT_IS:
13789 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13790 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13792 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13793 return JIM_ERR;
13795 return JIM_OK;
13798 /* [time] */
13799 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13801 long i, count = 1;
13802 jim_wide start, elapsed;
13803 char buf[60];
13804 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13806 if (argc < 2) {
13807 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13808 return JIM_ERR;
13810 if (argc == 3) {
13811 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13812 return JIM_ERR;
13814 if (count < 0)
13815 return JIM_OK;
13816 i = count;
13817 start = JimClock();
13818 while (i-- > 0) {
13819 int retval;
13821 retval = Jim_EvalObj(interp, argv[1]);
13822 if (retval != JIM_OK) {
13823 return retval;
13826 elapsed = JimClock() - start;
13827 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13828 Jim_SetResultString(interp, buf, -1);
13829 return JIM_OK;
13832 /* [exit] */
13833 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13835 long exitCode = 0;
13837 if (argc > 2) {
13838 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13839 return JIM_ERR;
13841 if (argc == 2) {
13842 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13843 return JIM_ERR;
13845 interp->exitCode = exitCode;
13846 return JIM_EXIT;
13849 /* [catch] */
13850 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13852 int exitCode = 0;
13853 int i;
13854 int sig = 0;
13856 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13857 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13858 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13860 /* Reset the error code before catch.
13861 * Note that this is not strictly correct.
13863 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13865 for (i = 1; i < argc - 1; i++) {
13866 const char *arg = Jim_String(argv[i]);
13867 jim_wide option;
13868 int ignore;
13870 /* It's a pity we can't use Jim_GetEnum here :-( */
13871 if (strcmp(arg, "--") == 0) {
13872 i++;
13873 break;
13875 if (*arg != '-') {
13876 break;
13879 if (strncmp(arg, "-no", 3) == 0) {
13880 arg += 3;
13881 ignore = 1;
13883 else {
13884 arg++;
13885 ignore = 0;
13888 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13889 option = -1;
13891 if (option < 0) {
13892 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13894 if (option < 0) {
13895 goto wrongargs;
13898 if (ignore) {
13899 ignore_mask |= (1 << option);
13901 else {
13902 ignore_mask &= ~(1 << option);
13906 argc -= i;
13907 if (argc < 1 || argc > 3) {
13908 wrongargs:
13909 Jim_WrongNumArgs(interp, 1, argv,
13910 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13911 return JIM_ERR;
13913 argv += i;
13915 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13916 sig++;
13919 interp->signal_level += sig;
13920 if (Jim_CheckSignal(interp)) {
13921 /* If a signal is set, don't even try to execute the body */
13922 exitCode = JIM_SIGNAL;
13924 else {
13925 exitCode = Jim_EvalObj(interp, argv[0]);
13926 /* Don't want any caught error included in a later stack trace */
13927 interp->errorFlag = 0;
13929 interp->signal_level -= sig;
13931 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13932 if (exitCode >= 0 && exitCode < max_ignore_code && ((1 << exitCode) & ignore_mask)) {
13933 /* Not caught, pass it up */
13934 return exitCode;
13937 if (sig && exitCode == JIM_SIGNAL) {
13938 /* Catch the signal at this level */
13939 if (interp->signal_set_result) {
13940 interp->signal_set_result(interp, interp->sigmask);
13942 else {
13943 Jim_SetResultInt(interp, interp->sigmask);
13945 interp->sigmask = 0;
13948 if (argc >= 2) {
13949 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13950 return JIM_ERR;
13952 if (argc == 3) {
13953 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13955 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13956 Jim_ListAppendElement(interp, optListObj,
13957 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13958 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13959 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13960 if (exitCode == JIM_ERR) {
13961 Jim_Obj *errorCode;
13962 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13963 -1));
13964 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13966 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13967 if (errorCode) {
13968 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13969 Jim_ListAppendElement(interp, optListObj, errorCode);
13972 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13973 return JIM_ERR;
13977 Jim_SetResultInt(interp, exitCode);
13978 return JIM_OK;
13981 #ifdef JIM_REFERENCES
13983 /* [ref] */
13984 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13986 if (argc != 3 && argc != 4) {
13987 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13988 return JIM_ERR;
13990 if (argc == 3) {
13991 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13993 else {
13994 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13996 return JIM_OK;
13999 /* [getref] */
14000 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14002 Jim_Reference *refPtr;
14004 if (argc != 2) {
14005 Jim_WrongNumArgs(interp, 1, argv, "reference");
14006 return JIM_ERR;
14008 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14009 return JIM_ERR;
14010 Jim_SetResult(interp, refPtr->objPtr);
14011 return JIM_OK;
14014 /* [setref] */
14015 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14017 Jim_Reference *refPtr;
14019 if (argc != 3) {
14020 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14021 return JIM_ERR;
14023 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14024 return JIM_ERR;
14025 Jim_IncrRefCount(argv[2]);
14026 Jim_DecrRefCount(interp, refPtr->objPtr);
14027 refPtr->objPtr = argv[2];
14028 Jim_SetResult(interp, argv[2]);
14029 return JIM_OK;
14032 /* [collect] */
14033 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14035 if (argc != 1) {
14036 Jim_WrongNumArgs(interp, 1, argv, "");
14037 return JIM_ERR;
14039 Jim_SetResultInt(interp, Jim_Collect(interp));
14041 /* Free all the freed objects. */
14042 while (interp->freeList) {
14043 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14044 Jim_Free(interp->freeList);
14045 interp->freeList = nextObjPtr;
14048 return JIM_OK;
14051 /* [finalize] reference ?newValue? */
14052 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14054 if (argc != 2 && argc != 3) {
14055 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14056 return JIM_ERR;
14058 if (argc == 2) {
14059 Jim_Obj *cmdNamePtr;
14061 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14062 return JIM_ERR;
14063 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14064 Jim_SetResult(interp, cmdNamePtr);
14066 else {
14067 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14068 return JIM_ERR;
14069 Jim_SetResult(interp, argv[2]);
14071 return JIM_OK;
14074 /* [info references] */
14075 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14077 Jim_Obj *listObjPtr;
14078 Jim_HashTableIterator htiter;
14079 Jim_HashEntry *he;
14081 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14083 JimInitHashTableIterator(&interp->references, &htiter);
14084 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14085 char buf[JIM_REFERENCE_SPACE + 1];
14086 Jim_Reference *refPtr = he->u.val;
14087 const unsigned long *refId = he->key;
14089 JimFormatReference(buf, refPtr, *refId);
14090 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14092 Jim_SetResult(interp, listObjPtr);
14093 return JIM_OK;
14095 #endif
14097 /* [rename] */
14098 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14100 if (argc != 3) {
14101 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14102 return JIM_ERR;
14105 if (JimValidName(interp, "new procedure", argv[2])) {
14106 return JIM_ERR;
14109 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14112 #define JIM_DICTMATCH_VALUES 0x0001
14114 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14116 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14118 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14119 if (type & JIM_DICTMATCH_VALUES) {
14120 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->u.val);
14125 * Like JimHashtablePatternMatch, but for dictionaries.
14127 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14128 JimDictMatchCallbackType *callback, int type)
14130 Jim_HashEntry *he;
14131 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14133 /* Check for the non-pattern case. We can do this much more efficiently. */
14134 Jim_HashTableIterator htiter;
14135 JimInitHashTableIterator(ht, &htiter);
14136 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14137 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14138 callback(interp, listObjPtr, he, type);
14142 return listObjPtr;
14146 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14148 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14149 return JIM_ERR;
14151 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14152 return JIM_OK;
14155 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14157 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14158 return JIM_ERR;
14160 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14161 return JIM_OK;
14164 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14166 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14167 return -1;
14169 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14172 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14174 Jim_HashTable *ht;
14175 unsigned int i;
14177 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14178 return JIM_ERR;
14181 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14183 /* Note that this uses internal knowledge of the hash table */
14184 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14186 for (i = 0; i < ht->size; i++) {
14187 Jim_HashEntry *he = he = ht->table[i];
14189 if (he) {
14190 printf("%d: ", i);
14192 while (he) {
14193 printf(" %s", Jim_String(he->key));
14194 he = he->next;
14196 printf("\n");
14199 return JIM_OK;
14202 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14204 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14206 Jim_AppendString(interp, prefixObj, " ", 1);
14207 Jim_AppendString(interp, prefixObj, subcmd, -1);
14209 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14212 /* [dict] */
14213 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14215 Jim_Obj *objPtr;
14216 int option;
14217 static const char * const options[] = {
14218 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14219 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14220 "replace", "update", NULL
14222 enum
14224 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14225 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14226 OPT_REPLACE, OPT_UPDATE,
14229 if (argc < 2) {
14230 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14231 return JIM_ERR;
14234 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14235 return JIM_ERR;
14238 switch (option) {
14239 case OPT_GET:
14240 if (argc < 3) {
14241 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14242 return JIM_ERR;
14244 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14245 JIM_ERRMSG) != JIM_OK) {
14246 return JIM_ERR;
14248 Jim_SetResult(interp, objPtr);
14249 return JIM_OK;
14251 case OPT_SET:
14252 if (argc < 5) {
14253 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14254 return JIM_ERR;
14256 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14258 case OPT_EXISTS:
14259 if (argc < 4) {
14260 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14261 return JIM_ERR;
14263 else {
14264 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14265 if (rc < 0) {
14266 return JIM_ERR;
14268 Jim_SetResultBool(interp, rc == JIM_OK);
14269 return JIM_OK;
14272 case OPT_UNSET:
14273 if (argc < 4) {
14274 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14275 return JIM_ERR;
14277 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14278 return JIM_ERR;
14280 return JIM_OK;
14282 case OPT_KEYS:
14283 if (argc != 3 && argc != 4) {
14284 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14285 return JIM_ERR;
14287 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14289 case OPT_SIZE:
14290 if (argc != 3) {
14291 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14292 return JIM_ERR;
14294 else if (Jim_DictSize(interp, argv[2]) < 0) {
14295 return JIM_ERR;
14297 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14298 return JIM_OK;
14300 case OPT_MERGE:
14301 if (argc == 2) {
14302 return JIM_OK;
14304 if (Jim_DictSize(interp, argv[2]) < 0) {
14305 return JIM_ERR;
14307 /* Handle as ensemble */
14308 break;
14310 case OPT_UPDATE:
14311 if (argc < 6 || argc % 2) {
14312 /* Better error message */
14313 argc = 2;
14315 break;
14317 case OPT_CREATE:
14318 if (argc % 2) {
14319 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14320 return JIM_ERR;
14322 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14323 Jim_SetResult(interp, objPtr);
14324 return JIM_OK;
14326 case OPT_INFO:
14327 if (argc != 3) {
14328 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14329 return JIM_ERR;
14331 return Jim_DictInfo(interp, argv[2]);
14333 /* Handle command as an ensemble */
14334 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14337 /* [subst] */
14338 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14340 static const char * const options[] = {
14341 "-nobackslashes", "-nocommands", "-novariables", NULL
14343 enum
14344 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14345 int i;
14346 int flags = JIM_SUBST_FLAG;
14347 Jim_Obj *objPtr;
14349 if (argc < 2) {
14350 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14351 return JIM_ERR;
14353 for (i = 1; i < (argc - 1); i++) {
14354 int option;
14356 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14357 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14358 return JIM_ERR;
14360 switch (option) {
14361 case OPT_NOBACKSLASHES:
14362 flags |= JIM_SUBST_NOESC;
14363 break;
14364 case OPT_NOCOMMANDS:
14365 flags |= JIM_SUBST_NOCMD;
14366 break;
14367 case OPT_NOVARIABLES:
14368 flags |= JIM_SUBST_NOVAR;
14369 break;
14372 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14373 return JIM_ERR;
14375 Jim_SetResult(interp, objPtr);
14376 return JIM_OK;
14379 /* [info] */
14380 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14382 int cmd;
14383 Jim_Obj *objPtr;
14384 int mode = 0;
14386 static const char * const commands[] = {
14387 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14388 "vars", "version", "patchlevel", "complete", "args", "hostname",
14389 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14390 "references", "alias", NULL
14392 enum
14393 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14394 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14395 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14396 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14399 #ifdef jim_ext_namespace
14400 int nons = 0;
14402 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14403 /* This is for internal use only */
14404 argc--;
14405 argv++;
14406 nons = 1;
14408 #endif
14410 if (argc < 2) {
14411 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14412 return JIM_ERR;
14414 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14415 != JIM_OK) {
14416 return JIM_ERR;
14419 /* Test for the the most common commands first, just in case it makes a difference */
14420 switch (cmd) {
14421 case INFO_EXISTS:
14422 if (argc != 3) {
14423 Jim_WrongNumArgs(interp, 2, argv, "varName");
14424 return JIM_ERR;
14426 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14427 break;
14429 case INFO_ALIAS:{
14430 Jim_Cmd *cmdPtr;
14432 if (argc != 3) {
14433 Jim_WrongNumArgs(interp, 2, argv, "command");
14434 return JIM_ERR;
14436 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14437 return JIM_ERR;
14439 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14440 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14441 return JIM_ERR;
14443 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14444 return JIM_OK;
14447 case INFO_CHANNELS:
14448 mode++; /* JIM_CMDLIST_CHANNELS */
14449 #ifndef jim_ext_aio
14450 Jim_SetResultString(interp, "aio not enabled", -1);
14451 return JIM_ERR;
14452 #endif
14453 case INFO_PROCS:
14454 mode++; /* JIM_CMDLIST_PROCS */
14455 case INFO_COMMANDS:
14456 /* mode 0 => JIM_CMDLIST_COMMANDS */
14457 if (argc != 2 && argc != 3) {
14458 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14459 return JIM_ERR;
14461 #ifdef jim_ext_namespace
14462 if (!nons) {
14463 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14464 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14467 #endif
14468 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14469 break;
14471 case INFO_VARS:
14472 mode++; /* JIM_VARLIST_VARS */
14473 case INFO_LOCALS:
14474 mode++; /* JIM_VARLIST_LOCALS */
14475 case INFO_GLOBALS:
14476 /* mode 0 => JIM_VARLIST_GLOBALS */
14477 if (argc != 2 && argc != 3) {
14478 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14479 return JIM_ERR;
14481 #ifdef jim_ext_namespace
14482 if (!nons) {
14483 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14484 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14487 #endif
14488 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14489 break;
14491 case INFO_SCRIPT:
14492 if (argc != 2) {
14493 Jim_WrongNumArgs(interp, 2, argv, "");
14494 return JIM_ERR;
14496 Jim_SetResult(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileNameObj);
14497 break;
14499 case INFO_SOURCE:{
14500 int line;
14501 Jim_Obj *resObjPtr;
14502 Jim_Obj *fileNameObj;
14504 if (argc != 3) {
14505 Jim_WrongNumArgs(interp, 2, argv, "source");
14506 return JIM_ERR;
14508 if (argv[2]->typePtr == &sourceObjType) {
14509 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14510 line = argv[2]->internalRep.sourceValue.lineNumber;
14512 else if (argv[2]->typePtr == &scriptObjType) {
14513 ScriptObj *script = Jim_GetScript(interp, argv[2]);
14514 fileNameObj = script->fileNameObj;
14515 line = script->firstline;
14517 else {
14518 fileNameObj = interp->emptyObj;
14519 line = 1;
14521 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14522 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14523 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14524 Jim_SetResult(interp, resObjPtr);
14525 break;
14528 case INFO_STACKTRACE:
14529 Jim_SetResult(interp, interp->stackTrace);
14530 break;
14532 case INFO_LEVEL:
14533 case INFO_FRAME:
14534 switch (argc) {
14535 case 2:
14536 Jim_SetResultInt(interp, interp->framePtr->level);
14537 break;
14539 case 3:
14540 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14541 return JIM_ERR;
14543 Jim_SetResult(interp, objPtr);
14544 break;
14546 default:
14547 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14548 return JIM_ERR;
14550 break;
14552 case INFO_BODY:
14553 case INFO_STATICS:
14554 case INFO_ARGS:{
14555 Jim_Cmd *cmdPtr;
14557 if (argc != 3) {
14558 Jim_WrongNumArgs(interp, 2, argv, "procname");
14559 return JIM_ERR;
14561 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14562 return JIM_ERR;
14564 if (!cmdPtr->isproc) {
14565 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14566 return JIM_ERR;
14568 switch (cmd) {
14569 case INFO_BODY:
14570 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14571 break;
14572 case INFO_ARGS:
14573 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14574 break;
14575 case INFO_STATICS:
14576 if (cmdPtr->u.proc.staticVars) {
14577 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14578 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14579 NULL, JimVariablesMatch, mode));
14581 break;
14583 break;
14586 case INFO_VERSION:
14587 case INFO_PATCHLEVEL:{
14588 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14590 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14591 Jim_SetResultString(interp, buf, -1);
14592 break;
14595 case INFO_COMPLETE:
14596 if (argc != 3 && argc != 4) {
14597 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14598 return JIM_ERR;
14600 else {
14601 int len;
14602 const char *s = Jim_GetString(argv[2], &len);
14603 char missing;
14605 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14606 if (missing != ' ' && argc == 4) {
14607 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14610 break;
14612 case INFO_HOSTNAME:
14613 /* Redirect to os.gethostname if it exists */
14614 return Jim_Eval(interp, "os.gethostname");
14616 case INFO_NAMEOFEXECUTABLE:
14617 /* Redirect to Tcl proc */
14618 return Jim_Eval(interp, "{info nameofexecutable}");
14620 case INFO_RETURNCODES:
14621 if (argc == 2) {
14622 int i;
14623 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14625 for (i = 0; jimReturnCodes[i]; i++) {
14626 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14627 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14628 jimReturnCodes[i], -1));
14631 Jim_SetResult(interp, listObjPtr);
14633 else if (argc == 3) {
14634 long code;
14635 const char *name;
14637 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14638 return JIM_ERR;
14640 name = Jim_ReturnCode(code);
14641 if (*name == '?') {
14642 Jim_SetResultInt(interp, code);
14644 else {
14645 Jim_SetResultString(interp, name, -1);
14648 else {
14649 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14650 return JIM_ERR;
14652 break;
14653 case INFO_REFERENCES:
14654 #ifdef JIM_REFERENCES
14655 return JimInfoReferences(interp, argc, argv);
14656 #else
14657 Jim_SetResultString(interp, "not supported", -1);
14658 return JIM_ERR;
14659 #endif
14661 return JIM_OK;
14664 /* [exists] */
14665 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14667 Jim_Obj *objPtr;
14668 int result = 0;
14670 static const char * const options[] = {
14671 "-command", "-proc", "-alias", "-var", NULL
14673 enum
14675 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14677 int option;
14679 if (argc == 2) {
14680 option = OPT_VAR;
14681 objPtr = argv[1];
14683 else if (argc == 3) {
14684 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14685 return JIM_ERR;
14687 objPtr = argv[2];
14689 else {
14690 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14691 return JIM_ERR;
14694 if (option == OPT_VAR) {
14695 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14697 else {
14698 /* Now different kinds of commands */
14699 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14701 if (cmd) {
14702 switch (option) {
14703 case OPT_COMMAND:
14704 result = 1;
14705 break;
14707 case OPT_ALIAS:
14708 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14709 break;
14711 case OPT_PROC:
14712 result = cmd->isproc;
14713 break;
14717 Jim_SetResultBool(interp, result);
14718 return JIM_OK;
14721 /* [split] */
14722 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14724 const char *str, *splitChars, *noMatchStart;
14725 int splitLen, strLen;
14726 Jim_Obj *resObjPtr;
14727 int c;
14728 int len;
14730 if (argc != 2 && argc != 3) {
14731 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14732 return JIM_ERR;
14735 str = Jim_GetString(argv[1], &len);
14736 if (len == 0) {
14737 return JIM_OK;
14739 strLen = Jim_Utf8Length(interp, argv[1]);
14741 /* Init */
14742 if (argc == 2) {
14743 splitChars = " \n\t\r";
14744 splitLen = 4;
14746 else {
14747 splitChars = Jim_String(argv[2]);
14748 splitLen = Jim_Utf8Length(interp, argv[2]);
14751 noMatchStart = str;
14752 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14754 /* Split */
14755 if (splitLen) {
14756 Jim_Obj *objPtr;
14757 while (strLen--) {
14758 const char *sc = splitChars;
14759 int scLen = splitLen;
14760 int sl = utf8_tounicode(str, &c);
14761 while (scLen--) {
14762 int pc;
14763 sc += utf8_tounicode(sc, &pc);
14764 if (c == pc) {
14765 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14766 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14767 noMatchStart = str + sl;
14768 break;
14771 str += sl;
14773 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14774 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14776 else {
14777 /* This handles the special case of splitchars eq {}
14778 * Optimise by sharing common (ASCII) characters
14780 Jim_Obj **commonObj = NULL;
14781 #define NUM_COMMON (128 - 9)
14782 while (strLen--) {
14783 int n = utf8_tounicode(str, &c);
14784 #ifdef JIM_OPTIMIZATION
14785 if (c >= 9 && c < 128) {
14786 /* Common ASCII char. Note that 9 is the tab character */
14787 c -= 9;
14788 if (!commonObj) {
14789 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14790 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14792 if (!commonObj[c]) {
14793 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14795 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14796 str++;
14797 continue;
14799 #endif
14800 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14801 str += n;
14803 Jim_Free(commonObj);
14806 Jim_SetResult(interp, resObjPtr);
14807 return JIM_OK;
14810 /* [join] */
14811 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14813 const char *joinStr;
14814 int joinStrLen;
14816 if (argc != 2 && argc != 3) {
14817 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14818 return JIM_ERR;
14820 /* Init */
14821 if (argc == 2) {
14822 joinStr = " ";
14823 joinStrLen = 1;
14825 else {
14826 joinStr = Jim_GetString(argv[2], &joinStrLen);
14828 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14829 return JIM_OK;
14832 /* [format] */
14833 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14835 Jim_Obj *objPtr;
14837 if (argc < 2) {
14838 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14839 return JIM_ERR;
14841 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14842 if (objPtr == NULL)
14843 return JIM_ERR;
14844 Jim_SetResult(interp, objPtr);
14845 return JIM_OK;
14848 /* [scan] */
14849 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14851 Jim_Obj *listPtr, **outVec;
14852 int outc, i;
14854 if (argc < 3) {
14855 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14856 return JIM_ERR;
14858 if (argv[2]->typePtr != &scanFmtStringObjType)
14859 SetScanFmtFromAny(interp, argv[2]);
14860 if (FormatGetError(argv[2]) != 0) {
14861 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14862 return JIM_ERR;
14864 if (argc > 3) {
14865 int maxPos = FormatGetMaxPos(argv[2]);
14866 int count = FormatGetCnvCount(argv[2]);
14868 if (maxPos > argc - 3) {
14869 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14870 return JIM_ERR;
14872 else if (count > argc - 3) {
14873 Jim_SetResultString(interp, "different numbers of variable names and "
14874 "field specifiers", -1);
14875 return JIM_ERR;
14877 else if (count < argc - 3) {
14878 Jim_SetResultString(interp, "variable is not assigned by any "
14879 "conversion specifiers", -1);
14880 return JIM_ERR;
14883 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14884 if (listPtr == 0)
14885 return JIM_ERR;
14886 if (argc > 3) {
14887 int rc = JIM_OK;
14888 int count = 0;
14890 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14891 int len = Jim_ListLength(interp, listPtr);
14893 if (len != 0) {
14894 JimListGetElements(interp, listPtr, &outc, &outVec);
14895 for (i = 0; i < outc; ++i) {
14896 if (Jim_Length(outVec[i]) > 0) {
14897 ++count;
14898 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14899 rc = JIM_ERR;
14904 Jim_FreeNewObj(interp, listPtr);
14906 else {
14907 count = -1;
14909 if (rc == JIM_OK) {
14910 Jim_SetResultInt(interp, count);
14912 return rc;
14914 else {
14915 if (listPtr == (Jim_Obj *)EOF) {
14916 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14917 return JIM_OK;
14919 Jim_SetResult(interp, listPtr);
14921 return JIM_OK;
14924 /* [error] */
14925 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14927 if (argc != 2 && argc != 3) {
14928 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14929 return JIM_ERR;
14931 Jim_SetResult(interp, argv[1]);
14932 if (argc == 3) {
14933 JimSetStackTrace(interp, argv[2]);
14934 return JIM_ERR;
14936 interp->addStackTrace++;
14937 return JIM_ERR;
14940 /* [lrange] */
14941 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14943 Jim_Obj *objPtr;
14945 if (argc != 4) {
14946 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14947 return JIM_ERR;
14949 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14950 return JIM_ERR;
14951 Jim_SetResult(interp, objPtr);
14952 return JIM_OK;
14955 /* [lrepeat] */
14956 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14958 Jim_Obj *objPtr;
14959 long count;
14961 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14962 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14963 return JIM_ERR;
14966 if (count == 0 || argc == 2) {
14967 return JIM_OK;
14970 argc -= 2;
14971 argv += 2;
14973 objPtr = Jim_NewListObj(interp, argv, argc);
14974 while (--count) {
14975 ListInsertElements(objPtr, -1, argc, argv);
14978 Jim_SetResult(interp, objPtr);
14979 return JIM_OK;
14982 char **Jim_GetEnviron(void)
14984 #if defined(HAVE__NSGETENVIRON)
14985 return *_NSGetEnviron();
14986 #else
14987 #if !defined(NO_ENVIRON_EXTERN)
14988 extern char **environ;
14989 #endif
14991 return environ;
14992 #endif
14995 void Jim_SetEnviron(char **env)
14997 #if defined(HAVE__NSGETENVIRON)
14998 *_NSGetEnviron() = env;
14999 #else
15000 #if !defined(NO_ENVIRON_EXTERN)
15001 extern char **environ;
15002 #endif
15004 environ = env;
15005 #endif
15008 /* [env] */
15009 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15011 const char *key;
15012 const char *val;
15014 if (argc == 1) {
15015 char **e = Jim_GetEnviron();
15017 int i;
15018 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15020 for (i = 0; e[i]; i++) {
15021 const char *equals = strchr(e[i], '=');
15023 if (equals) {
15024 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15025 equals - e[i]));
15026 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15030 Jim_SetResult(interp, listObjPtr);
15031 return JIM_OK;
15034 if (argc < 2) {
15035 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15036 return JIM_ERR;
15038 key = Jim_String(argv[1]);
15039 val = getenv(key);
15040 if (val == NULL) {
15041 if (argc < 3) {
15042 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15043 return JIM_ERR;
15045 val = Jim_String(argv[2]);
15047 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15048 return JIM_OK;
15051 /* [source] */
15052 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15054 int retval;
15056 if (argc != 2) {
15057 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15058 return JIM_ERR;
15060 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15061 if (retval == JIM_RETURN)
15062 return JIM_OK;
15063 return retval;
15066 /* [lreverse] */
15067 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15069 Jim_Obj *revObjPtr, **ele;
15070 int len;
15072 if (argc != 2) {
15073 Jim_WrongNumArgs(interp, 1, argv, "list");
15074 return JIM_ERR;
15076 JimListGetElements(interp, argv[1], &len, &ele);
15077 len--;
15078 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15079 while (len >= 0)
15080 ListAppendElement(revObjPtr, ele[len--]);
15081 Jim_SetResult(interp, revObjPtr);
15082 return JIM_OK;
15085 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15087 jim_wide len;
15089 if (step == 0)
15090 return -1;
15091 if (start == end)
15092 return 0;
15093 else if (step > 0 && start > end)
15094 return -1;
15095 else if (step < 0 && end > start)
15096 return -1;
15097 len = end - start;
15098 if (len < 0)
15099 len = -len; /* abs(len) */
15100 if (step < 0)
15101 step = -step; /* abs(step) */
15102 len = 1 + ((len - 1) / step);
15103 /* We can truncate safely to INT_MAX, the range command
15104 * will always return an error for a such long range
15105 * because Tcl lists can't be so long. */
15106 if (len > INT_MAX)
15107 len = INT_MAX;
15108 return (int)((len < 0) ? -1 : len);
15111 /* [range] */
15112 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15114 jim_wide start = 0, end, step = 1;
15115 int len, i;
15116 Jim_Obj *objPtr;
15118 if (argc < 2 || argc > 4) {
15119 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15120 return JIM_ERR;
15122 if (argc == 2) {
15123 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15124 return JIM_ERR;
15126 else {
15127 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15128 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15129 return JIM_ERR;
15130 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15131 return JIM_ERR;
15133 if ((len = JimRangeLen(start, end, step)) == -1) {
15134 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15135 return JIM_ERR;
15137 objPtr = Jim_NewListObj(interp, NULL, 0);
15138 for (i = 0; i < len; i++)
15139 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15140 Jim_SetResult(interp, objPtr);
15141 return JIM_OK;
15144 /* [rand] */
15145 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15147 jim_wide min = 0, max = 0, len, maxMul;
15149 if (argc < 1 || argc > 3) {
15150 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15151 return JIM_ERR;
15153 if (argc == 1) {
15154 max = JIM_WIDE_MAX;
15155 } else if (argc == 2) {
15156 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15157 return JIM_ERR;
15158 } else if (argc == 3) {
15159 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15160 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15161 return JIM_ERR;
15163 len = max-min;
15164 if (len < 0) {
15165 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15166 return JIM_ERR;
15168 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15169 while (1) {
15170 jim_wide r;
15172 JimRandomBytes(interp, &r, sizeof(jim_wide));
15173 if (r < 0 || r >= maxMul) continue;
15174 r = (len == 0) ? 0 : r%len;
15175 Jim_SetResultInt(interp, min+r);
15176 return JIM_OK;
15180 static const struct {
15181 const char *name;
15182 Jim_CmdProc cmdProc;
15183 } Jim_CoreCommandsTable[] = {
15184 {"alias", Jim_AliasCoreCommand},
15185 {"set", Jim_SetCoreCommand},
15186 {"unset", Jim_UnsetCoreCommand},
15187 {"puts", Jim_PutsCoreCommand},
15188 {"+", Jim_AddCoreCommand},
15189 {"*", Jim_MulCoreCommand},
15190 {"-", Jim_SubCoreCommand},
15191 {"/", Jim_DivCoreCommand},
15192 {"incr", Jim_IncrCoreCommand},
15193 {"while", Jim_WhileCoreCommand},
15194 {"loop", Jim_LoopCoreCommand},
15195 {"for", Jim_ForCoreCommand},
15196 {"foreach", Jim_ForeachCoreCommand},
15197 {"lmap", Jim_LmapCoreCommand},
15198 {"lassign", Jim_LassignCoreCommand},
15199 {"if", Jim_IfCoreCommand},
15200 {"switch", Jim_SwitchCoreCommand},
15201 {"list", Jim_ListCoreCommand},
15202 {"lindex", Jim_LindexCoreCommand},
15203 {"lset", Jim_LsetCoreCommand},
15204 {"lsearch", Jim_LsearchCoreCommand},
15205 {"llength", Jim_LlengthCoreCommand},
15206 {"lappend", Jim_LappendCoreCommand},
15207 {"linsert", Jim_LinsertCoreCommand},
15208 {"lreplace", Jim_LreplaceCoreCommand},
15209 {"lsort", Jim_LsortCoreCommand},
15210 {"append", Jim_AppendCoreCommand},
15211 {"debug", Jim_DebugCoreCommand},
15212 {"eval", Jim_EvalCoreCommand},
15213 {"uplevel", Jim_UplevelCoreCommand},
15214 {"expr", Jim_ExprCoreCommand},
15215 {"break", Jim_BreakCoreCommand},
15216 {"continue", Jim_ContinueCoreCommand},
15217 {"proc", Jim_ProcCoreCommand},
15218 {"concat", Jim_ConcatCoreCommand},
15219 {"return", Jim_ReturnCoreCommand},
15220 {"upvar", Jim_UpvarCoreCommand},
15221 {"global", Jim_GlobalCoreCommand},
15222 {"string", Jim_StringCoreCommand},
15223 {"time", Jim_TimeCoreCommand},
15224 {"exit", Jim_ExitCoreCommand},
15225 {"catch", Jim_CatchCoreCommand},
15226 #ifdef JIM_REFERENCES
15227 {"ref", Jim_RefCoreCommand},
15228 {"getref", Jim_GetrefCoreCommand},
15229 {"setref", Jim_SetrefCoreCommand},
15230 {"finalize", Jim_FinalizeCoreCommand},
15231 {"collect", Jim_CollectCoreCommand},
15232 #endif
15233 {"rename", Jim_RenameCoreCommand},
15234 {"dict", Jim_DictCoreCommand},
15235 {"subst", Jim_SubstCoreCommand},
15236 {"info", Jim_InfoCoreCommand},
15237 {"exists", Jim_ExistsCoreCommand},
15238 {"split", Jim_SplitCoreCommand},
15239 {"join", Jim_JoinCoreCommand},
15240 {"format", Jim_FormatCoreCommand},
15241 {"scan", Jim_ScanCoreCommand},
15242 {"error", Jim_ErrorCoreCommand},
15243 {"lrange", Jim_LrangeCoreCommand},
15244 {"lrepeat", Jim_LrepeatCoreCommand},
15245 {"env", Jim_EnvCoreCommand},
15246 {"source", Jim_SourceCoreCommand},
15247 {"lreverse", Jim_LreverseCoreCommand},
15248 {"range", Jim_RangeCoreCommand},
15249 {"rand", Jim_RandCoreCommand},
15250 {"tailcall", Jim_TailcallCoreCommand},
15251 {"local", Jim_LocalCoreCommand},
15252 {"upcall", Jim_UpcallCoreCommand},
15253 {"apply", Jim_ApplyCoreCommand},
15254 {NULL, NULL},
15257 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15259 int i = 0;
15261 while (Jim_CoreCommandsTable[i].name != NULL) {
15262 Jim_CreateCommand(interp,
15263 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15264 i++;
15268 /* -----------------------------------------------------------------------------
15269 * Interactive prompt
15270 * ---------------------------------------------------------------------------*/
15271 void Jim_MakeErrorMessage(Jim_Interp *interp)
15273 Jim_Obj *argv[2];
15275 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15276 argv[1] = interp->result;
15278 Jim_EvalObjVector(interp, 2, argv);
15281 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15282 const char *prefix, const char *const *tablePtr, const char *name)
15284 int count;
15285 char **tablePtrSorted;
15286 int i;
15288 for (count = 0; tablePtr[count]; count++) {
15291 if (name == NULL) {
15292 name = "option";
15295 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15296 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15297 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15298 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15299 for (i = 0; i < count; i++) {
15300 if (i + 1 == count && count > 1) {
15301 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15303 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15304 if (i + 1 != count) {
15305 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15308 Jim_Free(tablePtrSorted);
15311 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15312 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15314 const char *bad = "bad ";
15315 const char *const *entryPtr = NULL;
15316 int i;
15317 int match = -1;
15318 int arglen;
15319 const char *arg = Jim_GetString(objPtr, &arglen);
15321 *indexPtr = -1;
15323 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15324 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15325 /* Found an exact match */
15326 *indexPtr = i;
15327 return JIM_OK;
15329 if (flags & JIM_ENUM_ABBREV) {
15330 /* Accept an unambiguous abbreviation.
15331 * Note that '-' doesnt' consitute a valid abbreviation
15333 if (strncmp(arg, *entryPtr, arglen) == 0) {
15334 if (*arg == '-' && arglen == 1) {
15335 break;
15337 if (match >= 0) {
15338 bad = "ambiguous ";
15339 goto ambiguous;
15341 match = i;
15346 /* If we had an unambiguous partial match */
15347 if (match >= 0) {
15348 *indexPtr = match;
15349 return JIM_OK;
15352 ambiguous:
15353 if (flags & JIM_ERRMSG) {
15354 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15356 return JIM_ERR;
15359 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15361 int i;
15363 for (i = 0; i < (int)len; i++) {
15364 if (array[i] && strcmp(array[i], name) == 0) {
15365 return i;
15368 return -1;
15371 int Jim_IsDict(Jim_Obj *objPtr)
15373 return objPtr->typePtr == &dictObjType;
15376 int Jim_IsList(Jim_Obj *objPtr)
15378 return objPtr->typePtr == &listObjType;
15382 * Very simple printf-like formatting, designed for error messages.
15384 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15385 * The resulting string is created and set as the result.
15387 * Each '%s' should correspond to a regular string parameter.
15388 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15389 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15391 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15393 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15395 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15397 /* Initial space needed */
15398 int len = strlen(format);
15399 int extra = 0;
15400 int n = 0;
15401 const char *params[5];
15402 char *buf;
15403 va_list args;
15404 int i;
15406 va_start(args, format);
15408 for (i = 0; i < len && n < 5; i++) {
15409 int l;
15411 if (strncmp(format + i, "%s", 2) == 0) {
15412 params[n] = va_arg(args, char *);
15414 l = strlen(params[n]);
15416 else if (strncmp(format + i, "%#s", 3) == 0) {
15417 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15419 params[n] = Jim_GetString(objPtr, &l);
15421 else {
15422 if (format[i] == '%') {
15423 i++;
15425 continue;
15427 n++;
15428 extra += l;
15431 len += extra;
15432 buf = Jim_Alloc(len + 1);
15433 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15435 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15438 /* stubs */
15439 #ifndef jim_ext_package
15440 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15442 return JIM_OK;
15444 #endif
15445 #ifndef jim_ext_aio
15446 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15448 Jim_SetResultString(interp, "aio not enabled", -1);
15449 return NULL;
15451 #endif
15455 * Local Variables: ***
15456 * c-basic-offset: 4 ***
15457 * tab-width: 4 ***
15458 * End: ***