jim.c: Use key dup and val dup for dicts
[jimtcl.git] / jim.c
blob517fd05ae75b7ad84321f584a8c35e3606c2cc96
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
45 #include <stdio.h>
46 #include <stdlib.h>
48 #include <string.h>
49 #include <stdarg.h>
50 #include <ctype.h>
51 #include <limits.h>
52 #include <assert.h>
53 #include <errno.h>
54 #include <time.h>
55 #include <setjmp.h>
57 #include "jim.h"
58 #include "jimautoconf.h"
59 #include "utf8.h"
61 #ifdef HAVE_SYS_TIME_H
62 #include <sys/time.h>
63 #endif
64 #ifdef HAVE_BACKTRACE
65 #include <execinfo.h>
66 #endif
67 #ifdef HAVE_CRT_EXTERNS_H
68 #include <crt_externs.h>
69 #endif
71 /* For INFINITY, even if math functions are not enabled */
72 #include <math.h>
74 /* We may decide to switch to using $[...] after all, so leave it as an option */
75 /*#define EXPRSUGAR_BRACKET*/
77 /* For the no-autoconf case */
78 #ifndef TCL_LIBRARY
79 #define TCL_LIBRARY "."
80 #endif
81 #ifndef TCL_PLATFORM_OS
82 #define TCL_PLATFORM_OS "unknown"
83 #endif
84 #ifndef TCL_PLATFORM_PLATFORM
85 #define TCL_PLATFORM_PLATFORM "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PATH_SEPARATOR
88 #define TCL_PLATFORM_PATH_SEPARATOR ":"
89 #endif
91 /*#define DEBUG_SHOW_SCRIPT*/
92 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
93 /*#define DEBUG_SHOW_SUBST*/
94 /*#define DEBUG_SHOW_EXPR*/
95 /*#define DEBUG_SHOW_EXPR_TOKENS*/
96 /*#define JIM_DEBUG_GC*/
97 #ifdef JIM_MAINTAINER
98 #define JIM_DEBUG_COMMAND
99 #define JIM_DEBUG_PANIC
100 #endif
101 /* Enable this (in conjunction with valgrind) to help debug
102 * reference counting issues
104 /*#define JIM_DISABLE_OBJECT_POOL*/
106 /* Maximum size of an integer */
107 #define JIM_INTEGER_SPACE 24
109 const char *jim_tt_name(int type);
111 #ifdef JIM_DEBUG_PANIC
112 static void JimPanicDump(int fail_condition, const char *fmt, ...);
113 #define JimPanic(X) JimPanicDump X
114 #else
115 #define JimPanic(X)
116 #endif
118 /* -----------------------------------------------------------------------------
119 * Global variables
120 * ---------------------------------------------------------------------------*/
122 /* A shared empty string for the objects string representation.
123 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
124 static char JimEmptyStringRep[] = "";
126 /* -----------------------------------------------------------------------------
127 * Required prototypes of not exported functions
128 * ---------------------------------------------------------------------------*/
129 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
130 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags);
131 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
132 int flags);
133 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
134 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
135 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
136 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
137 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
138 const char *prefix, const char *const *tablePtr, const char *name);
139 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
140 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
141 static int JimSign(jim_wide w);
142 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
143 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
144 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
147 /* Fast access to the int (wide) value of an object which is known to be of int type */
148 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
150 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
152 static int utf8_tounicode_case(const char *s, int *uc, int upper)
154 int l = utf8_tounicode(s, uc);
155 if (upper) {
156 *uc = utf8_upper(*uc);
158 return l;
161 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
162 #define JIM_CHARSET_SCAN 2
163 #define JIM_CHARSET_GLOB 0
166 * pattern points to a string like "[^a-z\ub5]"
168 * The pattern may contain trailing chars, which are ignored.
170 * The pattern is matched against unicode char 'c'.
172 * If (flags & JIM_NOCASE), case is ignored when matching.
173 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
174 * of the charset, per scan, rather than glob/string match.
176 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
177 * or the null character if the ']' is missing.
179 * Returns NULL on no match.
181 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
183 int not = 0;
184 int pchar;
185 int match = 0;
186 int nocase = 0;
188 if (flags & JIM_NOCASE) {
189 nocase++;
190 c = utf8_upper(c);
193 if (flags & JIM_CHARSET_SCAN) {
194 if (*pattern == '^') {
195 not++;
196 pattern++;
199 /* Special case. If the first char is ']', it is part of the set */
200 if (*pattern == ']') {
201 goto first;
205 while (*pattern && *pattern != ']') {
206 /* Exact match */
207 if (pattern[0] == '\\') {
208 first:
209 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
211 else {
212 /* Is this a range? a-z */
213 int start;
214 int end;
216 pattern += utf8_tounicode_case(pattern, &start, nocase);
217 if (pattern[0] == '-' && pattern[1]) {
218 /* skip '-' */
219 pattern += utf8_tounicode(pattern, &pchar);
220 pattern += utf8_tounicode_case(pattern, &end, nocase);
222 /* Handle reversed range too */
223 if ((c >= start && c <= end) || (c >= end && c <= start)) {
224 match = 1;
226 continue;
228 pchar = start;
231 if (pchar == c) {
232 match = 1;
235 if (not) {
236 match = !match;
239 return match ? pattern : NULL;
242 /* Glob-style pattern matching. */
244 /* Note: string *must* be valid UTF-8 sequences
246 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
248 int c;
249 int pchar;
250 while (*pattern) {
251 switch (pattern[0]) {
252 case '*':
253 while (pattern[1] == '*') {
254 pattern++;
256 pattern++;
257 if (!pattern[0]) {
258 return 1; /* match */
260 while (*string) {
261 /* Recursive call - Does the remaining pattern match anywhere? */
262 if (JimGlobMatch(pattern, string, nocase))
263 return 1; /* match */
264 string += utf8_tounicode(string, &c);
266 return 0; /* no match */
268 case '?':
269 string += utf8_tounicode(string, &c);
270 break;
272 case '[': {
273 string += utf8_tounicode(string, &c);
274 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
275 if (!pattern) {
276 return 0;
278 if (!*pattern) {
279 /* Ran out of pattern (no ']') */
280 continue;
282 break;
284 case '\\':
285 if (pattern[1]) {
286 pattern++;
288 /* fall through */
289 default:
290 string += utf8_tounicode_case(string, &c, nocase);
291 utf8_tounicode_case(pattern, &pchar, nocase);
292 if (pchar != c) {
293 return 0;
295 break;
297 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
298 if (!*string) {
299 while (*pattern == '*') {
300 pattern++;
302 break;
305 if (!*pattern && !*string) {
306 return 1;
308 return 0;
312 * string comparison. Works on binary data.
314 * Returns -1, 0 or 1
316 * Note that the lengths are byte lengths, not char lengths.
318 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
320 if (l1 < l2) {
321 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
323 else if (l2 < l1) {
324 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
326 else {
327 return JimSign(memcmp(s1, s2, l1));
332 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
333 * (or end of string if 'maxchars' is -1).
335 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
337 * Note: does not support embedded nulls.
339 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
341 while (*s1 && *s2 && maxchars) {
342 int c1, c2;
343 s1 += utf8_tounicode_case(s1, &c1, nocase);
344 s2 += utf8_tounicode_case(s2, &c2, nocase);
345 if (c1 != c2) {
346 return JimSign(c1 - c2);
348 maxchars--;
350 if (!maxchars) {
351 return 0;
353 /* One string or both terminated */
354 if (*s1) {
355 return 1;
357 if (*s2) {
358 return -1;
360 return 0;
363 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
364 * The index of the first occurrence of s1 in s2 is returned.
365 * If s1 is not found inside s2, -1 is returned. */
366 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
368 int i;
369 int l1bytelen;
371 if (!l1 || !l2 || l1 > l2) {
372 return -1;
374 if (idx < 0)
375 idx = 0;
376 s2 += utf8_index(s2, idx);
378 l1bytelen = utf8_index(s1, l1);
380 for (i = idx; i <= l2 - l1; i++) {
381 int c;
382 if (memcmp(s2, s1, l1bytelen) == 0) {
383 return i;
385 s2 += utf8_tounicode(s2, &c);
387 return -1;
391 * Note: Lengths and return value are in bytes, not chars.
393 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
395 const char *p;
397 if (!l1 || !l2 || l1 > l2)
398 return -1;
400 /* Now search for the needle */
401 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
402 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
403 return p - s2;
406 return -1;
409 #ifdef JIM_UTF8
411 * Note: Lengths and return value are in chars.
413 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
415 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
416 if (n > 0) {
417 n = utf8_strlen(s2, n);
419 return n;
421 #endif
424 * After an strtol()/strtod()-like conversion,
425 * check whether something was converted and that
426 * the only thing left is white space.
428 * Returns JIM_OK or JIM_ERR.
430 static int JimCheckConversion(const char *str, const char *endptr)
432 if (str[0] == '\0' || str == endptr) {
433 return JIM_ERR;
436 if (endptr[0] != '\0') {
437 while (*endptr) {
438 if (!isspace(UCHAR(*endptr))) {
439 return JIM_ERR;
441 endptr++;
444 return JIM_OK;
447 /* Parses the front of a number to determine it's sign and base
448 * Returns the index to start parsing according to the given base
450 static int JimNumberBase(const char *str, int *base, int *sign)
452 int i = 0;
454 *base = 10;
456 while (isspace(UCHAR(str[i]))) {
457 i++;
460 if (str[i] == '-') {
461 *sign = -1;
462 i++;
464 else {
465 if (str[i] == '+') {
466 i++;
468 *sign = 1;
471 if (str[i] != '0') {
472 /* base 10 */
473 return 0;
476 /* We have 0<x>, so see if we can convert it */
477 switch (str[i + 1]) {
478 case 'x': case 'X': *base = 16; break;
479 case 'o': case 'O': *base = 8; break;
480 case 'b': case 'B': *base = 2; break;
481 default: return 0;
483 i += 2;
484 /* Ensure that (e.g.) 0x-5 fails to parse */
485 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
486 /* Parse according to this base */
487 return i;
489 /* Parse as base 10 */
490 *base = 10;
491 return 0;
494 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
495 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
497 static long jim_strtol(const char *str, char **endptr)
499 int sign;
500 int base;
501 int i = JimNumberBase(str, &base, &sign);
503 if (base != 10) {
504 long value = strtol(str + i, endptr, base);
505 if (endptr == NULL || *endptr != str + i) {
506 return value * sign;
510 /* Can just do a regular base-10 conversion */
511 return strtol(str, endptr, 10);
515 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
516 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
518 static jim_wide jim_strtoull(const char *str, char **endptr)
520 #ifdef HAVE_LONG_LONG
521 int sign;
522 int base;
523 int i = JimNumberBase(str, &base, &sign);
525 if (base != 10) {
526 jim_wide value = strtoull(str + i, endptr, base);
527 if (endptr == NULL || *endptr != str + i) {
528 return value * sign;
532 /* Can just do a regular base-10 conversion */
533 return strtoull(str, endptr, 10);
534 #else
535 return (unsigned long)jim_strtol(str, endptr);
536 #endif
539 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
541 char *endptr;
543 if (base) {
544 *widePtr = strtoull(str, &endptr, base);
546 else {
547 *widePtr = jim_strtoull(str, &endptr);
550 return JimCheckConversion(str, endptr);
553 int Jim_StringToDouble(const char *str, double *doublePtr)
555 char *endptr;
557 /* Callers can check for underflow via ERANGE */
558 errno = 0;
560 *doublePtr = strtod(str, &endptr);
562 return JimCheckConversion(str, endptr);
565 static jim_wide JimPowWide(jim_wide b, jim_wide e)
567 jim_wide i, res = 1;
569 if ((b == 0 && e != 0) || (e < 0))
570 return 0;
571 for (i = 0; i < e; i++) {
572 res *= b;
574 return res;
577 /* -----------------------------------------------------------------------------
578 * Special functions
579 * ---------------------------------------------------------------------------*/
580 #ifdef JIM_DEBUG_PANIC
581 void JimPanicDump(int condition, const char *fmt, ...)
583 va_list ap;
585 if (!condition) {
586 return;
589 va_start(ap, fmt);
591 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
592 vfprintf(stderr, fmt, ap);
593 fprintf(stderr, JIM_NL JIM_NL);
594 va_end(ap);
596 #ifdef HAVE_BACKTRACE
598 void *array[40];
599 int size, i;
600 char **strings;
602 size = backtrace(array, 40);
603 strings = backtrace_symbols(array, size);
604 for (i = 0; i < size; i++)
605 fprintf(stderr, "[backtrace] %s" JIM_NL, strings[i]);
606 fprintf(stderr, "[backtrace] Include the above lines and the output" JIM_NL);
607 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
609 #endif
611 exit(1);
613 #endif
615 /* -----------------------------------------------------------------------------
616 * Memory allocation
617 * ---------------------------------------------------------------------------*/
619 void *Jim_Alloc(int size)
621 return size ? malloc(size) : NULL;
624 void Jim_Free(void *ptr)
626 free(ptr);
629 void *Jim_Realloc(void *ptr, int size)
631 return realloc(ptr, size);
634 char *Jim_StrDup(const char *s)
636 return strdup(s);
639 char *Jim_StrDupLen(const char *s, int l)
641 char *copy = Jim_Alloc(l + 1);
643 memcpy(copy, s, l + 1);
644 copy[l] = 0; /* Just to be sure, original could be substring */
645 return copy;
648 /* -----------------------------------------------------------------------------
649 * Time related functions
650 * ---------------------------------------------------------------------------*/
652 /* Returns current time in microseconds */
653 static jim_wide JimClock(void)
655 struct timeval tv;
657 gettimeofday(&tv, NULL);
658 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
661 /* -----------------------------------------------------------------------------
662 * Hash Tables
663 * ---------------------------------------------------------------------------*/
665 /* -------------------------- private prototypes ---------------------------- */
666 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
667 static unsigned int JimHashTableNextPower(unsigned int size);
668 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
670 /* -------------------------- hash functions -------------------------------- */
672 /* Thomas Wang's 32 bit Mix Function */
673 unsigned int Jim_IntHashFunction(unsigned int key)
675 key += ~(key << 15);
676 key ^= (key >> 10);
677 key += (key << 3);
678 key ^= (key >> 6);
679 key += ~(key << 11);
680 key ^= (key >> 16);
681 return key;
684 /* Generic hash function (we are using to multiply by 9 and add the byte
685 * as Tcl) */
686 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
688 unsigned int h = 0;
690 while (len--)
691 h += (h << 3) + *buf++;
692 return h;
695 /* ----------------------------- API implementation ------------------------- */
697 /* reset a hashtable already initialized */
698 static void JimResetHashTable(Jim_HashTable *ht)
700 ht->table = NULL;
701 ht->size = 0;
702 ht->sizemask = 0;
703 ht->used = 0;
704 ht->collisions = 0;
705 #ifdef JIM_RANDOMISE_HASH
706 /* This is initialised to a random value to avoid a hash collision attack.
707 * See: n.runs-SA-2011.004
709 ht->uniq = (rand() ^ time(NULL) ^ clock());
710 #else
711 ht->uniq = 0;
712 #endif
715 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
717 iter->ht = ht;
718 iter->index = -1;
719 iter->entry = NULL;
720 iter->nextEntry = NULL;
723 /* Initialize the hash table */
724 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
726 JimResetHashTable(ht);
727 ht->type = type;
728 ht->privdata = privDataPtr;
729 return JIM_OK;
732 /* Resize the table to the minimal size that contains all the elements,
733 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
734 void Jim_ResizeHashTable(Jim_HashTable *ht)
736 int minimal = ht->used;
738 if (minimal < JIM_HT_INITIAL_SIZE)
739 minimal = JIM_HT_INITIAL_SIZE;
740 Jim_ExpandHashTable(ht, minimal);
743 /* Expand or create the hashtable */
744 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
746 Jim_HashTable n; /* the new hashtable */
747 unsigned int realsize = JimHashTableNextPower(size), i;
749 /* the size is invalid if it is smaller than the number of
750 * elements already inside the hashtable */
751 if (size <= ht->used)
752 return;
754 Jim_InitHashTable(&n, ht->type, ht->privdata);
755 n.size = realsize;
756 n.sizemask = realsize - 1;
757 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
758 /* Keep the same 'uniq' as the original */
759 n.uniq = ht->uniq;
761 /* Initialize all the pointers to NULL */
762 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
764 /* Copy all the elements from the old to the new table:
765 * note that if the old hash table is empty ht->used is zero,
766 * so Jim_ExpandHashTable just creates an empty hash table. */
767 n.used = ht->used;
768 for (i = 0; ht->used > 0; i++) {
769 Jim_HashEntry *he, *nextHe;
771 if (ht->table[i] == NULL)
772 continue;
774 /* For each hash entry on this slot... */
775 he = ht->table[i];
776 while (he) {
777 unsigned int h;
779 nextHe = he->next;
780 /* Get the new element index */
781 h = Jim_HashKey(ht, he->key) & n.sizemask;
782 he->next = n.table[h];
783 n.table[h] = he;
784 ht->used--;
785 /* Pass to the next element */
786 he = nextHe;
789 assert(ht->used == 0);
790 Jim_Free(ht->table);
792 /* Remap the new hashtable in the old */
793 *ht = n;
796 /* Add an element to the target hash table */
797 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
799 Jim_HashEntry *entry;
801 /* Get the index of the new element, or -1 if
802 * the element already exists. */
803 entry = JimInsertHashEntry(ht, key, 0);
804 if (entry == NULL)
805 return JIM_ERR;
807 /* Set the hash entry fields. */
808 Jim_SetHashKey(ht, entry, key);
809 Jim_SetHashVal(ht, entry, val);
810 return JIM_OK;
813 /* Add an element, discarding the old if the key already exists */
814 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
816 int existed;
817 Jim_HashEntry *entry;
819 /* Get the index of the new element, or -1 if
820 * the element already exists. */
821 entry = JimInsertHashEntry(ht, key, 1);
822 if (entry->key) {
823 /* It already exists, so only replace the value.
824 * Note if both a destructor and a duplicate function exist,
825 * need to dup before destroy. perhaps they are the same
826 * reference counted object
828 if (ht->type->valDestructor && ht->type->valDup) {
829 void *newval = ht->type->valDup(ht->privdata, val);
830 ht->type->valDestructor(ht->privdata, entry->u.val);
831 entry->u.val = newval;
833 else {
834 Jim_FreeEntryVal(ht, entry);
835 Jim_SetHashVal(ht, entry, val);
837 existed = 1;
839 else {
840 /* Doesn't exist, so set the key */
841 Jim_SetHashKey(ht, entry, key);
842 Jim_SetHashVal(ht, entry, val);
843 existed = 0;
846 return existed;
849 /* Search and remove an element */
850 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
852 unsigned int h;
853 Jim_HashEntry *he, *prevHe;
855 if (ht->used == 0)
856 return JIM_ERR;
857 h = Jim_HashKey(ht, key) & ht->sizemask;
858 he = ht->table[h];
860 prevHe = NULL;
861 while (he) {
862 if (Jim_CompareHashKeys(ht, key, he->key)) {
863 /* Unlink the element from the list */
864 if (prevHe)
865 prevHe->next = he->next;
866 else
867 ht->table[h] = he->next;
868 Jim_FreeEntryKey(ht, he);
869 Jim_FreeEntryVal(ht, he);
870 Jim_Free(he);
871 ht->used--;
872 return JIM_OK;
874 prevHe = he;
875 he = he->next;
877 return JIM_ERR; /* not found */
880 /* Destroy an entire hash table */
881 int Jim_FreeHashTable(Jim_HashTable *ht)
883 unsigned int i;
885 /* Free all the elements */
886 for (i = 0; ht->used > 0; i++) {
887 Jim_HashEntry *he, *nextHe;
889 if ((he = ht->table[i]) == NULL)
890 continue;
891 while (he) {
892 nextHe = he->next;
893 Jim_FreeEntryKey(ht, he);
894 Jim_FreeEntryVal(ht, he);
895 Jim_Free(he);
896 ht->used--;
897 he = nextHe;
900 /* Free the table and the allocated cache structure */
901 Jim_Free(ht->table);
902 /* Re-initialize the table */
903 JimResetHashTable(ht);
904 return JIM_OK; /* never fails */
907 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
909 Jim_HashEntry *he;
910 unsigned int h;
912 if (ht->used == 0)
913 return NULL;
914 h = Jim_HashKey(ht, key) & ht->sizemask;
915 he = ht->table[h];
916 while (he) {
917 if (Jim_CompareHashKeys(ht, key, he->key))
918 return he;
919 he = he->next;
921 return NULL;
924 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
926 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
927 JimInitHashTableIterator(ht, iter);
928 return iter;
931 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
933 while (1) {
934 if (iter->entry == NULL) {
935 iter->index++;
936 if (iter->index >= (signed)iter->ht->size)
937 break;
938 iter->entry = iter->ht->table[iter->index];
940 else {
941 iter->entry = iter->nextEntry;
943 if (iter->entry) {
944 /* We need to save the 'next' here, the iterator user
945 * may delete the entry we are returning. */
946 iter->nextEntry = iter->entry->next;
947 return iter->entry;
950 return NULL;
953 /* ------------------------- private functions ------------------------------ */
955 /* Expand the hash table if needed */
956 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
958 /* If the hash table is empty expand it to the intial size,
959 * if the table is "full" dobule its size. */
960 if (ht->size == 0)
961 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
962 if (ht->size == ht->used)
963 Jim_ExpandHashTable(ht, ht->size * 2);
966 /* Our hash table capability is a power of two */
967 static unsigned int JimHashTableNextPower(unsigned int size)
969 unsigned int i = JIM_HT_INITIAL_SIZE;
971 if (size >= 2147483648U)
972 return 2147483648U;
973 while (1) {
974 if (i >= size)
975 return i;
976 i *= 2;
980 /* Returns the index of a free slot that can be populated with
981 * a hash entry for the given 'key'.
982 * If the key already exists, -1 is returned. */
983 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
985 unsigned int h;
986 Jim_HashEntry *he;
988 /* Expand the hashtable if needed */
989 JimExpandHashTableIfNeeded(ht);
991 /* Compute the key hash value */
992 h = Jim_HashKey(ht, key) & ht->sizemask;
993 /* Search if this slot does not already contain the given key */
994 he = ht->table[h];
995 while (he) {
996 if (Jim_CompareHashKeys(ht, key, he->key))
997 return replace ? he : NULL;
998 he = he->next;
1001 /* Allocates the memory and stores key */
1002 he = Jim_Alloc(sizeof(*he));
1003 he->next = ht->table[h];
1004 ht->table[h] = he;
1005 ht->used++;
1006 he->key = NULL;
1008 return he;
1011 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1013 static unsigned int JimStringCopyHTHashFunction(const void *key)
1015 return Jim_GenHashFunction(key, strlen(key));
1018 static void *JimStringCopyHTDup(void *privdata, const void *key)
1020 return Jim_StrDup(key);
1023 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1025 return strcmp(key1, key2) == 0;
1028 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1030 Jim_Free(key);
1033 static const Jim_HashTableType JimPackageHashTableType = {
1034 JimStringCopyHTHashFunction, /* hash function */
1035 JimStringCopyHTDup, /* key dup */
1036 NULL, /* val dup */
1037 JimStringCopyHTKeyCompare, /* key compare */
1038 JimStringCopyHTKeyDestructor, /* key destructor */
1039 NULL /* val destructor */
1042 typedef struct AssocDataValue
1044 Jim_InterpDeleteProc *delProc;
1045 void *data;
1046 } AssocDataValue;
1048 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1050 AssocDataValue *assocPtr = (AssocDataValue *) data;
1052 if (assocPtr->delProc != NULL)
1053 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1054 Jim_Free(data);
1057 static const Jim_HashTableType JimAssocDataHashTableType = {
1058 JimStringCopyHTHashFunction, /* hash function */
1059 JimStringCopyHTDup, /* key dup */
1060 NULL, /* val dup */
1061 JimStringCopyHTKeyCompare, /* key compare */
1062 JimStringCopyHTKeyDestructor, /* key destructor */
1063 JimAssocDataHashTableValueDestructor /* val destructor */
1066 /* -----------------------------------------------------------------------------
1067 * Stack - This is a simple generic stack implementation. It is used for
1068 * example in the 'expr' expression compiler.
1069 * ---------------------------------------------------------------------------*/
1070 void Jim_InitStack(Jim_Stack *stack)
1072 stack->len = 0;
1073 stack->maxlen = 0;
1074 stack->vector = NULL;
1077 void Jim_FreeStack(Jim_Stack *stack)
1079 Jim_Free(stack->vector);
1082 int Jim_StackLen(Jim_Stack *stack)
1084 return stack->len;
1087 void Jim_StackPush(Jim_Stack *stack, void *element)
1089 int neededLen = stack->len + 1;
1091 if (neededLen > stack->maxlen) {
1092 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1093 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1095 stack->vector[stack->len] = element;
1096 stack->len++;
1099 void *Jim_StackPop(Jim_Stack *stack)
1101 if (stack->len == 0)
1102 return NULL;
1103 stack->len--;
1104 return stack->vector[stack->len];
1107 void *Jim_StackPeek(Jim_Stack *stack)
1109 if (stack->len == 0)
1110 return NULL;
1111 return stack->vector[stack->len - 1];
1114 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1116 int i;
1118 for (i = 0; i < stack->len; i++)
1119 freeFunc(stack->vector[i]);
1122 /* -----------------------------------------------------------------------------
1123 * Tcl Parser
1124 * ---------------------------------------------------------------------------*/
1126 /* Token types */
1127 #define JIM_TT_NONE 0 /* No token returned */
1128 #define JIM_TT_STR 1 /* simple string */
1129 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1130 #define JIM_TT_VAR 3 /* var substitution */
1131 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1132 #define JIM_TT_CMD 5 /* command substitution */
1133 /* Note: Keep these three together for TOKEN_IS_SEP() */
1134 #define JIM_TT_SEP 6 /* word separator (white space) */
1135 #define JIM_TT_EOL 7 /* line separator */
1136 #define JIM_TT_EOF 8 /* end of script */
1138 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1139 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1141 /* Additional token types needed for expressions */
1142 #define JIM_TT_SUBEXPR_START 11
1143 #define JIM_TT_SUBEXPR_END 12
1144 #define JIM_TT_SUBEXPR_COMMA 13
1145 #define JIM_TT_EXPR_INT 14
1146 #define JIM_TT_EXPR_DOUBLE 15
1148 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1150 /* Operator token types start here */
1151 #define JIM_TT_EXPR_OP 20
1153 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1155 /* Parser states */
1156 #define JIM_PS_DEF 0 /* Default state */
1157 #define JIM_PS_QUOTE 1 /* Inside "" */
1158 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1160 /* Parser context structure. The same context is used both to parse
1161 * Tcl scripts and lists. */
1162 struct JimParserCtx
1164 const char *p; /* Pointer to the point of the program we are parsing */
1165 int len; /* Remaining length */
1166 int linenr; /* Current line number */
1167 const char *tstart;
1168 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1169 int tline; /* Line number of the returned token */
1170 int tt; /* Token type */
1171 int eof; /* Non zero if EOF condition is true. */
1172 int state; /* Parser state */
1173 int comment; /* Non zero if the next chars may be a comment. */
1174 char missing; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1175 int missingline; /* Line number starting the missing token */
1179 * Results of missing quotes, braces, etc. from parsing.
1181 struct JimParseResult {
1182 char missing; /* From JimParserCtx.missing */
1183 int line; /* From JimParserCtx.missingline */
1186 static int JimParseScript(struct JimParserCtx *pc);
1187 static int JimParseSep(struct JimParserCtx *pc);
1188 static int JimParseEol(struct JimParserCtx *pc);
1189 static int JimParseCmd(struct JimParserCtx *pc);
1190 static int JimParseQuote(struct JimParserCtx *pc);
1191 static int JimParseVar(struct JimParserCtx *pc);
1192 static int JimParseBrace(struct JimParserCtx *pc);
1193 static int JimParseStr(struct JimParserCtx *pc);
1194 static int JimParseComment(struct JimParserCtx *pc);
1195 static void JimParseSubCmd(struct JimParserCtx *pc);
1196 static int JimParseSubQuote(struct JimParserCtx *pc);
1197 static void JimParseSubCmd(struct JimParserCtx *pc);
1198 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1200 /* Initialize a parser context.
1201 * 'prg' is a pointer to the program text, linenr is the line
1202 * number of the first line contained in the program. */
1203 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1205 pc->p = prg;
1206 pc->len = len;
1207 pc->tstart = NULL;
1208 pc->tend = NULL;
1209 pc->tline = 0;
1210 pc->tt = JIM_TT_NONE;
1211 pc->eof = 0;
1212 pc->state = JIM_PS_DEF;
1213 pc->linenr = linenr;
1214 pc->comment = 1;
1215 pc->missing = ' ';
1216 pc->missingline = linenr;
1219 static int JimParseScript(struct JimParserCtx *pc)
1221 while (1) { /* the while is used to reiterate with continue if needed */
1222 if (!pc->len) {
1223 pc->tstart = pc->p;
1224 pc->tend = pc->p - 1;
1225 pc->tline = pc->linenr;
1226 pc->tt = JIM_TT_EOL;
1227 pc->eof = 1;
1228 return JIM_OK;
1230 switch (*(pc->p)) {
1231 case '\\':
1232 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1233 return JimParseSep(pc);
1235 pc->comment = 0;
1236 return JimParseStr(pc);
1237 case ' ':
1238 case '\t':
1239 case '\r':
1240 case '\f':
1241 if (pc->state == JIM_PS_DEF)
1242 return JimParseSep(pc);
1243 pc->comment = 0;
1244 return JimParseStr(pc);
1245 case '\n':
1246 case ';':
1247 pc->comment = 1;
1248 if (pc->state == JIM_PS_DEF)
1249 return JimParseEol(pc);
1250 return JimParseStr(pc);
1251 case '[':
1252 pc->comment = 0;
1253 return JimParseCmd(pc);
1254 case '$':
1255 pc->comment = 0;
1256 if (JimParseVar(pc) == JIM_ERR) {
1257 /* An orphan $. Create as a separate token */
1258 pc->tstart = pc->tend = pc->p++;
1259 pc->len--;
1260 pc->tt = JIM_TT_ESC;
1262 return JIM_OK;
1263 case '#':
1264 if (pc->comment) {
1265 JimParseComment(pc);
1266 continue;
1268 return JimParseStr(pc);
1269 default:
1270 pc->comment = 0;
1271 return JimParseStr(pc);
1273 return JIM_OK;
1277 static int JimParseSep(struct JimParserCtx *pc)
1279 pc->tstart = pc->p;
1280 pc->tline = pc->linenr;
1281 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1282 if (*pc->p == '\n') {
1283 break;
1285 if (*pc->p == '\\') {
1286 pc->p++;
1287 pc->len--;
1288 pc->linenr++;
1290 pc->p++;
1291 pc->len--;
1293 pc->tend = pc->p - 1;
1294 pc->tt = JIM_TT_SEP;
1295 return JIM_OK;
1298 static int JimParseEol(struct JimParserCtx *pc)
1300 pc->tstart = pc->p;
1301 pc->tline = pc->linenr;
1302 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1303 if (*pc->p == '\n')
1304 pc->linenr++;
1305 pc->p++;
1306 pc->len--;
1308 pc->tend = pc->p - 1;
1309 pc->tt = JIM_TT_EOL;
1310 return JIM_OK;
1314 ** Here are the rules for parsing:
1315 ** {braced expression}
1316 ** - Count open and closing braces
1317 ** - Backslash escapes meaning of braces
1319 ** "quoted expression"
1320 ** - First double quote at start of word terminates the expression
1321 ** - Backslash escapes quote and bracket
1322 ** - [commands brackets] are counted/nested
1323 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1325 ** [command expression]
1326 ** - Count open and closing brackets
1327 ** - Backslash escapes quote, bracket and brace
1328 ** - [commands brackets] are counted/nested
1329 ** - "quoted expressions" are parsed according to quoting rules
1330 ** - {braced expressions} are parsed according to brace rules
1332 ** For everything, backslash escapes the next char, newline increments current line
1336 * Parses a braced expression starting at pc->p.
1338 * Positions the parser at the end of the braced expression,
1339 * sets pc->tend and possibly pc->missing.
1341 static void JimParseSubBrace(struct JimParserCtx *pc)
1343 int level = 1;
1345 /* Skip the brace */
1346 pc->p++;
1347 pc->len--;
1348 while (pc->len) {
1349 switch (*pc->p) {
1350 case '\\':
1351 if (pc->len > 1) {
1352 if (*++pc->p == '\n') {
1353 pc->linenr++;
1355 pc->len--;
1357 break;
1359 case '{':
1360 level++;
1361 break;
1363 case '}':
1364 if (--level == 0) {
1365 pc->tend = pc->p - 1;
1366 pc->p++;
1367 pc->len--;
1368 return;
1370 break;
1372 case '\n':
1373 pc->linenr++;
1374 break;
1376 pc->p++;
1377 pc->len--;
1379 pc->missing = '{';
1380 pc->missingline = pc->tline;
1381 pc->tend = pc->p - 1;
1385 * Parses a quoted expression starting at pc->p.
1387 * Positions the parser at the end of the quoted expression,
1388 * sets pc->tend and possibly pc->missing.
1390 * Returns the type of the token of the string,
1391 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1392 * or JIM_TT_STR.
1394 static int JimParseSubQuote(struct JimParserCtx *pc)
1396 int tt = JIM_TT_STR;
1397 int line = pc->tline;
1399 /* Skip the quote */
1400 pc->p++;
1401 pc->len--;
1402 while (pc->len) {
1403 switch (*pc->p) {
1404 case '\\':
1405 if (pc->len > 1) {
1406 if (*++pc->p == '\n') {
1407 pc->linenr++;
1409 pc->len--;
1410 tt = JIM_TT_ESC;
1412 break;
1414 case '"':
1415 pc->tend = pc->p - 1;
1416 pc->p++;
1417 pc->len--;
1418 return tt;
1420 case '[':
1421 JimParseSubCmd(pc);
1422 tt = JIM_TT_ESC;
1423 continue;
1425 case '\n':
1426 pc->linenr++;
1427 break;
1429 case '$':
1430 tt = JIM_TT_ESC;
1431 break;
1433 pc->p++;
1434 pc->len--;
1436 pc->missing = '"';
1437 pc->missingline = line;
1438 pc->tend = pc->p - 1;
1439 return tt;
1443 * Parses a [command] expression starting at pc->p.
1445 * Positions the parser at the end of the command expression,
1446 * sets pc->tend and possibly pc->missing.
1448 static void JimParseSubCmd(struct JimParserCtx *pc)
1450 int level = 1;
1451 int startofword = 1;
1452 int line = pc->tline;
1454 /* Skip the bracket */
1455 pc->p++;
1456 pc->len--;
1457 while (pc->len) {
1458 switch (*pc->p) {
1459 case '\\':
1460 if (pc->len > 1) {
1461 if (*++pc->p == '\n') {
1462 pc->linenr++;
1464 pc->len--;
1466 break;
1468 case '[':
1469 level++;
1470 break;
1472 case ']':
1473 if (--level == 0) {
1474 pc->tend = pc->p - 1;
1475 pc->p++;
1476 pc->len--;
1477 return;
1479 break;
1481 case '"':
1482 if (startofword) {
1483 JimParseSubQuote(pc);
1484 continue;
1486 break;
1488 case '{':
1489 JimParseSubBrace(pc);
1490 startofword = 0;
1491 continue;
1493 case '\n':
1494 pc->linenr++;
1495 break;
1497 startofword = isspace(UCHAR(*pc->p));
1498 pc->p++;
1499 pc->len--;
1501 pc->missing = '[';
1502 pc->missingline = line;
1503 pc->tend = pc->p - 1;
1506 static int JimParseBrace(struct JimParserCtx *pc)
1508 pc->tstart = pc->p + 1;
1509 pc->tline = pc->linenr;
1510 pc->tt = JIM_TT_STR;
1511 JimParseSubBrace(pc);
1512 return JIM_OK;
1515 static int JimParseCmd(struct JimParserCtx *pc)
1517 pc->tstart = pc->p + 1;
1518 pc->tline = pc->linenr;
1519 pc->tt = JIM_TT_CMD;
1520 JimParseSubCmd(pc);
1521 return JIM_OK;
1524 static int JimParseQuote(struct JimParserCtx *pc)
1526 pc->tstart = pc->p + 1;
1527 pc->tline = pc->linenr;
1528 pc->tt = JimParseSubQuote(pc);
1529 return JIM_OK;
1532 static int JimParseVar(struct JimParserCtx *pc)
1534 /* skip the $ */
1535 pc->p++;
1536 pc->len--;
1538 #ifdef EXPRSUGAR_BRACKET
1539 if (*pc->p == '[') {
1540 /* Parse $[...] expr shorthand syntax */
1541 JimParseCmd(pc);
1542 pc->tt = JIM_TT_EXPRSUGAR;
1543 return JIM_OK;
1545 #endif
1547 pc->tstart = pc->p;
1548 pc->tt = JIM_TT_VAR;
1549 pc->tline = pc->linenr;
1551 if (*pc->p == '{') {
1552 pc->tstart = ++pc->p;
1553 pc->len--;
1555 while (pc->len && *pc->p != '}') {
1556 if (*pc->p == '\n') {
1557 pc->linenr++;
1559 pc->p++;
1560 pc->len--;
1562 pc->tend = pc->p - 1;
1563 if (pc->len) {
1564 pc->p++;
1565 pc->len--;
1568 else {
1569 while (1) {
1570 /* Skip double colon, but not single colon! */
1571 if (pc->p[0] == ':' && pc->p[1] == ':') {
1572 while (*pc->p == ':') {
1573 pc->p++;
1574 pc->len--;
1576 continue;
1578 /* Note that any char >= 0x80 must be part of a utf-8 char.
1579 * We consider all unicode points outside of ASCII as letters
1581 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1582 pc->p++;
1583 pc->len--;
1584 continue;
1586 break;
1588 /* Parse [dict get] syntax sugar. */
1589 if (*pc->p == '(') {
1590 int count = 1;
1591 const char *paren = NULL;
1593 pc->tt = JIM_TT_DICTSUGAR;
1595 while (count && pc->len) {
1596 pc->p++;
1597 pc->len--;
1598 if (*pc->p == '\\' && pc->len >= 1) {
1599 pc->p++;
1600 pc->len--;
1602 else if (*pc->p == '(') {
1603 count++;
1605 else if (*pc->p == ')') {
1606 paren = pc->p;
1607 count--;
1610 if (count == 0) {
1611 pc->p++;
1612 pc->len--;
1614 else if (paren) {
1615 /* Did not find a matching paren. Back up */
1616 paren++;
1617 pc->len += (pc->p - paren);
1618 pc->p = paren;
1620 #ifndef EXPRSUGAR_BRACKET
1621 if (*pc->tstart == '(') {
1622 pc->tt = JIM_TT_EXPRSUGAR;
1624 #endif
1626 pc->tend = pc->p - 1;
1628 /* Check if we parsed just the '$' character.
1629 * That's not a variable so an error is returned
1630 * to tell the state machine to consider this '$' just
1631 * a string. */
1632 if (pc->tstart == pc->p) {
1633 pc->p--;
1634 pc->len++;
1635 return JIM_ERR;
1637 return JIM_OK;
1640 static int JimParseStr(struct JimParserCtx *pc)
1642 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1643 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1644 /* Starting a new word */
1645 if (*pc->p == '{') {
1646 return JimParseBrace(pc);
1648 if (*pc->p == '"') {
1649 pc->state = JIM_PS_QUOTE;
1650 pc->p++;
1651 pc->len--;
1652 /* In case the end quote is missing */
1653 pc->missingline = pc->tline;
1656 pc->tstart = pc->p;
1657 pc->tline = pc->linenr;
1658 while (1) {
1659 if (pc->len == 0) {
1660 if (pc->state == JIM_PS_QUOTE) {
1661 pc->missing = '"';
1663 pc->tend = pc->p - 1;
1664 pc->tt = JIM_TT_ESC;
1665 return JIM_OK;
1667 switch (*pc->p) {
1668 case '\\':
1669 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1670 pc->tend = pc->p - 1;
1671 pc->tt = JIM_TT_ESC;
1672 return JIM_OK;
1674 if (pc->len >= 2) {
1675 if (*(pc->p + 1) == '\n') {
1676 pc->linenr++;
1678 pc->p++;
1679 pc->len--;
1681 else if (pc->len == 1) {
1682 /* End of script with trailing backslash */
1683 pc->missing = '\\';
1685 break;
1686 case '(':
1687 /* If the following token is not '$' just keep going */
1688 if (pc->len > 1 && pc->p[1] != '$') {
1689 break;
1691 case ')':
1692 /* Only need a separate ')' token if the previous was a var */
1693 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1694 if (pc->p == pc->tstart) {
1695 /* At the start of the token, so just return this char */
1696 pc->p++;
1697 pc->len--;
1699 pc->tend = pc->p - 1;
1700 pc->tt = JIM_TT_ESC;
1701 return JIM_OK;
1703 break;
1705 case '$':
1706 case '[':
1707 pc->tend = pc->p - 1;
1708 pc->tt = JIM_TT_ESC;
1709 return JIM_OK;
1710 case ' ':
1711 case '\t':
1712 case '\n':
1713 case '\r':
1714 case '\f':
1715 case ';':
1716 if (pc->state == JIM_PS_DEF) {
1717 pc->tend = pc->p - 1;
1718 pc->tt = JIM_TT_ESC;
1719 return JIM_OK;
1721 else if (*pc->p == '\n') {
1722 pc->linenr++;
1724 break;
1725 case '"':
1726 if (pc->state == JIM_PS_QUOTE) {
1727 pc->tend = pc->p - 1;
1728 pc->tt = JIM_TT_ESC;
1729 pc->p++;
1730 pc->len--;
1731 pc->state = JIM_PS_DEF;
1732 return JIM_OK;
1734 break;
1736 pc->p++;
1737 pc->len--;
1739 return JIM_OK; /* unreached */
1742 static int JimParseComment(struct JimParserCtx *pc)
1744 while (*pc->p) {
1745 if (*pc->p == '\\') {
1746 pc->p++;
1747 pc->len--;
1748 if (pc->len == 0) {
1749 pc->missing = '\\';
1750 return JIM_OK;
1752 if (*pc->p == '\n') {
1753 pc->linenr++;
1756 else if (*pc->p == '\n') {
1757 pc->p++;
1758 pc->len--;
1759 pc->linenr++;
1760 break;
1762 pc->p++;
1763 pc->len--;
1765 return JIM_OK;
1768 /* xdigitval and odigitval are helper functions for JimEscape() */
1769 static int xdigitval(int c)
1771 if (c >= '0' && c <= '9')
1772 return c - '0';
1773 if (c >= 'a' && c <= 'f')
1774 return c - 'a' + 10;
1775 if (c >= 'A' && c <= 'F')
1776 return c - 'A' + 10;
1777 return -1;
1780 static int odigitval(int c)
1782 if (c >= '0' && c <= '7')
1783 return c - '0';
1784 return -1;
1787 /* Perform Tcl escape substitution of 's', storing the result
1788 * string into 'dest'. The escaped string is guaranteed to
1789 * be the same length or shorted than the source string.
1790 * Slen is the length of the string at 's', if it's -1 the string
1791 * length will be calculated by the function.
1793 * The function returns the length of the resulting string. */
1794 static int JimEscape(char *dest, const char *s, int slen)
1796 char *p = dest;
1797 int i, len;
1799 if (slen == -1)
1800 slen = strlen(s);
1802 for (i = 0; i < slen; i++) {
1803 switch (s[i]) {
1804 case '\\':
1805 switch (s[i + 1]) {
1806 case 'a':
1807 *p++ = 0x7;
1808 i++;
1809 break;
1810 case 'b':
1811 *p++ = 0x8;
1812 i++;
1813 break;
1814 case 'f':
1815 *p++ = 0xc;
1816 i++;
1817 break;
1818 case 'n':
1819 *p++ = 0xa;
1820 i++;
1821 break;
1822 case 'r':
1823 *p++ = 0xd;
1824 i++;
1825 break;
1826 case 't':
1827 *p++ = 0x9;
1828 i++;
1829 break;
1830 case 'u':
1831 case 'U':
1832 case 'x':
1833 /* A unicode or hex sequence.
1834 * \x Expect 1-2 hex chars and convert to hex.
1835 * \u Expect 1-4 hex chars and convert to utf-8.
1836 * \U Expect 1-8 hex chars and convert to utf-8.
1837 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1838 * An invalid sequence means simply the escaped char.
1841 unsigned val = 0;
1842 int k;
1843 int maxchars = 2;
1845 i++;
1847 if (s[i] == 'U') {
1848 maxchars = 8;
1850 else if (s[i] == 'u') {
1851 if (s[i + 1] == '{') {
1852 maxchars = 6;
1853 i++;
1855 else {
1856 maxchars = 4;
1860 for (k = 0; k < maxchars; k++) {
1861 int c = xdigitval(s[i + k + 1]);
1862 if (c == -1) {
1863 break;
1865 val = (val << 4) | c;
1867 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1868 if (s[i] == '{') {
1869 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1870 /* Back up */
1871 i--;
1872 k = 0;
1874 else {
1875 /* Skip the closing brace */
1876 k++;
1879 if (k) {
1880 /* Got a valid sequence, so convert */
1881 if (s[i] == 'x') {
1882 *p++ = val;
1884 else {
1885 p += utf8_fromunicode(p, val);
1887 i += k;
1888 break;
1890 /* Not a valid codepoint, just an escaped char */
1891 *p++ = s[i];
1893 break;
1894 case 'v':
1895 *p++ = 0xb;
1896 i++;
1897 break;
1898 case '\0':
1899 *p++ = '\\';
1900 i++;
1901 break;
1902 case '\n':
1903 /* Replace all spaces and tabs after backslash newline with a single space*/
1904 *p++ = ' ';
1905 do {
1906 i++;
1907 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1908 break;
1909 case '0':
1910 case '1':
1911 case '2':
1912 case '3':
1913 case '4':
1914 case '5':
1915 case '6':
1916 case '7':
1917 /* octal escape */
1919 int val = 0;
1920 int c = odigitval(s[i + 1]);
1922 val = c;
1923 c = odigitval(s[i + 2]);
1924 if (c == -1) {
1925 *p++ = val;
1926 i++;
1927 break;
1929 val = (val * 8) + c;
1930 c = odigitval(s[i + 3]);
1931 if (c == -1) {
1932 *p++ = val;
1933 i += 2;
1934 break;
1936 val = (val * 8) + c;
1937 *p++ = val;
1938 i += 3;
1940 break;
1941 default:
1942 *p++ = s[i + 1];
1943 i++;
1944 break;
1946 break;
1947 default:
1948 *p++ = s[i];
1949 break;
1952 len = p - dest;
1953 *p = '\0';
1954 return len;
1957 /* Returns a dynamically allocated copy of the current token in the
1958 * parser context. The function performs conversion of escapes if
1959 * the token is of type JIM_TT_ESC.
1961 * Note that after the conversion, tokens that are grouped with
1962 * braces in the source code, are always recognizable from the
1963 * identical string obtained in a different way from the type.
1965 * For example the string:
1967 * {*}$a
1969 * will return as first token "*", of type JIM_TT_STR
1971 * While the string:
1973 * *$a
1975 * will return as first token "*", of type JIM_TT_ESC
1977 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1979 const char *start, *end;
1980 char *token;
1981 int len;
1983 start = pc->tstart;
1984 end = pc->tend;
1985 if (start > end) {
1986 len = 0;
1987 token = Jim_Alloc(1);
1988 token[0] = '\0';
1990 else {
1991 len = (end - start) + 1;
1992 token = Jim_Alloc(len + 1);
1993 if (pc->tt != JIM_TT_ESC) {
1994 /* No escape conversion needed? Just copy it. */
1995 memcpy(token, start, len);
1996 token[len] = '\0';
1998 else {
1999 /* Else convert the escape chars. */
2000 len = JimEscape(token, start, len);
2004 return Jim_NewStringObjNoAlloc(interp, token, len);
2007 /* Parses the given string to determine if it represents a complete script.
2009 * This is useful for interactive shells implementation, for [info complete].
2011 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2012 * '{' on scripts incomplete missing one or more '}' to be balanced.
2013 * '[' on scripts incomplete missing one or more ']' to be balanced.
2014 * '"' on scripts incomplete missing a '"' char.
2015 * '\\' on scripts with a trailing backslash.
2017 * If the script is complete, 1 is returned, otherwise 0.
2019 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2021 struct JimParserCtx parser;
2023 JimParserInit(&parser, s, len, 1);
2024 while (!parser.eof) {
2025 JimParseScript(&parser);
2027 if (stateCharPtr) {
2028 *stateCharPtr = parser.missing;
2030 return parser.missing == ' ';
2033 /* -----------------------------------------------------------------------------
2034 * Tcl Lists parsing
2035 * ---------------------------------------------------------------------------*/
2036 static int JimParseListSep(struct JimParserCtx *pc);
2037 static int JimParseListStr(struct JimParserCtx *pc);
2038 static int JimParseListQuote(struct JimParserCtx *pc);
2040 static int JimParseList(struct JimParserCtx *pc)
2042 if (isspace(UCHAR(*pc->p))) {
2043 return JimParseListSep(pc);
2045 switch (*pc->p) {
2046 case '"':
2047 return JimParseListQuote(pc);
2049 case '{':
2050 return JimParseBrace(pc);
2052 default:
2053 if (pc->len) {
2054 return JimParseListStr(pc);
2056 break;
2059 pc->tstart = pc->tend = pc->p;
2060 pc->tline = pc->linenr;
2061 pc->tt = JIM_TT_EOL;
2062 pc->eof = 1;
2063 return JIM_OK;
2066 static int JimParseListSep(struct JimParserCtx *pc)
2068 pc->tstart = pc->p;
2069 pc->tline = pc->linenr;
2070 while (isspace(UCHAR(*pc->p))) {
2071 if (*pc->p == '\n') {
2072 pc->linenr++;
2074 pc->p++;
2075 pc->len--;
2077 pc->tend = pc->p - 1;
2078 pc->tt = JIM_TT_SEP;
2079 return JIM_OK;
2082 static int JimParseListQuote(struct JimParserCtx *pc)
2084 pc->p++;
2085 pc->len--;
2087 pc->tstart = pc->p;
2088 pc->tline = pc->linenr;
2089 pc->tt = JIM_TT_STR;
2091 while (pc->len) {
2092 switch (*pc->p) {
2093 case '\\':
2094 pc->tt = JIM_TT_ESC;
2095 if (--pc->len == 0) {
2096 /* Trailing backslash */
2097 pc->tend = pc->p;
2098 return JIM_OK;
2100 pc->p++;
2101 break;
2102 case '\n':
2103 pc->linenr++;
2104 break;
2105 case '"':
2106 pc->tend = pc->p - 1;
2107 pc->p++;
2108 pc->len--;
2109 return JIM_OK;
2111 pc->p++;
2112 pc->len--;
2115 pc->tend = pc->p - 1;
2116 return JIM_OK;
2119 static int JimParseListStr(struct JimParserCtx *pc)
2121 pc->tstart = pc->p;
2122 pc->tline = pc->linenr;
2123 pc->tt = JIM_TT_STR;
2125 while (pc->len) {
2126 if (isspace(UCHAR(*pc->p))) {
2127 pc->tend = pc->p - 1;
2128 return JIM_OK;
2130 if (*pc->p == '\\') {
2131 if (--pc->len == 0) {
2132 /* Trailing backslash */
2133 pc->tend = pc->p;
2134 return JIM_OK;
2136 pc->tt = JIM_TT_ESC;
2137 pc->p++;
2139 pc->p++;
2140 pc->len--;
2142 pc->tend = pc->p - 1;
2143 return JIM_OK;
2146 /* -----------------------------------------------------------------------------
2147 * Jim_Obj related functions
2148 * ---------------------------------------------------------------------------*/
2150 /* Return a new initialized object. */
2151 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2153 Jim_Obj *objPtr;
2155 /* -- Check if there are objects in the free list -- */
2156 if (interp->freeList != NULL) {
2157 /* -- Unlink the object from the free list -- */
2158 objPtr = interp->freeList;
2159 interp->freeList = objPtr->nextObjPtr;
2161 else {
2162 /* -- No ready to use objects: allocate a new one -- */
2163 objPtr = Jim_Alloc(sizeof(*objPtr));
2166 /* Object is returned with refCount of 0. Every
2167 * kind of GC implemented should take care to don't try
2168 * to scan objects with refCount == 0. */
2169 objPtr->refCount = 0;
2170 /* All the other fields are left not initialized to save time.
2171 * The caller will probably want to set them to the right
2172 * value anyway. */
2174 /* -- Put the object into the live list -- */
2175 objPtr->prevObjPtr = NULL;
2176 objPtr->nextObjPtr = interp->liveList;
2177 if (interp->liveList)
2178 interp->liveList->prevObjPtr = objPtr;
2179 interp->liveList = objPtr;
2181 return objPtr;
2184 /* Free an object. Actually objects are never freed, but
2185 * just moved to the free objects list, where they will be
2186 * reused by Jim_NewObj(). */
2187 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2189 /* Check if the object was already freed, panic. */
2190 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2191 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2193 /* Free the internal representation */
2194 Jim_FreeIntRep(interp, objPtr);
2195 /* Free the string representation */
2196 if (objPtr->bytes != NULL) {
2197 if (objPtr->bytes != JimEmptyStringRep)
2198 Jim_Free(objPtr->bytes);
2200 /* Unlink the object from the live objects list */
2201 if (objPtr->prevObjPtr)
2202 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2203 if (objPtr->nextObjPtr)
2204 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2205 if (interp->liveList == objPtr)
2206 interp->liveList = objPtr->nextObjPtr;
2207 #ifdef JIM_DISABLE_OBJECT_POOL
2208 Jim_Free(objPtr);
2209 #else
2210 /* Link the object into the free objects list */
2211 objPtr->prevObjPtr = NULL;
2212 objPtr->nextObjPtr = interp->freeList;
2213 if (interp->freeList)
2214 interp->freeList->prevObjPtr = objPtr;
2215 interp->freeList = objPtr;
2216 objPtr->refCount = -1;
2217 #endif
2220 /* Invalidate the string representation of an object. */
2221 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2223 if (objPtr->bytes != NULL) {
2224 if (objPtr->bytes != JimEmptyStringRep)
2225 Jim_Free(objPtr->bytes);
2227 objPtr->bytes = NULL;
2230 /* Duplicate an object. The returned object has refcount = 0. */
2231 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2233 Jim_Obj *dupPtr;
2235 dupPtr = Jim_NewObj(interp);
2236 if (objPtr->bytes == NULL) {
2237 /* Object does not have a valid string representation. */
2238 dupPtr->bytes = NULL;
2240 else if (objPtr->length == 0) {
2241 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2242 dupPtr->bytes = JimEmptyStringRep;
2243 dupPtr->length = 0;
2244 dupPtr->typePtr = NULL;
2245 return dupPtr;
2247 else {
2248 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2249 dupPtr->length = objPtr->length;
2250 /* Copy the null byte too */
2251 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2254 /* By default, the new object has the same type as the old object */
2255 dupPtr->typePtr = objPtr->typePtr;
2256 if (objPtr->typePtr != NULL) {
2257 if (objPtr->typePtr->dupIntRepProc == NULL) {
2258 dupPtr->internalRep = objPtr->internalRep;
2260 else {
2261 /* The dup proc may set a different type, e.g. NULL */
2262 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2265 return dupPtr;
2268 /* Return the string representation for objPtr. If the object's
2269 * string representation is invalid, calls the updateStringProc method to create
2270 * a new one from the internal representation of the object.
2272 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2274 if (objPtr->bytes == NULL) {
2275 /* Invalid string repr. Generate it. */
2276 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2277 objPtr->typePtr->updateStringProc(objPtr);
2279 if (lenPtr)
2280 *lenPtr = objPtr->length;
2281 return objPtr->bytes;
2284 /* Just returns the length of the object's string rep */
2285 int Jim_Length(Jim_Obj *objPtr)
2287 if (objPtr->bytes == NULL) {
2288 /* Invalid string repr. Generate it. */
2289 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2290 objPtr->typePtr->updateStringProc(objPtr);
2292 return objPtr->length;
2295 /* Just returns the length of the object's string rep */
2296 const char *Jim_String(Jim_Obj *objPtr)
2298 if (objPtr->bytes == NULL) {
2299 /* Invalid string repr. Generate it. */
2300 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2301 objPtr->typePtr->updateStringProc(objPtr);
2303 return objPtr->bytes;
2306 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2308 objPtr->bytes = Jim_StrDup(str);
2309 objPtr->length = strlen(str);
2312 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2313 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2315 static const Jim_ObjType dictSubstObjType = {
2316 "dict-substitution",
2317 FreeDictSubstInternalRep,
2318 DupDictSubstInternalRep,
2319 NULL,
2320 JIM_TYPE_NONE,
2323 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2325 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2328 static const Jim_ObjType interpolatedObjType = {
2329 "interpolated",
2330 FreeInterpolatedInternalRep,
2331 NULL,
2332 NULL,
2333 JIM_TYPE_NONE,
2336 /* -----------------------------------------------------------------------------
2337 * String Object
2338 * ---------------------------------------------------------------------------*/
2339 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2340 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2342 static const Jim_ObjType stringObjType = {
2343 "string",
2344 NULL,
2345 DupStringInternalRep,
2346 NULL,
2347 JIM_TYPE_REFERENCES,
2350 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2352 JIM_NOTUSED(interp);
2354 /* This is a bit subtle: the only caller of this function
2355 * should be Jim_DuplicateObj(), that will copy the
2356 * string representaion. After the copy, the duplicated
2357 * object will not have more room in the buffer than
2358 * srcPtr->length bytes. So we just set it to length. */
2359 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2360 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2363 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2365 if (objPtr->typePtr != &stringObjType) {
2366 /* Get a fresh string representation. */
2367 if (objPtr->bytes == NULL) {
2368 /* Invalid string repr. Generate it. */
2369 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2370 objPtr->typePtr->updateStringProc(objPtr);
2372 /* Free any other internal representation. */
2373 Jim_FreeIntRep(interp, objPtr);
2374 /* Set it as string, i.e. just set the maxLength field. */
2375 objPtr->typePtr = &stringObjType;
2376 objPtr->internalRep.strValue.maxLength = objPtr->length;
2377 /* Don't know the utf-8 length yet */
2378 objPtr->internalRep.strValue.charLength = -1;
2380 return JIM_OK;
2384 * Returns the length of the object string in chars, not bytes.
2386 * These may be different for a utf-8 string.
2388 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2390 #ifdef JIM_UTF8
2391 SetStringFromAny(interp, objPtr);
2393 if (objPtr->internalRep.strValue.charLength < 0) {
2394 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2396 return objPtr->internalRep.strValue.charLength;
2397 #else
2398 return Jim_Length(objPtr);
2399 #endif
2402 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2403 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2405 Jim_Obj *objPtr = Jim_NewObj(interp);
2407 /* Need to find out how many bytes the string requires */
2408 if (len == -1)
2409 len = strlen(s);
2410 /* Alloc/Set the string rep. */
2411 if (len == 0) {
2412 objPtr->bytes = JimEmptyStringRep;
2414 else {
2415 objPtr->bytes = Jim_Alloc(len + 1);
2416 memcpy(objPtr->bytes, s, len);
2417 objPtr->bytes[len] = '\0';
2419 objPtr->length = len;
2421 /* No typePtr field for the vanilla string object. */
2422 objPtr->typePtr = NULL;
2423 return objPtr;
2426 /* charlen is in characters -- see also Jim_NewStringObj() */
2427 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2429 #ifdef JIM_UTF8
2430 /* Need to find out how many bytes the string requires */
2431 int bytelen = utf8_index(s, charlen);
2433 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2435 /* Remember the utf8 length, so set the type */
2436 objPtr->typePtr = &stringObjType;
2437 objPtr->internalRep.strValue.maxLength = bytelen;
2438 objPtr->internalRep.strValue.charLength = charlen;
2440 return objPtr;
2441 #else
2442 return Jim_NewStringObj(interp, s, charlen);
2443 #endif
2446 /* This version does not try to duplicate the 's' pointer, but
2447 * use it directly. */
2448 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2450 Jim_Obj *objPtr = Jim_NewObj(interp);
2452 objPtr->bytes = s;
2453 objPtr->length = (len == -1) ? strlen(s) : len;
2454 objPtr->typePtr = NULL;
2455 return objPtr;
2458 /* Low-level string append. Use it only against unshared objects
2459 * of type "string". */
2460 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2462 int needlen;
2464 if (len == -1)
2465 len = strlen(str);
2466 needlen = objPtr->length + len;
2467 if (objPtr->internalRep.strValue.maxLength < needlen ||
2468 objPtr->internalRep.strValue.maxLength == 0) {
2469 needlen *= 2;
2470 /* Inefficient to malloc() for less than 8 bytes */
2471 if (needlen < 7) {
2472 needlen = 7;
2474 if (objPtr->bytes == JimEmptyStringRep) {
2475 objPtr->bytes = Jim_Alloc(needlen + 1);
2477 else {
2478 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2480 objPtr->internalRep.strValue.maxLength = needlen;
2482 memcpy(objPtr->bytes + objPtr->length, str, len);
2483 objPtr->bytes[objPtr->length + len] = '\0';
2485 if (objPtr->internalRep.strValue.charLength >= 0) {
2486 /* Update the utf-8 char length */
2487 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2489 objPtr->length += len;
2492 /* Higher level API to append strings to objects.
2493 * Object must not be unshared for each of these.
2495 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2497 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2498 SetStringFromAny(interp, objPtr);
2499 StringAppendString(objPtr, str, len);
2502 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2504 int len;
2505 const char *str = Jim_GetString(appendObjPtr, &len);
2506 Jim_AppendString(interp, objPtr, str, len);
2509 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2511 va_list ap;
2513 SetStringFromAny(interp, objPtr);
2514 va_start(ap, objPtr);
2515 while (1) {
2516 const char *s = va_arg(ap, const char *);
2518 if (s == NULL)
2519 break;
2520 Jim_AppendString(interp, objPtr, s, -1);
2522 va_end(ap);
2525 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2527 const char *aStr, *bStr;
2528 int aLen, bLen;
2530 if (aObjPtr == bObjPtr)
2531 return 1;
2532 aStr = Jim_GetString(aObjPtr, &aLen);
2533 bStr = Jim_GetString(bObjPtr, &bLen);
2534 if (aLen != bLen)
2535 return 0;
2536 return JimStringCompare(aStr, aLen, bStr, bLen) == 0;
2540 * Note. Does not support embedded nulls in either the pattern or the object.
2542 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2544 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2548 * Note: does not support embedded nulls for the nocase option.
2550 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2552 int l1, l2;
2553 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2554 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2556 if (nocase) {
2557 /* Do a character compare for nocase */
2558 return JimStringCompareLen(s1, s2, -1, nocase);
2560 return JimStringCompare(s1, l1, s2, l2);
2564 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2566 * Note: does not support embedded nulls
2568 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2570 const char *s1 = Jim_String(firstObjPtr);
2571 const char *s2 = Jim_String(secondObjPtr);
2573 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2576 /* Convert a range, as returned by Jim_GetRange(), into
2577 * an absolute index into an object of the specified length.
2578 * This function may return negative values, or values
2579 * greater than or equal to the length of the list if the index
2580 * is out of range. */
2581 static int JimRelToAbsIndex(int len, int idx)
2583 if (idx < 0)
2584 return len + idx;
2585 return idx;
2588 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2589 * into a form suitable for implementation of commands like [string range] and [lrange].
2591 * The resulting range is guaranteed to address valid elements of
2592 * the structure.
2594 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2596 int rangeLen;
2598 if (*firstPtr > *lastPtr) {
2599 rangeLen = 0;
2601 else {
2602 rangeLen = *lastPtr - *firstPtr + 1;
2603 if (rangeLen) {
2604 if (*firstPtr < 0) {
2605 rangeLen += *firstPtr;
2606 *firstPtr = 0;
2608 if (*lastPtr >= len) {
2609 rangeLen -= (*lastPtr - (len - 1));
2610 *lastPtr = len - 1;
2614 if (rangeLen < 0)
2615 rangeLen = 0;
2617 *rangeLenPtr = rangeLen;
2620 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2621 int len, int *first, int *last, int *range)
2623 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2624 return JIM_ERR;
2626 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2627 return JIM_ERR;
2629 *first = JimRelToAbsIndex(len, *first);
2630 *last = JimRelToAbsIndex(len, *last);
2631 JimRelToAbsRange(len, first, last, range);
2632 return JIM_OK;
2635 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2636 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2638 int first, last;
2639 const char *str;
2640 int rangeLen;
2641 int bytelen;
2643 str = Jim_GetString(strObjPtr, &bytelen);
2645 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2646 return NULL;
2649 if (first == 0 && rangeLen == bytelen) {
2650 return strObjPtr;
2652 return Jim_NewStringObj(interp, str + first, rangeLen);
2655 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2656 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2658 #ifdef JIM_UTF8
2659 int first, last;
2660 const char *str;
2661 int len, rangeLen;
2662 int bytelen;
2664 str = Jim_GetString(strObjPtr, &bytelen);
2665 len = Jim_Utf8Length(interp, strObjPtr);
2667 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2668 return NULL;
2671 if (first == 0 && rangeLen == len) {
2672 return strObjPtr;
2674 if (len == bytelen) {
2675 /* ASCII optimisation */
2676 return Jim_NewStringObj(interp, str + first, rangeLen);
2678 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2679 #else
2680 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2681 #endif
2684 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2685 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2687 int first, last;
2688 const char *str;
2689 int len, rangeLen;
2690 Jim_Obj *objPtr;
2692 len = Jim_Utf8Length(interp, strObjPtr);
2694 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2695 return NULL;
2698 if (last < first) {
2699 return strObjPtr;
2702 str = Jim_String(strObjPtr);
2704 /* Before part */
2705 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2707 /* Replacement */
2708 if (newStrObj) {
2709 Jim_AppendObj(interp, objPtr, newStrObj);
2712 /* After part */
2713 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2715 return objPtr;
2719 * Note: does not support embedded nulls.
2721 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2723 while (*str) {
2724 int c;
2725 str += utf8_tounicode(str, &c);
2726 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2728 *dest = 0;
2732 * Note: does not support embedded nulls.
2734 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2736 char *buf;
2737 int len;
2738 const char *str;
2740 SetStringFromAny(interp, strObjPtr);
2742 str = Jim_GetString(strObjPtr, &len);
2744 #ifdef JIM_UTF8
2745 /* Case mapping can change the utf-8 length of the string.
2746 * But at worst it will be by one extra byte per char
2748 len *= 2;
2749 #endif
2750 buf = Jim_Alloc(len + 1);
2751 JimStrCopyUpperLower(buf, str, 0);
2752 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2756 * Note: does not support embedded nulls.
2758 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2760 char *buf;
2761 const char *str;
2762 int len;
2764 if (strObjPtr->typePtr != &stringObjType) {
2765 SetStringFromAny(interp, strObjPtr);
2768 str = Jim_GetString(strObjPtr, &len);
2770 #ifdef JIM_UTF8
2771 /* Case mapping can change the utf-8 length of the string.
2772 * But at worst it will be by one extra byte per char
2774 len *= 2;
2775 #endif
2776 buf = Jim_Alloc(len + 1);
2777 JimStrCopyUpperLower(buf, str, 1);
2778 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2782 * Note: does not support embedded nulls.
2784 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2786 char *buf, *p;
2787 int len;
2788 int c;
2789 const char *str;
2791 str = Jim_GetString(strObjPtr, &len);
2792 if (len == 0) {
2793 return strObjPtr;
2795 #ifdef JIM_UTF8
2796 /* Case mapping can change the utf-8 length of the string.
2797 * But at worst it will be by one extra byte per char
2799 len *= 2;
2800 #endif
2801 buf = p = Jim_Alloc(len + 1);
2803 str += utf8_tounicode(str, &c);
2804 p += utf8_getchars(p, utf8_title(c));
2806 JimStrCopyUpperLower(p, str, 0);
2808 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2811 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2812 * for unicode character 'c'.
2813 * Returns the position if found or NULL if not
2815 static const char *utf8_memchr(const char *str, int len, int c)
2817 #ifdef JIM_UTF8
2818 while (len) {
2819 int sc;
2820 int n = utf8_tounicode(str, &sc);
2821 if (sc == c) {
2822 return str;
2824 str += n;
2825 len -= n;
2827 return NULL;
2828 #else
2829 return memchr(str, c, len);
2830 #endif
2834 * Searches for the first non-trim char in string (str, len)
2836 * If none is found, returns just past the last char.
2838 * Lengths are in bytes.
2840 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2842 while (len) {
2843 int c;
2844 int n = utf8_tounicode(str, &c);
2846 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2847 /* Not a trim char, so stop */
2848 break;
2850 str += n;
2851 len -= n;
2853 return str;
2857 * Searches backwards for a non-trim char in string (str, len).
2859 * Returns a pointer to just after the non-trim char, or NULL if not found.
2861 * Lengths are in bytes.
2863 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2865 str += len;
2867 while (len) {
2868 int c;
2869 int n = utf8_prev_len(str, len);
2871 len -= n;
2872 str -= n;
2874 n = utf8_tounicode(str, &c);
2876 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2877 return str + n;
2881 return NULL;
2884 static const char default_trim_chars[] = " \t\n\r";
2885 /* sizeof() here includes the null byte */
2886 static int default_trim_chars_len = sizeof(default_trim_chars);
2888 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2890 int len;
2891 const char *str = Jim_GetString(strObjPtr, &len);
2892 const char *trimchars = default_trim_chars;
2893 int trimcharslen = default_trim_chars_len;
2894 const char *newstr;
2896 if (trimcharsObjPtr) {
2897 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2900 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2901 if (newstr == str) {
2902 return strObjPtr;
2905 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2908 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2910 int len;
2911 const char *trimchars = default_trim_chars;
2912 int trimcharslen = default_trim_chars_len;
2913 const char *nontrim;
2915 if (trimcharsObjPtr) {
2916 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2919 SetStringFromAny(interp, strObjPtr);
2921 len = Jim_Length(strObjPtr);
2922 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2924 if (nontrim == NULL) {
2925 /* All trim, so return a zero-length string */
2926 return Jim_NewEmptyStringObj(interp);
2928 if (nontrim == strObjPtr->bytes + len) {
2929 /* All non-trim, so return the original object */
2930 return strObjPtr;
2933 if (Jim_IsShared(strObjPtr)) {
2934 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2936 else {
2937 /* Can modify this string in place */
2938 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2939 strObjPtr->length = (nontrim - strObjPtr->bytes);
2942 return strObjPtr;
2945 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2947 /* First trim left. */
2948 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2950 /* Now trim right */
2951 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2953 /* Note: refCount check is needed since objPtr may be emptyObj */
2954 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2955 /* We don't want this object to be leaked */
2956 Jim_FreeNewObj(interp, objPtr);
2959 return strObjPtr;
2962 /* Some platforms don't have isascii - need a non-macro version */
2963 #ifdef HAVE_ISASCII
2964 #define jim_isascii isascii
2965 #else
2966 static int jim_isascii(int c)
2968 return !(c & ~0x7f);
2970 #endif
2972 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2974 static const char * const strclassnames[] = {
2975 "integer", "alpha", "alnum", "ascii", "digit",
2976 "double", "lower", "upper", "space", "xdigit",
2977 "control", "print", "graph", "punct",
2978 NULL
2980 enum {
2981 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2982 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2983 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2985 int strclass;
2986 int len;
2987 int i;
2988 const char *str;
2989 int (*isclassfunc)(int c) = NULL;
2991 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2992 return JIM_ERR;
2995 str = Jim_GetString(strObjPtr, &len);
2996 if (len == 0) {
2997 Jim_SetResultBool(interp, !strict);
2998 return JIM_OK;
3001 switch (strclass) {
3002 case STR_IS_INTEGER:
3004 jim_wide w;
3005 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3006 return JIM_OK;
3009 case STR_IS_DOUBLE:
3011 double d;
3012 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3013 return JIM_OK;
3016 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3017 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3018 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3019 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3020 case STR_IS_LOWER: isclassfunc = islower; break;
3021 case STR_IS_UPPER: isclassfunc = isupper; break;
3022 case STR_IS_SPACE: isclassfunc = isspace; break;
3023 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3024 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3025 case STR_IS_PRINT: isclassfunc = isprint; break;
3026 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3027 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3028 default:
3029 return JIM_ERR;
3032 for (i = 0; i < len; i++) {
3033 if (!isclassfunc(str[i])) {
3034 Jim_SetResultBool(interp, 0);
3035 return JIM_OK;
3038 Jim_SetResultBool(interp, 1);
3039 return JIM_OK;
3042 /* -----------------------------------------------------------------------------
3043 * Compared String Object
3044 * ---------------------------------------------------------------------------*/
3046 /* This is strange object that allows comparison of a C literal string
3047 * with a Jim object in a very short time if the same comparison is done
3048 * multiple times. For example every time the [if] command is executed,
3049 * Jim has to check if a given argument is "else".
3050 * If the code has no errors, this comparison is true most of the time,
3051 * so we can cache the pointer of the string of the last matching
3052 * comparison inside the object. Because most C compilers perform literal sharing,
3053 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3054 * this works pretty well even if comparisons are at different places
3055 * inside the C code. */
3057 static const Jim_ObjType comparedStringObjType = {
3058 "compared-string",
3059 NULL,
3060 NULL,
3061 NULL,
3062 JIM_TYPE_REFERENCES,
3065 /* The only way this object is exposed to the API is via the following
3066 * function. Returns true if the string and the object string repr.
3067 * are the same, otherwise zero is returned.
3069 * Note: this isn't binary safe, but it hardly needs to be.*/
3070 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3072 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3073 return 1;
3075 else {
3076 const char *objStr = Jim_String(objPtr);
3078 if (strcmp(str, objStr) != 0)
3079 return 0;
3081 if (objPtr->typePtr != &comparedStringObjType) {
3082 Jim_FreeIntRep(interp, objPtr);
3083 objPtr->typePtr = &comparedStringObjType;
3085 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3086 return 1;
3090 static int qsortCompareStringPointers(const void *a, const void *b)
3092 char *const *sa = (char *const *)a;
3093 char *const *sb = (char *const *)b;
3095 return strcmp(*sa, *sb);
3099 /* -----------------------------------------------------------------------------
3100 * Source Object
3102 * This object is just a string from the language point of view, but
3103 * the internal representation contains the filename and line number
3104 * where this token was read. This information is used by
3105 * Jim_EvalObj() if the object passed happens to be of type "source".
3107 * This allows propagation of the information about line numbers and file
3108 * names and gives error messages with absolute line numbers.
3110 * Note that this object uses the internal representation of the Jim_Object,
3111 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3113 * Also the object will be converted to something else if the given
3114 * token it represents in the source file is not something to be
3115 * evaluated (not a script), and will be specialized in some other way,
3116 * so the time overhead is also almost zero.
3117 * ---------------------------------------------------------------------------*/
3119 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3120 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3122 static const Jim_ObjType sourceObjType = {
3123 "source",
3124 FreeSourceInternalRep,
3125 DupSourceInternalRep,
3126 NULL,
3127 JIM_TYPE_REFERENCES,
3130 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3132 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3135 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3137 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3138 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3141 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3142 Jim_Obj *fileNameObj, int lineNumber)
3144 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3145 JimPanic((objPtr->typePtr == &sourceObjType, "JimSetSourceInfo called with non-source object"));
3146 Jim_IncrRefCount(fileNameObj);
3147 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3148 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3149 objPtr->typePtr = &sourceObjType;
3152 /* -----------------------------------------------------------------------------
3153 * ScriptLine Object
3155 * This object is used only in the Script internal represenation.
3156 * For each line of the script, it holds the number of tokens on the line
3157 * and the source line number.
3159 static const Jim_ObjType scriptLineObjType = {
3160 "scriptline",
3161 NULL,
3162 NULL,
3163 NULL,
3164 JIM_NONE,
3167 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3169 Jim_Obj *objPtr;
3171 #ifdef DEBUG_SHOW_SCRIPT
3172 char buf[100];
3173 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3174 objPtr = Jim_NewStringObj(interp, buf, -1);
3175 #else
3176 objPtr = Jim_NewEmptyStringObj(interp);
3177 #endif
3178 objPtr->typePtr = &scriptLineObjType;
3179 objPtr->internalRep.scriptLineValue.argc = argc;
3180 objPtr->internalRep.scriptLineValue.line = line;
3182 return objPtr;
3185 /* -----------------------------------------------------------------------------
3186 * Script Object
3188 * This object holds the parsed internal representation of a script.
3189 * This representation is help within an allocated ScriptObj (see below)
3191 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3192 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3193 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result);
3195 static const Jim_ObjType scriptObjType = {
3196 "script",
3197 FreeScriptInternalRep,
3198 DupScriptInternalRep,
3199 NULL,
3200 JIM_TYPE_REFERENCES,
3203 /* Each token of a script is represented by a ScriptToken.
3204 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3205 * can be specialized by commands operating on it.
3207 typedef struct ScriptToken
3209 Jim_Obj *objPtr;
3210 int type;
3211 } ScriptToken;
3213 /* This is the script object internal representation. An array of
3214 * ScriptToken structures, including a pre-computed representation of the
3215 * command length and arguments.
3217 * For example the script:
3219 * puts hello
3220 * set $i $x$y [foo]BAR
3222 * will produce a ScriptObj with the following ScriptToken's:
3224 * LIN 2
3225 * ESC puts
3226 * ESC hello
3227 * LIN 4
3228 * ESC set
3229 * VAR i
3230 * WRD 2
3231 * VAR x
3232 * VAR y
3233 * WRD 2
3234 * CMD foo
3235 * ESC BAR
3237 * "puts hello" has two args (LIN 2), composed of single tokens.
3238 * (Note that the WRD token is omitted for the common case of a single token.)
3240 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3241 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3243 * The precomputation of the command structure makes Jim_Eval() faster,
3244 * and simpler because there aren't dynamic lengths / allocations.
3246 * -- {expand}/{*} handling --
3248 * Expand is handled in a special way.
3250 * If a "word" begins with {*}, the word token count is -ve.
3252 * For example the command:
3254 * list {*}{a b}
3256 * Will produce the following cmdstruct array:
3258 * LIN 2
3259 * ESC list
3260 * WRD -1
3261 * STR a b
3263 * Note that the 'LIN' token also contains the source information for the
3264 * first word of the line for error reporting purposes
3266 * -- the substFlags field of the structure --
3268 * The scriptObj structure is used to represent both "script" objects
3269 * and "subst" objects. In the second case, the there are no LIN and WRD
3270 * tokens. Instead SEP and EOL tokens are added as-is.
3271 * In addition, the field 'substFlags' is used to represent the flags used to turn
3272 * the string into the internal representation.
3273 * If these flags do not match what the application requires,
3274 * the scriptObj is created again. For example the script:
3276 * subst -nocommands $string
3277 * subst -novariables $string
3279 * Will (re)create the internal representation of the $string object
3280 * two times.
3282 typedef struct ScriptObj
3284 ScriptToken *token; /* Tokens array. */
3285 Jim_Obj *fileNameObj; /* Filename */
3286 int len; /* Length of token[] */
3287 int substFlags; /* flags used for the compilation of "subst" objects */
3288 int inUse; /* Used to share a ScriptObj. Currently
3289 only used by Jim_EvalObj() as protection against
3290 shimmering of the currently evaluated object. */
3291 int firstline; /* Line number of the first line */
3292 int linenr; /* Line number of the current line */
3293 } ScriptObj;
3295 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3297 int i;
3298 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3300 if (--script->inUse != 0)
3301 return;
3302 for (i = 0; i < script->len; i++) {
3303 Jim_DecrRefCount(interp, script->token[i].objPtr);
3305 Jim_Free(script->token);
3306 Jim_DecrRefCount(interp, script->fileNameObj);
3307 Jim_Free(script);
3310 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3312 JIM_NOTUSED(interp);
3313 JIM_NOTUSED(srcPtr);
3315 /* Just return a simple string. We don't try to preserve the source info
3316 * since in practice scripts are never duplicated
3318 dupPtr->typePtr = NULL;
3321 /* A simple parse token.
3322 * As the script is parsed, the created tokens point into the script string rep.
3324 typedef struct
3326 const char *token; /* Pointer to the start of the token */
3327 int len; /* Length of this token */
3328 int type; /* Token type */
3329 int line; /* Line number */
3330 } ParseToken;
3332 /* A list of parsed tokens representing a script.
3333 * Tokens are added to this list as the script is parsed.
3334 * It grows as needed.
3336 typedef struct
3338 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3339 ParseToken *list; /* Array of tokens */
3340 int size; /* Current size of the list */
3341 int count; /* Number of entries used */
3342 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3343 } ParseTokenList;
3345 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3347 tokenlist->list = tokenlist->static_list;
3348 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3349 tokenlist->count = 0;
3352 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3354 if (tokenlist->list != tokenlist->static_list) {
3355 Jim_Free(tokenlist->list);
3360 * Adds the new token to the tokenlist.
3361 * The token has the given length, type and line number.
3362 * The token list is resized as necessary.
3364 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3365 int line)
3367 ParseToken *t;
3369 if (tokenlist->count == tokenlist->size) {
3370 /* Resize the list */
3371 tokenlist->size *= 2;
3372 if (tokenlist->list != tokenlist->static_list) {
3373 tokenlist->list =
3374 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3376 else {
3377 /* The list needs to become allocated */
3378 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3379 memcpy(tokenlist->list, tokenlist->static_list,
3380 tokenlist->count * sizeof(*tokenlist->list));
3383 t = &tokenlist->list[tokenlist->count++];
3384 t->token = token;
3385 t->len = len;
3386 t->type = type;
3387 t->line = line;
3390 /* Counts the number of adjoining non-separator tokens.
3392 * Returns -ve if the first token is the expansion
3393 * operator (in which case the count doesn't include
3394 * that token).
3396 static int JimCountWordTokens(ParseToken *t)
3398 int expand = 1;
3399 int count = 0;
3401 /* Is the first word {*} or {expand}? */
3402 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3403 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3404 /* Create an expand token */
3405 expand = -1;
3406 t++;
3410 /* Now count non-separator words */
3411 while (!TOKEN_IS_SEP(t->type)) {
3412 t++;
3413 count++;
3416 return count * expand;
3420 * Create a script/subst object from the given token.
3422 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3424 Jim_Obj *objPtr;
3426 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3427 /* Convert backlash escapes. The result will never be longer than the original */
3428 int len = t->len;
3429 char *str = Jim_Alloc(len + 1);
3430 len = JimEscape(str, t->token, len);
3431 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3433 else {
3434 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3435 * with a single space.
3437 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3439 return objPtr;
3443 * Takes a tokenlist and creates the allocated list of script tokens
3444 * in script->token, of length script->len.
3446 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3447 * as required.
3449 * Also sets script->line to the line number of the first token
3451 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3452 ParseTokenList *tokenlist)
3454 int i;
3455 struct ScriptToken *token;
3456 /* Number of tokens so far for the current command */
3457 int lineargs = 0;
3458 /* This is the first token for the current command */
3459 ScriptToken *linefirst;
3460 int count;
3461 int linenr;
3463 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3464 printf("==== Tokens ====\n");
3465 for (i = 0; i < tokenlist->count; i++) {
3466 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3467 tokenlist->list[i].len, tokenlist->list[i].token);
3469 #endif
3471 /* May need up to one extra script token for each EOL in the worst case */
3472 count = tokenlist->count;
3473 for (i = 0; i < tokenlist->count; i++) {
3474 if (tokenlist->list[i].type == JIM_TT_EOL) {
3475 count++;
3478 linenr = script->firstline = tokenlist->list[0].line;
3480 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3482 /* This is the first token for the current command */
3483 linefirst = token++;
3485 for (i = 0; i < tokenlist->count; ) {
3486 /* Look ahead to find out how many tokens make up the next word */
3487 int wordtokens;
3489 /* Skip any leading separators */
3490 while (tokenlist->list[i].type == JIM_TT_SEP) {
3491 i++;
3494 wordtokens = JimCountWordTokens(tokenlist->list + i);
3496 if (wordtokens == 0) {
3497 /* None, so at end of line */
3498 if (lineargs) {
3499 linefirst->type = JIM_TT_LINE;
3500 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3501 Jim_IncrRefCount(linefirst->objPtr);
3503 /* Reset for new line */
3504 lineargs = 0;
3505 linefirst = token++;
3507 i++;
3508 continue;
3510 else if (wordtokens != 1) {
3511 /* More than 1, or {*}, so insert a WORD token */
3512 token->type = JIM_TT_WORD;
3513 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3514 Jim_IncrRefCount(token->objPtr);
3515 token++;
3516 if (wordtokens < 0) {
3517 /* Skip the expand token */
3518 i++;
3519 wordtokens = -wordtokens - 1;
3520 lineargs--;
3524 if (lineargs == 0) {
3525 /* First real token on the line, so record the line number */
3526 linenr = tokenlist->list[i].line;
3528 lineargs++;
3530 /* Add each non-separator word token to the line */
3531 while (wordtokens--) {
3532 const ParseToken *t = &tokenlist->list[i++];
3534 token->type = t->type;
3535 token->objPtr = JimMakeScriptObj(interp, t);
3536 Jim_IncrRefCount(token->objPtr);
3538 /* Every object is initially a string of type 'source', but the
3539 * internal type may be specialized during execution of the
3540 * script. */
3541 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3542 token++;
3546 if (lineargs == 0) {
3547 token--;
3550 script->len = token - script->token;
3552 JimPanic((script->len >= count, "allocated script array is too short"));
3554 #ifdef DEBUG_SHOW_SCRIPT
3555 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3556 for (i = 0; i < script->len; i++) {
3557 const ScriptToken *t = &script->token[i];
3558 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3560 #endif
3565 * Similar to ScriptObjAddTokens(), but for subst objects.
3567 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3568 ParseTokenList *tokenlist)
3570 int i;
3571 struct ScriptToken *token;
3573 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3575 for (i = 0; i < tokenlist->count; i++) {
3576 const ParseToken *t = &tokenlist->list[i];
3578 /* Create a token for 't' */
3579 token->type = t->type;
3580 token->objPtr = JimMakeScriptObj(interp, t);
3581 Jim_IncrRefCount(token->objPtr);
3582 token++;
3585 script->len = i;
3588 /* This method takes the string representation of an object
3589 * as a Tcl script, and generates the pre-parsed internal representation
3590 * of the script. */
3591 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result)
3593 int scriptTextLen;
3594 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3595 struct JimParserCtx parser;
3596 struct ScriptObj *script;
3597 ParseTokenList tokenlist;
3598 int line = 1;
3600 /* Try to get information about filename / line number */
3601 if (objPtr->typePtr == &sourceObjType) {
3602 line = objPtr->internalRep.sourceValue.lineNumber;
3605 /* Initially parse the script into tokens (in tokenlist) */
3606 ScriptTokenListInit(&tokenlist);
3608 JimParserInit(&parser, scriptText, scriptTextLen, line);
3609 while (!parser.eof) {
3610 JimParseScript(&parser);
3611 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3612 parser.tline);
3614 /* Note that we accept a trailing backslash without error */
3615 if (result && parser.missing != ' ' && parser.missing != '\\') {
3616 ScriptTokenListFree(&tokenlist);
3617 result->missing = parser.missing;
3618 result->line = parser.missingline;
3619 return JIM_ERR;
3622 /* Add a final EOF token */
3623 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3625 /* Create the "real" script tokens from the parsed tokens */
3626 script = Jim_Alloc(sizeof(*script));
3627 memset(script, 0, sizeof(*script));
3628 script->inUse = 1;
3629 if (objPtr->typePtr == &sourceObjType) {
3630 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3632 else {
3633 script->fileNameObj = interp->emptyObj;
3635 Jim_IncrRefCount(script->fileNameObj);
3637 ScriptObjAddTokens(interp, script, &tokenlist);
3639 /* No longer need the token list */
3640 ScriptTokenListFree(&tokenlist);
3642 /* Free the old internal rep and set the new one. */
3643 Jim_FreeIntRep(interp, objPtr);
3644 Jim_SetIntRepPtr(objPtr, script);
3645 objPtr->typePtr = &scriptObjType;
3647 return JIM_OK;
3650 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3652 if (objPtr == interp->emptyObj) {
3653 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3654 objPtr = interp->nullScriptObj;
3657 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3658 SetScriptFromAny(interp, objPtr, NULL);
3660 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3663 /* -----------------------------------------------------------------------------
3664 * Commands
3665 * ---------------------------------------------------------------------------*/
3666 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3668 cmdPtr->inUse++;
3671 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3673 if (--cmdPtr->inUse == 0) {
3674 if (cmdPtr->isproc) {
3675 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3676 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3677 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3678 if (cmdPtr->u.proc.staticVars) {
3679 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3680 Jim_Free(cmdPtr->u.proc.staticVars);
3683 else {
3684 /* native (C) */
3685 if (cmdPtr->u.native.delProc) {
3686 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3689 if (cmdPtr->prevCmd) {
3690 /* Delete any pushed command too */
3691 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3693 Jim_Free(cmdPtr);
3697 /* Variables HashTable Type.
3699 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3702 /* Variables HashTable Type.
3704 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3705 static void JimVariablesHTValDestructor(void *interp, void *val)
3707 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3708 Jim_Free(val);
3711 static const Jim_HashTableType JimVariablesHashTableType = {
3712 JimStringCopyHTHashFunction, /* hash function */
3713 JimStringCopyHTDup, /* key dup */
3714 NULL, /* val dup */
3715 JimStringCopyHTKeyCompare, /* key compare */
3716 JimStringCopyHTKeyDestructor, /* key destructor */
3717 JimVariablesHTValDestructor /* val destructor */
3720 /* Commands HashTable Type.
3722 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3724 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3726 JimDecrCmdRefCount(interp, val);
3729 static const Jim_HashTableType JimCommandsHashTableType = {
3730 JimStringCopyHTHashFunction, /* hash function */
3731 JimStringCopyHTDup, /* key dup */
3732 NULL, /* val dup */
3733 JimStringCopyHTKeyCompare, /* key compare */
3734 JimStringCopyHTKeyDestructor, /* key destructor */
3735 JimCommandsHT_ValDestructor /* val destructor */
3738 /* ------------------------- Commands related functions --------------------- */
3740 #ifdef jim_ext_namespace
3742 * Returns the "unscoped" version of the given namespace.
3743 * That is, the fully qualfied name without the leading ::
3744 * The returned value is either nsObj, or an object with a zero ref count.
3746 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3748 const char *name = Jim_String(nsObj);
3749 if (name[0] == ':' && name[1] == ':') {
3750 /* This command is being defined in the global namespace */
3751 while (*++name == ':') {
3753 nsObj = Jim_NewStringObj(interp, name, -1);
3755 else if (Jim_Length(interp->framePtr->nsObj)) {
3756 /* This command is being defined in a non-global namespace */
3757 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3758 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3760 return nsObj;
3763 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3765 Jim_Obj *resultObj;
3767 const char *name = Jim_String(nameObjPtr);
3768 if (name[0] == ':' && name[1] == ':') {
3769 return nameObjPtr;
3771 Jim_IncrRefCount(nameObjPtr);
3772 resultObj = Jim_NewStringObj(interp, "::", -1);
3773 Jim_AppendObj(interp, resultObj, nameObjPtr);
3774 Jim_DecrRefCount(interp, nameObjPtr);
3776 return resultObj;
3780 * An efficient version of JimQualifyNameObj() where the name is
3781 * available (and needed) as a 'const char *'.
3782 * Avoids creating an object if not necessary.
3783 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3785 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3787 Jim_Obj *objPtr = interp->emptyObj;
3789 if (name[0] == ':' && name[1] == ':') {
3790 /* This command is being defined in the global namespace */
3791 while (*++name == ':') {
3794 else if (Jim_Length(interp->framePtr->nsObj)) {
3795 /* This command is being defined in a non-global namespace */
3796 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3797 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3798 name = Jim_String(objPtr);
3800 Jim_IncrRefCount(objPtr);
3801 *objPtrPtr = objPtr;
3802 return name;
3805 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3807 #else
3808 /* We can be more efficient in the no-namespace case */
3809 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3810 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3812 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3814 return nameObjPtr;
3816 #endif
3818 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3820 /* It may already exist, so we try to delete the old one.
3821 * Note that reference count means that it won't be deleted yet if
3822 * it exists in the call stack.
3824 * BUT, if 'local' is in force, instead of deleting the existing
3825 * proc, we stash a reference to the old proc here.
3827 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3828 if (he) {
3829 /* There was an old cmd with the same name,
3830 * so this requires a 'proc epoch' update. */
3832 /* If a procedure with the same name didn't exist there is no need
3833 * to increment the 'proc epoch' because creation of a new procedure
3834 * can never affect existing cached commands. We don't do
3835 * negative caching. */
3836 Jim_InterpIncrProcEpoch(interp);
3839 if (he && interp->local) {
3840 /* Push this command over the top of the previous one */
3841 cmd->prevCmd = he->u.val;
3842 he->u.val = cmd;
3844 else {
3845 if (he) {
3846 /* Replace the existing command */
3847 Jim_DeleteHashEntry(&interp->commands, name);
3850 Jim_AddHashEntry(&interp->commands, name, cmd);
3852 return JIM_OK;
3856 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3857 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3859 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3861 /* Store the new details for this command */
3862 memset(cmdPtr, 0, sizeof(*cmdPtr));
3863 cmdPtr->inUse = 1;
3864 cmdPtr->u.native.delProc = delProc;
3865 cmdPtr->u.native.cmdProc = cmdProc;
3866 cmdPtr->u.native.privData = privData;
3868 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3870 return JIM_OK;
3873 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3875 int len, i;
3877 len = Jim_ListLength(interp, staticsListObjPtr);
3878 if (len == 0) {
3879 return JIM_OK;
3882 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3883 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3884 for (i = 0; i < len; i++) {
3885 Jim_Obj *objPtr = NULL, *initObjPtr = NULL, *nameObjPtr = NULL;
3886 Jim_Var *varPtr;
3887 int subLen;
3889 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3890 /* Check if it's composed of two elements. */
3891 subLen = Jim_ListLength(interp, objPtr);
3892 if (subLen == 1 || subLen == 2) {
3893 /* Try to get the variable value from the current
3894 * environment. */
3895 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3896 if (subLen == 1) {
3897 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3898 if (initObjPtr == NULL) {
3899 Jim_SetResultFormatted(interp,
3900 "variable for initialization of static \"%#s\" not found in the local context",
3901 nameObjPtr);
3902 return JIM_ERR;
3905 else {
3906 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3908 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3909 return JIM_ERR;
3912 varPtr = Jim_Alloc(sizeof(*varPtr));
3913 varPtr->objPtr = initObjPtr;
3914 Jim_IncrRefCount(initObjPtr);
3915 varPtr->linkFramePtr = NULL;
3916 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3917 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3918 Jim_SetResultFormatted(interp,
3919 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3920 Jim_DecrRefCount(interp, initObjPtr);
3921 Jim_Free(varPtr);
3922 return JIM_ERR;
3925 else {
3926 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3927 objPtr);
3928 return JIM_ERR;
3931 return JIM_OK;
3934 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3936 #ifdef jim_ext_namespace
3937 if (cmdPtr->isproc) {
3938 /* XXX: Really need JimNamespaceSplit() */
3939 const char *pt = strrchr(cmdname, ':');
3940 if (pt && pt != cmdname && pt[-1] == ':') {
3941 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3942 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3943 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3945 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3946 /* This commands shadows a global command, so a proc epoch update is required */
3947 Jim_InterpIncrProcEpoch(interp);
3951 #endif
3954 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
3955 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
3957 Jim_Cmd *cmdPtr;
3958 int argListLen;
3959 int i;
3961 argListLen = Jim_ListLength(interp, argListObjPtr);
3963 /* Allocate space for both the command pointer and the arg list */
3964 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
3965 memset(cmdPtr, 0, sizeof(*cmdPtr));
3966 cmdPtr->inUse = 1;
3967 cmdPtr->isproc = 1;
3968 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
3969 cmdPtr->u.proc.argListLen = argListLen;
3970 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
3971 cmdPtr->u.proc.argsPos = -1;
3972 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
3973 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
3974 Jim_IncrRefCount(argListObjPtr);
3975 Jim_IncrRefCount(bodyObjPtr);
3976 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3978 /* Create the statics hash table. */
3979 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
3980 goto err;
3983 /* Parse the args out into arglist, validating as we go */
3984 /* Examine the argument list for default parameters and 'args' */
3985 for (i = 0; i < argListLen; i++) {
3986 Jim_Obj *argPtr;
3987 Jim_Obj *nameObjPtr;
3988 Jim_Obj *defaultObjPtr;
3989 int len;
3991 /* Examine a parameter */
3992 Jim_ListIndex(interp, argListObjPtr, i, &argPtr, JIM_NONE);
3993 len = Jim_ListLength(interp, argPtr);
3994 if (len == 0) {
3995 Jim_SetResultString(interp, "argument with no name", -1);
3996 err:
3997 JimDecrCmdRefCount(interp, cmdPtr);
3998 return NULL;
4000 if (len > 2) {
4001 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4002 goto err;
4005 if (len == 2) {
4006 /* Optional parameter */
4007 Jim_ListIndex(interp, argPtr, 0, &nameObjPtr, JIM_NONE);
4008 Jim_ListIndex(interp, argPtr, 1, &defaultObjPtr, JIM_NONE);
4010 else {
4011 /* Required parameter */
4012 nameObjPtr = argPtr;
4013 defaultObjPtr = NULL;
4017 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4018 if (cmdPtr->u.proc.argsPos >= 0) {
4019 Jim_SetResultString(interp, "'args' specified more than once", -1);
4020 goto err;
4022 cmdPtr->u.proc.argsPos = i;
4024 else {
4025 if (len == 2) {
4026 cmdPtr->u.proc.optArity++;
4028 else {
4029 cmdPtr->u.proc.reqArity++;
4033 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4034 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4037 return cmdPtr;
4040 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4042 int ret = JIM_OK;
4043 Jim_Obj *qualifiedNameObj;
4044 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4046 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4047 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4048 ret = JIM_ERR;
4050 else {
4051 Jim_InterpIncrProcEpoch(interp);
4054 JimFreeQualifiedName(interp, qualifiedNameObj);
4056 return ret;
4059 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4061 int ret = JIM_ERR;
4062 Jim_HashEntry *he;
4063 Jim_Cmd *cmdPtr;
4064 Jim_Obj *qualifiedOldNameObj;
4065 Jim_Obj *qualifiedNewNameObj;
4066 const char *fqold;
4067 const char *fqnew;
4069 if (newName[0] == 0) {
4070 return Jim_DeleteCommand(interp, oldName);
4073 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4074 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4076 /* Does it exist? */
4077 he = Jim_FindHashEntry(&interp->commands, fqold);
4078 if (he == NULL) {
4079 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4081 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4082 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4084 else {
4085 /* Add the new name first */
4086 cmdPtr = he->u.val;
4087 JimIncrCmdRefCount(cmdPtr);
4088 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4089 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4091 /* Now remove the old name */
4092 Jim_DeleteHashEntry(&interp->commands, fqold);
4094 /* Increment the epoch */
4095 Jim_InterpIncrProcEpoch(interp);
4097 ret = JIM_OK;
4100 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4101 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4103 return ret;
4106 /* -----------------------------------------------------------------------------
4107 * Command object
4108 * ---------------------------------------------------------------------------*/
4110 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4112 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4115 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4117 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4118 dupPtr->typePtr = srcPtr->typePtr;
4119 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4122 static const Jim_ObjType commandObjType = {
4123 "command",
4124 FreeCommandInternalRep,
4125 DupCommandInternalRep,
4126 NULL,
4127 JIM_TYPE_REFERENCES,
4130 /* This function returns the command structure for the command name
4131 * stored in objPtr. It tries to specialize the objPtr to contain
4132 * a cached info instead to perform the lookup into the hash table
4133 * every time. The information cached may not be uptodate, in such
4134 * a case the lookup is performed and the cache updated.
4136 * Respects the 'upcall' setting
4138 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4140 Jim_Cmd *cmd;
4142 /* In order to be valid, the proc epoch must match and
4143 * the lookup must have occurred in the same namespace
4145 if (objPtr->typePtr != &commandObjType ||
4146 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4147 #ifdef jim_ext_namespace
4148 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4149 #endif
4151 /* Not cached or out of date, so lookup */
4153 /* Do we need to try the local namespace? */
4154 const char *name = Jim_String(objPtr);
4155 Jim_HashEntry *he;
4157 if (name[0] == ':' && name[1] == ':') {
4158 while (*++name == ':') {
4161 #ifdef jim_ext_namespace
4162 else if (Jim_Length(interp->framePtr->nsObj)) {
4163 /* This command is being defined in a non-global namespace */
4164 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4165 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4166 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4167 Jim_FreeNewObj(interp, nameObj);
4168 if (he) {
4169 goto found;
4172 #endif
4174 /* Lookup in the global namespace */
4175 he = Jim_FindHashEntry(&interp->commands, name);
4176 if (he == NULL) {
4177 if (flags & JIM_ERRMSG) {
4178 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4180 return NULL;
4182 #ifdef jim_ext_namespace
4183 found:
4184 #endif
4185 cmd = (Jim_Cmd *)he->u.val;
4187 /* Free the old internal repr and set the new one. */
4188 Jim_FreeIntRep(interp, objPtr);
4189 objPtr->typePtr = &commandObjType;
4190 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4191 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4192 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4193 Jim_IncrRefCount(interp->framePtr->nsObj);
4195 else {
4196 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4198 while (cmd->u.proc.upcall) {
4199 cmd = cmd->prevCmd;
4201 return cmd;
4204 /* -----------------------------------------------------------------------------
4205 * Variables
4206 * ---------------------------------------------------------------------------*/
4208 /* -----------------------------------------------------------------------------
4209 * Variable object
4210 * ---------------------------------------------------------------------------*/
4212 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4214 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4216 static const Jim_ObjType variableObjType = {
4217 "variable",
4218 NULL,
4219 NULL,
4220 NULL,
4221 JIM_TYPE_REFERENCES,
4225 * Check that the name does not contain embedded nulls.
4227 * Variable and procedure names are maniplated as null terminated strings, so
4228 * don't allow names with embedded nulls.
4230 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4232 /* Variable names and proc names can't contain embedded nulls */
4233 if (nameObjPtr->typePtr != &variableObjType) {
4234 int len;
4235 const char *str = Jim_GetString(nameObjPtr, &len);
4236 if (memchr(str, '\0', len)) {
4237 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4238 return JIM_ERR;
4241 return JIM_OK;
4244 /* This method should be called only by the variable API.
4245 * It returns JIM_OK on success (variable already exists),
4246 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4247 * a variable name, but syntax glue for [dict] i.e. the last
4248 * character is ')' */
4249 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4251 const char *varName;
4252 Jim_CallFrame *framePtr;
4253 Jim_HashEntry *he;
4254 int global;
4255 int len;
4257 /* Check if the object is already an uptodate variable */
4258 if (objPtr->typePtr == &variableObjType) {
4259 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4260 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4261 /* nothing to do */
4262 return JIM_OK;
4264 /* Need to re-resolve the variable in the updated callframe */
4266 else if (objPtr->typePtr == &dictSubstObjType) {
4267 return JIM_DICT_SUGAR;
4269 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4270 return JIM_ERR;
4274 varName = Jim_GetString(objPtr, &len);
4276 /* Make sure it's not syntax glue to get/set dict. */
4277 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4278 return JIM_DICT_SUGAR;
4281 if (varName[0] == ':' && varName[1] == ':') {
4282 while (*++varName == ':') {
4284 global = 1;
4285 framePtr = interp->topFramePtr;
4287 else {
4288 global = 0;
4289 framePtr = interp->framePtr;
4292 /* Resolve this name in the variables hash table */
4293 he = Jim_FindHashEntry(&framePtr->vars, varName);
4294 if (he == NULL) {
4295 if (!global && framePtr->staticVars) {
4296 /* Try with static vars. */
4297 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4299 if (he == NULL) {
4300 return JIM_ERR;
4304 /* Free the old internal repr and set the new one. */
4305 Jim_FreeIntRep(interp, objPtr);
4306 objPtr->typePtr = &variableObjType;
4307 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4308 objPtr->internalRep.varValue.varPtr = he->u.val;
4309 objPtr->internalRep.varValue.global = global;
4310 return JIM_OK;
4313 /* -------------------- Variables related functions ------------------------- */
4314 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4315 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4317 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4319 const char *name;
4320 Jim_CallFrame *framePtr;
4321 int global;
4323 /* New variable to create */
4324 Jim_Var *var = Jim_Alloc(sizeof(*var));
4326 var->objPtr = valObjPtr;
4327 Jim_IncrRefCount(valObjPtr);
4328 var->linkFramePtr = NULL;
4330 name = Jim_String(nameObjPtr);
4331 if (name[0] == ':' && name[1] == ':') {
4332 while (*++name == ':') {
4334 framePtr = interp->topFramePtr;
4335 global = 1;
4337 else {
4338 framePtr = interp->framePtr;
4339 global = 0;
4342 /* Insert the new variable */
4343 Jim_AddHashEntry(&framePtr->vars, name, var);
4345 /* Make the object int rep a variable */
4346 Jim_FreeIntRep(interp, nameObjPtr);
4347 nameObjPtr->typePtr = &variableObjType;
4348 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4349 nameObjPtr->internalRep.varValue.varPtr = var;
4350 nameObjPtr->internalRep.varValue.global = global;
4352 return var;
4355 /* For now that's dummy. Variables lookup should be optimized
4356 * in many ways, with caching of lookups, and possibly with
4357 * a table of pre-allocated vars in every CallFrame for local vars.
4358 * All the caching should also have an 'epoch' mechanism similar
4359 * to the one used by Tcl for procedures lookup caching. */
4361 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4363 int err;
4364 Jim_Var *var;
4366 switch (SetVariableFromAny(interp, nameObjPtr)) {
4367 case JIM_DICT_SUGAR:
4368 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4370 case JIM_ERR:
4371 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4372 return JIM_ERR;
4374 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4375 break;
4377 case JIM_OK:
4378 var = nameObjPtr->internalRep.varValue.varPtr;
4379 if (var->linkFramePtr == NULL) {
4380 Jim_IncrRefCount(valObjPtr);
4381 Jim_DecrRefCount(interp, var->objPtr);
4382 var->objPtr = valObjPtr;
4384 else { /* Else handle the link */
4385 Jim_CallFrame *savedCallFrame;
4387 savedCallFrame = interp->framePtr;
4388 interp->framePtr = var->linkFramePtr;
4389 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4390 interp->framePtr = savedCallFrame;
4391 if (err != JIM_OK)
4392 return err;
4395 return JIM_OK;
4398 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4400 Jim_Obj *nameObjPtr;
4401 int result;
4403 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4404 Jim_IncrRefCount(nameObjPtr);
4405 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4406 Jim_DecrRefCount(interp, nameObjPtr);
4407 return result;
4410 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4412 Jim_CallFrame *savedFramePtr;
4413 int result;
4415 savedFramePtr = interp->framePtr;
4416 interp->framePtr = interp->topFramePtr;
4417 result = Jim_SetVariableStr(interp, name, objPtr);
4418 interp->framePtr = savedFramePtr;
4419 return result;
4422 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4424 Jim_Obj *nameObjPtr, *valObjPtr;
4425 int result;
4427 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4428 valObjPtr = Jim_NewStringObj(interp, val, -1);
4429 Jim_IncrRefCount(nameObjPtr);
4430 Jim_IncrRefCount(valObjPtr);
4431 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4432 Jim_DecrRefCount(interp, nameObjPtr);
4433 Jim_DecrRefCount(interp, valObjPtr);
4434 return result;
4437 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4438 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4440 const char *varName;
4441 const char *targetName;
4442 Jim_CallFrame *framePtr;
4443 Jim_Var *varPtr;
4445 /* Check for an existing variable or link */
4446 switch (SetVariableFromAny(interp, nameObjPtr)) {
4447 case JIM_DICT_SUGAR:
4448 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4449 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4450 return JIM_ERR;
4452 case JIM_OK:
4453 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4455 if (varPtr->linkFramePtr == NULL) {
4456 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4457 return JIM_ERR;
4460 /* It exists, but is a link, so first delete the link */
4461 varPtr->linkFramePtr = NULL;
4462 break;
4465 /* Resolve the call frames for both variables */
4466 /* XXX: SetVariableFromAny() already did this! */
4467 varName = Jim_String(nameObjPtr);
4469 if (varName[0] == ':' && varName[1] == ':') {
4470 while (*++varName == ':') {
4472 /* Linking a global var does nothing */
4473 framePtr = interp->topFramePtr;
4475 else {
4476 framePtr = interp->framePtr;
4479 targetName = Jim_String(targetNameObjPtr);
4480 if (targetName[0] == ':' && targetName[1] == ':') {
4481 while (*++targetName == ':') {
4483 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4484 targetCallFrame = interp->topFramePtr;
4486 Jim_IncrRefCount(targetNameObjPtr);
4488 if (framePtr->level < targetCallFrame->level) {
4489 Jim_SetResultFormatted(interp,
4490 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4491 nameObjPtr);
4492 Jim_DecrRefCount(interp, targetNameObjPtr);
4493 return JIM_ERR;
4496 /* Check for cycles. */
4497 if (framePtr == targetCallFrame) {
4498 Jim_Obj *objPtr = targetNameObjPtr;
4500 /* Cycles are only possible with 'uplevel 0' */
4501 while (1) {
4502 if (strcmp(Jim_String(objPtr), varName) == 0) {
4503 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4504 Jim_DecrRefCount(interp, targetNameObjPtr);
4505 return JIM_ERR;
4507 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4508 break;
4509 varPtr = objPtr->internalRep.varValue.varPtr;
4510 if (varPtr->linkFramePtr != targetCallFrame)
4511 break;
4512 objPtr = varPtr->objPtr;
4516 /* Perform the binding */
4517 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4518 /* We are now sure 'nameObjPtr' type is variableObjType */
4519 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4520 Jim_DecrRefCount(interp, targetNameObjPtr);
4521 return JIM_OK;
4524 /* Return the Jim_Obj pointer associated with a variable name,
4525 * or NULL if the variable was not found in the current context.
4526 * The same optimization discussed in the comment to the
4527 * 'SetVariable' function should apply here.
4529 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4530 * in a dictionary which is shared, the array variable value is duplicated first.
4531 * This allows the array element to be updated (e.g. append, lappend) without
4532 * affecting other references to the dictionary.
4534 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4536 switch (SetVariableFromAny(interp, nameObjPtr)) {
4537 case JIM_OK:{
4538 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4540 if (varPtr->linkFramePtr == NULL) {
4541 return varPtr->objPtr;
4543 else {
4544 Jim_Obj *objPtr;
4546 /* The variable is a link? Resolve it. */
4547 Jim_CallFrame *savedCallFrame = interp->framePtr;
4549 interp->framePtr = varPtr->linkFramePtr;
4550 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4551 interp->framePtr = savedCallFrame;
4552 if (objPtr) {
4553 return objPtr;
4555 /* Error, so fall through to the error message */
4558 break;
4560 case JIM_DICT_SUGAR:
4561 /* [dict] syntax sugar. */
4562 return JimDictSugarGet(interp, nameObjPtr, flags);
4564 if (flags & JIM_ERRMSG) {
4565 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4567 return NULL;
4570 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4572 Jim_CallFrame *savedFramePtr;
4573 Jim_Obj *objPtr;
4575 savedFramePtr = interp->framePtr;
4576 interp->framePtr = interp->topFramePtr;
4577 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4578 interp->framePtr = savedFramePtr;
4580 return objPtr;
4583 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4585 Jim_Obj *nameObjPtr, *varObjPtr;
4587 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4588 Jim_IncrRefCount(nameObjPtr);
4589 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4590 Jim_DecrRefCount(interp, nameObjPtr);
4591 return varObjPtr;
4594 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4596 Jim_CallFrame *savedFramePtr;
4597 Jim_Obj *objPtr;
4599 savedFramePtr = interp->framePtr;
4600 interp->framePtr = interp->topFramePtr;
4601 objPtr = Jim_GetVariableStr(interp, name, flags);
4602 interp->framePtr = savedFramePtr;
4604 return objPtr;
4607 /* Unset a variable.
4608 * Note: On success unset invalidates all the variable objects created
4609 * in the current call frame incrementing. */
4610 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4612 Jim_Var *varPtr;
4613 int retval;
4614 Jim_CallFrame *framePtr;
4616 retval = SetVariableFromAny(interp, nameObjPtr);
4617 if (retval == JIM_DICT_SUGAR) {
4618 /* [dict] syntax sugar. */
4619 return JimDictSugarSet(interp, nameObjPtr, NULL);
4621 else if (retval == JIM_OK) {
4622 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4624 /* If it's a link call UnsetVariable recursively */
4625 if (varPtr->linkFramePtr) {
4626 framePtr = interp->framePtr;
4627 interp->framePtr = varPtr->linkFramePtr;
4628 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4629 interp->framePtr = framePtr;
4631 else {
4632 const char *name = Jim_String(nameObjPtr);
4633 if (nameObjPtr->internalRep.varValue.global) {
4634 name += 2;
4635 framePtr = interp->topFramePtr;
4637 else {
4638 framePtr = interp->framePtr;
4641 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4642 if (retval == JIM_OK) {
4643 /* Change the callframe id, invalidating var lookup caching */
4644 JimChangeCallFrameId(interp, framePtr);
4648 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4649 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4651 return retval;
4654 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4656 /* Given a variable name for [dict] operation syntax sugar,
4657 * this function returns two objects, the first with the name
4658 * of the variable to set, and the second with the rispective key.
4659 * For example "foo(bar)" will return objects with string repr. of
4660 * "foo" and "bar".
4662 * The returned objects have refcount = 1. The function can't fail. */
4663 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4664 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4666 const char *str, *p;
4667 int len, keyLen;
4668 Jim_Obj *varObjPtr, *keyObjPtr;
4670 str = Jim_GetString(objPtr, &len);
4672 p = strchr(str, '(');
4673 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4675 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4677 p++;
4678 keyLen = (str + len) - p;
4679 if (str[len - 1] == ')') {
4680 keyLen--;
4683 /* Create the objects with the variable name and key. */
4684 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4686 Jim_IncrRefCount(varObjPtr);
4687 Jim_IncrRefCount(keyObjPtr);
4688 *varPtrPtr = varObjPtr;
4689 *keyPtrPtr = keyObjPtr;
4692 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4693 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4694 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4696 int err;
4698 SetDictSubstFromAny(interp, objPtr);
4700 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4701 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4703 if (err == JIM_OK) {
4704 /* Don't keep an extra ref to the result */
4705 Jim_SetEmptyResult(interp);
4707 else {
4708 if (!valObjPtr) {
4709 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4710 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4711 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4712 objPtr);
4713 return err;
4716 /* Make the error more informative and Tcl-compatible */
4717 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4718 (valObjPtr ? "set" : "unset"), objPtr);
4720 return err;
4724 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4726 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4727 * and stored back to the variable before expansion.
4729 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4730 Jim_Obj *keyObjPtr, int flags)
4732 Jim_Obj *dictObjPtr;
4733 Jim_Obj *resObjPtr = NULL;
4734 int ret;
4736 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4737 if (!dictObjPtr) {
4738 return NULL;
4741 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4742 if (ret != JIM_OK) {
4743 resObjPtr = NULL;
4744 if (ret < 0) {
4745 Jim_SetResultFormatted(interp,
4746 "can't read \"%#s(%#s)\": variable isn't array", varObjPtr, keyObjPtr);
4748 else {
4749 Jim_SetResultFormatted(interp,
4750 "can't read \"%#s(%#s)\": no such element in array", varObjPtr, keyObjPtr);
4753 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4754 dictObjPtr = Jim_DuplicateObj(interp, dictObjPtr);
4755 if (Jim_SetVariable(interp, varObjPtr, dictObjPtr) != JIM_OK) {
4756 /* This can probably never happen */
4757 JimPanic((1, "SetVariable failed for JIM_UNSHARED"));
4759 /* We know that the key exists. Get the result in the now-unshared dictionary */
4760 Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4763 return resObjPtr;
4766 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4767 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4769 SetDictSubstFromAny(interp, objPtr);
4771 return JimDictExpandArrayVariable(interp,
4772 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4773 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4776 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4778 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4780 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4781 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4784 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4786 JIM_NOTUSED(interp);
4788 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4789 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4790 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4791 dupPtr->typePtr = &dictSubstObjType;
4794 /* Note: The object *must* be in dict-sugar format */
4795 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4797 if (objPtr->typePtr != &dictSubstObjType) {
4798 Jim_Obj *varObjPtr, *keyObjPtr;
4800 if (objPtr->typePtr == &interpolatedObjType) {
4801 /* An interpolated object in dict-sugar form */
4803 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4804 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4806 Jim_IncrRefCount(varObjPtr);
4807 Jim_IncrRefCount(keyObjPtr);
4809 else {
4810 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4813 Jim_FreeIntRep(interp, objPtr);
4814 objPtr->typePtr = &dictSubstObjType;
4815 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4816 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4820 /* This function is used to expand [dict get] sugar in the form
4821 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4822 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4823 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4824 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4825 * the [dict]ionary contained in variable VARNAME. */
4826 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4828 Jim_Obj *resObjPtr = NULL;
4829 Jim_Obj *substKeyObjPtr = NULL;
4831 SetDictSubstFromAny(interp, objPtr);
4833 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4834 &substKeyObjPtr, JIM_NONE)
4835 != JIM_OK) {
4836 return NULL;
4838 Jim_IncrRefCount(substKeyObjPtr);
4839 resObjPtr =
4840 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4841 substKeyObjPtr, 0);
4842 Jim_DecrRefCount(interp, substKeyObjPtr);
4844 return resObjPtr;
4847 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4849 Jim_Obj *resultObjPtr;
4851 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4852 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4853 resultObjPtr->refCount--;
4854 return resultObjPtr;
4856 return NULL;
4859 /* -----------------------------------------------------------------------------
4860 * CallFrame
4861 * ---------------------------------------------------------------------------*/
4863 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4865 Jim_CallFrame *cf;
4867 if (interp->freeFramesList) {
4868 cf = interp->freeFramesList;
4869 interp->freeFramesList = cf->next;
4871 cf->argv = NULL;
4872 cf->argc = 0;
4873 cf->procArgsObjPtr = NULL;
4874 cf->procBodyObjPtr = NULL;
4875 cf->next = NULL;
4876 cf->staticVars = NULL;
4877 cf->localCommands = NULL;
4878 cf->tailcall = 0;
4879 cf->tailcallObj = NULL;
4880 cf->tailcallCmd = NULL;
4882 else {
4883 cf = Jim_Alloc(sizeof(*cf));
4884 memset(cf, 0, sizeof(*cf));
4886 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4889 cf->id = interp->callFrameEpoch++;
4890 cf->parent = parent;
4891 cf->level = parent ? parent->level + 1 : 0;
4892 cf->nsObj = nsObj;
4893 Jim_IncrRefCount(nsObj);
4895 return cf;
4898 /* Used to invalidate every caching related to callframe stability. */
4899 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
4901 cf->id = interp->callFrameEpoch++;
4904 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4906 /* Delete any local procs */
4907 if (localCommands) {
4908 Jim_Obj *cmdNameObj;
4910 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4911 Jim_HashEntry *he;
4912 Jim_Obj *fqObjName;
4914 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4916 he = Jim_FindHashEntry(&interp->commands, fqname);
4918 if (he) {
4919 Jim_Cmd *cmd = he->u.val;
4920 if (cmd->prevCmd) {
4921 Jim_Cmd *prevCmd = cmd->prevCmd;
4922 cmd->prevCmd = NULL;
4924 /* Delete the old command */
4925 JimDecrCmdRefCount(interp, cmd);
4927 /* And restore the original */
4928 he->u.val = prevCmd;
4930 else {
4931 Jim_DeleteHashEntry(&interp->commands, fqname);
4932 Jim_InterpIncrProcEpoch(interp);
4935 Jim_DecrRefCount(interp, cmdNameObj);
4936 JimFreeQualifiedName(interp, fqObjName);
4938 Jim_FreeStack(localCommands);
4939 Jim_Free(localCommands);
4941 return JIM_OK;
4945 #define JIM_FCF_NONE 0 /* no flags */
4946 #define JIM_FCF_NOHT 1 /* don't free the hash table */
4947 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int flags)
4949 if (cf->procArgsObjPtr)
4950 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4951 if (cf->procBodyObjPtr)
4952 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4953 Jim_DecrRefCount(interp, cf->nsObj);
4954 if (!(flags & JIM_FCF_NOHT))
4955 Jim_FreeHashTable(&cf->vars);
4956 else {
4957 int i;
4958 Jim_HashEntry **table = cf->vars.table, *he;
4960 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4961 he = table[i];
4962 while (he != NULL) {
4963 Jim_HashEntry *nextEntry = he->next;
4964 Jim_Var *varPtr = (void *)he->u.val;
4966 Jim_DecrRefCount(interp, varPtr->objPtr);
4967 Jim_Free(he->u.val);
4968 Jim_Free((void *)he->key); /* ATTENTION: const cast */
4969 Jim_Free(he);
4970 table[i] = NULL;
4971 he = nextEntry;
4974 cf->vars.used = 0;
4977 JimDeleteLocalProcs(interp, cf->localCommands);
4979 cf->next = interp->freeFramesList;
4980 interp->freeFramesList = cf;
4985 /* -----------------------------------------------------------------------------
4986 * References
4987 * ---------------------------------------------------------------------------*/
4988 #ifdef JIM_REFERENCES
4990 /* References HashTable Type.
4992 * Keys are unsigned long integers, dynamically allocated for now but in the
4993 * future it's worth to cache this 4 bytes objects. Values are pointers
4994 * to Jim_References. */
4995 static void JimReferencesHTValDestructor(void *interp, void *val)
4997 Jim_Reference *refPtr = (void *)val;
4999 Jim_DecrRefCount(interp, refPtr->objPtr);
5000 if (refPtr->finalizerCmdNamePtr != NULL) {
5001 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5003 Jim_Free(val);
5006 static unsigned int JimReferencesHTHashFunction(const void *key)
5008 /* Only the least significant bits are used. */
5009 const unsigned long *widePtr = key;
5010 unsigned int intValue = (unsigned int)*widePtr;
5012 return Jim_IntHashFunction(intValue);
5015 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5017 void *copy = Jim_Alloc(sizeof(unsigned long));
5019 JIM_NOTUSED(privdata);
5021 memcpy(copy, key, sizeof(unsigned long));
5022 return copy;
5025 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5027 JIM_NOTUSED(privdata);
5029 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5032 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5034 JIM_NOTUSED(privdata);
5036 Jim_Free(key);
5039 static const Jim_HashTableType JimReferencesHashTableType = {
5040 JimReferencesHTHashFunction, /* hash function */
5041 JimReferencesHTKeyDup, /* key dup */
5042 NULL, /* val dup */
5043 JimReferencesHTKeyCompare, /* key compare */
5044 JimReferencesHTKeyDestructor, /* key destructor */
5045 JimReferencesHTValDestructor /* val destructor */
5048 /* -----------------------------------------------------------------------------
5049 * Reference object type and References API
5050 * ---------------------------------------------------------------------------*/
5052 /* The string representation of references has two features in order
5053 * to make the GC faster. The first is that every reference starts
5054 * with a non common character '<', in order to make the string matching
5055 * faster. The second is that the reference string rep is 42 characters
5056 * in length, this allows to avoid to check every object with a string
5057 * repr < 42, and usually there aren't many of these objects. */
5059 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5061 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5063 const char *fmt = "<reference.<%s>.%020lu>";
5065 sprintf(buf, fmt, refPtr->tag, id);
5066 return JIM_REFERENCE_SPACE;
5069 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5071 static const Jim_ObjType referenceObjType = {
5072 "reference",
5073 NULL,
5074 NULL,
5075 UpdateStringOfReference,
5076 JIM_TYPE_REFERENCES,
5079 void UpdateStringOfReference(struct Jim_Obj *objPtr)
5081 char buf[JIM_REFERENCE_SPACE + 1];
5083 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5084 JimSetStringBytes(objPtr, buf);
5087 /* returns true if 'c' is a valid reference tag character.
5088 * i.e. inside the range [_a-zA-Z0-9] */
5089 static int isrefchar(int c)
5091 return (c == '_' || isalnum(c));
5094 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5096 unsigned long value;
5097 int i, len;
5098 const char *str, *start, *end;
5099 char refId[21];
5100 Jim_Reference *refPtr;
5101 Jim_HashEntry *he;
5102 char *endptr;
5104 /* Get the string representation */
5105 str = Jim_GetString(objPtr, &len);
5106 /* Check if it looks like a reference */
5107 if (len < JIM_REFERENCE_SPACE)
5108 goto badformat;
5109 /* Trim spaces */
5110 start = str;
5111 end = str + len - 1;
5112 while (*start == ' ')
5113 start++;
5114 while (*end == ' ' && end > start)
5115 end--;
5116 if (end - start + 1 != JIM_REFERENCE_SPACE)
5117 goto badformat;
5118 /* <reference.<1234567>.%020> */
5119 if (memcmp(start, "<reference.<", 12) != 0)
5120 goto badformat;
5121 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5122 goto badformat;
5123 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5124 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5125 if (!isrefchar(start[12 + i]))
5126 goto badformat;
5128 /* Extract info from the reference. */
5129 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5130 refId[20] = '\0';
5131 /* Try to convert the ID into an unsigned long */
5132 value = strtoul(refId, &endptr, 10);
5133 if (JimCheckConversion(refId, endptr) != JIM_OK)
5134 goto badformat;
5135 /* Check if the reference really exists! */
5136 he = Jim_FindHashEntry(&interp->references, &value);
5137 if (he == NULL) {
5138 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5139 return JIM_ERR;
5141 refPtr = he->u.val;
5142 /* Free the old internal repr and set the new one. */
5143 Jim_FreeIntRep(interp, objPtr);
5144 objPtr->typePtr = &referenceObjType;
5145 objPtr->internalRep.refValue.id = value;
5146 objPtr->internalRep.refValue.refPtr = refPtr;
5147 return JIM_OK;
5149 badformat:
5150 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5151 return JIM_ERR;
5154 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5155 * as finalizer command (or NULL if there is no finalizer).
5156 * The returned reference object has refcount = 0. */
5157 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5159 struct Jim_Reference *refPtr;
5160 unsigned long id;
5161 Jim_Obj *refObjPtr;
5162 const char *tag;
5163 int tagLen, i;
5165 /* Perform the Garbage Collection if needed. */
5166 Jim_CollectIfNeeded(interp);
5168 refPtr = Jim_Alloc(sizeof(*refPtr));
5169 refPtr->objPtr = objPtr;
5170 Jim_IncrRefCount(objPtr);
5171 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5172 if (cmdNamePtr)
5173 Jim_IncrRefCount(cmdNamePtr);
5174 id = interp->referenceNextId++;
5175 Jim_AddHashEntry(&interp->references, &id, refPtr);
5176 refObjPtr = Jim_NewObj(interp);
5177 refObjPtr->typePtr = &referenceObjType;
5178 refObjPtr->bytes = NULL;
5179 refObjPtr->internalRep.refValue.id = id;
5180 refObjPtr->internalRep.refValue.refPtr = refPtr;
5181 interp->referenceNextId++;
5182 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5183 * that does not pass the 'isrefchar' test is replaced with '_' */
5184 tag = Jim_GetString(tagPtr, &tagLen);
5185 if (tagLen > JIM_REFERENCE_TAGLEN)
5186 tagLen = JIM_REFERENCE_TAGLEN;
5187 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5188 if (i < tagLen && isrefchar(tag[i]))
5189 refPtr->tag[i] = tag[i];
5190 else
5191 refPtr->tag[i] = '_';
5193 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5194 return refObjPtr;
5197 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5199 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5200 return NULL;
5201 return objPtr->internalRep.refValue.refPtr;
5204 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5206 Jim_Reference *refPtr;
5208 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5209 return JIM_ERR;
5210 Jim_IncrRefCount(cmdNamePtr);
5211 if (refPtr->finalizerCmdNamePtr)
5212 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5213 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5214 return JIM_OK;
5217 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5219 Jim_Reference *refPtr;
5221 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5222 return JIM_ERR;
5223 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5224 return JIM_OK;
5227 /* -----------------------------------------------------------------------------
5228 * References Garbage Collection
5229 * ---------------------------------------------------------------------------*/
5231 /* This the hash table type for the "MARK" phase of the GC */
5232 static const Jim_HashTableType JimRefMarkHashTableType = {
5233 JimReferencesHTHashFunction, /* hash function */
5234 JimReferencesHTKeyDup, /* key dup */
5235 NULL, /* val dup */
5236 JimReferencesHTKeyCompare, /* key compare */
5237 JimReferencesHTKeyDestructor, /* key destructor */
5238 NULL /* val destructor */
5241 /* Performs the garbage collection. */
5242 int Jim_Collect(Jim_Interp *interp)
5244 int collected = 0;
5245 #ifndef JIM_BOOTSTRAP
5246 Jim_HashTable marks;
5247 Jim_HashTableIterator htiter;
5248 Jim_HashEntry *he;
5249 Jim_Obj *objPtr;
5251 /* Avoid recursive calls */
5252 if (interp->lastCollectId == -1) {
5253 /* Jim_Collect() already running. Return just now. */
5254 return 0;
5256 interp->lastCollectId = -1;
5258 /* Mark all the references found into the 'mark' hash table.
5259 * The references are searched in every live object that
5260 * is of a type that can contain references. */
5261 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5262 objPtr = interp->liveList;
5263 while (objPtr) {
5264 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5265 const char *str, *p;
5266 int len;
5268 /* If the object is of type reference, to get the
5269 * Id is simple... */
5270 if (objPtr->typePtr == &referenceObjType) {
5271 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5272 #ifdef JIM_DEBUG_GC
5273 printf("MARK (reference): %d refcount: %d" JIM_NL,
5274 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5275 #endif
5276 objPtr = objPtr->nextObjPtr;
5277 continue;
5279 /* Get the string repr of the object we want
5280 * to scan for references. */
5281 p = str = Jim_GetString(objPtr, &len);
5282 /* Skip objects too little to contain references. */
5283 if (len < JIM_REFERENCE_SPACE) {
5284 objPtr = objPtr->nextObjPtr;
5285 continue;
5287 /* Extract references from the object string repr. */
5288 while (1) {
5289 int i;
5290 unsigned long id;
5292 if ((p = strstr(p, "<reference.<")) == NULL)
5293 break;
5294 /* Check if it's a valid reference. */
5295 if (len - (p - str) < JIM_REFERENCE_SPACE)
5296 break;
5297 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5298 break;
5299 for (i = 21; i <= 40; i++)
5300 if (!isdigit(UCHAR(p[i])))
5301 break;
5302 /* Get the ID */
5303 id = strtoul(p + 21, NULL, 10);
5305 /* Ok, a reference for the given ID
5306 * was found. Mark it. */
5307 Jim_AddHashEntry(&marks, &id, NULL);
5308 #ifdef JIM_DEBUG_GC
5309 printf("MARK: %d" JIM_NL, (int)id);
5310 #endif
5311 p += JIM_REFERENCE_SPACE;
5314 objPtr = objPtr->nextObjPtr;
5317 /* Run the references hash table to destroy every reference that
5318 * is not referenced outside (not present in the mark HT). */
5319 JimInitHashTableIterator(&interp->references, &htiter);
5320 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5321 const unsigned long *refId;
5322 Jim_Reference *refPtr;
5324 refId = he->key;
5325 /* Check if in the mark phase we encountered
5326 * this reference. */
5327 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5328 #ifdef JIM_DEBUG_GC
5329 printf("COLLECTING %d" JIM_NL, (int)*refId);
5330 #endif
5331 collected++;
5332 /* Drop the reference, but call the
5333 * finalizer first if registered. */
5334 refPtr = he->u.val;
5335 if (refPtr->finalizerCmdNamePtr) {
5336 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5337 Jim_Obj *objv[3], *oldResult;
5339 JimFormatReference(refstr, refPtr, *refId);
5341 objv[0] = refPtr->finalizerCmdNamePtr;
5342 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5343 objv[2] = refPtr->objPtr;
5345 /* Drop the reference itself */
5346 /* Avoid the finaliser being freed here */
5347 Jim_IncrRefCount(objv[0]);
5348 /* Don't remove the reference from the hash table just yet
5349 * since that will free refPtr, and hence refPtr->objPtr
5352 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5353 oldResult = interp->result;
5354 Jim_IncrRefCount(oldResult);
5355 Jim_EvalObjVector(interp, 3, objv);
5356 Jim_SetResult(interp, oldResult);
5357 Jim_DecrRefCount(interp, oldResult);
5359 Jim_DecrRefCount(interp, objv[0]);
5361 Jim_DeleteHashEntry(&interp->references, refId);
5364 Jim_FreeHashTable(&marks);
5365 interp->lastCollectId = interp->referenceNextId;
5366 interp->lastCollectTime = time(NULL);
5367 #endif /* JIM_BOOTSTRAP */
5368 return collected;
5371 #define JIM_COLLECT_ID_PERIOD 5000
5372 #define JIM_COLLECT_TIME_PERIOD 300
5374 void Jim_CollectIfNeeded(Jim_Interp *interp)
5376 unsigned long elapsedId;
5377 int elapsedTime;
5379 elapsedId = interp->referenceNextId - interp->lastCollectId;
5380 elapsedTime = time(NULL) - interp->lastCollectTime;
5383 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5384 Jim_Collect(interp);
5387 #endif
5389 int Jim_IsBigEndian(void)
5391 union {
5392 unsigned short s;
5393 unsigned char c[2];
5394 } uval = {0x0102};
5396 return uval.c[0] == 1;
5399 /* -----------------------------------------------------------------------------
5400 * Interpreter related functions
5401 * ---------------------------------------------------------------------------*/
5403 Jim_Interp *Jim_CreateInterp(void)
5405 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5407 memset(i, 0, sizeof(*i));
5409 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5410 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5411 i->lastCollectTime = time(NULL);
5413 /* Note that we can create objects only after the
5414 * interpreter liveList and freeList pointers are
5415 * initialized to NULL. */
5416 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5417 #ifdef JIM_REFERENCES
5418 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5419 #endif
5420 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5421 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5422 i->emptyObj = Jim_NewEmptyStringObj(i);
5423 i->trueObj = Jim_NewIntObj(i, 1);
5424 i->falseObj = Jim_NewIntObj(i, 0);
5425 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5426 i->errorFileNameObj = i->emptyObj;
5427 i->result = i->emptyObj;
5428 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5429 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5430 i->errorProc = i->emptyObj;
5431 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5432 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5433 Jim_IncrRefCount(i->emptyObj);
5434 Jim_IncrRefCount(i->errorFileNameObj);
5435 Jim_IncrRefCount(i->result);
5436 Jim_IncrRefCount(i->stackTrace);
5437 Jim_IncrRefCount(i->unknown);
5438 Jim_IncrRefCount(i->currentScriptObj);
5439 Jim_IncrRefCount(i->nullScriptObj);
5440 Jim_IncrRefCount(i->errorProc);
5441 Jim_IncrRefCount(i->trueObj);
5442 Jim_IncrRefCount(i->falseObj);
5444 /* Initialize key variables every interpreter should contain */
5445 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5446 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5448 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5449 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5450 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5451 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5452 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5453 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5454 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5456 return i;
5459 void Jim_FreeInterp(Jim_Interp *i)
5461 Jim_CallFrame *cf = i->framePtr, *prevcf, *nextcf;
5462 Jim_Obj *objPtr, *nextObjPtr;
5464 /* Free the call frames list - must be done before i->commands is destroyed */
5465 while (cf) {
5466 prevcf = cf->parent;
5467 JimFreeCallFrame(i, cf, JIM_FCF_NONE);
5468 cf = prevcf;
5471 Jim_DecrRefCount(i, i->emptyObj);
5472 Jim_DecrRefCount(i, i->trueObj);
5473 Jim_DecrRefCount(i, i->falseObj);
5474 Jim_DecrRefCount(i, i->result);
5475 Jim_DecrRefCount(i, i->stackTrace);
5476 Jim_DecrRefCount(i, i->errorProc);
5477 Jim_DecrRefCount(i, i->unknown);
5478 Jim_DecrRefCount(i, i->errorFileNameObj);
5479 Jim_DecrRefCount(i, i->currentScriptObj);
5480 Jim_DecrRefCount(i, i->nullScriptObj);
5481 Jim_FreeHashTable(&i->commands);
5482 #ifdef JIM_REFERENCES
5483 Jim_FreeHashTable(&i->references);
5484 #endif
5485 Jim_FreeHashTable(&i->packages);
5486 Jim_Free(i->prngState);
5487 Jim_FreeHashTable(&i->assocData);
5489 /* Check that the live object list is empty, otherwise
5490 * there is a memory leak. */
5491 #ifdef JIM_MAINTAINER
5492 if (i->liveList != NULL) {
5493 printf(JIM_NL "-------------------------------------" JIM_NL);
5494 printf("Objects still in the free list:" JIM_NL);
5496 objPtr = i->liveList;
5498 while (objPtr) {
5499 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5501 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5502 printf("%p (%d) %-10s: '%.20s...'" JIM_NL,
5503 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5505 else {
5506 printf("%p (%d) %-10s: '%s'" JIM_NL,
5507 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5509 if (objPtr->typePtr == &sourceObjType) {
5510 printf("FILE %s LINE %d" JIM_NL,
5511 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5512 objPtr->internalRep.sourceValue.lineNumber);
5514 objPtr = objPtr->nextObjPtr;
5516 printf("-------------------------------------" JIM_NL JIM_NL);
5517 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5519 #endif
5521 /* Free all the freed objects. */
5522 objPtr = i->freeList;
5523 while (objPtr) {
5524 nextObjPtr = objPtr->nextObjPtr;
5525 Jim_Free(objPtr);
5526 objPtr = nextObjPtr;
5528 /* Free cached CallFrame structures */
5529 cf = i->freeFramesList;
5530 while (cf) {
5531 nextcf = cf->next;
5532 if (cf->vars.table != NULL)
5533 Jim_Free(cf->vars.table);
5534 Jim_Free(cf);
5535 cf = nextcf;
5538 /* Free the interpreter structure. */
5539 Jim_Free(i);
5542 /* Returns the call frame relative to the level represented by
5543 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
5545 * This function accepts the 'level' argument in the form
5546 * of the commands [uplevel] and [upvar].
5548 * For a function accepting a relative integer as level suitable
5549 * for implementation of [info level ?level?] check the
5550 * JimGetCallFrameByInteger() function.
5552 * Returns NULL on error.
5554 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5556 long level;
5557 const char *str;
5558 Jim_CallFrame *framePtr;
5560 if (levelObjPtr) {
5561 str = Jim_String(levelObjPtr);
5562 if (str[0] == '#') {
5563 char *endptr;
5565 level = jim_strtol(str + 1, &endptr);
5566 if (str[1] == '\0' || endptr[0] != '\0') {
5567 level = -1;
5570 else {
5571 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5572 level = -1;
5574 else {
5575 /* Convert from a relative to an absolute level */
5576 level = interp->framePtr->level - level;
5580 else {
5581 str = "1"; /* Needed to format the error message. */
5582 level = interp->framePtr->level - 1;
5585 if (level == 0) {
5586 return interp->topFramePtr;
5588 if (level > 0) {
5589 /* Lookup */
5590 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5591 if (framePtr->level == level) {
5592 return framePtr;
5597 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5598 return NULL;
5601 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5602 * as a relative integer like in the [info level ?level?] command.
5604 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5606 long level;
5607 Jim_CallFrame *framePtr;
5609 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5610 if (level <= 0) {
5611 /* Convert from a relative to an absolute level */
5612 level = interp->framePtr->level + level;
5615 if (level == 0) {
5616 return interp->topFramePtr;
5619 /* Lookup */
5620 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5621 if (framePtr->level == level) {
5622 return framePtr;
5627 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5628 return NULL;
5631 static void JimResetStackTrace(Jim_Interp *interp)
5633 Jim_DecrRefCount(interp, interp->stackTrace);
5634 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5635 Jim_IncrRefCount(interp->stackTrace);
5638 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5640 int len;
5642 /* Increment reference first in case these are the same object */
5643 Jim_IncrRefCount(stackTraceObj);
5644 Jim_DecrRefCount(interp, interp->stackTrace);
5645 interp->stackTrace = stackTraceObj;
5646 interp->errorFlag = 1;
5648 /* This is a bit ugly.
5649 * If the filename of the last entry of the stack trace is empty,
5650 * the next stack level should be added.
5652 len = Jim_ListLength(interp, interp->stackTrace);
5653 if (len >= 3) {
5654 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5655 interp->addStackTrace = 1;
5660 /* Returns 1 if the stack trace information was used or 0 if not */
5661 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5662 Jim_Obj *fileNameObj, int linenr)
5664 if (strcmp(procname, "unknown") == 0) {
5665 procname = "";
5667 if (!*procname && !Jim_Length(fileNameObj)) {
5668 /* No useful info here */
5669 return;
5672 if (Jim_IsShared(interp->stackTrace)) {
5673 Jim_DecrRefCount(interp, interp->stackTrace);
5674 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5675 Jim_IncrRefCount(interp->stackTrace);
5678 /* If we have no procname but the previous element did, merge with that frame */
5679 if (!*procname && Jim_Length(fileNameObj)) {
5680 /* Just a filename. Check the previous entry */
5681 int len = Jim_ListLength(interp, interp->stackTrace);
5683 if (len >= 3) {
5684 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5685 if (Jim_Length(objPtr)) {
5686 /* Yes, the previous level had procname */
5687 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5688 if (Jim_Length(objPtr) == 0) {
5689 /* But no filename, so merge the new info with that frame */
5690 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5691 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5692 return;
5698 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5699 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5700 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5703 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5704 void *data)
5706 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5708 assocEntryPtr->delProc = delProc;
5709 assocEntryPtr->data = data;
5710 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5713 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5715 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5717 if (entryPtr != NULL) {
5718 AssocDataValue *assocEntryPtr = (AssocDataValue *) entryPtr->u.val;
5720 return assocEntryPtr->data;
5722 return NULL;
5725 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5727 return Jim_DeleteHashEntry(&interp->assocData, key);
5730 int Jim_GetExitCode(Jim_Interp *interp)
5732 return interp->exitCode;
5735 /* -----------------------------------------------------------------------------
5736 * Integer object
5737 * ---------------------------------------------------------------------------*/
5738 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5739 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5741 static const Jim_ObjType intObjType = {
5742 "int",
5743 NULL,
5744 NULL,
5745 UpdateStringOfInt,
5746 JIM_TYPE_NONE,
5749 /* A coerced double is closer to an int than a double.
5750 * It is an int value temporarily masquerading as a double value.
5751 * i.e. it has the same string value as an int and Jim_GetWide()
5752 * succeeds, but also Jim_GetDouble() returns the value directly.
5754 static const Jim_ObjType coercedDoubleObjType = {
5755 "coerced-double",
5756 NULL,
5757 NULL,
5758 UpdateStringOfInt,
5759 JIM_TYPE_NONE,
5763 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5765 char buf[JIM_INTEGER_SPACE + 1];
5766 jim_wide wideValue = JimWideValue(objPtr);
5767 int pos = 0;
5769 if (wideValue == 0) {
5770 buf[pos++] = '0';
5772 else {
5773 char tmp[JIM_INTEGER_SPACE];
5774 int num = 0;
5775 int i;
5777 if (wideValue < 0) {
5778 buf[pos++] = '-';
5779 /* -106 % 10 may be -6 or 4! */
5780 i = wideValue % 10;
5781 tmp[num++] = (i > 0) ? (10 - i) : -i;
5782 wideValue /= -10;
5785 while (wideValue) {
5786 tmp[num++] = wideValue % 10;
5787 wideValue /= 10;
5790 for (i = 0; i < num; i++) {
5791 buf[pos++] = '0' + tmp[num - i - 1];
5794 buf[pos] = 0;
5796 JimSetStringBytes(objPtr, buf);
5799 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5801 jim_wide wideValue;
5802 const char *str;
5804 if (objPtr->typePtr == &coercedDoubleObjType) {
5805 /* Simple switcheroo */
5806 objPtr->typePtr = &intObjType;
5807 return JIM_OK;
5810 /* Get the string representation */
5811 str = Jim_String(objPtr);
5812 /* Try to convert into a jim_wide */
5813 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5814 if (flags & JIM_ERRMSG) {
5815 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5817 return JIM_ERR;
5819 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5820 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5821 return JIM_ERR;
5823 /* Free the old internal repr and set the new one. */
5824 Jim_FreeIntRep(interp, objPtr);
5825 objPtr->typePtr = &intObjType;
5826 objPtr->internalRep.wideValue = wideValue;
5827 return JIM_OK;
5830 #ifdef JIM_OPTIMIZATION
5831 static int JimIsWide(Jim_Obj *objPtr)
5833 return objPtr->typePtr == &intObjType;
5835 #endif
5837 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5839 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5840 return JIM_ERR;
5841 *widePtr = JimWideValue(objPtr);
5842 return JIM_OK;
5845 /* Get a wide but does not set an error if the format is bad. */
5846 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5848 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5849 return JIM_ERR;
5850 *widePtr = JimWideValue(objPtr);
5851 return JIM_OK;
5854 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5856 jim_wide wideValue;
5857 int retval;
5859 retval = Jim_GetWide(interp, objPtr, &wideValue);
5860 if (retval == JIM_OK) {
5861 *longPtr = (long)wideValue;
5862 return JIM_OK;
5864 return JIM_ERR;
5867 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5869 Jim_Obj *objPtr;
5871 objPtr = Jim_NewObj(interp);
5872 objPtr->typePtr = &intObjType;
5873 objPtr->bytes = NULL;
5874 objPtr->internalRep.wideValue = wideValue;
5875 return objPtr;
5878 /* -----------------------------------------------------------------------------
5879 * Double object
5880 * ---------------------------------------------------------------------------*/
5881 #define JIM_DOUBLE_SPACE 30
5883 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5884 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5886 static const Jim_ObjType doubleObjType = {
5887 "double",
5888 NULL,
5889 NULL,
5890 UpdateStringOfDouble,
5891 JIM_TYPE_NONE,
5894 #ifndef HAVE_ISNAN
5895 #undef isnan
5896 #define isnan(X) ((X) != (X))
5897 #endif
5898 #ifndef HAVE_ISINF
5899 #undef isinf
5900 #define isinf(X) (1.0 / (X) == 0.0)
5901 #endif
5903 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5905 double value = objPtr->internalRep.doubleValue;
5907 if (isnan(value)) {
5908 JimSetStringBytes(objPtr, "NaN");
5909 return;
5911 if (isinf(value)) {
5912 if (value < 0) {
5913 JimSetStringBytes(objPtr, "-Inf");
5915 else {
5916 JimSetStringBytes(objPtr, "Inf");
5918 return;
5921 char buf[JIM_DOUBLE_SPACE + 1];
5922 int i;
5923 int len = sprintf(buf, "%.12g", value);
5925 /* Add a final ".0" if necessary */
5926 for (i = 0; i < len; i++) {
5927 if (buf[i] == '.' || buf[i] == 'e') {
5928 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5929 /* If 'buf' ends in e-0nn or e+0nn, remove
5930 * the 0 after the + or - and reduce the length by 1
5932 char *e = strchr(buf, 'e');
5933 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5934 /* Move it up */
5935 e += 2;
5936 memmove(e, e + 1, len - (e - buf));
5938 #endif
5939 break;
5942 if (buf[i] == '\0') {
5943 buf[i++] = '.';
5944 buf[i++] = '0';
5945 buf[i] = '\0';
5947 JimSetStringBytes(objPtr, buf);
5951 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5953 double doubleValue;
5954 jim_wide wideValue;
5955 const char *str;
5957 /* Preserve the string representation.
5958 * Needed so we can convert back to int without loss
5960 str = Jim_String(objPtr);
5962 #ifdef HAVE_LONG_LONG
5963 /* Assume a 53 bit mantissa */
5964 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5965 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5967 if (objPtr->typePtr == &intObjType
5968 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5969 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5971 /* Direct conversion to coerced double */
5972 objPtr->typePtr = &coercedDoubleObjType;
5973 return JIM_OK;
5975 else
5976 #endif
5977 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5978 /* Managed to convert to an int, so we can use this as a cooerced double */
5979 Jim_FreeIntRep(interp, objPtr);
5980 objPtr->typePtr = &coercedDoubleObjType;
5981 objPtr->internalRep.wideValue = wideValue;
5982 return JIM_OK;
5984 else {
5985 /* Try to convert into a double */
5986 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
5987 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
5988 return JIM_ERR;
5990 /* Free the old internal repr and set the new one. */
5991 Jim_FreeIntRep(interp, objPtr);
5993 objPtr->typePtr = &doubleObjType;
5994 objPtr->internalRep.doubleValue = doubleValue;
5995 return JIM_OK;
5998 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6000 if (objPtr->typePtr == &coercedDoubleObjType) {
6001 *doublePtr = JimWideValue(objPtr);
6002 return JIM_OK;
6004 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6005 return JIM_ERR;
6007 if (objPtr->typePtr == &coercedDoubleObjType) {
6008 *doublePtr = JimWideValue(objPtr);
6010 else {
6011 *doublePtr = objPtr->internalRep.doubleValue;
6013 return JIM_OK;
6016 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6018 Jim_Obj *objPtr;
6020 objPtr = Jim_NewObj(interp);
6021 objPtr->typePtr = &doubleObjType;
6022 objPtr->bytes = NULL;
6023 objPtr->internalRep.doubleValue = doubleValue;
6024 return objPtr;
6027 /* -----------------------------------------------------------------------------
6028 * List object
6029 * ---------------------------------------------------------------------------*/
6030 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6031 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6032 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6033 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6034 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6035 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6037 /* Note that while the elements of the list may contain references,
6038 * the list object itself can't. This basically means that the
6039 * list object string representation as a whole can't contain references
6040 * that are not presents in the single elements. */
6041 static const Jim_ObjType listObjType = {
6042 "list",
6043 FreeListInternalRep,
6044 DupListInternalRep,
6045 UpdateStringOfList,
6046 JIM_TYPE_NONE,
6049 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6051 int i;
6053 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6054 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6056 Jim_Free(objPtr->internalRep.listValue.ele);
6059 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6061 int i;
6063 JIM_NOTUSED(interp);
6065 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6066 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6067 dupPtr->internalRep.listValue.ele =
6068 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6069 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6070 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6071 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6072 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6074 dupPtr->typePtr = &listObjType;
6077 /* The following function checks if a given string can be encoded
6078 * into a list element without any kind of quoting, surrounded by braces,
6079 * or using escapes to quote. */
6080 #define JIM_ELESTR_SIMPLE 0
6081 #define JIM_ELESTR_BRACE 1
6082 #define JIM_ELESTR_QUOTE 2
6083 static unsigned char ListElementQuotingType(const char *s, int len)
6085 int i, level, blevel, trySimple = 1;
6087 /* Try with the SIMPLE case */
6088 if (len == 0)
6089 return JIM_ELESTR_BRACE;
6090 if (s[0] == '"' || s[0] == '{') {
6091 trySimple = 0;
6092 goto testbrace;
6094 for (i = 0; i < len; i++) {
6095 switch (s[i]) {
6096 case ' ':
6097 case '$':
6098 case '"':
6099 case '[':
6100 case ']':
6101 case ';':
6102 case '\\':
6103 case '\r':
6104 case '\n':
6105 case '\t':
6106 case '\f':
6107 case '\v':
6108 trySimple = 0;
6109 case '{':
6110 case '}':
6111 goto testbrace;
6114 return JIM_ELESTR_SIMPLE;
6116 testbrace:
6117 /* Test if it's possible to do with braces */
6118 if (s[len - 1] == '\\')
6119 return JIM_ELESTR_QUOTE;
6120 level = 0;
6121 blevel = 0;
6122 for (i = 0; i < len; i++) {
6123 switch (s[i]) {
6124 case '{':
6125 level++;
6126 break;
6127 case '}':
6128 level--;
6129 if (level < 0)
6130 return JIM_ELESTR_QUOTE;
6131 break;
6132 case '[':
6133 blevel++;
6134 break;
6135 case ']':
6136 blevel--;
6137 break;
6138 case '\\':
6139 if (s[i + 1] == '\n')
6140 return JIM_ELESTR_QUOTE;
6141 else if (s[i + 1] != '\0')
6142 i++;
6143 break;
6146 if (blevel < 0) {
6147 return JIM_ELESTR_QUOTE;
6150 if (level == 0) {
6151 if (!trySimple)
6152 return JIM_ELESTR_BRACE;
6153 for (i = 0; i < len; i++) {
6154 switch (s[i]) {
6155 case ' ':
6156 case '$':
6157 case '"':
6158 case '[':
6159 case ']':
6160 case ';':
6161 case '\\':
6162 case '\r':
6163 case '\n':
6164 case '\t':
6165 case '\f':
6166 case '\v':
6167 return JIM_ELESTR_BRACE;
6168 break;
6171 return JIM_ELESTR_SIMPLE;
6173 return JIM_ELESTR_QUOTE;
6176 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6177 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6178 * scenario.
6179 * Returns the length of the result.
6181 static int BackslashQuoteString(const char *s, int len, char *q)
6183 char *p = q;
6185 while (len--) {
6186 switch (*s) {
6187 case ' ':
6188 case '$':
6189 case '"':
6190 case '[':
6191 case ']':
6192 case '{':
6193 case '}':
6194 case ';':
6195 case '\\':
6196 *p++ = '\\';
6197 *p++ = *s++;
6198 break;
6199 case '\n':
6200 *p++ = '\\';
6201 *p++ = 'n';
6202 s++;
6203 break;
6204 case '\r':
6205 *p++ = '\\';
6206 *p++ = 'r';
6207 s++;
6208 break;
6209 case '\t':
6210 *p++ = '\\';
6211 *p++ = 't';
6212 s++;
6213 break;
6214 case '\f':
6215 *p++ = '\\';
6216 *p++ = 'f';
6217 s++;
6218 break;
6219 case '\v':
6220 *p++ = '\\';
6221 *p++ = 'v';
6222 s++;
6223 break;
6224 default:
6225 *p++ = *s++;
6226 break;
6229 *p = '\0';
6231 return p - q;
6234 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6236 #define STATIC_QUOTING_LEN 32
6237 int i, bufLen, realLength;
6238 const char *strRep;
6239 char *p;
6240 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6242 /* Estimate the space needed. */
6243 if (objc > STATIC_QUOTING_LEN) {
6244 quotingType = Jim_Alloc(objc);
6246 else {
6247 quotingType = staticQuoting;
6249 bufLen = 0;
6250 for (i = 0; i < objc; i++) {
6251 int len;
6253 strRep = Jim_GetString(objv[i], &len);
6254 quotingType[i] = ListElementQuotingType(strRep, len);
6255 switch (quotingType[i]) {
6256 case JIM_ELESTR_SIMPLE:
6257 if (i != 0 || strRep[0] != '#') {
6258 bufLen += len;
6259 break;
6261 /* Special case '#' on first element needs braces */
6262 quotingType[i] = JIM_ELESTR_BRACE;
6263 /* fall through */
6264 case JIM_ELESTR_BRACE:
6265 bufLen += len + 2;
6266 break;
6267 case JIM_ELESTR_QUOTE:
6268 bufLen += len * 2;
6269 break;
6271 bufLen++; /* elements separator. */
6273 bufLen++;
6275 /* Generate the string rep. */
6276 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6277 realLength = 0;
6278 for (i = 0; i < objc; i++) {
6279 int len, qlen;
6281 strRep = Jim_GetString(objv[i], &len);
6283 switch (quotingType[i]) {
6284 case JIM_ELESTR_SIMPLE:
6285 memcpy(p, strRep, len);
6286 p += len;
6287 realLength += len;
6288 break;
6289 case JIM_ELESTR_BRACE:
6290 *p++ = '{';
6291 memcpy(p, strRep, len);
6292 p += len;
6293 *p++ = '}';
6294 realLength += len + 2;
6295 break;
6296 case JIM_ELESTR_QUOTE:
6297 if (i == 0 && strRep[0] == '#') {
6298 *p++ = '\\';
6299 realLength++;
6301 qlen = BackslashQuoteString(strRep, len, p);
6302 p += qlen;
6303 realLength += qlen;
6304 break;
6306 /* Add a separating space */
6307 if (i + 1 != objc) {
6308 *p++ = ' ';
6309 realLength++;
6312 *p = '\0'; /* nul term. */
6313 objPtr->length = realLength;
6315 if (quotingType != staticQuoting) {
6316 Jim_Free(quotingType);
6320 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6322 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6325 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6327 struct JimParserCtx parser;
6328 const char *str;
6329 int strLen;
6330 Jim_Obj *fileNameObj;
6331 int linenr;
6333 if (objPtr->typePtr == &listObjType) {
6334 return JIM_OK;
6337 /* Optimise dict -> list for unshared object. Note that this may only save a little time, but
6338 * it also preserves any source location of the dict elements
6339 * which can be very useful
6341 if (Jim_IsDict(objPtr) && !Jim_IsShared(objPtr)) {
6342 Jim_Obj **listObjPtrPtr;
6343 int len;
6344 int i;
6346 listObjPtrPtr = JimDictPairs(objPtr, &len);
6347 for (i = 0; i < len; i++) {
6348 Jim_IncrRefCount(listObjPtrPtr[i]);
6351 /* Now just switch the internal rep */
6352 Jim_FreeIntRep(interp, objPtr);
6353 objPtr->typePtr = &listObjType;
6354 objPtr->internalRep.listValue.len = len;
6355 objPtr->internalRep.listValue.maxLen = len;
6356 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6358 return JIM_OK;
6361 /* Try to preserve information about filename / line number */
6362 if (objPtr->typePtr == &sourceObjType) {
6363 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6364 linenr = objPtr->internalRep.sourceValue.lineNumber;
6366 else {
6367 fileNameObj = interp->emptyObj;
6368 linenr = 1;
6370 Jim_IncrRefCount(fileNameObj);
6372 /* Get the string representation */
6373 str = Jim_GetString(objPtr, &strLen);
6375 /* Free the old internal repr just now and initialize the
6376 * new one just now. The string->list conversion can't fail. */
6377 Jim_FreeIntRep(interp, objPtr);
6378 objPtr->typePtr = &listObjType;
6379 objPtr->internalRep.listValue.len = 0;
6380 objPtr->internalRep.listValue.maxLen = 0;
6381 objPtr->internalRep.listValue.ele = NULL;
6383 /* Convert into a list */
6384 if (strLen) {
6385 JimParserInit(&parser, str, strLen, linenr);
6386 while (!parser.eof) {
6387 Jim_Obj *elementPtr;
6389 JimParseList(&parser);
6390 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6391 continue;
6392 elementPtr = JimParserGetTokenObj(interp, &parser);
6393 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6394 ListAppendElement(objPtr, elementPtr);
6397 Jim_DecrRefCount(interp, fileNameObj);
6398 return JIM_OK;
6401 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6403 Jim_Obj *objPtr;
6405 objPtr = Jim_NewObj(interp);
6406 objPtr->typePtr = &listObjType;
6407 objPtr->bytes = NULL;
6408 objPtr->internalRep.listValue.ele = NULL;
6409 objPtr->internalRep.listValue.len = 0;
6410 objPtr->internalRep.listValue.maxLen = 0;
6412 if (len) {
6413 ListInsertElements(objPtr, 0, len, elements);
6416 return objPtr;
6419 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6420 * length of the vector. Note that the user of this function should make
6421 * sure that the list object can't shimmer while the vector returned
6422 * is in use, this vector is the one stored inside the internal representation
6423 * of the list object. This function is not exported, extensions should
6424 * always access to the List object elements using Jim_ListIndex(). */
6425 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6426 Jim_Obj ***listVec)
6428 *listLen = Jim_ListLength(interp, listObj);
6429 *listVec = listObj->internalRep.listValue.ele;
6432 /* Sorting uses ints, but commands may return wide */
6433 static int JimSign(jim_wide w)
6435 if (w == 0) {
6436 return 0;
6438 else if (w < 0) {
6439 return -1;
6441 return 1;
6444 /* ListSortElements type values */
6445 struct lsort_info {
6446 jmp_buf jmpbuf;
6447 Jim_Obj *command;
6448 Jim_Interp *interp;
6449 enum {
6450 JIM_LSORT_ASCII,
6451 JIM_LSORT_NOCASE,
6452 JIM_LSORT_INTEGER,
6453 JIM_LSORT_REAL,
6454 JIM_LSORT_COMMAND
6455 } type;
6456 int order;
6457 int index;
6458 int indexed;
6459 int unique;
6460 int (*subfn)(Jim_Obj **, Jim_Obj **);
6463 static struct lsort_info *sort_info;
6465 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6467 Jim_Obj *lObj, *rObj;
6469 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6470 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6471 longjmp(sort_info->jmpbuf, JIM_ERR);
6473 return sort_info->subfn(&lObj, &rObj);
6476 /* Sort the internal rep of a list. */
6477 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6479 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6482 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6484 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6487 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6489 jim_wide lhs = 0, rhs = 0;
6491 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6492 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6493 longjmp(sort_info->jmpbuf, JIM_ERR);
6496 return JimSign(lhs - rhs) * sort_info->order;
6499 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6501 double lhs = 0, rhs = 0;
6503 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6504 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6505 longjmp(sort_info->jmpbuf, JIM_ERR);
6507 if (lhs == rhs) {
6508 return 0;
6510 if (lhs > rhs) {
6511 return sort_info->order;
6513 return -sort_info->order;
6516 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6518 Jim_Obj *compare_script;
6519 int rc;
6521 jim_wide ret = 0;
6523 /* This must be a valid list */
6524 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6525 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6526 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6528 rc = Jim_EvalObj(sort_info->interp, compare_script);
6530 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6531 longjmp(sort_info->jmpbuf, rc);
6534 return JimSign(ret) * sort_info->order;
6537 /* Remove duplicate elements from the (sorted) list in-place, according to the
6538 * comparison function, comp.
6540 * Note that the last unique value is kept, not the first
6542 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6544 int src;
6545 int dst = 0;
6546 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6548 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6549 if (comp(&ele[dst], &ele[src]) == 0) {
6550 /* Match, so replace the dest with the current source */
6551 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6553 else {
6554 /* No match, so keep the current source and move to the next destination */
6555 dst++;
6557 ele[dst] = ele[src];
6559 /* At end of list, keep the final element */
6560 ele[++dst] = ele[src];
6562 /* Set the new length */
6563 listObjPtr->internalRep.listValue.len = dst;
6566 /* Sort a list *in place*. MUST be called with non-shared objects. */
6567 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6569 struct lsort_info *prev_info;
6571 typedef int (qsort_comparator) (const void *, const void *);
6572 int (*fn) (Jim_Obj **, Jim_Obj **);
6573 Jim_Obj **vector;
6574 int len;
6575 int rc;
6577 JimPanic((Jim_IsShared(listObjPtr), "Jim_ListSortElements called with shared object"));
6578 SetListFromAny(interp, listObjPtr);
6580 /* Allow lsort to be called reentrantly */
6581 prev_info = sort_info;
6582 sort_info = info;
6584 vector = listObjPtr->internalRep.listValue.ele;
6585 len = listObjPtr->internalRep.listValue.len;
6586 switch (info->type) {
6587 case JIM_LSORT_ASCII:
6588 fn = ListSortString;
6589 break;
6590 case JIM_LSORT_NOCASE:
6591 fn = ListSortStringNoCase;
6592 break;
6593 case JIM_LSORT_INTEGER:
6594 fn = ListSortInteger;
6595 break;
6596 case JIM_LSORT_REAL:
6597 fn = ListSortReal;
6598 break;
6599 case JIM_LSORT_COMMAND:
6600 fn = ListSortCommand;
6601 break;
6602 default:
6603 fn = NULL; /* avoid warning */
6604 JimPanic((1, "ListSort called with invalid sort type"));
6607 if (info->indexed) {
6608 /* Need to interpose a "list index" function */
6609 info->subfn = fn;
6610 fn = ListSortIndexHelper;
6613 if ((rc = setjmp(info->jmpbuf)) == 0) {
6614 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6616 if (info->unique && len > 1) {
6617 ListRemoveDuplicates(listObjPtr, fn);
6620 Jim_InvalidateStringRep(listObjPtr);
6622 sort_info = prev_info;
6624 return rc;
6627 /* This is the low-level function to insert elements into a list.
6628 * The higher-level Jim_ListInsertElements() performs shared object
6629 * check and invalidate the string repr. This version is used
6630 * in the internals of the List Object and is not exported.
6632 * NOTE: this function can be called only against objects
6633 * with internal type of List.
6635 * An insertion point (idx) of -1 means end-of-list.
6637 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6639 int currentLen = listPtr->internalRep.listValue.len;
6640 int requiredLen = currentLen + elemc;
6641 int i;
6642 Jim_Obj **point;
6644 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6645 if (requiredLen < 2) {
6646 /* Don't do allocations of under 4 pointers. */
6647 requiredLen = 4;
6649 else {
6650 requiredLen *= 2;
6653 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6654 sizeof(Jim_Obj *) * requiredLen);
6656 listPtr->internalRep.listValue.maxLen = requiredLen;
6658 if (idx < 0) {
6659 idx = currentLen;
6661 point = listPtr->internalRep.listValue.ele + idx;
6662 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6663 for (i = 0; i < elemc; ++i) {
6664 point[i] = elemVec[i];
6665 Jim_IncrRefCount(point[i]);
6667 listPtr->internalRep.listValue.len += elemc;
6670 /* Convenience call to ListInsertElements() to append a single element.
6672 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6674 ListInsertElements(listPtr, -1, 1, &objPtr);
6677 /* Appends every element of appendListPtr into listPtr.
6678 * Both have to be of the list type.
6679 * Convenience call to ListInsertElements()
6681 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6683 ListInsertElements(listPtr, -1,
6684 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6687 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6689 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6690 SetListFromAny(interp, listPtr);
6691 Jim_InvalidateStringRep(listPtr);
6692 ListAppendElement(listPtr, objPtr);
6695 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6697 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6698 SetListFromAny(interp, listPtr);
6699 SetListFromAny(interp, appendListPtr);
6700 Jim_InvalidateStringRep(listPtr);
6701 ListAppendList(listPtr, appendListPtr);
6704 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6706 SetListFromAny(interp, objPtr);
6707 return objPtr->internalRep.listValue.len;
6710 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6711 int objc, Jim_Obj *const *objVec)
6713 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6714 SetListFromAny(interp, listPtr);
6715 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6716 idx = listPtr->internalRep.listValue.len;
6717 else if (idx < 0)
6718 idx = 0;
6719 Jim_InvalidateStringRep(listPtr);
6720 ListInsertElements(listPtr, idx, objc, objVec);
6723 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6725 SetListFromAny(interp, listPtr);
6726 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6727 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6728 return NULL;
6730 if (idx < 0)
6731 idx = listPtr->internalRep.listValue.len + idx;
6732 return listPtr->internalRep.listValue.ele[idx];
6735 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6737 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6738 if (*objPtrPtr == NULL) {
6739 if (flags & JIM_ERRMSG) {
6740 Jim_SetResultString(interp, "list index out of range", -1);
6742 return JIM_ERR;
6744 return JIM_OK;
6747 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6748 Jim_Obj *newObjPtr, int flags)
6750 SetListFromAny(interp, listPtr);
6751 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6752 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6753 if (flags & JIM_ERRMSG) {
6754 Jim_SetResultString(interp, "list index out of range", -1);
6756 return JIM_ERR;
6758 if (idx < 0)
6759 idx = listPtr->internalRep.listValue.len + idx;
6760 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6761 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6762 Jim_IncrRefCount(newObjPtr);
6763 return JIM_OK;
6766 /* Modify the list stored into the variable named 'varNamePtr'
6767 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6768 * with the new element 'newObjptr'. */
6769 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6770 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6772 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6773 int shared, i, idx;
6775 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6776 if (objPtr == NULL)
6777 return JIM_ERR;
6778 if ((shared = Jim_IsShared(objPtr)))
6779 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6780 for (i = 0; i < indexc - 1; i++) {
6781 listObjPtr = objPtr;
6782 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6783 goto err;
6784 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6785 goto err;
6787 if (Jim_IsShared(objPtr)) {
6788 objPtr = Jim_DuplicateObj(interp, objPtr);
6789 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6791 Jim_InvalidateStringRep(listObjPtr);
6793 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6794 goto err;
6795 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6796 goto err;
6797 Jim_InvalidateStringRep(objPtr);
6798 Jim_InvalidateStringRep(varObjPtr);
6799 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6800 goto err;
6801 Jim_SetResult(interp, varObjPtr);
6802 return JIM_OK;
6803 err:
6804 if (shared) {
6805 Jim_FreeNewObj(interp, varObjPtr);
6807 return JIM_ERR;
6810 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6812 int i;
6813 int listLen = Jim_ListLength(interp, listObjPtr);
6814 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6816 for (i = 0; i < listLen; ) {
6817 Jim_Obj *objPtr;
6819 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
6820 Jim_AppendObj(interp, resObjPtr, objPtr);
6821 if (++i != listLen) {
6822 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6825 return resObjPtr;
6828 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6830 int i;
6832 /* If all the objects in objv are lists,
6833 * it's possible to return a list as result, that's the
6834 * concatenation of all the lists. */
6835 for (i = 0; i < objc; i++) {
6836 if (!Jim_IsList(objv[i]))
6837 break;
6839 if (i == objc) {
6840 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6842 for (i = 0; i < objc; i++)
6843 ListAppendList(objPtr, objv[i]);
6844 return objPtr;
6846 else {
6847 /* Else... we have to glue strings together */
6848 int len = 0, objLen;
6849 char *bytes, *p;
6851 /* Compute the length */
6852 for (i = 0; i < objc; i++) {
6853 Jim_GetString(objv[i], &objLen);
6854 len += objLen;
6856 if (objc)
6857 len += objc - 1;
6858 /* Create the string rep, and a string object holding it. */
6859 p = bytes = Jim_Alloc(len + 1);
6860 for (i = 0; i < objc; i++) {
6861 const char *s = Jim_GetString(objv[i], &objLen);
6863 /* Remove leading space */
6864 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n')) {
6865 s++;
6866 objLen--;
6867 len--;
6869 /* And trailing space */
6870 while (objLen && (s[objLen - 1] == ' ' ||
6871 s[objLen - 1] == '\n' || s[objLen - 1] == '\t')) {
6872 /* Handle trailing backslash-space case */
6873 if (objLen > 1 && s[objLen - 2] == '\\') {
6874 break;
6876 objLen--;
6877 len--;
6879 memcpy(p, s, objLen);
6880 p += objLen;
6881 if (objLen && i + 1 != objc) {
6882 *p++ = ' ';
6884 else if (i + 1 != objc) {
6885 /* Drop the space calcuated for this
6886 * element that is instead null. */
6887 len--;
6890 *p = '\0';
6891 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6895 /* Returns a list composed of the elements in the specified range.
6896 * first and start are directly accepted as Jim_Objects and
6897 * processed for the end?-index? case. */
6898 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6899 Jim_Obj *lastObjPtr)
6901 int first, last;
6902 int len, rangeLen;
6904 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6905 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6906 return NULL;
6907 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6908 first = JimRelToAbsIndex(len, first);
6909 last = JimRelToAbsIndex(len, last);
6910 JimRelToAbsRange(len, &first, &last, &rangeLen);
6911 if (first == 0 && last == len) {
6912 return listObjPtr;
6914 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6917 /* -----------------------------------------------------------------------------
6918 * Dict object
6919 * ---------------------------------------------------------------------------*/
6920 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6921 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6922 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6923 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6925 /* Dict HashTable Type.
6927 * Keys and Values are Jim objects. */
6929 static unsigned int JimObjectHTHashFunction(const void *key)
6931 int len;
6932 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6933 return Jim_GenHashFunction((const unsigned char *)str, len);
6936 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6938 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6941 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
6943 Jim_IncrRefCount((Jim_Obj *)val);
6944 return (void *)val;
6947 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6949 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6952 static const Jim_HashTableType JimDictHashTableType = {
6953 JimObjectHTHashFunction, /* hash function */
6954 JimObjectHTKeyValDup, /* key dup */
6955 JimObjectHTKeyValDup, /* val dup */
6956 JimObjectHTKeyCompare, /* key compare */
6957 JimObjectHTKeyValDestructor, /* key destructor */
6958 JimObjectHTKeyValDestructor /* val destructor */
6961 /* Note that while the elements of the dict may contain references,
6962 * the list object itself can't. This basically means that the
6963 * dict object string representation as a whole can't contain references
6964 * that are not presents in the single elements. */
6965 static const Jim_ObjType dictObjType = {
6966 "dict",
6967 FreeDictInternalRep,
6968 DupDictInternalRep,
6969 UpdateStringOfDict,
6970 JIM_TYPE_NONE,
6973 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6975 JIM_NOTUSED(interp);
6977 Jim_FreeHashTable(objPtr->internalRep.ptr);
6978 Jim_Free(objPtr->internalRep.ptr);
6981 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6983 Jim_HashTable *ht, *dupHt;
6984 Jim_HashTableIterator htiter;
6985 Jim_HashEntry *he;
6987 /* Create a new hash table */
6988 ht = srcPtr->internalRep.ptr;
6989 dupHt = Jim_Alloc(sizeof(*dupHt));
6990 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
6991 if (ht->size != 0)
6992 Jim_ExpandHashTable(dupHt, ht->size);
6993 /* Copy every element from the source to the dup hash table */
6994 JimInitHashTableIterator(ht, &htiter);
6995 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6996 Jim_AddHashEntry(dupHt, he->key, he->u.val);
6999 dupPtr->internalRep.ptr = dupHt;
7000 dupPtr->typePtr = &dictObjType;
7003 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7005 Jim_HashTable *ht;
7006 Jim_HashTableIterator htiter;
7007 Jim_HashEntry *he;
7008 Jim_Obj **objv;
7009 int i;
7011 ht = dictPtr->internalRep.ptr;
7013 /* Turn the hash table into a flat vector of Jim_Objects. */
7014 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7015 JimInitHashTableIterator(ht, &htiter);
7016 i = 0;
7017 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7018 objv[i++] = (Jim_Obj *)he->key;
7019 objv[i++] = he->u.val;
7021 *len = i;
7022 return objv;
7025 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7027 /* Turn the hash table into a flat vector of Jim_Objects. */
7028 int len;
7029 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7031 JimMakeListStringRep(objPtr, objv, len);
7033 Jim_Free(objv);
7036 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7038 int listlen;
7040 if (objPtr->typePtr == &dictObjType) {
7041 return JIM_OK;
7044 /* Get the string representation. Do this first so we don't
7045 * change order in case of fast conversion to dict.
7047 Jim_String(objPtr);
7049 /* For simplicity, convert a non-list object to a list and then to a dict */
7050 listlen = Jim_ListLength(interp, objPtr);
7051 if (listlen % 2) {
7052 Jim_SetResultString(interp, "missing value to go with key", -1);
7053 return JIM_ERR;
7055 else {
7056 /* Now it is easy to convert to a dict from a list, and it can't fail */
7057 Jim_HashTable *ht;
7058 int i;
7060 ht = Jim_Alloc(sizeof(*ht));
7061 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7063 for (i = 0; i < listlen; i += 2) {
7064 Jim_Obj *keyObjPtr;
7065 Jim_Obj *valObjPtr;
7067 Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
7068 Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
7070 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7073 Jim_FreeIntRep(interp, objPtr);
7074 objPtr->typePtr = &dictObjType;
7075 objPtr->internalRep.ptr = ht;
7077 return JIM_OK;
7081 /* Dict object API */
7083 /* Add an element to a dict. objPtr must be of the "dict" type.
7084 * The higer-level exported function is Jim_DictAddElement().
7085 * If an element with the specified key already exists, the value
7086 * associated is replaced with the new one.
7088 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7089 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7090 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7092 Jim_HashTable *ht = objPtr->internalRep.ptr;
7094 if (valueObjPtr == NULL) { /* unset */
7095 return Jim_DeleteHashEntry(ht, keyObjPtr);
7097 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7098 return JIM_OK;
7101 /* Add an element, higher-level interface for DictAddElement().
7102 * If valueObjPtr == NULL, the key is removed if it exists. */
7103 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7104 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7106 int retcode;
7108 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7109 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7110 return JIM_ERR;
7112 retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7113 Jim_InvalidateStringRep(objPtr);
7114 return retcode;
7117 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7119 Jim_Obj *objPtr;
7120 int i;
7122 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7124 objPtr = Jim_NewObj(interp);
7125 objPtr->typePtr = &dictObjType;
7126 objPtr->bytes = NULL;
7127 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7128 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7129 for (i = 0; i < len; i += 2)
7130 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7131 return objPtr;
7134 /* Return the value associated to the specified dict key
7135 * Note: Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7137 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7138 Jim_Obj **objPtrPtr, int flags)
7140 Jim_HashEntry *he;
7141 Jim_HashTable *ht;
7143 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7144 return -1;
7146 ht = dictPtr->internalRep.ptr;
7147 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7148 if (flags & JIM_ERRMSG) {
7149 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7151 return JIM_ERR;
7153 *objPtrPtr = he->u.val;
7154 return JIM_OK;
7157 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7158 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7160 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7161 return JIM_ERR;
7163 *objPtrPtr = JimDictPairs(dictPtr, len);
7165 return JIM_OK;
7169 /* Return the value associated to the specified dict keys */
7170 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7171 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7173 int i;
7175 if (keyc == 0) {
7176 *objPtrPtr = dictPtr;
7177 return JIM_OK;
7180 for (i = 0; i < keyc; i++) {
7181 Jim_Obj *objPtr;
7183 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7184 if (rc != JIM_OK) {
7185 return rc;
7187 dictPtr = objPtr;
7189 *objPtrPtr = dictPtr;
7190 return JIM_OK;
7193 /* Modify the dict stored into the variable named 'varNamePtr'
7194 * setting the element specified by the 'keyc' keys objects in 'keyv',
7195 * with the new value of the element 'newObjPtr'.
7197 * If newObjPtr == NULL the operation is to remove the given key
7198 * from the dictionary.
7200 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7201 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7203 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7204 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7206 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7207 int shared, i;
7209 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7210 if (objPtr == NULL) {
7211 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7212 /* Cannot remove a key from non existing var */
7213 return JIM_ERR;
7215 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7216 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7217 Jim_FreeNewObj(interp, varObjPtr);
7218 return JIM_ERR;
7221 if ((shared = Jim_IsShared(objPtr)))
7222 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7223 for (i = 0; i < keyc; i++) {
7224 dictObjPtr = objPtr;
7226 /* Check if it's a valid dictionary */
7227 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7228 goto err;
7231 if (i == keyc - 1) {
7232 /* Last key: Note that error on unset with missing last key is OK */
7233 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7234 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7235 goto err;
7238 break;
7241 /* Check if the given key exists. */
7242 Jim_InvalidateStringRep(dictObjPtr);
7243 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7244 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7245 /* This key exists at the current level.
7246 * Make sure it's not shared!. */
7247 if (Jim_IsShared(objPtr)) {
7248 objPtr = Jim_DuplicateObj(interp, objPtr);
7249 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7252 else {
7253 /* Key not found. If it's an [unset] operation
7254 * this is an error. Only the last key may not
7255 * exist. */
7256 if (newObjPtr == NULL) {
7257 goto err;
7259 /* Otherwise set an empty dictionary
7260 * as key's value. */
7261 objPtr = Jim_NewDictObj(interp, NULL, 0);
7262 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7265 Jim_InvalidateStringRep(objPtr);
7266 Jim_InvalidateStringRep(varObjPtr);
7267 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7268 goto err;
7270 Jim_SetResult(interp, varObjPtr);
7271 return JIM_OK;
7272 err:
7273 if (shared) {
7274 Jim_FreeNewObj(interp, varObjPtr);
7276 return JIM_ERR;
7279 /* -----------------------------------------------------------------------------
7280 * Index object
7281 * ---------------------------------------------------------------------------*/
7282 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7283 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7285 static const Jim_ObjType indexObjType = {
7286 "index",
7287 NULL,
7288 NULL,
7289 UpdateStringOfIndex,
7290 JIM_TYPE_NONE,
7293 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7295 if (objPtr->internalRep.intValue == -1) {
7296 JimSetStringBytes(objPtr, "end");
7298 else {
7299 char buf[JIM_INTEGER_SPACE + 1];
7300 if (objPtr->internalRep.intValue >= 0) {
7301 sprintf(buf, "%d", objPtr->internalRep.intValue);
7303 else {
7304 /* Must be <= -2 */
7305 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7307 JimSetStringBytes(objPtr, buf);
7311 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7313 int idx, end = 0;
7314 const char *str;
7315 char *endptr;
7317 /* Get the string representation */
7318 str = Jim_String(objPtr);
7320 /* Try to convert into an index */
7321 if (strncmp(str, "end", 3) == 0) {
7322 end = 1;
7323 str += 3;
7324 idx = 0;
7326 else {
7327 idx = jim_strtol(str, &endptr);
7329 if (endptr == str) {
7330 goto badindex;
7332 str = endptr;
7335 /* Now str may include or +<num> or -<num> */
7336 if (*str == '+' || *str == '-') {
7337 int sign = (*str == '+' ? 1 : -1);
7339 idx += sign * jim_strtol(++str, &endptr);
7340 if (str == endptr || *endptr) {
7341 goto badindex;
7343 str = endptr;
7345 /* The only thing left should be spaces */
7346 while (isspace(UCHAR(*str))) {
7347 str++;
7349 if (*str) {
7350 goto badindex;
7352 if (end) {
7353 if (idx > 0) {
7354 idx = INT_MAX;
7356 else {
7357 /* end-1 is repesented as -2 */
7358 idx--;
7361 else if (idx < 0) {
7362 idx = -INT_MAX;
7365 /* Free the old internal repr and set the new one. */
7366 Jim_FreeIntRep(interp, objPtr);
7367 objPtr->typePtr = &indexObjType;
7368 objPtr->internalRep.intValue = idx;
7369 return JIM_OK;
7371 badindex:
7372 Jim_SetResultFormatted(interp,
7373 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7374 return JIM_ERR;
7377 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7379 /* Avoid shimmering if the object is an integer. */
7380 if (objPtr->typePtr == &intObjType) {
7381 jim_wide val = JimWideValue(objPtr);
7383 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
7384 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
7385 return JIM_OK;
7388 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7389 return JIM_ERR;
7390 *indexPtr = objPtr->internalRep.intValue;
7391 return JIM_OK;
7394 /* -----------------------------------------------------------------------------
7395 * Return Code Object.
7396 * ---------------------------------------------------------------------------*/
7398 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7399 static const char * const jimReturnCodes[] = {
7400 "ok",
7401 "error",
7402 "return",
7403 "break",
7404 "continue",
7405 "signal",
7406 "exit",
7407 "eval",
7408 NULL
7411 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7413 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
7415 static const Jim_ObjType returnCodeObjType = {
7416 "return-code",
7417 NULL,
7418 NULL,
7419 NULL,
7420 JIM_TYPE_NONE,
7423 /* Converts a (standard) return code to a string. Returns "?" for
7424 * non-standard return codes.
7426 const char *Jim_ReturnCode(int code)
7428 if (code < 0 || code >= (int)jimReturnCodesSize) {
7429 return "?";
7431 else {
7432 return jimReturnCodes[code];
7436 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7438 int returnCode;
7439 jim_wide wideValue;
7441 /* Try to convert into an integer */
7442 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7443 returnCode = (int)wideValue;
7444 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7445 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7446 return JIM_ERR;
7448 /* Free the old internal repr and set the new one. */
7449 Jim_FreeIntRep(interp, objPtr);
7450 objPtr->typePtr = &returnCodeObjType;
7451 objPtr->internalRep.intValue = returnCode;
7452 return JIM_OK;
7455 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7457 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7458 return JIM_ERR;
7459 *intPtr = objPtr->internalRep.intValue;
7460 return JIM_OK;
7463 /* -----------------------------------------------------------------------------
7464 * Expression Parsing
7465 * ---------------------------------------------------------------------------*/
7466 static int JimParseExprOperator(struct JimParserCtx *pc);
7467 static int JimParseExprNumber(struct JimParserCtx *pc);
7468 static int JimParseExprIrrational(struct JimParserCtx *pc);
7470 /* Exrp's Stack machine operators opcodes. */
7472 /* Binary operators (numbers) */
7473 enum
7475 /* Continues on from the JIM_TT_ space */
7476 /* Operations */
7477 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7478 JIM_EXPROP_DIV,
7479 JIM_EXPROP_MOD,
7480 JIM_EXPROP_SUB,
7481 JIM_EXPROP_ADD,
7482 JIM_EXPROP_LSHIFT,
7483 JIM_EXPROP_RSHIFT,
7484 JIM_EXPROP_ROTL,
7485 JIM_EXPROP_ROTR,
7486 JIM_EXPROP_LT,
7487 JIM_EXPROP_GT,
7488 JIM_EXPROP_LTE,
7489 JIM_EXPROP_GTE,
7490 JIM_EXPROP_NUMEQ,
7491 JIM_EXPROP_NUMNE,
7492 JIM_EXPROP_BITAND, /* 35 */
7493 JIM_EXPROP_BITXOR,
7494 JIM_EXPROP_BITOR,
7496 /* Note must keep these together */
7497 JIM_EXPROP_LOGICAND, /* 38 */
7498 JIM_EXPROP_LOGICAND_LEFT,
7499 JIM_EXPROP_LOGICAND_RIGHT,
7501 /* and these */
7502 JIM_EXPROP_LOGICOR, /* 41 */
7503 JIM_EXPROP_LOGICOR_LEFT,
7504 JIM_EXPROP_LOGICOR_RIGHT,
7506 /* and these */
7507 /* Ternary operators */
7508 JIM_EXPROP_TERNARY, /* 44 */
7509 JIM_EXPROP_TERNARY_LEFT,
7510 JIM_EXPROP_TERNARY_RIGHT,
7512 /* and these */
7513 JIM_EXPROP_COLON, /* 47 */
7514 JIM_EXPROP_COLON_LEFT,
7515 JIM_EXPROP_COLON_RIGHT,
7517 JIM_EXPROP_POW, /* 50 */
7519 /* Binary operators (strings) */
7520 JIM_EXPROP_STREQ, /* 51 */
7521 JIM_EXPROP_STRNE,
7522 JIM_EXPROP_STRIN,
7523 JIM_EXPROP_STRNI,
7525 /* Unary operators (numbers) */
7526 JIM_EXPROP_NOT, /* 55 */
7527 JIM_EXPROP_BITNOT,
7528 JIM_EXPROP_UNARYMINUS,
7529 JIM_EXPROP_UNARYPLUS,
7531 /* Functions */
7532 JIM_EXPROP_FUNC_FIRST, /* 59 */
7533 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7534 JIM_EXPROP_FUNC_ABS,
7535 JIM_EXPROP_FUNC_DOUBLE,
7536 JIM_EXPROP_FUNC_ROUND,
7537 JIM_EXPROP_FUNC_RAND,
7538 JIM_EXPROP_FUNC_SRAND,
7540 /* math functions from libm */
7541 JIM_EXPROP_FUNC_SIN, /* 64 */
7542 JIM_EXPROP_FUNC_COS,
7543 JIM_EXPROP_FUNC_TAN,
7544 JIM_EXPROP_FUNC_ASIN,
7545 JIM_EXPROP_FUNC_ACOS,
7546 JIM_EXPROP_FUNC_ATAN,
7547 JIM_EXPROP_FUNC_SINH,
7548 JIM_EXPROP_FUNC_COSH,
7549 JIM_EXPROP_FUNC_TANH,
7550 JIM_EXPROP_FUNC_CEIL,
7551 JIM_EXPROP_FUNC_FLOOR,
7552 JIM_EXPROP_FUNC_EXP,
7553 JIM_EXPROP_FUNC_LOG,
7554 JIM_EXPROP_FUNC_LOG10,
7555 JIM_EXPROP_FUNC_SQRT,
7556 JIM_EXPROP_FUNC_POW,
7559 struct JimExprState
7561 Jim_Obj **stack;
7562 int stacklen;
7563 int opcode;
7564 int skip;
7567 /* Operators table */
7568 typedef struct Jim_ExprOperator
7570 const char *name;
7571 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7572 unsigned char precedence;
7573 unsigned char arity;
7574 unsigned char lazy;
7575 unsigned char namelen;
7576 } Jim_ExprOperator;
7578 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7580 Jim_IncrRefCount(obj);
7581 e->stack[e->stacklen++] = obj;
7584 static Jim_Obj *ExprPop(struct JimExprState *e)
7586 return e->stack[--e->stacklen];
7589 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7591 int intresult = 0;
7592 int rc = JIM_OK;
7593 Jim_Obj *A = ExprPop(e);
7594 double dA, dC = 0;
7595 jim_wide wA, wC = 0;
7597 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7598 intresult = 1;
7600 switch (e->opcode) {
7601 case JIM_EXPROP_FUNC_INT:
7602 wC = wA;
7603 break;
7604 case JIM_EXPROP_FUNC_ROUND:
7605 wC = wA;
7606 break;
7607 case JIM_EXPROP_FUNC_DOUBLE:
7608 dC = wA;
7609 intresult = 0;
7610 break;
7611 case JIM_EXPROP_FUNC_ABS:
7612 wC = wA >= 0 ? wA : -wA;
7613 break;
7614 case JIM_EXPROP_UNARYMINUS:
7615 wC = -wA;
7616 break;
7617 case JIM_EXPROP_UNARYPLUS:
7618 wC = wA;
7619 break;
7620 case JIM_EXPROP_NOT:
7621 wC = !wA;
7622 break;
7623 default:
7624 abort();
7627 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7628 switch (e->opcode) {
7629 case JIM_EXPROP_FUNC_INT:
7630 wC = dA;
7631 intresult = 1;
7632 break;
7633 case JIM_EXPROP_FUNC_ROUND:
7634 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7635 intresult = 1;
7636 break;
7637 case JIM_EXPROP_FUNC_DOUBLE:
7638 dC = dA;
7639 break;
7640 case JIM_EXPROP_FUNC_ABS:
7641 dC = dA >= 0 ? dA : -dA;
7642 break;
7643 case JIM_EXPROP_UNARYMINUS:
7644 dC = -dA;
7645 break;
7646 case JIM_EXPROP_UNARYPLUS:
7647 dC = dA;
7648 break;
7649 case JIM_EXPROP_NOT:
7650 wC = !dA;
7651 intresult = 1;
7652 break;
7653 default:
7654 abort();
7658 if (rc == JIM_OK) {
7659 if (intresult) {
7660 ExprPush(e, Jim_NewIntObj(interp, wC));
7662 else {
7663 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7667 Jim_DecrRefCount(interp, A);
7669 return rc;
7672 static double JimRandDouble(Jim_Interp *interp)
7674 unsigned long x;
7675 JimRandomBytes(interp, &x, sizeof(x));
7677 return (double)x / (unsigned long)~0;
7680 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7682 Jim_Obj *A = ExprPop(e);
7683 jim_wide wA;
7685 int rc = Jim_GetWide(interp, A, &wA);
7686 if (rc == JIM_OK) {
7687 switch (e->opcode) {
7688 case JIM_EXPROP_BITNOT:
7689 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7690 break;
7691 case JIM_EXPROP_FUNC_SRAND:
7692 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7693 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7694 break;
7695 default:
7696 abort();
7700 Jim_DecrRefCount(interp, A);
7702 return rc;
7705 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7707 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7709 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7711 return JIM_OK;
7714 #ifdef JIM_MATH_FUNCTIONS
7715 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7717 int rc;
7718 Jim_Obj *A = ExprPop(e);
7719 double dA, dC;
7721 rc = Jim_GetDouble(interp, A, &dA);
7722 if (rc == JIM_OK) {
7723 switch (e->opcode) {
7724 case JIM_EXPROP_FUNC_SIN:
7725 dC = sin(dA);
7726 break;
7727 case JIM_EXPROP_FUNC_COS:
7728 dC = cos(dA);
7729 break;
7730 case JIM_EXPROP_FUNC_TAN:
7731 dC = tan(dA);
7732 break;
7733 case JIM_EXPROP_FUNC_ASIN:
7734 dC = asin(dA);
7735 break;
7736 case JIM_EXPROP_FUNC_ACOS:
7737 dC = acos(dA);
7738 break;
7739 case JIM_EXPROP_FUNC_ATAN:
7740 dC = atan(dA);
7741 break;
7742 case JIM_EXPROP_FUNC_SINH:
7743 dC = sinh(dA);
7744 break;
7745 case JIM_EXPROP_FUNC_COSH:
7746 dC = cosh(dA);
7747 break;
7748 case JIM_EXPROP_FUNC_TANH:
7749 dC = tanh(dA);
7750 break;
7751 case JIM_EXPROP_FUNC_CEIL:
7752 dC = ceil(dA);
7753 break;
7754 case JIM_EXPROP_FUNC_FLOOR:
7755 dC = floor(dA);
7756 break;
7757 case JIM_EXPROP_FUNC_EXP:
7758 dC = exp(dA);
7759 break;
7760 case JIM_EXPROP_FUNC_LOG:
7761 dC = log(dA);
7762 break;
7763 case JIM_EXPROP_FUNC_LOG10:
7764 dC = log10(dA);
7765 break;
7766 case JIM_EXPROP_FUNC_SQRT:
7767 dC = sqrt(dA);
7768 break;
7769 default:
7770 abort();
7772 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7775 Jim_DecrRefCount(interp, A);
7777 return rc;
7779 #endif
7781 /* A binary operation on two ints */
7782 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7784 Jim_Obj *B = ExprPop(e);
7785 Jim_Obj *A = ExprPop(e);
7786 jim_wide wA, wB;
7787 int rc = JIM_ERR;
7789 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7790 jim_wide wC;
7792 rc = JIM_OK;
7794 switch (e->opcode) {
7795 case JIM_EXPROP_LSHIFT:
7796 wC = wA << wB;
7797 break;
7798 case JIM_EXPROP_RSHIFT:
7799 wC = wA >> wB;
7800 break;
7801 case JIM_EXPROP_BITAND:
7802 wC = wA & wB;
7803 break;
7804 case JIM_EXPROP_BITXOR:
7805 wC = wA ^ wB;
7806 break;
7807 case JIM_EXPROP_BITOR:
7808 wC = wA | wB;
7809 break;
7810 case JIM_EXPROP_MOD:
7811 if (wB == 0) {
7812 wC = 0;
7813 Jim_SetResultString(interp, "Division by zero", -1);
7814 rc = JIM_ERR;
7816 else {
7818 * From Tcl 8.x
7820 * This code is tricky: C doesn't guarantee much
7821 * about the quotient or remainder, but Tcl does.
7822 * The remainder always has the same sign as the
7823 * divisor and a smaller absolute value.
7825 int negative = 0;
7827 if (wB < 0) {
7828 wB = -wB;
7829 wA = -wA;
7830 negative = 1;
7832 wC = wA % wB;
7833 if (wC < 0) {
7834 wC += wB;
7836 if (negative) {
7837 wC = -wC;
7840 break;
7841 case JIM_EXPROP_ROTL:
7842 case JIM_EXPROP_ROTR:{
7843 /* uint32_t would be better. But not everyone has inttypes.h? */
7844 unsigned long uA = (unsigned long)wA;
7845 unsigned long uB = (unsigned long)wB;
7846 const unsigned int S = sizeof(unsigned long) * 8;
7848 /* Shift left by the word size or more is undefined. */
7849 uB %= S;
7851 if (e->opcode == JIM_EXPROP_ROTR) {
7852 uB = S - uB;
7854 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7855 break;
7857 default:
7858 abort();
7860 ExprPush(e, Jim_NewIntObj(interp, wC));
7864 Jim_DecrRefCount(interp, A);
7865 Jim_DecrRefCount(interp, B);
7867 return rc;
7871 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7872 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7874 int intresult = 0;
7875 int rc = JIM_OK;
7876 double dA, dB, dC = 0;
7877 jim_wide wA, wB, wC = 0;
7879 Jim_Obj *B = ExprPop(e);
7880 Jim_Obj *A = ExprPop(e);
7882 if ((A->typePtr != &doubleObjType || A->bytes) &&
7883 (B->typePtr != &doubleObjType || B->bytes) &&
7884 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7886 /* Both are ints */
7888 intresult = 1;
7890 switch (e->opcode) {
7891 case JIM_EXPROP_POW:
7892 case JIM_EXPROP_FUNC_POW:
7893 wC = JimPowWide(wA, wB);
7894 break;
7895 case JIM_EXPROP_ADD:
7896 wC = wA + wB;
7897 break;
7898 case JIM_EXPROP_SUB:
7899 wC = wA - wB;
7900 break;
7901 case JIM_EXPROP_MUL:
7902 wC = wA * wB;
7903 break;
7904 case JIM_EXPROP_DIV:
7905 if (wB == 0) {
7906 Jim_SetResultString(interp, "Division by zero", -1);
7907 rc = JIM_ERR;
7909 else {
7911 * From Tcl 8.x
7913 * This code is tricky: C doesn't guarantee much
7914 * about the quotient or remainder, but Tcl does.
7915 * The remainder always has the same sign as the
7916 * divisor and a smaller absolute value.
7918 if (wB < 0) {
7919 wB = -wB;
7920 wA = -wA;
7922 wC = wA / wB;
7923 if (wA % wB < 0) {
7924 wC--;
7927 break;
7928 case JIM_EXPROP_LT:
7929 wC = wA < wB;
7930 break;
7931 case JIM_EXPROP_GT:
7932 wC = wA > wB;
7933 break;
7934 case JIM_EXPROP_LTE:
7935 wC = wA <= wB;
7936 break;
7937 case JIM_EXPROP_GTE:
7938 wC = wA >= wB;
7939 break;
7940 case JIM_EXPROP_NUMEQ:
7941 wC = wA == wB;
7942 break;
7943 case JIM_EXPROP_NUMNE:
7944 wC = wA != wB;
7945 break;
7946 default:
7947 abort();
7950 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7951 switch (e->opcode) {
7952 case JIM_EXPROP_POW:
7953 case JIM_EXPROP_FUNC_POW:
7954 #ifdef JIM_MATH_FUNCTIONS
7955 dC = pow(dA, dB);
7956 #else
7957 Jim_SetResultString(interp, "unsupported", -1);
7958 rc = JIM_ERR;
7959 #endif
7960 break;
7961 case JIM_EXPROP_ADD:
7962 dC = dA + dB;
7963 break;
7964 case JIM_EXPROP_SUB:
7965 dC = dA - dB;
7966 break;
7967 case JIM_EXPROP_MUL:
7968 dC = dA * dB;
7969 break;
7970 case JIM_EXPROP_DIV:
7971 if (dB == 0) {
7972 #ifdef INFINITY
7973 dC = dA < 0 ? -INFINITY : INFINITY;
7974 #else
7975 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7976 #endif
7978 else {
7979 dC = dA / dB;
7981 break;
7982 case JIM_EXPROP_LT:
7983 wC = dA < dB;
7984 intresult = 1;
7985 break;
7986 case JIM_EXPROP_GT:
7987 wC = dA > dB;
7988 intresult = 1;
7989 break;
7990 case JIM_EXPROP_LTE:
7991 wC = dA <= dB;
7992 intresult = 1;
7993 break;
7994 case JIM_EXPROP_GTE:
7995 wC = dA >= dB;
7996 intresult = 1;
7997 break;
7998 case JIM_EXPROP_NUMEQ:
7999 wC = dA == dB;
8000 intresult = 1;
8001 break;
8002 case JIM_EXPROP_NUMNE:
8003 wC = dA != dB;
8004 intresult = 1;
8005 break;
8006 default:
8007 abort();
8010 else {
8011 /* Handle the string case */
8013 /* REVISIT: Could optimise the eq/ne case by checking lengths */
8014 int i = Jim_StringCompareObj(interp, A, B, 0);
8016 intresult = 1;
8018 switch (e->opcode) {
8019 case JIM_EXPROP_LT:
8020 wC = i < 0;
8021 break;
8022 case JIM_EXPROP_GT:
8023 wC = i > 0;
8024 break;
8025 case JIM_EXPROP_LTE:
8026 wC = i <= 0;
8027 break;
8028 case JIM_EXPROP_GTE:
8029 wC = i >= 0;
8030 break;
8031 case JIM_EXPROP_NUMEQ:
8032 wC = i == 0;
8033 break;
8034 case JIM_EXPROP_NUMNE:
8035 wC = i != 0;
8036 break;
8037 default:
8038 rc = JIM_ERR;
8039 break;
8043 if (rc == JIM_OK) {
8044 if (intresult) {
8045 ExprPush(e, Jim_NewIntObj(interp, wC));
8047 else {
8048 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8052 Jim_DecrRefCount(interp, A);
8053 Jim_DecrRefCount(interp, B);
8055 return rc;
8058 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8060 int listlen;
8061 int i;
8063 listlen = Jim_ListLength(interp, listObjPtr);
8064 for (i = 0; i < listlen; i++) {
8065 Jim_Obj *objPtr;
8067 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
8069 if (Jim_StringEqObj(objPtr, valObj)) {
8070 return 1;
8073 return 0;
8076 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8078 Jim_Obj *B = ExprPop(e);
8079 Jim_Obj *A = ExprPop(e);
8081 jim_wide wC;
8083 switch (e->opcode) {
8084 case JIM_EXPROP_STREQ:
8085 case JIM_EXPROP_STRNE: {
8086 int Alen, Blen;
8087 const char *sA = Jim_GetString(A, &Alen);
8088 const char *sB = Jim_GetString(B, &Blen);
8090 if (e->opcode == JIM_EXPROP_STREQ) {
8091 wC = (Alen == Blen && memcmp(sA, sB, Alen) == 0);
8093 else {
8094 wC = (Alen != Blen || memcmp(sA, sB, Alen) != 0);
8096 break;
8098 case JIM_EXPROP_STRIN:
8099 wC = JimSearchList(interp, B, A);
8100 break;
8101 case JIM_EXPROP_STRNI:
8102 wC = !JimSearchList(interp, B, A);
8103 break;
8104 default:
8105 abort();
8107 ExprPush(e, Jim_NewIntObj(interp, wC));
8109 Jim_DecrRefCount(interp, A);
8110 Jim_DecrRefCount(interp, B);
8112 return JIM_OK;
8115 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8117 long l;
8118 double d;
8120 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8121 return l != 0;
8123 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8124 return d != 0;
8126 return -1;
8129 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8131 Jim_Obj *skip = ExprPop(e);
8132 Jim_Obj *A = ExprPop(e);
8133 int rc = JIM_OK;
8135 switch (ExprBool(interp, A)) {
8136 case 0:
8137 /* false, so skip RHS opcodes with a 0 result */
8138 e->skip = JimWideValue(skip);
8139 ExprPush(e, Jim_NewIntObj(interp, 0));
8140 break;
8142 case 1:
8143 /* true so continue */
8144 break;
8146 case -1:
8147 /* Invalid */
8148 rc = JIM_ERR;
8150 Jim_DecrRefCount(interp, A);
8151 Jim_DecrRefCount(interp, skip);
8153 return rc;
8156 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8158 Jim_Obj *skip = ExprPop(e);
8159 Jim_Obj *A = ExprPop(e);
8160 int rc = JIM_OK;
8162 switch (ExprBool(interp, A)) {
8163 case 0:
8164 /* false, so do nothing */
8165 break;
8167 case 1:
8168 /* true so skip RHS opcodes with a 1 result */
8169 e->skip = JimWideValue(skip);
8170 ExprPush(e, Jim_NewIntObj(interp, 1));
8171 break;
8173 case -1:
8174 /* Invalid */
8175 rc = JIM_ERR;
8176 break;
8178 Jim_DecrRefCount(interp, A);
8179 Jim_DecrRefCount(interp, skip);
8181 return rc;
8184 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8186 Jim_Obj *A = ExprPop(e);
8187 int rc = JIM_OK;
8189 switch (ExprBool(interp, A)) {
8190 case 0:
8191 ExprPush(e, Jim_NewIntObj(interp, 0));
8192 break;
8194 case 1:
8195 ExprPush(e, Jim_NewIntObj(interp, 1));
8196 break;
8198 case -1:
8199 /* Invalid */
8200 rc = JIM_ERR;
8201 break;
8203 Jim_DecrRefCount(interp, A);
8205 return rc;
8208 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8210 Jim_Obj *skip = ExprPop(e);
8211 Jim_Obj *A = ExprPop(e);
8212 int rc = JIM_OK;
8214 /* Repush A */
8215 ExprPush(e, A);
8217 switch (ExprBool(interp, A)) {
8218 case 0:
8219 /* false, skip RHS opcodes */
8220 e->skip = JimWideValue(skip);
8221 /* Push a dummy value */
8222 ExprPush(e, Jim_NewIntObj(interp, 0));
8223 break;
8225 case 1:
8226 /* true so do nothing */
8227 break;
8229 case -1:
8230 /* Invalid */
8231 rc = JIM_ERR;
8232 break;
8234 Jim_DecrRefCount(interp, A);
8235 Jim_DecrRefCount(interp, skip);
8237 return rc;
8240 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8242 Jim_Obj *skip = ExprPop(e);
8243 Jim_Obj *B = ExprPop(e);
8244 Jim_Obj *A = ExprPop(e);
8246 /* No need to check for A as non-boolean */
8247 if (ExprBool(interp, A)) {
8248 /* true, so skip RHS opcodes */
8249 e->skip = JimWideValue(skip);
8250 /* Repush B as the answer */
8251 ExprPush(e, B);
8254 Jim_DecrRefCount(interp, skip);
8255 Jim_DecrRefCount(interp, A);
8256 Jim_DecrRefCount(interp, B);
8257 return JIM_OK;
8260 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8262 return JIM_OK;
8265 enum
8267 LAZY_NONE,
8268 LAZY_OP,
8269 LAZY_LEFT,
8270 LAZY_RIGHT
8273 /* name - precedence - arity - opcode
8275 * This array *must* be kept in sync with the JIM_EXPROP enum.
8277 * The following macro pre-computes the string length at compile time.
8279 #define OPRINIT(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8281 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8282 OPRINIT("*", 110, 2, JimExprOpBin, LAZY_NONE),
8283 OPRINIT("/", 110, 2, JimExprOpBin, LAZY_NONE),
8284 OPRINIT("%", 110, 2, JimExprOpIntBin, LAZY_NONE),
8286 OPRINIT("-", 100, 2, JimExprOpBin, LAZY_NONE),
8287 OPRINIT("+", 100, 2, JimExprOpBin, LAZY_NONE),
8289 OPRINIT("<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8290 OPRINIT(">>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8292 OPRINIT("<<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8293 OPRINIT(">>>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8295 OPRINIT("<", 80, 2, JimExprOpBin, LAZY_NONE),
8296 OPRINIT(">", 80, 2, JimExprOpBin, LAZY_NONE),
8297 OPRINIT("<=", 80, 2, JimExprOpBin, LAZY_NONE),
8298 OPRINIT(">=", 80, 2, JimExprOpBin, LAZY_NONE),
8300 OPRINIT("==", 70, 2, JimExprOpBin, LAZY_NONE),
8301 OPRINIT("!=", 70, 2, JimExprOpBin, LAZY_NONE),
8303 OPRINIT("&", 50, 2, JimExprOpIntBin, LAZY_NONE),
8304 OPRINIT("^", 49, 2, JimExprOpIntBin, LAZY_NONE),
8305 OPRINIT("|", 48, 2, JimExprOpIntBin, LAZY_NONE),
8307 OPRINIT("&&", 10, 2, NULL, LAZY_OP),
8308 OPRINIT(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8309 OPRINIT(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8311 OPRINIT("||", 9, 2, NULL, LAZY_OP),
8312 OPRINIT(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8313 OPRINIT(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8315 OPRINIT("?", 5, 2, JimExprOpNull, LAZY_OP),
8316 OPRINIT(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8317 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8319 OPRINIT(":", 5, 2, JimExprOpNull, LAZY_OP),
8320 OPRINIT(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8321 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8323 OPRINIT("**", 250, 2, JimExprOpBin, LAZY_NONE),
8325 OPRINIT("eq", 60, 2, JimExprOpStrBin, LAZY_NONE),
8326 OPRINIT("ne", 60, 2, JimExprOpStrBin, LAZY_NONE),
8328 OPRINIT("in", 55, 2, JimExprOpStrBin, LAZY_NONE),
8329 OPRINIT("ni", 55, 2, JimExprOpStrBin, LAZY_NONE),
8331 OPRINIT("!", 150, 1, JimExprOpNumUnary, LAZY_NONE),
8332 OPRINIT("~", 150, 1, JimExprOpIntUnary, LAZY_NONE),
8333 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8334 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8338 OPRINIT("int", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8339 OPRINIT("abs", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8340 OPRINIT("double", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8341 OPRINIT("round", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8342 OPRINIT("rand", 200, 0, JimExprOpNone, LAZY_NONE),
8343 OPRINIT("srand", 200, 1, JimExprOpIntUnary, LAZY_NONE),
8345 #ifdef JIM_MATH_FUNCTIONS
8346 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8347 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8348 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8349 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8350 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8351 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8352 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8353 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8354 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8355 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8356 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8357 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8358 OPRINIT("log", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8359 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8360 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8361 OPRINIT("pow", 200, 2, JimExprOpBin, LAZY_NONE),
8362 #endif
8364 #undef OPRINIT
8366 #define JIM_EXPR_OPERATORS_NUM \
8367 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8369 static int JimParseExpression(struct JimParserCtx *pc)
8371 /* Discard spaces and quoted newline */
8372 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8373 if (*pc->p == '\n') {
8374 pc->linenr++;
8376 pc->p++;
8377 pc->len--;
8380 if (pc->len == 0) {
8381 pc->tstart = pc->tend = pc->p;
8382 pc->tline = pc->linenr;
8383 pc->tt = JIM_TT_EOL;
8384 pc->eof = 1;
8385 return JIM_OK;
8387 switch (*(pc->p)) {
8388 case '(':
8389 pc->tt = JIM_TT_SUBEXPR_START;
8390 goto singlechar;
8391 case ')':
8392 pc->tt = JIM_TT_SUBEXPR_END;
8393 goto singlechar;
8394 case ',':
8395 pc->tt = JIM_TT_SUBEXPR_COMMA;
8396 singlechar:
8397 pc->tstart = pc->tend = pc->p;
8398 pc->tline = pc->linenr;
8399 pc->p++;
8400 pc->len--;
8401 break;
8402 case '[':
8403 return JimParseCmd(pc);
8404 case '$':
8405 if (JimParseVar(pc) == JIM_ERR)
8406 return JimParseExprOperator(pc);
8407 else {
8408 /* Don't allow expr sugar in expressions */
8409 if (pc->tt == JIM_TT_EXPRSUGAR) {
8410 return JIM_ERR;
8412 return JIM_OK;
8414 break;
8415 case '0':
8416 case '1':
8417 case '2':
8418 case '3':
8419 case '4':
8420 case '5':
8421 case '6':
8422 case '7':
8423 case '8':
8424 case '9':
8425 case '.':
8426 return JimParseExprNumber(pc);
8427 case '"':
8428 return JimParseQuote(pc);
8429 case '{':
8430 return JimParseBrace(pc);
8432 case 'N':
8433 case 'I':
8434 case 'n':
8435 case 'i':
8436 if (JimParseExprIrrational(pc) == JIM_ERR)
8437 return JimParseExprOperator(pc);
8438 break;
8439 default:
8440 return JimParseExprOperator(pc);
8441 break;
8443 return JIM_OK;
8446 static int JimParseExprNumber(struct JimParserCtx *pc)
8448 int allowdot = 1;
8449 int base = 10;
8451 /* Assume an integer for now */
8452 pc->tt = JIM_TT_EXPR_INT;
8453 pc->tstart = pc->p;
8454 pc->tline = pc->linenr;
8456 /* Parse initial 0<x> */
8457 if (pc->p[0] == '0') {
8458 switch (pc->p[1]) {
8459 case 'x':
8460 case 'X':
8461 base = 16;
8462 allowdot = 0;
8463 pc->p += 2;
8464 pc->len -= 2;
8465 break;
8466 case 'o':
8467 case 'O':
8468 base = 8;
8469 allowdot = 0;
8470 pc->p += 2;
8471 pc->len -= 2;
8472 break;
8473 case 'b':
8474 case 'B':
8475 base = 2;
8476 allowdot = 0;
8477 pc->p += 2;
8478 pc->len -= 2;
8479 break;
8483 while (isdigit(UCHAR(*pc->p))
8484 || (base == 16 && isxdigit(UCHAR(*pc->p)))
8485 || (base == 8 && *pc->p >= '0' && *pc->p <= '7')
8486 || (base == 2 && (*pc->p == '0' || *pc->p == '1'))
8487 || (allowdot && *pc->p == '.')
8489 if (*pc->p == '.') {
8490 allowdot = 0;
8491 pc->tt = JIM_TT_EXPR_DOUBLE;
8493 pc->p++;
8494 pc->len--;
8495 if (base == 10 && (*pc->p == 'e' || *pc->p == 'E') && (pc->p[1] == '-' || pc->p[1] == '+'
8496 || isdigit(UCHAR(pc->p[1])))) {
8497 pc->p += 2;
8498 pc->len -= 2;
8499 pc->tt = JIM_TT_EXPR_DOUBLE;
8502 pc->tend = pc->p - 1;
8503 return JIM_OK;
8506 static int JimParseExprIrrational(struct JimParserCtx *pc)
8508 const char *Tokens[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8509 const char **token;
8511 for (token = Tokens; *token != NULL; token++) {
8512 int len = strlen(*token);
8514 if (strncmp(*token, pc->p, len) == 0) {
8515 pc->tstart = pc->p;
8516 pc->tend = pc->p + len - 1;
8517 pc->p += len;
8518 pc->len -= len;
8519 pc->tline = pc->linenr;
8520 pc->tt = JIM_TT_EXPR_DOUBLE;
8521 return JIM_OK;
8524 return JIM_ERR;
8527 static int JimParseExprOperator(struct JimParserCtx *pc)
8529 int i;
8530 int bestIdx = -1, bestLen = 0;
8532 /* Try to get the longest match. */
8533 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8534 const char * const opname = Jim_ExprOperators[i].name;
8535 const int oplen = Jim_ExprOperators[i].namelen;
8537 if (opname == NULL || opname[0] != pc->p[0]) {
8538 continue;
8541 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8542 bestIdx = i + JIM_TT_EXPR_OP;
8543 bestLen = oplen;
8546 if (bestIdx == -1) {
8547 return JIM_ERR;
8550 /* Validate paretheses around function arguments */
8551 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8552 const char *p = pc->p + bestLen;
8553 int len = pc->len - bestLen;
8555 while (len && isspace(UCHAR(*p))) {
8556 len--;
8557 p++;
8559 if (*p != '(') {
8560 return JIM_ERR;
8563 pc->tstart = pc->p;
8564 pc->tend = pc->p + bestLen - 1;
8565 pc->p += bestLen;
8566 pc->len -= bestLen;
8567 pc->tline = pc->linenr;
8569 pc->tt = bestIdx;
8570 return JIM_OK;
8573 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8575 static Jim_ExprOperator dummy_op;
8576 if (opcode < JIM_TT_EXPR_OP) {
8577 return &dummy_op;
8579 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8582 const char *jim_tt_name(int type)
8584 static const char * const tt_names[JIM_TT_EXPR_OP] =
8585 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8586 "DBL", "$()" };
8587 if (type < JIM_TT_EXPR_OP) {
8588 return tt_names[type];
8590 else {
8591 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8592 static char buf[20];
8594 if (op->name) {
8595 return op->name;
8597 sprintf(buf, "(%d)", type);
8598 return buf;
8602 /* -----------------------------------------------------------------------------
8603 * Expression Object
8604 * ---------------------------------------------------------------------------*/
8605 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8606 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8607 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8609 static const Jim_ObjType exprObjType = {
8610 "expression",
8611 FreeExprInternalRep,
8612 DupExprInternalRep,
8613 NULL,
8614 JIM_TYPE_REFERENCES,
8617 /* Expr bytecode structure */
8618 typedef struct ExprByteCode
8620 ScriptToken *token; /* Tokens array. */
8621 int len; /* Length as number of tokens. */
8622 int inUse; /* Used for sharing. */
8623 } ExprByteCode;
8625 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8627 int i;
8629 for (i = 0; i < expr->len; i++) {
8630 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8632 Jim_Free(expr->token);
8633 Jim_Free(expr);
8636 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8638 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8640 if (expr) {
8641 if (--expr->inUse != 0) {
8642 return;
8645 ExprFreeByteCode(interp, expr);
8649 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8651 JIM_NOTUSED(interp);
8652 JIM_NOTUSED(srcPtr);
8654 /* Just returns an simple string. */
8655 dupPtr->typePtr = NULL;
8658 /* Check if an expr program looks correct. */
8659 static int ExprCheckCorrectness(ExprByteCode * expr)
8661 int i;
8662 int stacklen = 0;
8663 int ternary = 0;
8665 /* Try to check if there are stack underflows,
8666 * and make sure at the end of the program there is
8667 * a single result on the stack. */
8668 for (i = 0; i < expr->len; i++) {
8669 ScriptToken *t = &expr->token[i];
8670 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8672 stacklen -= op->arity;
8673 if (stacklen < 0) {
8674 break;
8676 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8677 ternary++;
8679 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8680 ternary--;
8683 /* All operations and operands add one to the stack */
8684 stacklen++;
8686 if (stacklen != 1 || ternary != 0) {
8687 return JIM_ERR;
8689 return JIM_OK;
8692 /* This procedure converts every occurrence of || and && opereators
8693 * in lazy unary versions.
8695 * a b || is converted into:
8697 * a <offset> |L b |R
8699 * a b && is converted into:
8701 * a <offset> &L b &R
8703 * "|L" checks if 'a' is true:
8704 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8705 * the opcode just after |R.
8706 * 2) if it is false does nothing.
8707 * "|R" checks if 'b' is true:
8708 * 1) if it is true pushes 1, otherwise pushes 0.
8710 * "&L" checks if 'a' is true:
8711 * 1) if it is true does nothing.
8712 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8713 * the opcode just after &R
8714 * "&R" checks if 'a' is true:
8715 * if it is true pushes 1, otherwise pushes 0.
8717 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8719 int i;
8721 int leftindex, arity, offset;
8723 /* Search for the end of the first operator */
8724 leftindex = expr->len - 1;
8726 arity = 1;
8727 while (arity) {
8728 ScriptToken *tt = &expr->token[leftindex];
8730 if (tt->type >= JIM_TT_EXPR_OP) {
8731 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8733 arity--;
8734 if (--leftindex < 0) {
8735 return JIM_ERR;
8738 leftindex++;
8740 /* Move them up */
8741 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8742 sizeof(*expr->token) * (expr->len - leftindex));
8743 expr->len += 2;
8744 offset = (expr->len - leftindex) - 1;
8746 /* Now we rely on the fact the the left and right version have opcodes
8747 * 1 and 2 after the main opcode respectively
8749 expr->token[leftindex + 1].type = t->type + 1;
8750 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8752 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8753 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8755 /* Now add the 'R' operator */
8756 expr->token[expr->len].objPtr = interp->emptyObj;
8757 expr->token[expr->len].type = t->type + 2;
8758 expr->len++;
8760 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8761 for (i = leftindex - 1; i > 0; i--) {
8762 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8763 if (op->lazy == LAZY_LEFT) {
8764 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8765 JimWideValue(expr->token[i - 1].objPtr) += 2;
8769 return JIM_OK;
8772 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8774 struct ScriptToken *token = &expr->token[expr->len];
8775 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8777 if (op->lazy == LAZY_OP) {
8778 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8779 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8780 return JIM_ERR;
8783 else {
8784 token->objPtr = interp->emptyObj;
8785 token->type = t->type;
8786 expr->len++;
8788 return JIM_OK;
8792 * Returns the index of the COLON_LEFT to the left of 'right_index'
8793 * taking into account nesting.
8795 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8797 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8799 int ternary_count = 1;
8801 right_index--;
8803 while (right_index > 1) {
8804 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8805 ternary_count--;
8807 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8808 ternary_count++;
8810 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8811 return right_index;
8813 right_index--;
8816 /*notreached*/
8817 return -1;
8821 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8823 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8824 * Otherwise returns 0.
8826 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8828 int i = right_index - 1;
8829 int ternary_count = 1;
8831 while (i > 1) {
8832 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8833 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8834 *prev_right_index = i - 2;
8835 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8836 return 1;
8839 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8840 if (ternary_count == 0) {
8841 return 0;
8843 ternary_count++;
8845 i--;
8847 return 0;
8851 * ExprTernaryReorderExpression description
8852 * ========================================
8854 * ?: is right-to-left associative which doesn't work with the stack-based
8855 * expression engine. The fix is to reorder the bytecode.
8857 * The expression:
8859 * expr 1?2:0?3:4
8861 * Has initial bytecode:
8863 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8864 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8866 * The fix involves simulating this expression instead:
8868 * expr 1?2:(0?3:4)
8870 * With the following bytecode:
8872 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8873 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8875 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8876 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8877 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8878 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8880 * ExprTernaryReorderExpression works thus as follows :
8881 * - start from the end of the stack
8882 * - while walking towards the beginning of the stack
8883 * if token=JIM_EXPROP_COLON_RIGHT then
8884 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8885 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8886 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8887 * if all found then
8888 * perform the rotation
8889 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8890 * end if
8891 * end if
8893 * Note: care has to be taken for nested ternary constructs!!!
8895 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8897 int i;
8899 for (i = expr->len - 1; i > 1; i--) {
8900 int prev_right_index;
8901 int prev_left_index;
8902 int j;
8903 ScriptToken tmp;
8905 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8906 continue;
8909 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8910 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8911 continue;
8915 ** rotate tokens down
8917 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8918 ** | | |
8919 ** | V V
8920 ** | [...] : ...
8921 ** | | |
8922 ** | V V
8923 ** | [...] : ...
8924 ** | | |
8925 ** | V V
8926 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8928 tmp = expr->token[prev_right_index];
8929 for (j = prev_right_index; j < i; j++) {
8930 expr->token[j] = expr->token[j + 1];
8932 expr->token[i] = tmp;
8934 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8936 * This is 'colon left increment' = i - prev_right_index
8938 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8939 * [prev_left_index-1] : skip_count
8942 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8944 /* Adjust for i-- in the loop */
8945 i++;
8949 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8951 Jim_Stack stack;
8952 ExprByteCode *expr;
8953 int ok = 1;
8954 int i;
8955 int prevtt = JIM_TT_NONE;
8956 int have_ternary = 0;
8958 /* -1 for EOL */
8959 int count = tokenlist->count - 1;
8961 expr = Jim_Alloc(sizeof(*expr));
8962 expr->inUse = 1;
8963 expr->len = 0;
8965 Jim_InitStack(&stack);
8967 /* Need extra bytecodes for lazy operators.
8968 * Also check for the ternary operator
8970 for (i = 0; i < tokenlist->count; i++) {
8971 ParseToken *t = &tokenlist->list[i];
8972 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8974 if (op->lazy == LAZY_OP) {
8975 count += 2;
8976 /* Ternary is a lazy op but also needs reordering */
8977 if (t->type == JIM_EXPROP_TERNARY) {
8978 have_ternary = 1;
8983 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8985 for (i = 0; i < tokenlist->count && ok; i++) {
8986 ParseToken *t = &tokenlist->list[i];
8988 /* Next token will be stored here */
8989 struct ScriptToken *token = &expr->token[expr->len];
8991 if (t->type == JIM_TT_EOL) {
8992 break;
8995 switch (t->type) {
8996 case JIM_TT_STR:
8997 case JIM_TT_ESC:
8998 case JIM_TT_VAR:
8999 case JIM_TT_DICTSUGAR:
9000 case JIM_TT_EXPRSUGAR:
9001 case JIM_TT_CMD:
9002 token->type = t->type;
9003 strexpr:
9004 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
9005 if (t->type == JIM_TT_CMD) {
9006 /* Only commands need source info */
9007 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
9009 expr->len++;
9010 break;
9012 case JIM_TT_EXPR_INT:
9013 case JIM_TT_EXPR_DOUBLE:
9015 char *endptr;
9016 if (t->type == JIM_TT_EXPR_INT) {
9017 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9019 else {
9020 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9022 if (endptr != t->token + t->len) {
9023 /* Conversion failed, so just store it as a string */
9024 Jim_FreeNewObj(interp, token->objPtr);
9025 token->type = JIM_TT_STR;
9026 goto strexpr;
9028 token->type = t->type;
9029 expr->len++;
9031 break;
9033 case JIM_TT_SUBEXPR_START:
9034 Jim_StackPush(&stack, t);
9035 prevtt = JIM_TT_NONE;
9036 continue;
9038 case JIM_TT_SUBEXPR_COMMA:
9039 /* Simple approach. Comma is simply ignored */
9040 continue;
9042 case JIM_TT_SUBEXPR_END:
9043 ok = 0;
9044 while (Jim_StackLen(&stack)) {
9045 ParseToken *tt = Jim_StackPop(&stack);
9047 if (tt->type == JIM_TT_SUBEXPR_START) {
9048 ok = 1;
9049 break;
9052 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9053 goto err;
9056 if (!ok) {
9057 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
9058 goto err;
9060 break;
9063 default:{
9064 /* Must be an operator */
9065 const struct Jim_ExprOperator *op;
9066 ParseToken *tt;
9068 /* Convert -/+ to unary minus or unary plus if necessary */
9069 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9070 if (t->type == JIM_EXPROP_SUB) {
9071 t->type = JIM_EXPROP_UNARYMINUS;
9073 else if (t->type == JIM_EXPROP_ADD) {
9074 t->type = JIM_EXPROP_UNARYPLUS;
9078 op = JimExprOperatorInfoByOpcode(t->type);
9080 /* Now handle precedence */
9081 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9082 const struct Jim_ExprOperator *tt_op =
9083 JimExprOperatorInfoByOpcode(tt->type);
9085 /* Note that right-to-left associativity of ?: operator is handled later */
9087 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9088 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9089 ok = 0;
9090 goto err;
9092 Jim_StackPop(&stack);
9094 else {
9095 break;
9098 Jim_StackPush(&stack, t);
9099 break;
9102 prevtt = t->type;
9105 /* Reduce any remaining subexpr */
9106 while (Jim_StackLen(&stack)) {
9107 ParseToken *tt = Jim_StackPop(&stack);
9109 if (tt->type == JIM_TT_SUBEXPR_START) {
9110 ok = 0;
9111 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9112 goto err;
9114 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9115 ok = 0;
9116 goto err;
9120 if (have_ternary) {
9121 ExprTernaryReorderExpression(interp, expr);
9124 err:
9125 /* Free the stack used for the compilation. */
9126 Jim_FreeStack(&stack);
9128 for (i = 0; i < expr->len; i++) {
9129 Jim_IncrRefCount(expr->token[i].objPtr);
9132 if (!ok) {
9133 ExprFreeByteCode(interp, expr);
9134 return NULL;
9137 return expr;
9141 /* This method takes the string representation of an expression
9142 * and generates a program for the Expr's stack-based VM. */
9143 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9145 int exprTextLen;
9146 const char *exprText;
9147 struct JimParserCtx parser;
9148 struct ExprByteCode *expr;
9149 ParseTokenList tokenlist;
9150 int line;
9151 Jim_Obj *fileNameObj;
9152 int rc = JIM_ERR;
9154 /* Try to get information about filename / line number */
9155 if (objPtr->typePtr == &sourceObjType) {
9156 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9157 line = objPtr->internalRep.sourceValue.lineNumber;
9159 else {
9160 fileNameObj = interp->emptyObj;
9161 line = 1;
9163 Jim_IncrRefCount(fileNameObj);
9165 exprText = Jim_GetString(objPtr, &exprTextLen);
9167 /* Initially tokenise the expression into tokenlist */
9168 ScriptTokenListInit(&tokenlist);
9170 JimParserInit(&parser, exprText, exprTextLen, line);
9171 while (!parser.eof) {
9172 if (JimParseExpression(&parser) != JIM_OK) {
9173 ScriptTokenListFree(&tokenlist);
9174 invalidexpr:
9175 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9176 expr = NULL;
9177 goto err;
9180 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9181 parser.tline);
9184 #ifdef DEBUG_SHOW_EXPR_TOKENS
9186 int i;
9187 printf("==== Expr Tokens ====\n");
9188 for (i = 0; i < tokenlist.count; i++) {
9189 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9190 tokenlist.list[i].len, tokenlist.list[i].token);
9193 #endif
9195 /* Now create the expression bytecode from the tokenlist */
9196 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9198 /* No longer need the token list */
9199 ScriptTokenListFree(&tokenlist);
9201 if (!expr) {
9202 goto err;
9205 #ifdef DEBUG_SHOW_EXPR
9207 int i;
9209 printf("==== Expr ====\n");
9210 for (i = 0; i < expr->len; i++) {
9211 ScriptToken *t = &expr->token[i];
9213 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9216 #endif
9218 /* Check program correctness. */
9219 if (ExprCheckCorrectness(expr) != JIM_OK) {
9220 ExprFreeByteCode(interp, expr);
9221 goto invalidexpr;
9224 rc = JIM_OK;
9226 err:
9227 /* Free the old internal rep and set the new one. */
9228 Jim_DecrRefCount(interp, fileNameObj);
9229 Jim_FreeIntRep(interp, objPtr);
9230 Jim_SetIntRepPtr(objPtr, expr);
9231 objPtr->typePtr = &exprObjType;
9232 return rc;
9235 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9237 if (objPtr->typePtr != &exprObjType) {
9238 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9239 return NULL;
9242 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9245 #ifdef JIM_OPTIMIZATION
9246 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9248 if (token->type == JIM_TT_EXPR_INT)
9249 return token->objPtr;
9250 else if (token->type == JIM_TT_VAR)
9251 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9252 else if (token->type == JIM_TT_DICTSUGAR)
9253 return JimExpandDictSugar(interp, token->objPtr);
9254 else
9255 return NULL;
9257 #endif
9259 /* -----------------------------------------------------------------------------
9260 * Expressions evaluation.
9261 * Jim uses a specialized stack-based virtual machine for expressions,
9262 * that takes advantage of the fact that expr's operators
9263 * can't be redefined.
9265 * Jim_EvalExpression() uses the bytecode compiled by
9266 * SetExprFromAny() method of the "expression" object.
9268 * On success a Tcl Object containing the result of the evaluation
9269 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9270 * returned.
9271 * On error the function returns a retcode != to JIM_OK and set a suitable
9272 * error on the interp.
9273 * ---------------------------------------------------------------------------*/
9274 #define JIM_EE_STATICSTACK_LEN 10
9276 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9278 ExprByteCode *expr;
9279 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9280 int i;
9281 int retcode = JIM_OK;
9282 struct JimExprState e;
9284 expr = JimGetExpression(interp, exprObjPtr);
9285 if (!expr) {
9286 return JIM_ERR; /* error in expression. */
9289 #ifdef JIM_OPTIMIZATION
9290 /* Check for one of the following common expressions used by while/for
9292 * CONST
9293 * $a
9294 * !$a
9295 * $a < CONST, $a < $b
9296 * $a <= CONST, $a <= $b
9297 * $a > CONST, $a > $b
9298 * $a >= CONST, $a >= $b
9299 * $a != CONST, $a != $b
9300 * $a == CONST, $a == $b
9303 Jim_Obj *objPtr;
9305 /* STEP 1 -- Check if there are the conditions to run the specialized
9306 * version of while */
9308 switch (expr->len) {
9309 case 1:
9310 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9311 if (objPtr) {
9312 Jim_IncrRefCount(objPtr);
9313 *exprResultPtrPtr = objPtr;
9314 return JIM_OK;
9316 break;
9318 case 2:
9319 if (expr->token[1].type == JIM_EXPROP_NOT) {
9320 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9322 if (objPtr && JimIsWide(objPtr)) {
9323 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9324 Jim_IncrRefCount(*exprResultPtrPtr);
9325 return JIM_OK;
9328 break;
9330 case 3:
9331 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9332 if (objPtr && JimIsWide(objPtr)) {
9333 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9334 if (objPtr2 && JimIsWide(objPtr2)) {
9335 jim_wide wideValueA = JimWideValue(objPtr);
9336 jim_wide wideValueB = JimWideValue(objPtr2);
9337 int cmpRes;
9338 switch (expr->token[2].type) {
9339 case JIM_EXPROP_LT:
9340 cmpRes = wideValueA < wideValueB;
9341 break;
9342 case JIM_EXPROP_LTE:
9343 cmpRes = wideValueA <= wideValueB;
9344 break;
9345 case JIM_EXPROP_GT:
9346 cmpRes = wideValueA > wideValueB;
9347 break;
9348 case JIM_EXPROP_GTE:
9349 cmpRes = wideValueA >= wideValueB;
9350 break;
9351 case JIM_EXPROP_NUMEQ:
9352 cmpRes = wideValueA == wideValueB;
9353 break;
9354 case JIM_EXPROP_NUMNE:
9355 cmpRes = wideValueA != wideValueB;
9356 break;
9357 default:
9358 goto noopt;
9360 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9361 Jim_IncrRefCount(*exprResultPtrPtr);
9362 return JIM_OK;
9365 break;
9368 noopt:
9369 #endif
9371 /* In order to avoid that the internal repr gets freed due to
9372 * shimmering of the exprObjPtr's object, we make the internal rep
9373 * shared. */
9374 expr->inUse++;
9376 /* The stack-based expr VM itself */
9378 /* Stack allocation. Expr programs have the feature that
9379 * a program of length N can't require a stack longer than
9380 * N. */
9381 if (expr->len > JIM_EE_STATICSTACK_LEN)
9382 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9383 else
9384 e.stack = staticStack;
9386 e.stacklen = 0;
9388 /* Execute every instruction */
9389 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9390 Jim_Obj *objPtr;
9392 switch (expr->token[i].type) {
9393 case JIM_TT_EXPR_INT:
9394 case JIM_TT_EXPR_DOUBLE:
9395 case JIM_TT_STR:
9396 ExprPush(&e, expr->token[i].objPtr);
9397 break;
9399 case JIM_TT_VAR:
9400 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9401 if (objPtr) {
9402 ExprPush(&e, objPtr);
9404 else {
9405 retcode = JIM_ERR;
9407 break;
9409 case JIM_TT_DICTSUGAR:
9410 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9411 if (objPtr) {
9412 ExprPush(&e, objPtr);
9414 else {
9415 retcode = JIM_ERR;
9417 break;
9419 case JIM_TT_ESC:
9420 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9421 if (retcode == JIM_OK) {
9422 ExprPush(&e, objPtr);
9424 break;
9426 case JIM_TT_CMD:
9427 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9428 if (retcode == JIM_OK) {
9429 ExprPush(&e, Jim_GetResult(interp));
9431 break;
9433 default:{
9434 /* Find and execute the operation */
9435 e.skip = 0;
9436 e.opcode = expr->token[i].type;
9438 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9439 /* Skip some opcodes if necessary */
9440 i += e.skip;
9441 continue;
9446 expr->inUse--;
9448 if (retcode == JIM_OK) {
9449 *exprResultPtrPtr = ExprPop(&e);
9451 else {
9452 for (i = 0; i < e.stacklen; i++) {
9453 Jim_DecrRefCount(interp, e.stack[i]);
9456 if (e.stack != staticStack) {
9457 Jim_Free(e.stack);
9459 return retcode;
9462 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9464 int retcode;
9465 jim_wide wideValue;
9466 double doubleValue;
9467 Jim_Obj *exprResultPtr;
9469 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9470 if (retcode != JIM_OK)
9471 return retcode;
9473 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9474 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9475 Jim_DecrRefCount(interp, exprResultPtr);
9476 return JIM_ERR;
9478 else {
9479 Jim_DecrRefCount(interp, exprResultPtr);
9480 *boolPtr = doubleValue != 0;
9481 return JIM_OK;
9484 *boolPtr = wideValue != 0;
9486 Jim_DecrRefCount(interp, exprResultPtr);
9487 return JIM_OK;
9490 /* -----------------------------------------------------------------------------
9491 * ScanFormat String Object
9492 * ---------------------------------------------------------------------------*/
9494 /* This Jim_Obj will held a parsed representation of a format string passed to
9495 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9496 * to be parsed in its entirely first and then, if correct, can be used for
9497 * scanning. To avoid endless re-parsing, the parsed representation will be
9498 * stored in an internal representation and re-used for performance reason. */
9500 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9501 * scanformat string. This part will later be used to extract information
9502 * out from the string to be parsed by Jim_ScanString */
9504 typedef struct ScanFmtPartDescr
9506 char *arg; /* Specification of a CHARSET conversion */
9507 char *prefix; /* Prefix to be scanned literally before conversion */
9508 size_t width; /* Maximal width of input to be converted */
9509 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9510 char type; /* Type of conversion (e.g. c, d, f) */
9511 char modifier; /* Modify type (e.g. l - long, h - short */
9512 } ScanFmtPartDescr;
9514 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9515 * string parsed and separated in part descriptions. Furthermore it contains
9516 * the original string representation of the scanformat string to allow for
9517 * fast update of the Jim_Obj's string representation part.
9519 * As an add-on the internal object representation adds some scratch pad area
9520 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9521 * memory for purpose of string scanning.
9523 * The error member points to a static allocated string in case of a mal-
9524 * formed scanformat string or it contains '0' (NULL) in case of a valid
9525 * parse representation.
9527 * The whole memory of the internal representation is allocated as a single
9528 * area of memory that will be internally separated. So freeing and duplicating
9529 * of such an object is cheap */
9531 typedef struct ScanFmtStringObj
9533 jim_wide size; /* Size of internal repr in bytes */
9534 char *stringRep; /* Original string representation */
9535 size_t count; /* Number of ScanFmtPartDescr contained */
9536 size_t convCount; /* Number of conversions that will assign */
9537 size_t maxPos; /* Max position index if XPG3 is used */
9538 const char *error; /* Ptr to error text (NULL if no error */
9539 char *scratch; /* Some scratch pad used by Jim_ScanString */
9540 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9541 } ScanFmtStringObj;
9544 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9545 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9546 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9548 static const Jim_ObjType scanFmtStringObjType = {
9549 "scanformatstring",
9550 FreeScanFmtInternalRep,
9551 DupScanFmtInternalRep,
9552 UpdateStringOfScanFmt,
9553 JIM_TYPE_NONE,
9556 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9558 JIM_NOTUSED(interp);
9559 Jim_Free((char *)objPtr->internalRep.ptr);
9560 objPtr->internalRep.ptr = 0;
9563 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9565 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9566 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9568 JIM_NOTUSED(interp);
9569 memcpy(newVec, srcPtr->internalRep.ptr, size);
9570 dupPtr->internalRep.ptr = newVec;
9571 dupPtr->typePtr = &scanFmtStringObjType;
9574 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9576 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9579 /* SetScanFmtFromAny will parse a given string and create the internal
9580 * representation of the format specification. In case of an error
9581 * the error data member of the internal representation will be set
9582 * to an descriptive error text and the function will be left with
9583 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9584 * specification */
9586 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9588 ScanFmtStringObj *fmtObj;
9589 char *buffer;
9590 int maxCount, i, approxSize, lastPos = -1;
9591 const char *fmt = objPtr->bytes;
9592 int maxFmtLen = objPtr->length;
9593 const char *fmtEnd = fmt + maxFmtLen;
9594 int curr;
9596 Jim_FreeIntRep(interp, objPtr);
9597 /* Count how many conversions could take place maximally */
9598 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9599 if (fmt[i] == '%')
9600 ++maxCount;
9601 /* Calculate an approximation of the memory necessary */
9602 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9603 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9604 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9605 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9606 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9607 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9608 +1; /* safety byte */
9609 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9610 memset(fmtObj, 0, approxSize);
9611 fmtObj->size = approxSize;
9612 fmtObj->maxPos = 0;
9613 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9614 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9615 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9616 buffer = fmtObj->stringRep + maxFmtLen + 1;
9617 objPtr->internalRep.ptr = fmtObj;
9618 objPtr->typePtr = &scanFmtStringObjType;
9619 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9620 int width = 0, skip;
9621 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9623 fmtObj->count++;
9624 descr->width = 0; /* Assume width unspecified */
9625 /* Overread and store any "literal" prefix */
9626 if (*fmt != '%' || fmt[1] == '%') {
9627 descr->type = 0;
9628 descr->prefix = &buffer[i];
9629 for (; fmt < fmtEnd; ++fmt) {
9630 if (*fmt == '%') {
9631 if (fmt[1] != '%')
9632 break;
9633 ++fmt;
9635 buffer[i++] = *fmt;
9637 buffer[i++] = 0;
9639 /* Skip the conversion introducing '%' sign */
9640 ++fmt;
9641 /* End reached due to non-conversion literal only? */
9642 if (fmt >= fmtEnd)
9643 goto done;
9644 descr->pos = 0; /* Assume "natural" positioning */
9645 if (*fmt == '*') {
9646 descr->pos = -1; /* Okay, conversion will not be assigned */
9647 ++fmt;
9649 else
9650 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9651 /* Check if next token is a number (could be width or pos */
9652 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9653 fmt += skip;
9654 /* Was the number a XPG3 position specifier? */
9655 if (descr->pos != -1 && *fmt == '$') {
9656 int prev;
9658 ++fmt;
9659 descr->pos = width;
9660 width = 0;
9661 /* Look if "natural" postioning and XPG3 one was mixed */
9662 if ((lastPos == 0 && descr->pos > 0)
9663 || (lastPos > 0 && descr->pos == 0)) {
9664 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9665 return JIM_ERR;
9667 /* Look if this position was already used */
9668 for (prev = 0; prev < curr; ++prev) {
9669 if (fmtObj->descr[prev].pos == -1)
9670 continue;
9671 if (fmtObj->descr[prev].pos == descr->pos) {
9672 fmtObj->error =
9673 "variable is assigned by multiple \"%n$\" conversion specifiers";
9674 return JIM_ERR;
9677 /* Try to find a width after the XPG3 specifier */
9678 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9679 descr->width = width;
9680 fmt += skip;
9682 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9683 fmtObj->maxPos = descr->pos;
9685 else {
9686 /* Number was not a XPG3, so it has to be a width */
9687 descr->width = width;
9690 /* If positioning mode was undetermined yet, fix this */
9691 if (lastPos == -1)
9692 lastPos = descr->pos;
9693 /* Handle CHARSET conversion type ... */
9694 if (*fmt == '[') {
9695 int swapped = 1, beg = i, end, j;
9697 descr->type = '[';
9698 descr->arg = &buffer[i];
9699 ++fmt;
9700 if (*fmt == '^')
9701 buffer[i++] = *fmt++;
9702 if (*fmt == ']')
9703 buffer[i++] = *fmt++;
9704 while (*fmt && *fmt != ']')
9705 buffer[i++] = *fmt++;
9706 if (*fmt != ']') {
9707 fmtObj->error = "unmatched [ in format string";
9708 return JIM_ERR;
9710 end = i;
9711 buffer[i++] = 0;
9712 /* In case a range fence was given "backwards", swap it */
9713 while (swapped) {
9714 swapped = 0;
9715 for (j = beg + 1; j < end - 1; ++j) {
9716 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9717 char tmp = buffer[j - 1];
9719 buffer[j - 1] = buffer[j + 1];
9720 buffer[j + 1] = tmp;
9721 swapped = 1;
9726 else {
9727 /* Remember any valid modifier if given */
9728 if (strchr("hlL", *fmt) != 0)
9729 descr->modifier = tolower((int)*fmt++);
9731 descr->type = *fmt;
9732 if (strchr("efgcsndoxui", *fmt) == 0) {
9733 fmtObj->error = "bad scan conversion character";
9734 return JIM_ERR;
9736 else if (*fmt == 'c' && descr->width != 0) {
9737 fmtObj->error = "field width may not be specified in %c " "conversion";
9738 return JIM_ERR;
9740 else if (*fmt == 'u' && descr->modifier == 'l') {
9741 fmtObj->error = "unsigned wide not supported";
9742 return JIM_ERR;
9745 curr++;
9747 done:
9748 return JIM_OK;
9751 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9753 #define FormatGetCnvCount(_fo_) \
9754 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9755 #define FormatGetMaxPos(_fo_) \
9756 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9757 #define FormatGetError(_fo_) \
9758 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9760 /* JimScanAString is used to scan an unspecified string that ends with
9761 * next WS, or a string that is specified via a charset.
9764 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9766 char *buffer = Jim_StrDup(str);
9767 char *p = buffer;
9769 while (*str) {
9770 int c;
9771 int n;
9773 if (!sdescr && isspace(UCHAR(*str)))
9774 break; /* EOS via WS if unspecified */
9776 n = utf8_tounicode(str, &c);
9777 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9778 break;
9779 while (n--)
9780 *p++ = *str++;
9782 *p = 0;
9783 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9786 /* ScanOneEntry will scan one entry out of the string passed as argument.
9787 * It use the sscanf() function for this task. After extracting and
9788 * converting of the value, the count of scanned characters will be
9789 * returned of -1 in case of no conversion tool place and string was
9790 * already scanned thru */
9792 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9793 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9795 const char *tok;
9796 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9797 size_t scanned = 0;
9798 size_t anchor = pos;
9799 int i;
9800 Jim_Obj *tmpObj = NULL;
9802 /* First pessimistically assume, we will not scan anything :-) */
9803 *valObjPtr = 0;
9804 if (descr->prefix) {
9805 /* There was a prefix given before the conversion, skip it and adjust
9806 * the string-to-be-parsed accordingly */
9807 /* XXX: Should be checking strLen, not str[pos] */
9808 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9809 /* If prefix require, skip WS */
9810 if (isspace(UCHAR(descr->prefix[i])))
9811 while (pos < strLen && isspace(UCHAR(str[pos])))
9812 ++pos;
9813 else if (descr->prefix[i] != str[pos])
9814 break; /* Prefix do not match here, leave the loop */
9815 else
9816 ++pos; /* Prefix matched so far, next round */
9818 if (pos >= strLen) {
9819 return -1; /* All of str consumed: EOF condition */
9821 else if (descr->prefix[i] != 0)
9822 return 0; /* Not whole prefix consumed, no conversion possible */
9824 /* For all but following conversion, skip leading WS */
9825 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9826 while (isspace(UCHAR(str[pos])))
9827 ++pos;
9828 /* Determine how much skipped/scanned so far */
9829 scanned = pos - anchor;
9831 /* %c is a special, simple case. no width */
9832 if (descr->type == 'n') {
9833 /* Return pseudo conversion means: how much scanned so far? */
9834 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9836 else if (pos >= strLen) {
9837 /* Cannot scan anything, as str is totally consumed */
9838 return -1;
9840 else if (descr->type == 'c') {
9841 int c;
9842 scanned += utf8_tounicode(&str[pos], &c);
9843 *valObjPtr = Jim_NewIntObj(interp, c);
9844 return scanned;
9846 else {
9847 /* Processing of conversions follows ... */
9848 if (descr->width > 0) {
9849 /* Do not try to scan as fas as possible but only the given width.
9850 * To ensure this, we copy the part that should be scanned. */
9851 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9852 size_t tLen = descr->width > sLen ? sLen : descr->width;
9854 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9855 tok = tmpObj->bytes;
9857 else {
9858 /* As no width was given, simply refer to the original string */
9859 tok = &str[pos];
9861 switch (descr->type) {
9862 case 'd':
9863 case 'o':
9864 case 'x':
9865 case 'u':
9866 case 'i':{
9867 char *endp; /* Position where the number finished */
9868 jim_wide w;
9870 int base = descr->type == 'o' ? 8
9871 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9873 /* Try to scan a number with the given base */
9874 if (base == 0) {
9875 w = jim_strtoull(tok, &endp);
9877 else {
9878 w = strtoull(tok, &endp, base);
9881 if (endp != tok) {
9882 /* There was some number sucessfully scanned! */
9883 *valObjPtr = Jim_NewIntObj(interp, w);
9885 /* Adjust the number-of-chars scanned so far */
9886 scanned += endp - tok;
9888 else {
9889 /* Nothing was scanned. We have to determine if this
9890 * happened due to e.g. prefix mismatch or input str
9891 * exhausted */
9892 scanned = *tok ? 0 : -1;
9894 break;
9896 case 's':
9897 case '[':{
9898 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9899 scanned += Jim_Length(*valObjPtr);
9900 break;
9902 case 'e':
9903 case 'f':
9904 case 'g':{
9905 char *endp;
9906 double value = strtod(tok, &endp);
9908 if (endp != tok) {
9909 /* There was some number sucessfully scanned! */
9910 *valObjPtr = Jim_NewDoubleObj(interp, value);
9911 /* Adjust the number-of-chars scanned so far */
9912 scanned += endp - tok;
9914 else {
9915 /* Nothing was scanned. We have to determine if this
9916 * happened due to e.g. prefix mismatch or input str
9917 * exhausted */
9918 scanned = *tok ? 0 : -1;
9920 break;
9923 /* If a substring was allocated (due to pre-defined width) do not
9924 * forget to free it */
9925 if (tmpObj) {
9926 Jim_FreeNewObj(interp, tmpObj);
9929 return scanned;
9932 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9933 * string and returns all converted (and not ignored) values in a list back
9934 * to the caller. If an error occured, a NULL pointer will be returned */
9936 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9938 size_t i, pos;
9939 int scanned = 1;
9940 const char *str = Jim_String(strObjPtr);
9941 int strLen = Jim_Utf8Length(interp, strObjPtr);
9942 Jim_Obj *resultList = 0;
9943 Jim_Obj **resultVec = 0;
9944 int resultc;
9945 Jim_Obj *emptyStr = 0;
9946 ScanFmtStringObj *fmtObj;
9948 /* This should never happen. The format object should already be of the correct type */
9949 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9951 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9952 /* Check if format specification was valid */
9953 if (fmtObj->error != 0) {
9954 if (flags & JIM_ERRMSG)
9955 Jim_SetResultString(interp, fmtObj->error, -1);
9956 return 0;
9958 /* Allocate a new "shared" empty string for all unassigned conversions */
9959 emptyStr = Jim_NewEmptyStringObj(interp);
9960 Jim_IncrRefCount(emptyStr);
9961 /* Create a list and fill it with empty strings up to max specified XPG3 */
9962 resultList = Jim_NewListObj(interp, NULL, 0);
9963 if (fmtObj->maxPos > 0) {
9964 for (i = 0; i < fmtObj->maxPos; ++i)
9965 Jim_ListAppendElement(interp, resultList, emptyStr);
9966 JimListGetElements(interp, resultList, &resultc, &resultVec);
9968 /* Now handle every partial format description */
9969 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9970 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9971 Jim_Obj *value = 0;
9973 /* Only last type may be "literal" w/o conversion - skip it! */
9974 if (descr->type == 0)
9975 continue;
9976 /* As long as any conversion could be done, we will proceed */
9977 if (scanned > 0)
9978 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9979 /* In case our first try results in EOF, we will leave */
9980 if (scanned == -1 && i == 0)
9981 goto eof;
9982 /* Advance next pos-to-be-scanned for the amount scanned already */
9983 pos += scanned;
9985 /* value == 0 means no conversion took place so take empty string */
9986 if (value == 0)
9987 value = Jim_NewEmptyStringObj(interp);
9988 /* If value is a non-assignable one, skip it */
9989 if (descr->pos == -1) {
9990 Jim_FreeNewObj(interp, value);
9992 else if (descr->pos == 0)
9993 /* Otherwise append it to the result list if no XPG3 was given */
9994 Jim_ListAppendElement(interp, resultList, value);
9995 else if (resultVec[descr->pos - 1] == emptyStr) {
9996 /* But due to given XPG3, put the value into the corr. slot */
9997 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9998 Jim_IncrRefCount(value);
9999 resultVec[descr->pos - 1] = value;
10001 else {
10002 /* Otherwise, the slot was already used - free obj and ERROR */
10003 Jim_FreeNewObj(interp, value);
10004 goto err;
10007 Jim_DecrRefCount(interp, emptyStr);
10008 return resultList;
10009 eof:
10010 Jim_DecrRefCount(interp, emptyStr);
10011 Jim_FreeNewObj(interp, resultList);
10012 return (Jim_Obj *)EOF;
10013 err:
10014 Jim_DecrRefCount(interp, emptyStr);
10015 Jim_FreeNewObj(interp, resultList);
10016 return 0;
10019 /* -----------------------------------------------------------------------------
10020 * Pseudo Random Number Generation
10021 * ---------------------------------------------------------------------------*/
10022 /* Initialize the sbox with the numbers from 0 to 255 */
10023 static void JimPrngInit(Jim_Interp *interp)
10025 #define PRNG_SEED_SIZE 256
10026 int i;
10027 unsigned int *seed;
10028 time_t t = time(NULL);
10030 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10032 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10033 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10034 seed[i] = (rand() ^ t ^ clock());
10036 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10037 Jim_Free(seed);
10040 /* Generates N bytes of random data */
10041 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10043 Jim_PrngState *prng;
10044 unsigned char *destByte = (unsigned char *)dest;
10045 unsigned int si, sj, x;
10047 /* initialization, only needed the first time */
10048 if (interp->prngState == NULL)
10049 JimPrngInit(interp);
10050 prng = interp->prngState;
10051 /* generates 'len' bytes of pseudo-random numbers */
10052 for (x = 0; x < len; x++) {
10053 prng->i = (prng->i + 1) & 0xff;
10054 si = prng->sbox[prng->i];
10055 prng->j = (prng->j + si) & 0xff;
10056 sj = prng->sbox[prng->j];
10057 prng->sbox[prng->i] = sj;
10058 prng->sbox[prng->j] = si;
10059 *destByte++ = prng->sbox[(si + sj) & 0xff];
10063 /* Re-seed the generator with user-provided bytes */
10064 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10066 int i;
10067 Jim_PrngState *prng;
10069 /* initialization, only needed the first time */
10070 if (interp->prngState == NULL)
10071 JimPrngInit(interp);
10072 prng = interp->prngState;
10074 /* Set the sbox[i] with i */
10075 for (i = 0; i < 256; i++)
10076 prng->sbox[i] = i;
10077 /* Now use the seed to perform a random permutation of the sbox */
10078 for (i = 0; i < seedLen; i++) {
10079 unsigned char t;
10081 t = prng->sbox[i & 0xFF];
10082 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10083 prng->sbox[seed[i]] = t;
10085 prng->i = prng->j = 0;
10087 /* discard at least the first 256 bytes of stream.
10088 * borrow the seed buffer for this
10090 for (i = 0; i < 256; i += seedLen) {
10091 JimRandomBytes(interp, seed, seedLen);
10095 /* [incr] */
10096 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10098 jim_wide wideValue, increment = 1;
10099 Jim_Obj *intObjPtr;
10101 if (argc != 2 && argc != 3) {
10102 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10103 return JIM_ERR;
10105 if (argc == 3) {
10106 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10107 return JIM_ERR;
10109 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10110 if (!intObjPtr) {
10111 /* Set missing variable to 0 */
10112 wideValue = 0;
10114 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10115 return JIM_ERR;
10117 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10118 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10119 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10120 Jim_FreeNewObj(interp, intObjPtr);
10121 return JIM_ERR;
10124 else {
10125 /* Can do it the quick way */
10126 Jim_InvalidateStringRep(intObjPtr);
10127 JimWideValue(intObjPtr) = wideValue + increment;
10129 /* The following step is required in order to invalidate the
10130 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10131 if (argv[1]->typePtr != &variableObjType) {
10132 /* Note that this can't fail since GetVariable already succeeded */
10133 Jim_SetVariable(interp, argv[1], intObjPtr);
10136 Jim_SetResult(interp, intObjPtr);
10137 return JIM_OK;
10141 /* -----------------------------------------------------------------------------
10142 * Eval
10143 * ---------------------------------------------------------------------------*/
10144 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10145 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10147 /* Handle calls to the [unknown] command */
10148 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10150 int retcode;
10152 /* If JimUnknown() is recursively called too many times...
10153 * done here
10155 if (interp->unknown_called > 50) {
10156 return JIM_ERR;
10159 /* The object interp->unknown just contains
10160 * the "unknown" string, it is used in order to
10161 * avoid to lookup the unknown command every time
10162 * but instead to cache the result. */
10164 /* If the [unknown] command does not exist ... */
10165 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10166 return JIM_ERR;
10168 interp->unknown_called++;
10169 /* XXX: Are we losing fileNameObj and linenr? */
10170 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10171 interp->unknown_called--;
10173 return retcode;
10176 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10178 int retcode;
10179 Jim_Cmd *cmdPtr;
10181 #if 0
10182 printf("invoke");
10183 int j;
10184 for (j = 0; j < objc; j++) {
10185 printf(" '%s'", Jim_String(objv[j]));
10187 printf("\n");
10188 #endif
10190 if (interp->framePtr->tailcallCmd) {
10191 /* Special tailcall command was pre-resolved */
10192 cmdPtr = interp->framePtr->tailcallCmd;
10193 interp->framePtr->tailcallCmd = NULL;
10195 else {
10196 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10197 if (cmdPtr == NULL) {
10198 return JimUnknown(interp, objc, objv);
10200 JimIncrCmdRefCount(cmdPtr);
10203 if (interp->evalDepth == interp->maxEvalDepth) {
10204 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10205 retcode = JIM_ERR;
10206 goto out;
10208 interp->evalDepth++;
10210 /* Call it -- Make sure result is an empty object. */
10211 Jim_SetEmptyResult(interp);
10212 if (cmdPtr->isproc) {
10213 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10215 else {
10216 interp->cmdPrivData = cmdPtr->u.native.privData;
10217 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10219 interp->evalDepth--;
10221 out:
10222 JimDecrCmdRefCount(interp, cmdPtr);
10224 return retcode;
10227 /* Eval the object vector 'objv' composed of 'objc' elements.
10228 * Every element is used as single argument.
10229 * Jim_EvalObj() will call this function every time its object
10230 * argument is of "list" type, with no string representation.
10232 * This is possible because the string representation of a
10233 * list object generated by the UpdateStringOfList is made
10234 * in a way that ensures that every list element is a different
10235 * command argument. */
10236 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10238 int i, retcode;
10240 /* Incr refcount of arguments. */
10241 for (i = 0; i < objc; i++)
10242 Jim_IncrRefCount(objv[i]);
10244 retcode = JimInvokeCommand(interp, objc, objv);
10246 /* Decr refcount of arguments and return the retcode */
10247 for (i = 0; i < objc; i++)
10248 Jim_DecrRefCount(interp, objv[i]);
10250 return retcode;
10254 * Invokes 'prefix' as a command with the objv array as arguments.
10256 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10258 int ret;
10259 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10261 nargv[0] = prefix;
10262 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10263 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10264 Jim_Free(nargv);
10265 return ret;
10268 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, ScriptObj *script)
10270 int rc = retcode;
10272 if (rc == JIM_ERR && !interp->errorFlag) {
10273 /* This is the first error, so save the file/line information and reset the stack */
10274 interp->errorFlag = 1;
10275 Jim_IncrRefCount(script->fileNameObj);
10276 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10277 interp->errorFileNameObj = script->fileNameObj;
10278 interp->errorLine = script->linenr;
10280 JimResetStackTrace(interp);
10281 /* Always add a level where the error first occurs */
10282 interp->addStackTrace++;
10285 /* Now if this is an "interesting" level, add it to the stack trace */
10286 if (rc == JIM_ERR && interp->addStackTrace > 0) {
10287 /* Add the stack info for the current level */
10289 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10291 /* Note: if we didn't have a filename for this level,
10292 * don't clear the addStackTrace flag
10293 * so we can pick it up at the next level
10295 if (Jim_Length(script->fileNameObj)) {
10296 interp->addStackTrace = 0;
10299 Jim_DecrRefCount(interp, interp->errorProc);
10300 interp->errorProc = interp->emptyObj;
10301 Jim_IncrRefCount(interp->errorProc);
10303 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
10304 /* Propagate the addStackTrace value through 'return -code error' */
10306 else {
10307 interp->addStackTrace = 0;
10311 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10313 Jim_Obj *objPtr;
10315 switch (token->type) {
10316 case JIM_TT_STR:
10317 case JIM_TT_ESC:
10318 objPtr = token->objPtr;
10319 break;
10320 case JIM_TT_VAR:
10321 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10322 break;
10323 case JIM_TT_DICTSUGAR:
10324 objPtr = JimExpandDictSugar(interp, token->objPtr);
10325 break;
10326 case JIM_TT_EXPRSUGAR:
10327 objPtr = JimExpandExprSugar(interp, token->objPtr);
10328 break;
10329 case JIM_TT_CMD:
10330 switch (Jim_EvalObj(interp, token->objPtr)) {
10331 case JIM_OK:
10332 case JIM_RETURN:
10333 objPtr = interp->result;
10334 break;
10335 case JIM_BREAK:
10336 /* Stop substituting */
10337 return JIM_BREAK;
10338 case JIM_CONTINUE:
10339 /* just skip this one */
10340 return JIM_CONTINUE;
10341 default:
10342 return JIM_ERR;
10344 break;
10345 default:
10346 JimPanic((1,
10347 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10348 objPtr = NULL;
10349 break;
10351 if (objPtr) {
10352 *objPtrPtr = objPtr;
10353 return JIM_OK;
10355 return JIM_ERR;
10358 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10359 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10360 * The returned object has refcount = 0.
10362 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10364 int totlen = 0, i;
10365 Jim_Obj **intv;
10366 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10367 Jim_Obj *objPtr;
10368 char *s;
10370 if (tokens <= JIM_EVAL_SINTV_LEN)
10371 intv = sintv;
10372 else
10373 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10375 /* Compute every token forming the argument
10376 * in the intv objects vector. */
10377 for (i = 0; i < tokens; i++) {
10378 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10379 case JIM_OK:
10380 case JIM_RETURN:
10381 break;
10382 case JIM_BREAK:
10383 if (flags & JIM_SUBST_FLAG) {
10384 /* Stop here */
10385 tokens = i;
10386 continue;
10388 /* XXX: Should probably set an error about break outside loop */
10389 /* fall through to error */
10390 case JIM_CONTINUE:
10391 if (flags & JIM_SUBST_FLAG) {
10392 intv[i] = NULL;
10393 continue;
10395 /* XXX: Ditto continue outside loop */
10396 /* fall through to error */
10397 default:
10398 while (i--) {
10399 Jim_DecrRefCount(interp, intv[i]);
10401 if (intv != sintv) {
10402 Jim_Free(intv);
10404 return NULL;
10406 Jim_IncrRefCount(intv[i]);
10407 Jim_String(intv[i]);
10408 totlen += intv[i]->length;
10411 /* Fast path return for a single token */
10412 if (tokens == 1 && intv[0] && intv == sintv) {
10413 Jim_DecrRefCount(interp, intv[0]);
10414 return intv[0];
10417 /* Concatenate every token in an unique
10418 * object. */
10419 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10421 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10422 && token[2].type == JIM_TT_VAR) {
10423 /* May be able to do fast interpolated object -> dictSubst */
10424 objPtr->typePtr = &interpolatedObjType;
10425 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10426 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10427 Jim_IncrRefCount(intv[2]);
10430 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10431 objPtr->length = totlen;
10432 for (i = 0; i < tokens; i++) {
10433 if (intv[i]) {
10434 memcpy(s, intv[i]->bytes, intv[i]->length);
10435 s += intv[i]->length;
10436 Jim_DecrRefCount(interp, intv[i]);
10439 objPtr->bytes[totlen] = '\0';
10440 /* Free the intv vector if not static. */
10441 if (intv != sintv) {
10442 Jim_Free(intv);
10445 return objPtr;
10449 /* listPtr *must* be a list.
10450 * The contents of the list is evaluated with the first element as the command and
10451 * the remaining elements as the arguments.
10453 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10455 int retcode = JIM_OK;
10457 if (listPtr->internalRep.listValue.len) {
10458 Jim_IncrRefCount(listPtr);
10459 retcode = JimInvokeCommand(interp,
10460 listPtr->internalRep.listValue.len,
10461 listPtr->internalRep.listValue.ele);
10462 Jim_DecrRefCount(interp, listPtr);
10464 return retcode;
10467 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10469 SetListFromAny(interp, listPtr);
10470 return JimEvalObjList(interp, listPtr);
10473 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10475 int i;
10476 ScriptObj *script;
10477 ScriptToken *token;
10478 int retcode = JIM_OK;
10479 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10480 Jim_Obj *prevScriptObj;
10482 /* If the object is of type "list", with no string rep we can call
10483 * a specialized version of Jim_EvalObj() */
10484 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10485 return JimEvalObjList(interp, scriptObjPtr);
10488 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10489 script = Jim_GetScript(interp, scriptObjPtr);
10491 /* Reset the interpreter result. This is useful to
10492 * return the empty result in the case of empty program. */
10493 Jim_SetEmptyResult(interp);
10495 token = script->token;
10497 #ifdef JIM_OPTIMIZATION
10498 /* Check for one of the following common scripts used by for, while
10500 * {}
10501 * incr a
10503 if (script->len == 0) {
10504 Jim_DecrRefCount(interp, scriptObjPtr);
10505 return JIM_OK;
10507 if (script->len == 3
10508 && token[1].objPtr->typePtr == &commandObjType
10509 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10510 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10511 && token[2].objPtr->typePtr == &variableObjType) {
10513 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10515 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10516 JimWideValue(objPtr)++;
10517 Jim_InvalidateStringRep(objPtr);
10518 Jim_DecrRefCount(interp, scriptObjPtr);
10519 Jim_SetResult(interp, objPtr);
10520 return JIM_OK;
10523 #endif
10525 /* Now we have to make sure the internal repr will not be
10526 * freed on shimmering.
10528 * Think for example to this:
10530 * set x {llength $x; ... some more code ...}; eval $x
10532 * In order to preserve the internal rep, we increment the
10533 * inUse field of the script internal rep structure. */
10534 script->inUse++;
10536 /* Stash the current script */
10537 prevScriptObj = interp->currentScriptObj;
10538 interp->currentScriptObj = scriptObjPtr;
10540 interp->errorFlag = 0;
10541 argv = sargv;
10543 /* Execute every command sequentially until the end of the script
10544 * or an error occurs.
10546 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10547 int argc;
10548 int j;
10550 /* First token of the line is always JIM_TT_LINE */
10551 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10552 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10554 /* Allocate the arguments vector if required */
10555 if (argc > JIM_EVAL_SARGV_LEN)
10556 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10558 /* Skip the JIM_TT_LINE token */
10559 i++;
10561 /* Populate the arguments objects.
10562 * If an error occurs, retcode will be set and
10563 * 'j' will be set to the number of args expanded
10565 for (j = 0; j < argc; j++) {
10566 long wordtokens = 1;
10567 int expand = 0;
10568 Jim_Obj *wordObjPtr = NULL;
10570 if (token[i].type == JIM_TT_WORD) {
10571 wordtokens = JimWideValue(token[i++].objPtr);
10572 if (wordtokens < 0) {
10573 expand = 1;
10574 wordtokens = -wordtokens;
10578 if (wordtokens == 1) {
10579 /* Fast path if the token does not
10580 * need interpolation */
10582 switch (token[i].type) {
10583 case JIM_TT_ESC:
10584 case JIM_TT_STR:
10585 wordObjPtr = token[i].objPtr;
10586 break;
10587 case JIM_TT_VAR:
10588 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10589 break;
10590 case JIM_TT_EXPRSUGAR:
10591 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10592 break;
10593 case JIM_TT_DICTSUGAR:
10594 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10595 break;
10596 case JIM_TT_CMD:
10597 retcode = Jim_EvalObj(interp, token[i].objPtr);
10598 if (retcode == JIM_OK) {
10599 wordObjPtr = Jim_GetResult(interp);
10601 break;
10602 default:
10603 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10606 else {
10607 /* For interpolation we call a helper
10608 * function to do the work for us. */
10609 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10612 if (!wordObjPtr) {
10613 if (retcode == JIM_OK) {
10614 retcode = JIM_ERR;
10616 break;
10619 Jim_IncrRefCount(wordObjPtr);
10620 i += wordtokens;
10622 if (!expand) {
10623 argv[j] = wordObjPtr;
10625 else {
10626 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10627 int len = Jim_ListLength(interp, wordObjPtr);
10628 int newargc = argc + len - 1;
10629 int k;
10631 if (len > 1) {
10632 if (argv == sargv) {
10633 if (newargc > JIM_EVAL_SARGV_LEN) {
10634 argv = Jim_Alloc(sizeof(*argv) * newargc);
10635 memcpy(argv, sargv, sizeof(*argv) * j);
10638 else {
10639 /* Need to realloc to make room for (len - 1) more entries */
10640 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10644 /* Now copy in the expanded version */
10645 for (k = 0; k < len; k++) {
10646 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10647 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10650 /* The original object reference is no longer needed,
10651 * after the expansion it is no longer present on
10652 * the argument vector, but the single elements are
10653 * in its place. */
10654 Jim_DecrRefCount(interp, wordObjPtr);
10656 /* And update the indexes */
10657 j--;
10658 argc += len - 1;
10662 if (retcode == JIM_OK && argc) {
10663 /* Invoke the command */
10664 retcode = JimInvokeCommand(interp, argc, argv);
10665 /* Check for a signal after each command */
10666 if (Jim_CheckSignal(interp)) {
10667 retcode = JIM_SIGNAL;
10671 /* Finished with the command, so decrement ref counts of each argument */
10672 while (j-- > 0) {
10673 Jim_DecrRefCount(interp, argv[j]);
10676 if (argv != sargv) {
10677 Jim_Free(argv);
10678 argv = sargv;
10682 /* Possibly add to the error stack trace */
10683 JimAddErrorToStack(interp, retcode, script);
10685 /* Restore the current script */
10686 interp->currentScriptObj = prevScriptObj;
10688 /* Note that we don't have to decrement inUse, because the
10689 * following code transfers our use of the reference again to
10690 * the script object. */
10691 Jim_FreeIntRep(interp, scriptObjPtr);
10692 scriptObjPtr->typePtr = &scriptObjType;
10693 Jim_SetIntRepPtr(scriptObjPtr, script);
10694 Jim_DecrRefCount(interp, scriptObjPtr);
10696 return retcode;
10699 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10701 int retcode;
10702 /* If argObjPtr begins with '&', do an automatic upvar */
10703 const char *varname = Jim_String(argNameObj);
10704 if (*varname == '&') {
10705 /* First check that the target variable exists */
10706 Jim_Obj *objPtr;
10707 Jim_CallFrame *savedCallFrame = interp->framePtr;
10709 interp->framePtr = interp->framePtr->parent;
10710 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10711 interp->framePtr = savedCallFrame;
10712 if (!objPtr) {
10713 return JIM_ERR;
10716 /* It exists, so perform the binding. */
10717 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10718 Jim_IncrRefCount(objPtr);
10719 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10720 Jim_DecrRefCount(interp, objPtr);
10722 else {
10723 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10725 return retcode;
10729 * Sets the interp result to be an error message indicating the required proc args.
10731 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10733 /* Create a nice error message, consistent with Tcl 8.5 */
10734 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10735 int i;
10737 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10738 Jim_AppendString(interp, argmsg, " ", 1);
10740 if (i == cmd->u.proc.argsPos) {
10741 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10742 /* Renamed args */
10743 Jim_AppendString(interp, argmsg, "?", 1);
10744 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10745 Jim_AppendString(interp, argmsg, " ...?", -1);
10747 else {
10748 /* We have plain args */
10749 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10752 else {
10753 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10754 Jim_AppendString(interp, argmsg, "?", 1);
10755 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10756 Jim_AppendString(interp, argmsg, "?", 1);
10758 else {
10759 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10760 if (*arg == '&') {
10761 arg++;
10763 Jim_AppendString(interp, argmsg, arg, -1);
10767 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10768 Jim_FreeNewObj(interp, argmsg);
10771 #ifdef jim_ext_namespace
10773 * [namespace eval]
10775 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10777 Jim_CallFrame *callFramePtr;
10778 int retcode;
10780 /* Create a new callframe */
10781 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10782 callFramePtr->argv = &interp->emptyObj;
10783 callFramePtr->argc = 0;
10784 callFramePtr->procArgsObjPtr = NULL;
10785 callFramePtr->procBodyObjPtr = scriptObj;
10786 callFramePtr->staticVars = NULL;
10787 callFramePtr->fileNameObj = interp->emptyObj;
10788 callFramePtr->line = 0;
10789 Jim_IncrRefCount(scriptObj);
10790 interp->framePtr = callFramePtr;
10792 /* Check if there are too nested calls */
10793 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10794 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10795 retcode = JIM_ERR;
10797 else {
10798 /* Eval the body */
10799 retcode = Jim_EvalObj(interp, scriptObj);
10802 /* Destroy the callframe */
10803 interp->framePtr = interp->framePtr->parent;
10804 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10805 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10807 else {
10808 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10811 return retcode;
10813 #endif
10815 /* Call a procedure implemented in Tcl.
10816 * It's possible to speed-up a lot this function, currently
10817 * the callframes are not cached, but allocated and
10818 * destroied every time. What is expecially costly is
10819 * to create/destroy the local vars hash table every time.
10821 * This can be fixed just implementing callframes caching
10822 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10823 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10825 Jim_CallFrame *callFramePtr;
10826 int i, d, retcode, optargs;
10827 ScriptObj *script;
10829 /* Check arity */
10830 if (argc - 1 < cmd->u.proc.reqArity ||
10831 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10832 JimSetProcWrongArgs(interp, argv[0], cmd);
10833 return JIM_ERR;
10836 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10837 /* Optimise for procedure with no body - useful for optional debugging */
10838 return JIM_OK;
10841 /* Check if there are too nested calls */
10842 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10843 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10844 return JIM_ERR;
10847 /* Create a new callframe */
10848 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10849 callFramePtr->argv = argv;
10850 callFramePtr->argc = argc;
10851 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10852 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10853 callFramePtr->staticVars = cmd->u.proc.staticVars;
10855 /* Remember where we were called from. */
10856 script = Jim_GetScript(interp, interp->currentScriptObj);
10857 callFramePtr->fileNameObj = script->fileNameObj;
10858 callFramePtr->line = script->linenr;
10860 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10861 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10862 interp->framePtr = callFramePtr;
10864 /* How many optional args are available */
10865 optargs = (argc - 1 - cmd->u.proc.reqArity);
10867 /* Step 'i' along the actual args, and step 'd' along the formal args */
10868 i = 1;
10869 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10870 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10871 if (d == cmd->u.proc.argsPos) {
10872 /* assign $args */
10873 Jim_Obj *listObjPtr;
10874 int argsLen = 0;
10875 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10876 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10878 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10880 /* It is possible to rename args. */
10881 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10882 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10884 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10885 if (retcode != JIM_OK) {
10886 goto badargset;
10889 i += argsLen;
10890 continue;
10893 /* Optional or required? */
10894 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10895 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10897 else {
10898 /* Ran out, so use the default */
10899 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10901 if (retcode != JIM_OK) {
10902 goto badargset;
10906 /* Eval the body */
10907 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10909 badargset:
10911 /* Free the callframe */
10912 interp->framePtr = interp->framePtr->parent;
10914 if (callFramePtr->vars.size != JIM_HT_INITIAL_SIZE) {
10915 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NONE);
10917 else {
10918 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_NOHT);
10921 if (interp->framePtr->tailcallObj) {
10922 /* If a tailcall is already being executed, merge this tailcall with that one */
10923 if (interp->framePtr->tailcall++ == 0) {
10924 /* No current tailcall in this frame, so invoke the tailcall command */
10925 do {
10926 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10928 interp->framePtr->tailcallObj = NULL;
10930 if (retcode == JIM_EVAL) {
10931 retcode = Jim_EvalObjList(interp, tailcallObj);
10932 if (retcode == JIM_RETURN) {
10933 /* If the result of the tailcall is 'return', push
10934 * it up to the caller
10936 interp->returnLevel++;
10939 Jim_DecrRefCount(interp, tailcallObj);
10940 } while (interp->framePtr->tailcallObj);
10942 /* If the tailcall chain finished early, may need to manually discard the command */
10943 if (interp->framePtr->tailcallCmd) {
10944 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10945 interp->framePtr->tailcallCmd = NULL;
10948 interp->framePtr->tailcall--;
10951 /* Handle the JIM_RETURN return code */
10952 if (retcode == JIM_RETURN) {
10953 if (--interp->returnLevel <= 0) {
10954 retcode = interp->returnCode;
10955 interp->returnCode = JIM_OK;
10956 interp->returnLevel = 0;
10959 else if (retcode == JIM_ERR) {
10960 interp->addStackTrace++;
10961 Jim_DecrRefCount(interp, interp->errorProc);
10962 interp->errorProc = argv[0];
10963 Jim_IncrRefCount(interp->errorProc);
10966 return retcode;
10969 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10971 int retval;
10972 Jim_Obj *scriptObjPtr;
10974 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10975 Jim_IncrRefCount(scriptObjPtr);
10977 if (filename) {
10978 Jim_Obj *prevScriptObj;
10980 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10982 prevScriptObj = interp->currentScriptObj;
10983 interp->currentScriptObj = scriptObjPtr;
10985 retval = Jim_EvalObj(interp, scriptObjPtr);
10987 interp->currentScriptObj = prevScriptObj;
10989 else {
10990 retval = Jim_EvalObj(interp, scriptObjPtr);
10992 Jim_DecrRefCount(interp, scriptObjPtr);
10993 return retval;
10996 int Jim_Eval(Jim_Interp *interp, const char *script)
10998 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
11001 /* Execute script in the scope of the global level */
11002 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
11004 int retval;
11005 Jim_CallFrame *savedFramePtr = interp->framePtr;
11007 interp->framePtr = interp->topFramePtr;
11008 retval = Jim_Eval(interp, script);
11009 interp->framePtr = savedFramePtr;
11011 return retval;
11014 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
11016 int retval;
11017 Jim_CallFrame *savedFramePtr = interp->framePtr;
11019 interp->framePtr = interp->topFramePtr;
11020 retval = Jim_EvalFile(interp, filename);
11021 interp->framePtr = savedFramePtr;
11023 return retval;
11026 #include <sys/stat.h>
11028 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11030 FILE *fp;
11031 char *buf;
11032 Jim_Obj *scriptObjPtr;
11033 Jim_Obj *prevScriptObj;
11034 struct stat sb;
11035 int retcode;
11036 int readlen;
11037 struct JimParseResult result;
11039 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11040 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11041 return JIM_ERR;
11043 if (sb.st_size == 0) {
11044 fclose(fp);
11045 return JIM_OK;
11048 buf = Jim_Alloc(sb.st_size + 1);
11049 readlen = fread(buf, 1, sb.st_size, fp);
11050 if (ferror(fp)) {
11051 fclose(fp);
11052 Jim_Free(buf);
11053 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11054 return JIM_ERR;
11056 fclose(fp);
11057 buf[readlen] = 0;
11059 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11060 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11061 Jim_IncrRefCount(scriptObjPtr);
11063 /* Now check the script for unmatched braces, etc. */
11064 if (SetScriptFromAny(interp, scriptObjPtr, &result) == JIM_ERR) {
11065 const char *msg;
11066 char linebuf[20];
11068 switch (result.missing) {
11069 case '[':
11070 msg = "unmatched \"[\"";
11071 break;
11072 case '{':
11073 msg = "missing close-brace";
11074 break;
11075 case '"':
11076 default:
11077 msg = "missing quote";
11078 break;
11081 snprintf(linebuf, sizeof(linebuf), "%d", result.line);
11083 Jim_SetResultFormatted(interp, "%s in \"%s\" at line %s",
11084 msg, filename, linebuf);
11085 Jim_DecrRefCount(interp, scriptObjPtr);
11086 return JIM_ERR;
11089 prevScriptObj = interp->currentScriptObj;
11090 interp->currentScriptObj = scriptObjPtr;
11092 retcode = Jim_EvalObj(interp, scriptObjPtr);
11094 /* Handle the JIM_RETURN return code */
11095 if (retcode == JIM_RETURN) {
11096 if (--interp->returnLevel <= 0) {
11097 retcode = interp->returnCode;
11098 interp->returnCode = JIM_OK;
11099 interp->returnLevel = 0;
11102 if (retcode == JIM_ERR) {
11103 /* EvalFile changes context, so add a stack frame here */
11104 interp->addStackTrace++;
11107 interp->currentScriptObj = prevScriptObj;
11109 Jim_DecrRefCount(interp, scriptObjPtr);
11111 return retcode;
11114 /* -----------------------------------------------------------------------------
11115 * Subst
11116 * ---------------------------------------------------------------------------*/
11117 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11119 pc->tstart = pc->p;
11120 pc->tline = pc->linenr;
11122 if (pc->len == 0) {
11123 pc->tend = pc->p;
11124 pc->tt = JIM_TT_EOL;
11125 pc->eof = 1;
11126 return;
11128 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11129 JimParseCmd(pc);
11130 return;
11132 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11133 if (JimParseVar(pc) == JIM_OK) {
11134 return;
11136 /* Not a var, so treat as a string */
11137 pc->tstart = pc->p;
11138 flags |= JIM_SUBST_NOVAR;
11140 while (pc->len) {
11141 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11142 break;
11144 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11145 break;
11147 if (*pc->p == '\\' && pc->len > 1) {
11148 pc->p++;
11149 pc->len--;
11151 pc->p++;
11152 pc->len--;
11154 pc->tend = pc->p - 1;
11155 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11158 /* The subst object type reuses most of the data structures and functions
11159 * of the script object. Script's data structures are a bit more complex
11160 * for what is needed for [subst]itution tasks, but the reuse helps to
11161 * deal with a single data structure at the cost of some more memory
11162 * usage for substitutions. */
11164 /* This method takes the string representation of an object
11165 * as a Tcl string where to perform [subst]itution, and generates
11166 * the pre-parsed internal representation. */
11167 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11169 int scriptTextLen;
11170 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11171 struct JimParserCtx parser;
11172 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11173 ParseTokenList tokenlist;
11175 /* Initially parse the subst into tokens (in tokenlist) */
11176 ScriptTokenListInit(&tokenlist);
11178 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11179 while (1) {
11180 JimParseSubst(&parser, flags);
11181 if (parser.eof) {
11182 /* Note that subst doesn't need the EOL token */
11183 break;
11185 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11186 parser.tline);
11189 /* Create the "real" subst/script tokens from the initial token list */
11190 script->inUse = 1;
11191 script->substFlags = flags;
11192 script->fileNameObj = interp->emptyObj;
11193 Jim_IncrRefCount(script->fileNameObj);
11194 SubstObjAddTokens(interp, script, &tokenlist);
11196 /* No longer need the token list */
11197 ScriptTokenListFree(&tokenlist);
11199 #ifdef DEBUG_SHOW_SUBST
11201 int i;
11203 printf("==== Subst ====\n");
11204 for (i = 0; i < script->len; i++) {
11205 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11206 Jim_String(script->token[i].objPtr));
11209 #endif
11211 /* Free the old internal rep and set the new one. */
11212 Jim_FreeIntRep(interp, objPtr);
11213 Jim_SetIntRepPtr(objPtr, script);
11214 objPtr->typePtr = &scriptObjType;
11215 return JIM_OK;
11218 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11220 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11221 SetSubstFromAny(interp, objPtr, flags);
11222 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11225 /* Performs commands,variables,blackslashes substitution,
11226 * storing the result object (with refcount 0) into
11227 * resObjPtrPtr. */
11228 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11230 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11232 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11233 /* In order to preserve the internal rep, we increment the
11234 * inUse field of the script internal rep structure. */
11235 script->inUse++;
11237 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11239 script->inUse--;
11240 Jim_DecrRefCount(interp, substObjPtr);
11241 if (*resObjPtrPtr == NULL) {
11242 return JIM_ERR;
11244 return JIM_OK;
11247 /* -----------------------------------------------------------------------------
11248 * Core commands utility functions
11249 * ---------------------------------------------------------------------------*/
11250 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11252 Jim_Obj *objPtr;
11253 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11255 if (*msg) {
11256 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11258 Jim_IncrRefCount(listObjPtr);
11259 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11260 Jim_DecrRefCount(interp, listObjPtr);
11262 Jim_IncrRefCount(objPtr);
11263 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11264 Jim_DecrRefCount(interp, objPtr);
11268 * May add the key and/or value to the list.
11270 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11271 Jim_HashEntry *he, int type);
11273 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11276 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11277 * invoke the callback to add entries to a list.
11278 * Returns the list.
11280 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11281 JimHashtableIteratorCallbackType *callback, int type)
11283 Jim_HashEntry *he;
11284 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11286 /* Check for the non-pattern case. We can do this much more efficiently. */
11287 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11288 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11289 if (he) {
11290 callback(interp, listObjPtr, he, type);
11293 else {
11294 Jim_HashTableIterator htiter;
11295 JimInitHashTableIterator(ht, &htiter);
11296 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11297 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11298 callback(interp, listObjPtr, he, type);
11302 return listObjPtr;
11305 /* Keep these in order */
11306 #define JIM_CMDLIST_COMMANDS 0
11307 #define JIM_CMDLIST_PROCS 1
11308 #define JIM_CMDLIST_CHANNELS 2
11311 * Adds matching command names (procs, channels) to the list.
11313 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11314 Jim_HashEntry *he, int type)
11316 Jim_Cmd *cmdPtr = (Jim_Cmd *)he->u.val;
11317 Jim_Obj *objPtr;
11319 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11320 /* not a proc */
11321 return;
11324 objPtr = Jim_NewStringObj(interp, he->key, -1);
11325 Jim_IncrRefCount(objPtr);
11327 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11328 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11330 Jim_DecrRefCount(interp, objPtr);
11333 /* type is JIM_CMDLIST_xxx */
11334 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11336 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11339 /* Keep these in order */
11340 #define JIM_VARLIST_GLOBALS 0
11341 #define JIM_VARLIST_LOCALS 1
11342 #define JIM_VARLIST_VARS 2
11344 #define JIM_VARLIST_VALUES 0x1000
11347 * Adds matching variable names to the list.
11349 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11350 Jim_HashEntry *he, int type)
11352 Jim_Var *varPtr = (Jim_Var *)he->u.val;
11354 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11355 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11356 if (type & JIM_VARLIST_VALUES) {
11357 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11362 /* mode is JIM_VARLIST_xxx */
11363 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11365 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11366 /* For [info locals], if we are at top level an emtpy list
11367 * is returned. I don't agree, but we aim at compatibility (SS) */
11368 return interp->emptyObj;
11370 else {
11371 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11372 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11376 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11377 Jim_Obj **objPtrPtr, int info_level_cmd)
11379 Jim_CallFrame *targetCallFrame;
11381 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11382 if (targetCallFrame == NULL) {
11383 return JIM_ERR;
11385 /* No proc call at toplevel callframe */
11386 if (targetCallFrame == interp->topFramePtr) {
11387 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11388 return JIM_ERR;
11390 if (info_level_cmd) {
11391 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11393 else {
11394 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11396 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11397 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11398 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11399 *objPtrPtr = listObj;
11401 return JIM_OK;
11404 /* -----------------------------------------------------------------------------
11405 * Core commands
11406 * ---------------------------------------------------------------------------*/
11408 /* fake [puts] -- not the real puts, just for debugging. */
11409 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11411 if (argc != 2 && argc != 3) {
11412 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11413 return JIM_ERR;
11415 if (argc == 3) {
11416 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11417 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11418 return JIM_ERR;
11420 else {
11421 fputs(Jim_String(argv[2]), stdout);
11424 else {
11425 puts(Jim_String(argv[1]));
11427 return JIM_OK;
11430 /* Helper for [+] and [*] */
11431 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11433 jim_wide wideValue, res;
11434 double doubleValue, doubleRes;
11435 int i;
11437 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11439 for (i = 1; i < argc; i++) {
11440 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11441 goto trydouble;
11442 if (op == JIM_EXPROP_ADD)
11443 res += wideValue;
11444 else
11445 res *= wideValue;
11447 Jim_SetResultInt(interp, res);
11448 return JIM_OK;
11449 trydouble:
11450 doubleRes = (double)res;
11451 for (; i < argc; i++) {
11452 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11453 return JIM_ERR;
11454 if (op == JIM_EXPROP_ADD)
11455 doubleRes += doubleValue;
11456 else
11457 doubleRes *= doubleValue;
11459 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11460 return JIM_OK;
11463 /* Helper for [-] and [/] */
11464 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11466 jim_wide wideValue, res = 0;
11467 double doubleValue, doubleRes = 0;
11468 int i = 2;
11470 if (argc < 2) {
11471 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11472 return JIM_ERR;
11474 else if (argc == 2) {
11475 /* The arity = 2 case is different. For [- x] returns -x,
11476 * while [/ x] returns 1/x. */
11477 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11478 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11479 return JIM_ERR;
11481 else {
11482 if (op == JIM_EXPROP_SUB)
11483 doubleRes = -doubleValue;
11484 else
11485 doubleRes = 1.0 / doubleValue;
11486 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11487 return JIM_OK;
11490 if (op == JIM_EXPROP_SUB) {
11491 res = -wideValue;
11492 Jim_SetResultInt(interp, res);
11494 else {
11495 doubleRes = 1.0 / wideValue;
11496 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11498 return JIM_OK;
11500 else {
11501 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11502 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11503 != JIM_OK) {
11504 return JIM_ERR;
11506 else {
11507 goto trydouble;
11511 for (i = 2; i < argc; i++) {
11512 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11513 doubleRes = (double)res;
11514 goto trydouble;
11516 if (op == JIM_EXPROP_SUB)
11517 res -= wideValue;
11518 else
11519 res /= wideValue;
11521 Jim_SetResultInt(interp, res);
11522 return JIM_OK;
11523 trydouble:
11524 for (; i < argc; i++) {
11525 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11526 return JIM_ERR;
11527 if (op == JIM_EXPROP_SUB)
11528 doubleRes -= doubleValue;
11529 else
11530 doubleRes /= doubleValue;
11532 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11533 return JIM_OK;
11537 /* [+] */
11538 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11540 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11543 /* [*] */
11544 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11546 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11549 /* [-] */
11550 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11552 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11555 /* [/] */
11556 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11558 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11561 /* [set] */
11562 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11564 if (argc != 2 && argc != 3) {
11565 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11566 return JIM_ERR;
11568 if (argc == 2) {
11569 Jim_Obj *objPtr;
11571 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11572 if (!objPtr)
11573 return JIM_ERR;
11574 Jim_SetResult(interp, objPtr);
11575 return JIM_OK;
11577 /* argc == 3 case. */
11578 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11579 return JIM_ERR;
11580 Jim_SetResult(interp, argv[2]);
11581 return JIM_OK;
11584 /* [unset]
11586 * unset ?-nocomplain? ?--? ?varName ...?
11588 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11590 int i = 1;
11591 int complain = 1;
11593 while (i < argc) {
11594 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11595 i++;
11596 break;
11598 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11599 complain = 0;
11600 i++;
11601 continue;
11603 break;
11606 while (i < argc) {
11607 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11608 && complain) {
11609 return JIM_ERR;
11611 i++;
11613 return JIM_OK;
11616 /* [while] */
11617 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11619 if (argc != 3) {
11620 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11621 return JIM_ERR;
11624 /* The general purpose implementation of while starts here */
11625 while (1) {
11626 int boolean, retval;
11628 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11629 return retval;
11630 if (!boolean)
11631 break;
11633 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11634 switch (retval) {
11635 case JIM_BREAK:
11636 goto out;
11637 break;
11638 case JIM_CONTINUE:
11639 continue;
11640 break;
11641 default:
11642 return retval;
11646 out:
11647 Jim_SetEmptyResult(interp);
11648 return JIM_OK;
11651 /* [for] */
11652 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11654 int retval;
11655 int boolean = 1;
11656 Jim_Obj *varNamePtr = NULL;
11657 Jim_Obj *stopVarNamePtr = NULL;
11659 if (argc != 5) {
11660 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11661 return JIM_ERR;
11664 /* Do the initialisation */
11665 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11666 return retval;
11669 /* And do the first test now. Better for optimisation
11670 * if we can do next/test at the bottom of the loop
11672 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11674 /* Ready to do the body as follows:
11675 * while (1) {
11676 * body // check retcode
11677 * next // check retcode
11678 * test // check retcode/test bool
11682 #ifdef JIM_OPTIMIZATION
11683 /* Check if the for is on the form:
11684 * for ... {$i < CONST} {incr i}
11685 * for ... {$i < $j} {incr i}
11687 if (retval == JIM_OK && boolean) {
11688 ScriptObj *incrScript;
11689 ExprByteCode *expr;
11690 jim_wide stop, currentVal;
11691 Jim_Obj *objPtr;
11692 int cmpOffset;
11694 /* Do it only if there aren't shared arguments */
11695 expr = JimGetExpression(interp, argv[2]);
11696 incrScript = Jim_GetScript(interp, argv[3]);
11698 /* Ensure proper lengths to start */
11699 if (incrScript->len != 3 || !expr || expr->len != 3) {
11700 goto evalstart;
11702 /* Ensure proper token types. */
11703 if (incrScript->token[1].type != JIM_TT_ESC ||
11704 expr->token[0].type != JIM_TT_VAR ||
11705 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11706 goto evalstart;
11709 if (expr->token[2].type == JIM_EXPROP_LT) {
11710 cmpOffset = 0;
11712 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11713 cmpOffset = 1;
11715 else {
11716 goto evalstart;
11719 /* Update command must be incr */
11720 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11721 goto evalstart;
11724 /* incr, expression must be about the same variable */
11725 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11726 goto evalstart;
11729 /* Get the stop condition (must be a variable or integer) */
11730 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11731 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11732 goto evalstart;
11735 else {
11736 stopVarNamePtr = expr->token[1].objPtr;
11737 Jim_IncrRefCount(stopVarNamePtr);
11738 /* Keep the compiler happy */
11739 stop = 0;
11742 /* Initialization */
11743 varNamePtr = expr->token[0].objPtr;
11744 Jim_IncrRefCount(varNamePtr);
11746 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11747 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11748 goto testcond;
11751 /* --- OPTIMIZED FOR --- */
11752 while (retval == JIM_OK) {
11753 /* === Check condition === */
11754 /* Note that currentVal is already set here */
11756 /* Immediate or Variable? get the 'stop' value if the latter. */
11757 if (stopVarNamePtr) {
11758 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11759 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11760 goto testcond;
11764 if (currentVal >= stop + cmpOffset) {
11765 break;
11768 /* Eval body */
11769 retval = Jim_EvalObj(interp, argv[4]);
11770 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11771 retval = JIM_OK;
11773 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11775 /* Increment */
11776 if (objPtr == NULL) {
11777 retval = JIM_ERR;
11778 goto out;
11780 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11781 currentVal = ++JimWideValue(objPtr);
11782 Jim_InvalidateStringRep(objPtr);
11784 else {
11785 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11786 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11787 ++currentVal)) != JIM_OK) {
11788 goto evalnext;
11793 goto out;
11795 evalstart:
11796 #endif
11798 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11799 /* Body */
11800 retval = Jim_EvalObj(interp, argv[4]);
11802 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11803 /* increment */
11804 evalnext:
11805 retval = Jim_EvalObj(interp, argv[3]);
11806 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11807 /* test */
11808 testcond:
11809 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11813 out:
11814 if (stopVarNamePtr) {
11815 Jim_DecrRefCount(interp, stopVarNamePtr);
11817 if (varNamePtr) {
11818 Jim_DecrRefCount(interp, varNamePtr);
11821 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11822 Jim_SetEmptyResult(interp);
11823 return JIM_OK;
11826 return retval;
11829 /* [loop] */
11830 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11832 int retval;
11833 jim_wide i;
11834 jim_wide limit;
11835 jim_wide incr = 1;
11836 Jim_Obj *bodyObjPtr;
11838 if (argc != 5 && argc != 6) {
11839 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11840 return JIM_ERR;
11843 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11844 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11845 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11846 return JIM_ERR;
11848 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11850 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11852 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11853 retval = Jim_EvalObj(interp, bodyObjPtr);
11854 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11855 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11857 retval = JIM_OK;
11859 /* Increment */
11860 i += incr;
11862 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11863 if (argv[1]->typePtr != &variableObjType) {
11864 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11865 return JIM_ERR;
11868 JimWideValue(objPtr) = i;
11869 Jim_InvalidateStringRep(objPtr);
11871 /* The following step is required in order to invalidate the
11872 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11873 if (argv[1]->typePtr != &variableObjType) {
11874 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11875 retval = JIM_ERR;
11876 break;
11880 else {
11881 objPtr = Jim_NewIntObj(interp, i);
11882 retval = Jim_SetVariable(interp, argv[1], objPtr);
11883 if (retval != JIM_OK) {
11884 Jim_FreeNewObj(interp, objPtr);
11890 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11891 Jim_SetEmptyResult(interp);
11892 return JIM_OK;
11894 return retval;
11897 /* List iterators make it easy to iterate over a list.
11898 * At some point iterators will be expanded to support generators.
11900 typedef struct {
11901 Jim_Obj *objPtr;
11902 int idx;
11903 } Jim_ListIter;
11906 * Initialise the iterator at the start of the list.
11908 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11910 iter->objPtr = objPtr;
11911 iter->idx = 0;
11915 * Returns the next object from the list, or NULL on end-of-list.
11917 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11919 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11920 return NULL;
11922 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11926 * Returns 1 if end-of-list has been reached.
11928 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11930 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11933 /* foreach + lmap implementation. */
11934 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11936 int result = JIM_ERR;
11937 int i, numargs;
11938 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11939 Jim_ListIter *iters;
11940 Jim_Obj *script;
11941 Jim_Obj *resultObj;
11943 if (argc < 4 || argc % 2 != 0) {
11944 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11945 return JIM_ERR;
11947 script = argv[argc - 1]; /* Last argument is a script */
11948 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11950 if (numargs == 2) {
11951 iters = twoiters;
11953 else {
11954 iters = Jim_Alloc(numargs * sizeof(*iters));
11956 for (i = 0; i < numargs; i++) {
11957 JimListIterInit(&iters[i], argv[i + 1]);
11958 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11959 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11960 return JIM_ERR;
11964 if (doMap) {
11965 resultObj = Jim_NewListObj(interp, NULL, 0);
11967 else {
11968 resultObj = interp->emptyObj;
11970 Jim_IncrRefCount(resultObj);
11972 while (1) {
11973 /* Have we expired all lists? */
11974 for (i = 0; i < numargs; i += 2) {
11975 if (!JimListIterDone(interp, &iters[i + 1])) {
11976 break;
11979 if (i == numargs) {
11980 /* All done */
11981 break;
11984 /* For each list */
11985 for (i = 0; i < numargs; i += 2) {
11986 Jim_Obj *varName;
11988 /* foreach var */
11989 JimListIterInit(&iters[i], argv[i + 1]);
11990 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11991 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11992 if (!valObj) {
11993 /* Ran out, so store the empty string */
11994 valObj = interp->emptyObj;
11996 /* Avoid shimmering */
11997 Jim_IncrRefCount(valObj);
11998 result = Jim_SetVariable(interp, varName, valObj);
11999 Jim_DecrRefCount(interp, valObj);
12000 if (result != JIM_OK) {
12001 goto err;
12005 switch (result = Jim_EvalObj(interp, script)) {
12006 case JIM_OK:
12007 if (doMap) {
12008 Jim_ListAppendElement(interp, resultObj, interp->result);
12010 break;
12011 case JIM_CONTINUE:
12012 break;
12013 case JIM_BREAK:
12014 goto out;
12015 default:
12016 goto err;
12019 out:
12020 result = JIM_OK;
12021 Jim_SetResult(interp, resultObj);
12022 err:
12023 Jim_DecrRefCount(interp, resultObj);
12024 if (numargs > 2) {
12025 Jim_Free(iters);
12027 return result;
12030 /* [foreach] */
12031 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12033 return JimForeachMapHelper(interp, argc, argv, 0);
12036 /* [lmap] */
12037 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12039 return JimForeachMapHelper(interp, argc, argv, 1);
12042 /* [lassign] */
12043 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12045 int result = JIM_ERR;
12046 int i;
12047 Jim_ListIter iter;
12048 Jim_Obj *resultObj;
12050 if (argc < 2) {
12051 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12052 return JIM_ERR;
12055 JimListIterInit(&iter, argv[1]);
12057 for (i = 2; i < argc; i++) {
12058 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12059 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12060 if (result != JIM_OK) {
12061 return result;
12065 resultObj = Jim_NewListObj(interp, NULL, 0);
12066 while (!JimListIterDone(interp, &iter)) {
12067 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12070 Jim_SetResult(interp, resultObj);
12072 return JIM_OK;
12075 /* [if] */
12076 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12078 int boolean, retval, current = 1, falsebody = 0;
12080 if (argc >= 3) {
12081 while (1) {
12082 /* Far not enough arguments given! */
12083 if (current >= argc)
12084 goto err;
12085 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12086 != JIM_OK)
12087 return retval;
12088 /* There lacks something, isn't it? */
12089 if (current >= argc)
12090 goto err;
12091 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12092 current++;
12093 /* Tsk tsk, no then-clause? */
12094 if (current >= argc)
12095 goto err;
12096 if (boolean)
12097 return Jim_EvalObj(interp, argv[current]);
12098 /* Ok: no else-clause follows */
12099 if (++current >= argc) {
12100 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12101 return JIM_OK;
12103 falsebody = current++;
12104 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12105 /* IIICKS - else-clause isn't last cmd? */
12106 if (current != argc - 1)
12107 goto err;
12108 return Jim_EvalObj(interp, argv[current]);
12110 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12111 /* Ok: elseif follows meaning all the stuff
12112 * again (how boring...) */
12113 continue;
12114 /* OOPS - else-clause is not last cmd? */
12115 else if (falsebody != argc - 1)
12116 goto err;
12117 return Jim_EvalObj(interp, argv[falsebody]);
12119 return JIM_OK;
12121 err:
12122 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12123 return JIM_ERR;
12127 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12128 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12129 Jim_Obj *stringObj, int nocase)
12131 Jim_Obj *parms[4];
12132 int argc = 0;
12133 long eq;
12134 int rc;
12136 parms[argc++] = commandObj;
12137 if (nocase) {
12138 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12140 parms[argc++] = patternObj;
12141 parms[argc++] = stringObj;
12143 rc = Jim_EvalObjVector(interp, argc, parms);
12145 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12146 eq = -rc;
12149 return eq;
12152 enum
12153 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12155 /* [switch] */
12156 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12158 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12159 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12160 Jim_Obj *script = 0;
12162 if (argc < 3) {
12163 wrongnumargs:
12164 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12165 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12166 return JIM_ERR;
12168 for (opt = 1; opt < argc; ++opt) {
12169 const char *option = Jim_String(argv[opt]);
12171 if (*option != '-')
12172 break;
12173 else if (strncmp(option, "--", 2) == 0) {
12174 ++opt;
12175 break;
12177 else if (strncmp(option, "-exact", 2) == 0)
12178 matchOpt = SWITCH_EXACT;
12179 else if (strncmp(option, "-glob", 2) == 0)
12180 matchOpt = SWITCH_GLOB;
12181 else if (strncmp(option, "-regexp", 2) == 0)
12182 matchOpt = SWITCH_RE;
12183 else if (strncmp(option, "-command", 2) == 0) {
12184 matchOpt = SWITCH_CMD;
12185 if ((argc - opt) < 2)
12186 goto wrongnumargs;
12187 command = argv[++opt];
12189 else {
12190 Jim_SetResultFormatted(interp,
12191 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12192 argv[opt]);
12193 return JIM_ERR;
12195 if ((argc - opt) < 2)
12196 goto wrongnumargs;
12198 strObj = argv[opt++];
12199 patCount = argc - opt;
12200 if (patCount == 1) {
12201 Jim_Obj **vector;
12203 JimListGetElements(interp, argv[opt], &patCount, &vector);
12204 caseList = vector;
12206 else
12207 caseList = &argv[opt];
12208 if (patCount == 0 || patCount % 2 != 0)
12209 goto wrongnumargs;
12210 for (i = 0; script == 0 && i < patCount; i += 2) {
12211 Jim_Obj *patObj = caseList[i];
12213 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12214 || i < (patCount - 2)) {
12215 switch (matchOpt) {
12216 case SWITCH_EXACT:
12217 if (Jim_StringEqObj(strObj, patObj))
12218 script = caseList[i + 1];
12219 break;
12220 case SWITCH_GLOB:
12221 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12222 script = caseList[i + 1];
12223 break;
12224 case SWITCH_RE:
12225 command = Jim_NewStringObj(interp, "regexp", -1);
12226 /* Fall thru intentionally */
12227 case SWITCH_CMD:{
12228 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12230 /* After the execution of a command we need to
12231 * make sure to reconvert the object into a list
12232 * again. Only for the single-list style [switch]. */
12233 if (argc - opt == 1) {
12234 Jim_Obj **vector;
12236 JimListGetElements(interp, argv[opt], &patCount, &vector);
12237 caseList = vector;
12239 /* command is here already decref'd */
12240 if (rc < 0) {
12241 return -rc;
12243 if (rc)
12244 script = caseList[i + 1];
12245 break;
12249 else {
12250 script = caseList[i + 1];
12253 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12254 script = caseList[i + 1];
12255 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12256 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12257 return JIM_ERR;
12259 Jim_SetEmptyResult(interp);
12260 if (script) {
12261 return Jim_EvalObj(interp, script);
12263 return JIM_OK;
12266 /* [list] */
12267 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12269 Jim_Obj *listObjPtr;
12271 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12272 Jim_SetResult(interp, listObjPtr);
12273 return JIM_OK;
12276 /* [lindex] */
12277 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12279 Jim_Obj *objPtr, *listObjPtr;
12280 int i;
12281 int idx;
12283 if (argc < 3) {
12284 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
12285 return JIM_ERR;
12287 objPtr = argv[1];
12288 Jim_IncrRefCount(objPtr);
12289 for (i = 2; i < argc; i++) {
12290 listObjPtr = objPtr;
12291 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12292 Jim_DecrRefCount(interp, listObjPtr);
12293 return JIM_ERR;
12295 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12296 /* Returns an empty object if the index
12297 * is out of range. */
12298 Jim_DecrRefCount(interp, listObjPtr);
12299 Jim_SetEmptyResult(interp);
12300 return JIM_OK;
12302 Jim_IncrRefCount(objPtr);
12303 Jim_DecrRefCount(interp, listObjPtr);
12305 Jim_SetResult(interp, objPtr);
12306 Jim_DecrRefCount(interp, objPtr);
12307 return JIM_OK;
12310 /* [llength] */
12311 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12313 if (argc != 2) {
12314 Jim_WrongNumArgs(interp, 1, argv, "list");
12315 return JIM_ERR;
12317 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12318 return JIM_OK;
12321 /* [lsearch] */
12322 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12324 static const char * const options[] = {
12325 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12326 NULL
12328 enum
12329 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12330 OPT_COMMAND };
12331 int i;
12332 int opt_bool = 0;
12333 int opt_not = 0;
12334 int opt_nocase = 0;
12335 int opt_all = 0;
12336 int opt_inline = 0;
12337 int opt_match = OPT_EXACT;
12338 int listlen;
12339 int rc = JIM_OK;
12340 Jim_Obj *listObjPtr = NULL;
12341 Jim_Obj *commandObj = NULL;
12343 if (argc < 3) {
12344 wrongargs:
12345 Jim_WrongNumArgs(interp, 1, argv,
12346 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12347 return JIM_ERR;
12350 for (i = 1; i < argc - 2; i++) {
12351 int option;
12353 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12354 return JIM_ERR;
12356 switch (option) {
12357 case OPT_BOOL:
12358 opt_bool = 1;
12359 opt_inline = 0;
12360 break;
12361 case OPT_NOT:
12362 opt_not = 1;
12363 break;
12364 case OPT_NOCASE:
12365 opt_nocase = 1;
12366 break;
12367 case OPT_INLINE:
12368 opt_inline = 1;
12369 opt_bool = 0;
12370 break;
12371 case OPT_ALL:
12372 opt_all = 1;
12373 break;
12374 case OPT_COMMAND:
12375 if (i >= argc - 2) {
12376 goto wrongargs;
12378 commandObj = argv[++i];
12379 /* fallthru */
12380 case OPT_EXACT:
12381 case OPT_GLOB:
12382 case OPT_REGEXP:
12383 opt_match = option;
12384 break;
12388 argv += i;
12390 if (opt_all) {
12391 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12393 if (opt_match == OPT_REGEXP) {
12394 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12396 if (commandObj) {
12397 Jim_IncrRefCount(commandObj);
12400 listlen = Jim_ListLength(interp, argv[0]);
12401 for (i = 0; i < listlen; i++) {
12402 Jim_Obj *objPtr;
12403 int eq = 0;
12405 Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
12406 switch (opt_match) {
12407 case OPT_EXACT:
12408 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12409 break;
12411 case OPT_GLOB:
12412 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12413 break;
12415 case OPT_REGEXP:
12416 case OPT_COMMAND:
12417 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12418 if (eq < 0) {
12419 if (listObjPtr) {
12420 Jim_FreeNewObj(interp, listObjPtr);
12422 rc = JIM_ERR;
12423 goto done;
12425 break;
12428 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12429 if (!eq && opt_bool && opt_not && !opt_all) {
12430 continue;
12433 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12434 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12435 Jim_Obj *resultObj;
12437 if (opt_bool) {
12438 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12440 else if (!opt_inline) {
12441 resultObj = Jim_NewIntObj(interp, i);
12443 else {
12444 resultObj = objPtr;
12447 if (opt_all) {
12448 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12450 else {
12451 Jim_SetResult(interp, resultObj);
12452 goto done;
12457 if (opt_all) {
12458 Jim_SetResult(interp, listObjPtr);
12460 else {
12461 /* No match */
12462 if (opt_bool) {
12463 Jim_SetResultBool(interp, opt_not);
12465 else if (!opt_inline) {
12466 Jim_SetResultInt(interp, -1);
12470 done:
12471 if (commandObj) {
12472 Jim_DecrRefCount(interp, commandObj);
12474 return rc;
12477 /* [lappend] */
12478 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12480 Jim_Obj *listObjPtr;
12481 int shared, i;
12483 if (argc < 2) {
12484 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12485 return JIM_ERR;
12487 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12488 if (!listObjPtr) {
12489 /* Create the list if it does not exists */
12490 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12491 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12492 Jim_FreeNewObj(interp, listObjPtr);
12493 return JIM_ERR;
12496 shared = Jim_IsShared(listObjPtr);
12497 if (shared)
12498 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12499 for (i = 2; i < argc; i++)
12500 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12501 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12502 if (shared)
12503 Jim_FreeNewObj(interp, listObjPtr);
12504 return JIM_ERR;
12506 Jim_SetResult(interp, listObjPtr);
12507 return JIM_OK;
12510 /* [linsert] */
12511 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12513 int idx, len;
12514 Jim_Obj *listPtr;
12516 if (argc < 3) {
12517 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12518 return JIM_ERR;
12520 listPtr = argv[1];
12521 if (Jim_IsShared(listPtr))
12522 listPtr = Jim_DuplicateObj(interp, listPtr);
12523 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12524 goto err;
12525 len = Jim_ListLength(interp, listPtr);
12526 if (idx >= len)
12527 idx = len;
12528 else if (idx < 0)
12529 idx = len + idx + 1;
12530 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12531 Jim_SetResult(interp, listPtr);
12532 return JIM_OK;
12533 err:
12534 if (listPtr != argv[1]) {
12535 Jim_FreeNewObj(interp, listPtr);
12537 return JIM_ERR;
12540 /* [lreplace] */
12541 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12543 int first, last, len, rangeLen;
12544 Jim_Obj *listObj;
12545 Jim_Obj *newListObj;
12547 if (argc < 4) {
12548 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12549 return JIM_ERR;
12551 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12552 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12553 return JIM_ERR;
12556 listObj = argv[1];
12557 len = Jim_ListLength(interp, listObj);
12559 first = JimRelToAbsIndex(len, first);
12560 last = JimRelToAbsIndex(len, last);
12561 JimRelToAbsRange(len, &first, &last, &rangeLen);
12563 /* Now construct a new list which consists of:
12564 * <elements before first> <supplied elements> <elements after last>
12567 /* Check to see if trying to replace past the end of the list */
12568 if (first < len) {
12569 /* OK. Not past the end */
12571 else if (len == 0) {
12572 /* Special for empty list, adjust first to 0 */
12573 first = 0;
12575 else {
12576 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12577 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12578 return JIM_ERR;
12581 /* Add the first set of elements */
12582 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12584 /* Add supplied elements */
12585 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12587 /* Add the remaining elements */
12588 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12590 Jim_SetResult(interp, newListObj);
12591 return JIM_OK;
12594 /* [lset] */
12595 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12597 if (argc < 3) {
12598 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12599 return JIM_ERR;
12601 else if (argc == 3) {
12602 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12603 return JIM_ERR;
12604 Jim_SetResult(interp, argv[2]);
12605 return JIM_OK;
12607 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1])
12608 == JIM_ERR)
12609 return JIM_ERR;
12610 return JIM_OK;
12613 /* [lsort] */
12614 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12616 static const char * const options[] = {
12617 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12619 enum
12620 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12621 Jim_Obj *resObj;
12622 int i;
12623 int retCode;
12625 struct lsort_info info;
12627 if (argc < 2) {
12628 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12629 return JIM_ERR;
12632 info.type = JIM_LSORT_ASCII;
12633 info.order = 1;
12634 info.indexed = 0;
12635 info.unique = 0;
12636 info.command = NULL;
12637 info.interp = interp;
12639 for (i = 1; i < (argc - 1); i++) {
12640 int option;
12642 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12643 != JIM_OK)
12644 return JIM_ERR;
12645 switch (option) {
12646 case OPT_ASCII:
12647 info.type = JIM_LSORT_ASCII;
12648 break;
12649 case OPT_NOCASE:
12650 info.type = JIM_LSORT_NOCASE;
12651 break;
12652 case OPT_INTEGER:
12653 info.type = JIM_LSORT_INTEGER;
12654 break;
12655 case OPT_REAL:
12656 info.type = JIM_LSORT_REAL;
12657 break;
12658 case OPT_INCREASING:
12659 info.order = 1;
12660 break;
12661 case OPT_DECREASING:
12662 info.order = -1;
12663 break;
12664 case OPT_UNIQUE:
12665 info.unique = 1;
12666 break;
12667 case OPT_COMMAND:
12668 if (i >= (argc - 2)) {
12669 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12670 return JIM_ERR;
12672 info.type = JIM_LSORT_COMMAND;
12673 info.command = argv[i + 1];
12674 i++;
12675 break;
12676 case OPT_INDEX:
12677 if (i >= (argc - 2)) {
12678 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12679 return JIM_ERR;
12681 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12682 return JIM_ERR;
12684 info.indexed = 1;
12685 i++;
12686 break;
12689 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12690 retCode = ListSortElements(interp, resObj, &info);
12691 if (retCode == JIM_OK) {
12692 Jim_SetResult(interp, resObj);
12694 else {
12695 Jim_FreeNewObj(interp, resObj);
12697 return retCode;
12700 /* [append] */
12701 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12703 Jim_Obj *stringObjPtr;
12704 int i;
12706 if (argc < 2) {
12707 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12708 return JIM_ERR;
12710 if (argc == 2) {
12711 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12712 if (!stringObjPtr)
12713 return JIM_ERR;
12715 else {
12716 int freeobj = 0;
12717 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12718 if (!stringObjPtr) {
12719 /* Create the string if it doesn't exist */
12720 stringObjPtr = Jim_NewEmptyStringObj(interp);
12721 freeobj = 1;
12723 else if (Jim_IsShared(stringObjPtr)) {
12724 freeobj = 1;
12725 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12727 for (i = 2; i < argc; i++) {
12728 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12730 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12731 if (freeobj) {
12732 Jim_FreeNewObj(interp, stringObjPtr);
12734 return JIM_ERR;
12737 Jim_SetResult(interp, stringObjPtr);
12738 return JIM_OK;
12741 /* [debug] */
12742 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12744 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12745 static const char * const options[] = {
12746 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12747 "exprbc", "show",
12748 NULL
12750 enum
12752 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12753 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12755 int option;
12757 if (argc < 2) {
12758 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12759 return JIM_ERR;
12761 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12762 return JIM_ERR;
12763 if (option == OPT_REFCOUNT) {
12764 if (argc != 3) {
12765 Jim_WrongNumArgs(interp, 2, argv, "object");
12766 return JIM_ERR;
12768 Jim_SetResultInt(interp, argv[2]->refCount);
12769 return JIM_OK;
12771 else if (option == OPT_OBJCOUNT) {
12772 int freeobj = 0, liveobj = 0;
12773 char buf[256];
12774 Jim_Obj *objPtr;
12776 if (argc != 2) {
12777 Jim_WrongNumArgs(interp, 2, argv, "");
12778 return JIM_ERR;
12780 /* Count the number of free objects. */
12781 objPtr = interp->freeList;
12782 while (objPtr) {
12783 freeobj++;
12784 objPtr = objPtr->nextObjPtr;
12786 /* Count the number of live objects. */
12787 objPtr = interp->liveList;
12788 while (objPtr) {
12789 liveobj++;
12790 objPtr = objPtr->nextObjPtr;
12792 /* Set the result string and return. */
12793 sprintf(buf, "free %d used %d", freeobj, liveobj);
12794 Jim_SetResultString(interp, buf, -1);
12795 return JIM_OK;
12797 else if (option == OPT_OBJECTS) {
12798 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12800 /* Count the number of live objects. */
12801 objPtr = interp->liveList;
12802 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12803 while (objPtr) {
12804 char buf[128];
12805 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12807 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12808 sprintf(buf, "%p", objPtr);
12809 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12810 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12811 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12812 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12813 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12814 objPtr = objPtr->nextObjPtr;
12816 Jim_SetResult(interp, listObjPtr);
12817 return JIM_OK;
12819 else if (option == OPT_INVSTR) {
12820 Jim_Obj *objPtr;
12822 if (argc != 3) {
12823 Jim_WrongNumArgs(interp, 2, argv, "object");
12824 return JIM_ERR;
12826 objPtr = argv[2];
12827 if (objPtr->typePtr != NULL)
12828 Jim_InvalidateStringRep(objPtr);
12829 Jim_SetEmptyResult(interp);
12830 return JIM_OK;
12832 else if (option == OPT_SHOW) {
12833 const char *s;
12834 int len, charlen;
12836 if (argc != 3) {
12837 Jim_WrongNumArgs(interp, 2, argv, "object");
12838 return JIM_ERR;
12840 s = Jim_GetString(argv[2], &len);
12841 #ifdef JIM_UTF8
12842 charlen = utf8_strlen(s, len);
12843 #else
12844 charlen = len;
12845 #endif
12846 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12847 printf("chars (%d): <<%s>>\n", charlen, s);
12848 printf("bytes (%d):", len);
12849 while (len--) {
12850 printf(" %02x", (unsigned char)*s++);
12852 printf("\n");
12853 return JIM_OK;
12855 else if (option == OPT_SCRIPTLEN) {
12856 ScriptObj *script;
12858 if (argc != 3) {
12859 Jim_WrongNumArgs(interp, 2, argv, "script");
12860 return JIM_ERR;
12862 script = Jim_GetScript(interp, argv[2]);
12863 Jim_SetResultInt(interp, script->len);
12864 return JIM_OK;
12866 else if (option == OPT_EXPRLEN) {
12867 ExprByteCode *expr;
12869 if (argc != 3) {
12870 Jim_WrongNumArgs(interp, 2, argv, "expression");
12871 return JIM_ERR;
12873 expr = JimGetExpression(interp, argv[2]);
12874 if (expr == NULL)
12875 return JIM_ERR;
12876 Jim_SetResultInt(interp, expr->len);
12877 return JIM_OK;
12879 else if (option == OPT_EXPRBC) {
12880 Jim_Obj *objPtr;
12881 ExprByteCode *expr;
12882 int i;
12884 if (argc != 3) {
12885 Jim_WrongNumArgs(interp, 2, argv, "expression");
12886 return JIM_ERR;
12888 expr = JimGetExpression(interp, argv[2]);
12889 if (expr == NULL)
12890 return JIM_ERR;
12891 objPtr = Jim_NewListObj(interp, NULL, 0);
12892 for (i = 0; i < expr->len; i++) {
12893 const char *type;
12894 const Jim_ExprOperator *op;
12895 Jim_Obj *obj = expr->token[i].objPtr;
12897 switch (expr->token[i].type) {
12898 case JIM_TT_EXPR_INT:
12899 type = "int";
12900 break;
12901 case JIM_TT_EXPR_DOUBLE:
12902 type = "double";
12903 break;
12904 case JIM_TT_CMD:
12905 type = "command";
12906 break;
12907 case JIM_TT_VAR:
12908 type = "variable";
12909 break;
12910 case JIM_TT_DICTSUGAR:
12911 type = "dictsugar";
12912 break;
12913 case JIM_TT_EXPRSUGAR:
12914 type = "exprsugar";
12915 break;
12916 case JIM_TT_ESC:
12917 type = "subst";
12918 break;
12919 case JIM_TT_STR:
12920 type = "string";
12921 break;
12922 default:
12923 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12924 if (op == NULL) {
12925 type = "private";
12927 else {
12928 type = "operator";
12930 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12931 break;
12933 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12934 Jim_ListAppendElement(interp, objPtr, obj);
12936 Jim_SetResult(interp, objPtr);
12937 return JIM_OK;
12939 else {
12940 Jim_SetResultString(interp,
12941 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12942 return JIM_ERR;
12944 /* unreached */
12945 #endif /* JIM_BOOTSTRAP */
12946 #if !defined(JIM_DEBUG_COMMAND)
12947 Jim_SetResultString(interp, "unsupported", -1);
12948 return JIM_ERR;
12949 #endif
12952 /* [eval] */
12953 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12955 int rc;
12957 if (argc < 2) {
12958 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12959 return JIM_ERR;
12962 if (argc == 2) {
12963 rc = Jim_EvalObj(interp, argv[1]);
12965 else {
12966 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12969 if (rc == JIM_ERR) {
12970 /* eval is "interesting", so add a stack frame here */
12971 interp->addStackTrace++;
12973 return rc;
12976 /* [uplevel] */
12977 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12979 if (argc >= 2) {
12980 int retcode;
12981 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12982 int savedTailcall;
12983 const char *str;
12985 /* Save the old callframe pointer */
12986 savedCallFrame = interp->framePtr;
12988 /* Lookup the target frame pointer */
12989 str = Jim_String(argv[1]);
12990 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12991 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12992 argc--;
12993 argv++;
12995 else {
12996 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12998 if (targetCallFrame == NULL) {
12999 return JIM_ERR;
13001 if (argc < 2) {
13002 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
13003 return JIM_ERR;
13005 /* Eval the code in the target callframe. */
13006 interp->framePtr = targetCallFrame;
13007 /* Can't merge tailcalls across upcall */
13008 savedTailcall = interp->framePtr->tailcall;
13009 interp->framePtr->tailcall = 0;
13010 if (argc == 2) {
13011 retcode = Jim_EvalObj(interp, argv[1]);
13013 else {
13014 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13016 interp->framePtr->tailcall = savedTailcall;
13017 interp->framePtr = savedCallFrame;
13018 return retcode;
13020 else {
13021 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
13022 return JIM_ERR;
13026 /* [expr] */
13027 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13029 Jim_Obj *exprResultPtr;
13030 int retcode;
13032 if (argc == 2) {
13033 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
13035 else if (argc > 2) {
13036 Jim_Obj *objPtr;
13038 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13039 Jim_IncrRefCount(objPtr);
13040 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
13041 Jim_DecrRefCount(interp, objPtr);
13043 else {
13044 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13045 return JIM_ERR;
13047 if (retcode != JIM_OK)
13048 return retcode;
13049 Jim_SetResult(interp, exprResultPtr);
13050 Jim_DecrRefCount(interp, exprResultPtr);
13051 return JIM_OK;
13054 /* [break] */
13055 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13057 if (argc != 1) {
13058 Jim_WrongNumArgs(interp, 1, argv, "");
13059 return JIM_ERR;
13061 return JIM_BREAK;
13064 /* [continue] */
13065 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13067 if (argc != 1) {
13068 Jim_WrongNumArgs(interp, 1, argv, "");
13069 return JIM_ERR;
13071 return JIM_CONTINUE;
13074 /* [return] */
13075 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13077 int i;
13078 Jim_Obj *stackTraceObj = NULL;
13079 Jim_Obj *errorCodeObj = NULL;
13080 int returnCode = JIM_OK;
13081 long level = 1;
13083 for (i = 1; i < argc - 1; i += 2) {
13084 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13085 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13086 return JIM_ERR;
13089 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13090 stackTraceObj = argv[i + 1];
13092 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13093 errorCodeObj = argv[i + 1];
13095 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13096 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13097 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13098 return JIM_ERR;
13101 else {
13102 break;
13106 if (i != argc - 1 && i != argc) {
13107 Jim_WrongNumArgs(interp, 1, argv,
13108 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13111 /* If a stack trace is supplied and code is error, set the stack trace */
13112 if (stackTraceObj && returnCode == JIM_ERR) {
13113 JimSetStackTrace(interp, stackTraceObj);
13115 /* If an error code list is supplied, set the global $errorCode */
13116 if (errorCodeObj && returnCode == JIM_ERR) {
13117 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13119 interp->returnCode = returnCode;
13120 interp->returnLevel = level;
13122 if (i == argc - 1) {
13123 Jim_SetResult(interp, argv[i]);
13125 return JIM_RETURN;
13128 /* [tailcall] */
13129 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13131 if (interp->framePtr->level == 0) {
13132 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13133 return JIM_ERR;
13135 else if (argc >= 2) {
13136 /* Need to resolve the tailcall command in the current context */
13137 Jim_CallFrame *cf = interp->framePtr->parent;
13139 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13140 if (cmdPtr == NULL) {
13141 return JIM_ERR;
13144 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13146 /* And stash this pre-resolved command */
13147 JimIncrCmdRefCount(cmdPtr);
13148 cf->tailcallCmd = cmdPtr;
13150 /* And stash the command list */
13151 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13153 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13154 Jim_IncrRefCount(cf->tailcallObj);
13156 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13157 return JIM_EVAL;
13159 return JIM_OK;
13162 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13164 Jim_Obj *cmdList;
13165 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13167 /* prefixListObj is a list to which the args need to be appended */
13168 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13169 ListInsertElements(cmdList, -1, argc - 1, argv + 1);
13171 return JimEvalObjList(interp, cmdList);
13174 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13176 Jim_Obj *prefixListObj = privData;
13177 Jim_DecrRefCount(interp, prefixListObj);
13180 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13182 Jim_Obj *prefixListObj;
13183 const char *newname;
13185 if (argc < 3) {
13186 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13187 return JIM_ERR;
13190 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13191 Jim_IncrRefCount(prefixListObj);
13192 newname = Jim_String(argv[1]);
13193 if (newname[0] == ':' && newname[1] == ':') {
13194 while (*++newname == ':') {
13198 Jim_SetResult(interp, argv[1]);
13200 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13203 /* [proc] */
13204 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13206 Jim_Cmd *cmd;
13208 if (argc != 4 && argc != 5) {
13209 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13210 return JIM_ERR;
13213 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13214 return JIM_ERR;
13217 if (argc == 4) {
13218 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13220 else {
13221 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13224 if (cmd) {
13225 /* Add the new command */
13226 Jim_Obj *qualifiedCmdNameObj;
13227 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13229 JimCreateCommand(interp, cmdname, cmd);
13231 /* Calculate and set the namespace for this proc */
13232 JimUpdateProcNamespace(interp, cmd, cmdname);
13234 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13236 /* Unlike Tcl, set the name of the proc as the result */
13237 Jim_SetResult(interp, argv[1]);
13238 return JIM_OK;
13240 return JIM_ERR;
13243 /* [local] */
13244 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13246 int retcode;
13248 if (argc < 2) {
13249 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13250 return JIM_ERR;
13253 /* Evaluate the arguments with 'local' in force */
13254 interp->local++;
13255 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13256 interp->local--;
13259 /* If OK, and the result is a proc, add it to the list of local procs */
13260 if (retcode == 0) {
13261 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13263 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13264 return JIM_ERR;
13266 if (interp->framePtr->localCommands == NULL) {
13267 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13268 Jim_InitStack(interp->framePtr->localCommands);
13270 Jim_IncrRefCount(cmdNameObj);
13271 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13274 return retcode;
13277 /* [upcall] */
13278 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13280 if (argc < 2) {
13281 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13282 return JIM_ERR;
13284 else {
13285 int retcode;
13287 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13288 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13289 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13290 return JIM_ERR;
13292 /* OK. Mark this command as being in an upcall */
13293 cmdPtr->u.proc.upcall++;
13294 JimIncrCmdRefCount(cmdPtr);
13296 /* Invoke the command as normal */
13297 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13299 /* No longer in an upcall */
13300 cmdPtr->u.proc.upcall--;
13301 JimDecrCmdRefCount(interp, cmdPtr);
13303 return retcode;
13307 /* [apply] */
13308 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13310 if (argc < 2) {
13311 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13312 return JIM_ERR;
13314 else {
13315 int ret;
13316 Jim_Cmd *cmd;
13317 Jim_Obj *argListObjPtr;
13318 Jim_Obj *bodyObjPtr;
13319 Jim_Obj *nsObj = NULL;
13320 Jim_Obj **nargv;
13322 int len = Jim_ListLength(interp, argv[1]);
13323 if (len != 2 && len != 3) {
13324 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13325 return JIM_ERR;
13328 if (len == 3) {
13329 #ifdef jim_ext_namespace
13330 /* Need to canonicalise the given namespace. */
13331 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13332 #else
13333 Jim_SetResultString(interp, "namespaces not enabled", -1);
13334 return JIM_ERR;
13335 #endif
13337 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13338 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13340 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13342 if (cmd) {
13343 /* Create a new argv array with a dummy argv[0], for error messages */
13344 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13345 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13346 Jim_IncrRefCount(nargv[0]);
13347 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13348 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13349 Jim_DecrRefCount(interp, nargv[0]);
13350 Jim_Free(nargv);
13352 JimDecrCmdRefCount(interp, cmd);
13353 return ret;
13355 return JIM_ERR;
13360 /* [concat] */
13361 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13363 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13364 return JIM_OK;
13367 /* [upvar] */
13368 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13370 int i;
13371 Jim_CallFrame *targetCallFrame;
13373 /* Lookup the target frame pointer */
13374 if (argc > 3 && (argc % 2 == 0)) {
13375 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13376 argc--;
13377 argv++;
13379 else {
13380 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13382 if (targetCallFrame == NULL) {
13383 return JIM_ERR;
13386 /* Check for arity */
13387 if (argc < 3) {
13388 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13389 return JIM_ERR;
13392 /* Now... for every other/local couple: */
13393 for (i = 1; i < argc; i += 2) {
13394 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13395 return JIM_ERR;
13397 return JIM_OK;
13400 /* [global] */
13401 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13403 int i;
13405 if (argc < 2) {
13406 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13407 return JIM_ERR;
13409 /* Link every var to the toplevel having the same name */
13410 if (interp->framePtr->level == 0)
13411 return JIM_OK; /* global at toplevel... */
13412 for (i = 1; i < argc; i++) {
13413 /* global ::blah does nothing */
13414 const char *name = Jim_String(argv[i]);
13415 if (name[0] != ':' || name[1] != ':') {
13416 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13417 return JIM_ERR;
13420 return JIM_OK;
13423 /* does the [string map] operation. On error NULL is returned,
13424 * otherwise a new string object with the result, having refcount = 0,
13425 * is returned. */
13426 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13427 Jim_Obj *objPtr, int nocase)
13429 int numMaps;
13430 const char *str, *noMatchStart = NULL;
13431 int strLen, i;
13432 Jim_Obj *resultObjPtr;
13434 numMaps = Jim_ListLength(interp, mapListObjPtr);
13435 if (numMaps % 2) {
13436 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13437 return NULL;
13440 str = Jim_String(objPtr);
13441 strLen = Jim_Utf8Length(interp, objPtr);
13443 /* Map it */
13444 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13445 while (strLen) {
13446 for (i = 0; i < numMaps; i += 2) {
13447 Jim_Obj *objPtr;
13448 const char *k;
13449 int kl;
13451 Jim_ListIndex(interp, mapListObjPtr, i, &objPtr, JIM_NONE);
13452 k = Jim_String(objPtr);
13453 kl = Jim_Utf8Length(interp, objPtr);
13455 if (strLen >= kl && kl) {
13456 int rc;
13457 rc = JimStringCompareLen(str, k, kl, nocase);
13458 if (rc == 0) {
13459 if (noMatchStart) {
13460 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13461 noMatchStart = NULL;
13463 Jim_ListIndex(interp, mapListObjPtr, i + 1, &objPtr, JIM_NONE);
13464 Jim_AppendObj(interp, resultObjPtr, objPtr);
13465 str += utf8_index(str, kl);
13466 strLen -= kl;
13467 break;
13471 if (i == numMaps) { /* no match */
13472 int c;
13473 if (noMatchStart == NULL)
13474 noMatchStart = str;
13475 str += utf8_tounicode(str, &c);
13476 strLen--;
13479 if (noMatchStart) {
13480 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13482 return resultObjPtr;
13485 /* [string] */
13486 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13488 int len;
13489 int opt_case = 1;
13490 int option;
13491 static const char * const options[] = {
13492 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13493 "map", "repeat", "reverse", "index", "first", "last",
13494 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13496 enum
13498 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13499 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
13500 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13502 static const char * const nocase_options[] = {
13503 "-nocase", NULL
13505 static const char * const nocase_length_options[] = {
13506 "-nocase", "-length", NULL
13509 if (argc < 2) {
13510 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13511 return JIM_ERR;
13513 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13514 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13515 return JIM_ERR;
13517 switch (option) {
13518 case OPT_LENGTH:
13519 case OPT_BYTELENGTH:
13520 if (argc != 3) {
13521 Jim_WrongNumArgs(interp, 2, argv, "string");
13522 return JIM_ERR;
13524 if (option == OPT_LENGTH) {
13525 len = Jim_Utf8Length(interp, argv[2]);
13527 else {
13528 len = Jim_Length(argv[2]);
13530 Jim_SetResultInt(interp, len);
13531 return JIM_OK;
13533 case OPT_COMPARE:
13534 case OPT_EQUAL:
13536 /* n is the number of remaining option args */
13537 long opt_length = -1;
13538 int n = argc - 4;
13539 int i = 2;
13540 while (n > 0) {
13541 int subopt;
13542 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13543 JIM_ENUM_ABBREV) != JIM_OK) {
13544 badcompareargs:
13545 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13546 return JIM_ERR;
13548 if (subopt == 0) {
13549 /* -nocase */
13550 opt_case = 0;
13551 n--;
13553 else {
13554 /* -length */
13555 if (n < 2) {
13556 goto badcompareargs;
13558 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13559 return JIM_ERR;
13561 n -= 2;
13564 if (n) {
13565 goto badcompareargs;
13567 argv += argc - 2;
13568 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13569 /* Fast version - [string equal], case sensitive, no length */
13570 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13572 else {
13573 if (opt_length >= 0) {
13574 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13576 else {
13577 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13579 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13581 return JIM_OK;
13584 case OPT_MATCH:
13585 if (argc != 4 &&
13586 (argc != 5 ||
13587 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13588 JIM_ENUM_ABBREV) != JIM_OK)) {
13589 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13590 return JIM_ERR;
13592 if (opt_case == 0) {
13593 argv++;
13595 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13596 return JIM_OK;
13598 case OPT_MAP:{
13599 Jim_Obj *objPtr;
13601 if (argc != 4 &&
13602 (argc != 5 ||
13603 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13604 JIM_ENUM_ABBREV) != JIM_OK)) {
13605 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13606 return JIM_ERR;
13609 if (opt_case == 0) {
13610 argv++;
13612 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13613 if (objPtr == NULL) {
13614 return JIM_ERR;
13616 Jim_SetResult(interp, objPtr);
13617 return JIM_OK;
13620 case OPT_RANGE:
13621 case OPT_BYTERANGE:{
13622 Jim_Obj *objPtr;
13624 if (argc != 5) {
13625 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13626 return JIM_ERR;
13628 if (option == OPT_RANGE) {
13629 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13631 else
13633 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13636 if (objPtr == NULL) {
13637 return JIM_ERR;
13639 Jim_SetResult(interp, objPtr);
13640 return JIM_OK;
13643 case OPT_REPLACE:{
13644 Jim_Obj *objPtr;
13646 if (argc != 5 && argc != 6) {
13647 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13648 return JIM_ERR;
13650 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13651 if (objPtr == NULL) {
13652 return JIM_ERR;
13654 Jim_SetResult(interp, objPtr);
13655 return JIM_OK;
13659 case OPT_REPEAT:{
13660 Jim_Obj *objPtr;
13661 jim_wide count;
13663 if (argc != 4) {
13664 Jim_WrongNumArgs(interp, 2, argv, "string count");
13665 return JIM_ERR;
13667 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13668 return JIM_ERR;
13670 objPtr = Jim_NewStringObj(interp, "", 0);
13671 if (count > 0) {
13672 while (count--) {
13673 Jim_AppendObj(interp, objPtr, argv[2]);
13676 Jim_SetResult(interp, objPtr);
13677 return JIM_OK;
13680 case OPT_REVERSE:{
13681 char *buf, *p;
13682 const char *str;
13683 int len;
13684 int i;
13686 if (argc != 3) {
13687 Jim_WrongNumArgs(interp, 2, argv, "string");
13688 return JIM_ERR;
13691 str = Jim_GetString(argv[2], &len);
13692 buf = Jim_Alloc(len + 1);
13693 p = buf + len;
13694 *p = 0;
13695 for (i = 0; i < len; ) {
13696 int c;
13697 int l = utf8_tounicode(str, &c);
13698 memcpy(p - l, str, l);
13699 p -= l;
13700 i += l;
13701 str += l;
13703 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13704 return JIM_OK;
13707 case OPT_INDEX:{
13708 int idx;
13709 const char *str;
13711 if (argc != 4) {
13712 Jim_WrongNumArgs(interp, 2, argv, "string index");
13713 return JIM_ERR;
13715 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13716 return JIM_ERR;
13718 str = Jim_String(argv[2]);
13719 len = Jim_Utf8Length(interp, argv[2]);
13720 if (idx != INT_MIN && idx != INT_MAX) {
13721 idx = JimRelToAbsIndex(len, idx);
13723 if (idx < 0 || idx >= len || str == NULL) {
13724 Jim_SetResultString(interp, "", 0);
13726 else if (len == Jim_Length(argv[2])) {
13727 /* ASCII optimisation */
13728 Jim_SetResultString(interp, str + idx, 1);
13730 else {
13731 int c;
13732 int i = utf8_index(str, idx);
13733 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13735 return JIM_OK;
13738 case OPT_FIRST:
13739 case OPT_LAST:{
13740 int idx = 0, l1, l2;
13741 const char *s1, *s2;
13743 if (argc != 4 && argc != 5) {
13744 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13745 return JIM_ERR;
13747 s1 = Jim_String(argv[2]);
13748 s2 = Jim_String(argv[3]);
13749 l1 = Jim_Utf8Length(interp, argv[2]);
13750 l2 = Jim_Utf8Length(interp, argv[3]);
13751 if (argc == 5) {
13752 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13753 return JIM_ERR;
13755 idx = JimRelToAbsIndex(l2, idx);
13757 else if (option == OPT_LAST) {
13758 idx = l2;
13760 if (option == OPT_FIRST) {
13761 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13763 else {
13764 #ifdef JIM_UTF8
13765 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13766 #else
13767 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13768 #endif
13770 return JIM_OK;
13773 case OPT_TRIM:
13774 case OPT_TRIMLEFT:
13775 case OPT_TRIMRIGHT:{
13776 Jim_Obj *trimchars;
13778 if (argc != 3 && argc != 4) {
13779 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13780 return JIM_ERR;
13782 trimchars = (argc == 4 ? argv[3] : NULL);
13783 if (option == OPT_TRIM) {
13784 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13786 else if (option == OPT_TRIMLEFT) {
13787 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13789 else if (option == OPT_TRIMRIGHT) {
13790 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13792 return JIM_OK;
13795 case OPT_TOLOWER:
13796 case OPT_TOUPPER:
13797 case OPT_TOTITLE:
13798 if (argc != 3) {
13799 Jim_WrongNumArgs(interp, 2, argv, "string");
13800 return JIM_ERR;
13802 if (option == OPT_TOLOWER) {
13803 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13805 else if (option == OPT_TOUPPER) {
13806 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13808 else {
13809 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13811 return JIM_OK;
13813 case OPT_IS:
13814 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13815 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13817 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13818 return JIM_ERR;
13820 return JIM_OK;
13823 /* [time] */
13824 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13826 long i, count = 1;
13827 jim_wide start, elapsed;
13828 char buf[60];
13829 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13831 if (argc < 2) {
13832 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13833 return JIM_ERR;
13835 if (argc == 3) {
13836 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13837 return JIM_ERR;
13839 if (count < 0)
13840 return JIM_OK;
13841 i = count;
13842 start = JimClock();
13843 while (i-- > 0) {
13844 int retval;
13846 retval = Jim_EvalObj(interp, argv[1]);
13847 if (retval != JIM_OK) {
13848 return retval;
13851 elapsed = JimClock() - start;
13852 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13853 Jim_SetResultString(interp, buf, -1);
13854 return JIM_OK;
13857 /* [exit] */
13858 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13860 long exitCode = 0;
13862 if (argc > 2) {
13863 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13864 return JIM_ERR;
13866 if (argc == 2) {
13867 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13868 return JIM_ERR;
13870 interp->exitCode = exitCode;
13871 return JIM_EXIT;
13874 /* [catch] */
13875 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13877 int exitCode = 0;
13878 int i;
13879 int sig = 0;
13881 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13882 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13883 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13885 /* Reset the error code before catch.
13886 * Note that this is not strictly correct.
13888 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13890 for (i = 1; i < argc - 1; i++) {
13891 const char *arg = Jim_String(argv[i]);
13892 jim_wide option;
13893 int ignore;
13895 /* It's a pity we can't use Jim_GetEnum here :-( */
13896 if (strcmp(arg, "--") == 0) {
13897 i++;
13898 break;
13900 if (*arg != '-') {
13901 break;
13904 if (strncmp(arg, "-no", 3) == 0) {
13905 arg += 3;
13906 ignore = 1;
13908 else {
13909 arg++;
13910 ignore = 0;
13913 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13914 option = -1;
13916 if (option < 0) {
13917 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13919 if (option < 0) {
13920 goto wrongargs;
13923 if (ignore) {
13924 ignore_mask |= (1 << option);
13926 else {
13927 ignore_mask &= ~(1 << option);
13931 argc -= i;
13932 if (argc < 1 || argc > 3) {
13933 wrongargs:
13934 Jim_WrongNumArgs(interp, 1, argv,
13935 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13936 return JIM_ERR;
13938 argv += i;
13940 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13941 sig++;
13944 interp->signal_level += sig;
13945 if (Jim_CheckSignal(interp)) {
13946 /* If a signal is set, don't even try to execute the body */
13947 exitCode = JIM_SIGNAL;
13949 else {
13950 exitCode = Jim_EvalObj(interp, argv[0]);
13951 /* Don't want any caught error included in a later stack trace */
13952 interp->errorFlag = 0;
13954 interp->signal_level -= sig;
13956 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13957 if (exitCode >= 0 && exitCode < max_ignore_code && ((1 << exitCode) & ignore_mask)) {
13958 /* Not caught, pass it up */
13959 return exitCode;
13962 if (sig && exitCode == JIM_SIGNAL) {
13963 /* Catch the signal at this level */
13964 if (interp->signal_set_result) {
13965 interp->signal_set_result(interp, interp->sigmask);
13967 else {
13968 Jim_SetResultInt(interp, interp->sigmask);
13970 interp->sigmask = 0;
13973 if (argc >= 2) {
13974 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13975 return JIM_ERR;
13977 if (argc == 3) {
13978 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13980 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13981 Jim_ListAppendElement(interp, optListObj,
13982 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13983 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13984 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13985 if (exitCode == JIM_ERR) {
13986 Jim_Obj *errorCode;
13987 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13988 -1));
13989 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13991 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13992 if (errorCode) {
13993 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13994 Jim_ListAppendElement(interp, optListObj, errorCode);
13997 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13998 return JIM_ERR;
14002 Jim_SetResultInt(interp, exitCode);
14003 return JIM_OK;
14006 #ifdef JIM_REFERENCES
14008 /* [ref] */
14009 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14011 if (argc != 3 && argc != 4) {
14012 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
14013 return JIM_ERR;
14015 if (argc == 3) {
14016 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
14018 else {
14019 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
14021 return JIM_OK;
14024 /* [getref] */
14025 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14027 Jim_Reference *refPtr;
14029 if (argc != 2) {
14030 Jim_WrongNumArgs(interp, 1, argv, "reference");
14031 return JIM_ERR;
14033 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14034 return JIM_ERR;
14035 Jim_SetResult(interp, refPtr->objPtr);
14036 return JIM_OK;
14039 /* [setref] */
14040 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14042 Jim_Reference *refPtr;
14044 if (argc != 3) {
14045 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14046 return JIM_ERR;
14048 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14049 return JIM_ERR;
14050 Jim_IncrRefCount(argv[2]);
14051 Jim_DecrRefCount(interp, refPtr->objPtr);
14052 refPtr->objPtr = argv[2];
14053 Jim_SetResult(interp, argv[2]);
14054 return JIM_OK;
14057 /* [collect] */
14058 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14060 if (argc != 1) {
14061 Jim_WrongNumArgs(interp, 1, argv, "");
14062 return JIM_ERR;
14064 Jim_SetResultInt(interp, Jim_Collect(interp));
14066 /* Free all the freed objects. */
14067 while (interp->freeList) {
14068 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14069 Jim_Free(interp->freeList);
14070 interp->freeList = nextObjPtr;
14073 return JIM_OK;
14076 /* [finalize] reference ?newValue? */
14077 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14079 if (argc != 2 && argc != 3) {
14080 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14081 return JIM_ERR;
14083 if (argc == 2) {
14084 Jim_Obj *cmdNamePtr;
14086 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14087 return JIM_ERR;
14088 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14089 Jim_SetResult(interp, cmdNamePtr);
14091 else {
14092 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14093 return JIM_ERR;
14094 Jim_SetResult(interp, argv[2]);
14096 return JIM_OK;
14099 /* [info references] */
14100 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14102 Jim_Obj *listObjPtr;
14103 Jim_HashTableIterator htiter;
14104 Jim_HashEntry *he;
14106 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14108 JimInitHashTableIterator(&interp->references, &htiter);
14109 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14110 char buf[JIM_REFERENCE_SPACE + 1];
14111 Jim_Reference *refPtr = he->u.val;
14112 const unsigned long *refId = he->key;
14114 JimFormatReference(buf, refPtr, *refId);
14115 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14117 Jim_SetResult(interp, listObjPtr);
14118 return JIM_OK;
14120 #endif
14122 /* [rename] */
14123 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14125 if (argc != 3) {
14126 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14127 return JIM_ERR;
14130 if (JimValidName(interp, "new procedure", argv[2])) {
14131 return JIM_ERR;
14134 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14137 #define JIM_DICTMATCH_VALUES 0x0001
14139 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14141 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14143 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14144 if (type & JIM_DICTMATCH_VALUES) {
14145 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->u.val);
14150 * Like JimHashtablePatternMatch, but for dictionaries.
14152 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14153 JimDictMatchCallbackType *callback, int type)
14155 Jim_HashEntry *he;
14156 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14158 /* Check for the non-pattern case. We can do this much more efficiently. */
14159 Jim_HashTableIterator htiter;
14160 JimInitHashTableIterator(ht, &htiter);
14161 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14162 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14163 callback(interp, listObjPtr, he, type);
14167 return listObjPtr;
14171 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14173 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14174 return JIM_ERR;
14176 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14177 return JIM_OK;
14180 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14182 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14183 return JIM_ERR;
14185 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14186 return JIM_OK;
14189 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14191 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14192 return -1;
14194 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14197 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14199 Jim_HashTable *ht;
14200 unsigned int i;
14202 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14203 return JIM_ERR;
14206 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14208 /* Note that this uses internal knowledge of the hash table */
14209 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14211 for (i = 0; i < ht->size; i++) {
14212 Jim_HashEntry *he = he = ht->table[i];
14214 if (he) {
14215 printf("%d: ", i);
14217 while (he) {
14218 printf(" %s", Jim_String(he->key));
14219 he = he->next;
14221 printf("\n");
14224 return JIM_OK;
14227 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14229 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14231 Jim_AppendString(interp, prefixObj, " ", 1);
14232 Jim_AppendString(interp, prefixObj, subcmd, -1);
14234 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14237 /* [dict] */
14238 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14240 Jim_Obj *objPtr;
14241 int option;
14242 static const char * const options[] = {
14243 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14244 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14245 "replace", "update", NULL
14247 enum
14249 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14250 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14251 OPT_REPLACE, OPT_UPDATE,
14254 if (argc < 2) {
14255 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14256 return JIM_ERR;
14259 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14260 return JIM_ERR;
14263 switch (option) {
14264 case OPT_GET:
14265 if (argc < 3) {
14266 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14267 return JIM_ERR;
14269 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14270 JIM_ERRMSG) != JIM_OK) {
14271 return JIM_ERR;
14273 Jim_SetResult(interp, objPtr);
14274 return JIM_OK;
14276 case OPT_SET:
14277 if (argc < 5) {
14278 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14279 return JIM_ERR;
14281 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14283 case OPT_EXISTS:
14284 if (argc < 4) {
14285 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14286 return JIM_ERR;
14288 else {
14289 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14290 if (rc < 0) {
14291 return JIM_ERR;
14293 Jim_SetResultBool(interp, rc == JIM_OK);
14294 return JIM_OK;
14297 case OPT_UNSET:
14298 if (argc < 4) {
14299 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14300 return JIM_ERR;
14302 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14303 return JIM_ERR;
14305 return JIM_OK;
14307 case OPT_KEYS:
14308 if (argc != 3 && argc != 4) {
14309 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14310 return JIM_ERR;
14312 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14314 case OPT_SIZE:
14315 if (argc != 3) {
14316 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14317 return JIM_ERR;
14319 else if (Jim_DictSize(interp, argv[2]) < 0) {
14320 return JIM_ERR;
14322 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14323 return JIM_OK;
14325 case OPT_MERGE:
14326 if (argc == 2) {
14327 return JIM_OK;
14329 if (Jim_DictSize(interp, argv[2]) < 0) {
14330 return JIM_ERR;
14332 /* Handle as ensemble */
14333 break;
14335 case OPT_UPDATE:
14336 if (argc < 6 || argc % 2) {
14337 /* Better error message */
14338 argc = 2;
14340 break;
14342 case OPT_CREATE:
14343 if (argc % 2) {
14344 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14345 return JIM_ERR;
14347 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14348 Jim_SetResult(interp, objPtr);
14349 return JIM_OK;
14351 case OPT_INFO:
14352 if (argc != 3) {
14353 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14354 return JIM_ERR;
14356 return Jim_DictInfo(interp, argv[2]);
14358 /* Handle command as an ensemble */
14359 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14362 /* [subst] */
14363 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14365 static const char * const options[] = {
14366 "-nobackslashes", "-nocommands", "-novariables", NULL
14368 enum
14369 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14370 int i;
14371 int flags = JIM_SUBST_FLAG;
14372 Jim_Obj *objPtr;
14374 if (argc < 2) {
14375 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14376 return JIM_ERR;
14378 for (i = 1; i < (argc - 1); i++) {
14379 int option;
14381 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14382 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14383 return JIM_ERR;
14385 switch (option) {
14386 case OPT_NOBACKSLASHES:
14387 flags |= JIM_SUBST_NOESC;
14388 break;
14389 case OPT_NOCOMMANDS:
14390 flags |= JIM_SUBST_NOCMD;
14391 break;
14392 case OPT_NOVARIABLES:
14393 flags |= JIM_SUBST_NOVAR;
14394 break;
14397 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14398 return JIM_ERR;
14400 Jim_SetResult(interp, objPtr);
14401 return JIM_OK;
14404 /* [info] */
14405 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14407 int cmd;
14408 Jim_Obj *objPtr;
14409 int mode = 0;
14411 static const char * const commands[] = {
14412 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14413 "vars", "version", "patchlevel", "complete", "args", "hostname",
14414 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14415 "references", "alias", NULL
14417 enum
14418 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14419 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14420 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14421 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14424 #ifdef jim_ext_namespace
14425 int nons = 0;
14427 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14428 /* This is for internal use only */
14429 argc--;
14430 argv++;
14431 nons = 1;
14433 #endif
14435 if (argc < 2) {
14436 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14437 return JIM_ERR;
14439 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14440 != JIM_OK) {
14441 return JIM_ERR;
14444 /* Test for the the most common commands first, just in case it makes a difference */
14445 switch (cmd) {
14446 case INFO_EXISTS:
14447 if (argc != 3) {
14448 Jim_WrongNumArgs(interp, 2, argv, "varName");
14449 return JIM_ERR;
14451 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14452 break;
14454 case INFO_ALIAS:{
14455 Jim_Cmd *cmdPtr;
14457 if (argc != 3) {
14458 Jim_WrongNumArgs(interp, 2, argv, "command");
14459 return JIM_ERR;
14461 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14462 return JIM_ERR;
14464 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14465 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14466 return JIM_ERR;
14468 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14469 return JIM_OK;
14472 case INFO_CHANNELS:
14473 mode++; /* JIM_CMDLIST_CHANNELS */
14474 #ifndef jim_ext_aio
14475 Jim_SetResultString(interp, "aio not enabled", -1);
14476 return JIM_ERR;
14477 #endif
14478 case INFO_PROCS:
14479 mode++; /* JIM_CMDLIST_PROCS */
14480 case INFO_COMMANDS:
14481 /* mode 0 => JIM_CMDLIST_COMMANDS */
14482 if (argc != 2 && argc != 3) {
14483 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14484 return JIM_ERR;
14486 #ifdef jim_ext_namespace
14487 if (!nons) {
14488 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14489 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14492 #endif
14493 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14494 break;
14496 case INFO_VARS:
14497 mode++; /* JIM_VARLIST_VARS */
14498 case INFO_LOCALS:
14499 mode++; /* JIM_VARLIST_LOCALS */
14500 case INFO_GLOBALS:
14501 /* mode 0 => JIM_VARLIST_GLOBALS */
14502 if (argc != 2 && argc != 3) {
14503 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14504 return JIM_ERR;
14506 #ifdef jim_ext_namespace
14507 if (!nons) {
14508 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14509 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14512 #endif
14513 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14514 break;
14516 case INFO_SCRIPT:
14517 if (argc != 2) {
14518 Jim_WrongNumArgs(interp, 2, argv, "");
14519 return JIM_ERR;
14521 Jim_SetResult(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileNameObj);
14522 break;
14524 case INFO_SOURCE:{
14525 int line;
14526 Jim_Obj *resObjPtr;
14527 Jim_Obj *fileNameObj;
14529 if (argc != 3) {
14530 Jim_WrongNumArgs(interp, 2, argv, "source");
14531 return JIM_ERR;
14533 if (argv[2]->typePtr == &sourceObjType) {
14534 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14535 line = argv[2]->internalRep.sourceValue.lineNumber;
14537 else if (argv[2]->typePtr == &scriptObjType) {
14538 ScriptObj *script = Jim_GetScript(interp, argv[2]);
14539 fileNameObj = script->fileNameObj;
14540 line = script->firstline;
14542 else {
14543 fileNameObj = interp->emptyObj;
14544 line = 1;
14546 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14547 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14548 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14549 Jim_SetResult(interp, resObjPtr);
14550 break;
14553 case INFO_STACKTRACE:
14554 Jim_SetResult(interp, interp->stackTrace);
14555 break;
14557 case INFO_LEVEL:
14558 case INFO_FRAME:
14559 switch (argc) {
14560 case 2:
14561 Jim_SetResultInt(interp, interp->framePtr->level);
14562 break;
14564 case 3:
14565 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14566 return JIM_ERR;
14568 Jim_SetResult(interp, objPtr);
14569 break;
14571 default:
14572 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14573 return JIM_ERR;
14575 break;
14577 case INFO_BODY:
14578 case INFO_STATICS:
14579 case INFO_ARGS:{
14580 Jim_Cmd *cmdPtr;
14582 if (argc != 3) {
14583 Jim_WrongNumArgs(interp, 2, argv, "procname");
14584 return JIM_ERR;
14586 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14587 return JIM_ERR;
14589 if (!cmdPtr->isproc) {
14590 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14591 return JIM_ERR;
14593 switch (cmd) {
14594 case INFO_BODY:
14595 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14596 break;
14597 case INFO_ARGS:
14598 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14599 break;
14600 case INFO_STATICS:
14601 if (cmdPtr->u.proc.staticVars) {
14602 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14603 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14604 NULL, JimVariablesMatch, mode));
14606 break;
14608 break;
14611 case INFO_VERSION:
14612 case INFO_PATCHLEVEL:{
14613 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14615 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14616 Jim_SetResultString(interp, buf, -1);
14617 break;
14620 case INFO_COMPLETE:
14621 if (argc != 3 && argc != 4) {
14622 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14623 return JIM_ERR;
14625 else {
14626 int len;
14627 const char *s = Jim_GetString(argv[2], &len);
14628 char missing;
14630 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14631 if (missing != ' ' && argc == 4) {
14632 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14635 break;
14637 case INFO_HOSTNAME:
14638 /* Redirect to os.gethostname if it exists */
14639 return Jim_Eval(interp, "os.gethostname");
14641 case INFO_NAMEOFEXECUTABLE:
14642 /* Redirect to Tcl proc */
14643 return Jim_Eval(interp, "{info nameofexecutable}");
14645 case INFO_RETURNCODES:
14646 if (argc == 2) {
14647 int i;
14648 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14650 for (i = 0; jimReturnCodes[i]; i++) {
14651 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14652 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14653 jimReturnCodes[i], -1));
14656 Jim_SetResult(interp, listObjPtr);
14658 else if (argc == 3) {
14659 long code;
14660 const char *name;
14662 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14663 return JIM_ERR;
14665 name = Jim_ReturnCode(code);
14666 if (*name == '?') {
14667 Jim_SetResultInt(interp, code);
14669 else {
14670 Jim_SetResultString(interp, name, -1);
14673 else {
14674 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14675 return JIM_ERR;
14677 break;
14678 case INFO_REFERENCES:
14679 #ifdef JIM_REFERENCES
14680 return JimInfoReferences(interp, argc, argv);
14681 #else
14682 Jim_SetResultString(interp, "not supported", -1);
14683 return JIM_ERR;
14684 #endif
14686 return JIM_OK;
14689 /* [exists] */
14690 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14692 Jim_Obj *objPtr;
14693 int result = 0;
14695 static const char * const options[] = {
14696 "-command", "-proc", "-alias", "-var", NULL
14698 enum
14700 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14702 int option;
14704 if (argc == 2) {
14705 option = OPT_VAR;
14706 objPtr = argv[1];
14708 else if (argc == 3) {
14709 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14710 return JIM_ERR;
14712 objPtr = argv[2];
14714 else {
14715 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14716 return JIM_ERR;
14719 if (option == OPT_VAR) {
14720 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14722 else {
14723 /* Now different kinds of commands */
14724 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14726 if (cmd) {
14727 switch (option) {
14728 case OPT_COMMAND:
14729 result = 1;
14730 break;
14732 case OPT_ALIAS:
14733 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14734 break;
14736 case OPT_PROC:
14737 result = cmd->isproc;
14738 break;
14742 Jim_SetResultBool(interp, result);
14743 return JIM_OK;
14746 /* [split] */
14747 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14749 const char *str, *splitChars, *noMatchStart;
14750 int splitLen, strLen;
14751 Jim_Obj *resObjPtr;
14752 int c;
14753 int len;
14755 if (argc != 2 && argc != 3) {
14756 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14757 return JIM_ERR;
14760 str = Jim_GetString(argv[1], &len);
14761 if (len == 0) {
14762 return JIM_OK;
14764 strLen = Jim_Utf8Length(interp, argv[1]);
14766 /* Init */
14767 if (argc == 2) {
14768 splitChars = " \n\t\r";
14769 splitLen = 4;
14771 else {
14772 splitChars = Jim_String(argv[2]);
14773 splitLen = Jim_Utf8Length(interp, argv[2]);
14776 noMatchStart = str;
14777 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14779 /* Split */
14780 if (splitLen) {
14781 Jim_Obj *objPtr;
14782 while (strLen--) {
14783 const char *sc = splitChars;
14784 int scLen = splitLen;
14785 int sl = utf8_tounicode(str, &c);
14786 while (scLen--) {
14787 int pc;
14788 sc += utf8_tounicode(sc, &pc);
14789 if (c == pc) {
14790 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14791 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14792 noMatchStart = str + sl;
14793 break;
14796 str += sl;
14798 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14799 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14801 else {
14802 /* This handles the special case of splitchars eq {}
14803 * Optimise by sharing common (ASCII) characters
14805 Jim_Obj **commonObj = NULL;
14806 #define NUM_COMMON (128 - 9)
14807 while (strLen--) {
14808 int n = utf8_tounicode(str, &c);
14809 #ifdef JIM_OPTIMIZATION
14810 if (c >= 9 && c < 128) {
14811 /* Common ASCII char. Note that 9 is the tab character */
14812 c -= 9;
14813 if (!commonObj) {
14814 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14815 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14817 if (!commonObj[c]) {
14818 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14820 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14821 str++;
14822 continue;
14824 #endif
14825 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14826 str += n;
14828 Jim_Free(commonObj);
14831 Jim_SetResult(interp, resObjPtr);
14832 return JIM_OK;
14835 /* [join] */
14836 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14838 const char *joinStr;
14839 int joinStrLen;
14841 if (argc != 2 && argc != 3) {
14842 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14843 return JIM_ERR;
14845 /* Init */
14846 if (argc == 2) {
14847 joinStr = " ";
14848 joinStrLen = 1;
14850 else {
14851 joinStr = Jim_GetString(argv[2], &joinStrLen);
14853 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14854 return JIM_OK;
14857 /* [format] */
14858 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14860 Jim_Obj *objPtr;
14862 if (argc < 2) {
14863 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14864 return JIM_ERR;
14866 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14867 if (objPtr == NULL)
14868 return JIM_ERR;
14869 Jim_SetResult(interp, objPtr);
14870 return JIM_OK;
14873 /* [scan] */
14874 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14876 Jim_Obj *listPtr, **outVec;
14877 int outc, i;
14879 if (argc < 3) {
14880 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14881 return JIM_ERR;
14883 if (argv[2]->typePtr != &scanFmtStringObjType)
14884 SetScanFmtFromAny(interp, argv[2]);
14885 if (FormatGetError(argv[2]) != 0) {
14886 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14887 return JIM_ERR;
14889 if (argc > 3) {
14890 int maxPos = FormatGetMaxPos(argv[2]);
14891 int count = FormatGetCnvCount(argv[2]);
14893 if (maxPos > argc - 3) {
14894 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14895 return JIM_ERR;
14897 else if (count > argc - 3) {
14898 Jim_SetResultString(interp, "different numbers of variable names and "
14899 "field specifiers", -1);
14900 return JIM_ERR;
14902 else if (count < argc - 3) {
14903 Jim_SetResultString(interp, "variable is not assigned by any "
14904 "conversion specifiers", -1);
14905 return JIM_ERR;
14908 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14909 if (listPtr == 0)
14910 return JIM_ERR;
14911 if (argc > 3) {
14912 int rc = JIM_OK;
14913 int count = 0;
14915 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14916 int len = Jim_ListLength(interp, listPtr);
14918 if (len != 0) {
14919 JimListGetElements(interp, listPtr, &outc, &outVec);
14920 for (i = 0; i < outc; ++i) {
14921 if (Jim_Length(outVec[i]) > 0) {
14922 ++count;
14923 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14924 rc = JIM_ERR;
14929 Jim_FreeNewObj(interp, listPtr);
14931 else {
14932 count = -1;
14934 if (rc == JIM_OK) {
14935 Jim_SetResultInt(interp, count);
14937 return rc;
14939 else {
14940 if (listPtr == (Jim_Obj *)EOF) {
14941 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14942 return JIM_OK;
14944 Jim_SetResult(interp, listPtr);
14946 return JIM_OK;
14949 /* [error] */
14950 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14952 if (argc != 2 && argc != 3) {
14953 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14954 return JIM_ERR;
14956 Jim_SetResult(interp, argv[1]);
14957 if (argc == 3) {
14958 JimSetStackTrace(interp, argv[2]);
14959 return JIM_ERR;
14961 interp->addStackTrace++;
14962 return JIM_ERR;
14965 /* [lrange] */
14966 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14968 Jim_Obj *objPtr;
14970 if (argc != 4) {
14971 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14972 return JIM_ERR;
14974 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14975 return JIM_ERR;
14976 Jim_SetResult(interp, objPtr);
14977 return JIM_OK;
14980 /* [lrepeat] */
14981 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14983 Jim_Obj *objPtr;
14984 long count;
14986 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14987 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14988 return JIM_ERR;
14991 if (count == 0 || argc == 2) {
14992 return JIM_OK;
14995 argc -= 2;
14996 argv += 2;
14998 objPtr = Jim_NewListObj(interp, argv, argc);
14999 while (--count) {
15000 ListInsertElements(objPtr, -1, argc, argv);
15003 Jim_SetResult(interp, objPtr);
15004 return JIM_OK;
15007 char **Jim_GetEnviron(void)
15009 #if defined(HAVE__NSGETENVIRON)
15010 return *_NSGetEnviron();
15011 #else
15012 #if !defined(NO_ENVIRON_EXTERN)
15013 extern char **environ;
15014 #endif
15016 return environ;
15017 #endif
15020 void Jim_SetEnviron(char **env)
15022 #if defined(HAVE__NSGETENVIRON)
15023 *_NSGetEnviron() = env;
15024 #else
15025 #if !defined(NO_ENVIRON_EXTERN)
15026 extern char **environ;
15027 #endif
15029 environ = env;
15030 #endif
15033 /* [env] */
15034 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15036 const char *key;
15037 const char *val;
15039 if (argc == 1) {
15040 char **e = Jim_GetEnviron();
15042 int i;
15043 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15045 for (i = 0; e[i]; i++) {
15046 const char *equals = strchr(e[i], '=');
15048 if (equals) {
15049 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15050 equals - e[i]));
15051 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15055 Jim_SetResult(interp, listObjPtr);
15056 return JIM_OK;
15059 if (argc < 2) {
15060 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15061 return JIM_ERR;
15063 key = Jim_String(argv[1]);
15064 val = getenv(key);
15065 if (val == NULL) {
15066 if (argc < 3) {
15067 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15068 return JIM_ERR;
15070 val = Jim_String(argv[2]);
15072 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15073 return JIM_OK;
15076 /* [source] */
15077 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15079 int retval;
15081 if (argc != 2) {
15082 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15083 return JIM_ERR;
15085 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15086 if (retval == JIM_RETURN)
15087 return JIM_OK;
15088 return retval;
15091 /* [lreverse] */
15092 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15094 Jim_Obj *revObjPtr, **ele;
15095 int len;
15097 if (argc != 2) {
15098 Jim_WrongNumArgs(interp, 1, argv, "list");
15099 return JIM_ERR;
15101 JimListGetElements(interp, argv[1], &len, &ele);
15102 len--;
15103 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15104 while (len >= 0)
15105 ListAppendElement(revObjPtr, ele[len--]);
15106 Jim_SetResult(interp, revObjPtr);
15107 return JIM_OK;
15110 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15112 jim_wide len;
15114 if (step == 0)
15115 return -1;
15116 if (start == end)
15117 return 0;
15118 else if (step > 0 && start > end)
15119 return -1;
15120 else if (step < 0 && end > start)
15121 return -1;
15122 len = end - start;
15123 if (len < 0)
15124 len = -len; /* abs(len) */
15125 if (step < 0)
15126 step = -step; /* abs(step) */
15127 len = 1 + ((len - 1) / step);
15128 /* We can truncate safely to INT_MAX, the range command
15129 * will always return an error for a such long range
15130 * because Tcl lists can't be so long. */
15131 if (len > INT_MAX)
15132 len = INT_MAX;
15133 return (int)((len < 0) ? -1 : len);
15136 /* [range] */
15137 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15139 jim_wide start = 0, end, step = 1;
15140 int len, i;
15141 Jim_Obj *objPtr;
15143 if (argc < 2 || argc > 4) {
15144 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15145 return JIM_ERR;
15147 if (argc == 2) {
15148 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15149 return JIM_ERR;
15151 else {
15152 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15153 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15154 return JIM_ERR;
15155 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15156 return JIM_ERR;
15158 if ((len = JimRangeLen(start, end, step)) == -1) {
15159 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15160 return JIM_ERR;
15162 objPtr = Jim_NewListObj(interp, NULL, 0);
15163 for (i = 0; i < len; i++)
15164 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15165 Jim_SetResult(interp, objPtr);
15166 return JIM_OK;
15169 /* [rand] */
15170 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15172 jim_wide min = 0, max = 0, len, maxMul;
15174 if (argc < 1 || argc > 3) {
15175 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15176 return JIM_ERR;
15178 if (argc == 1) {
15179 max = JIM_WIDE_MAX;
15180 } else if (argc == 2) {
15181 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15182 return JIM_ERR;
15183 } else if (argc == 3) {
15184 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15185 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15186 return JIM_ERR;
15188 len = max-min;
15189 if (len < 0) {
15190 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15191 return JIM_ERR;
15193 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15194 while (1) {
15195 jim_wide r;
15197 JimRandomBytes(interp, &r, sizeof(jim_wide));
15198 if (r < 0 || r >= maxMul) continue;
15199 r = (len == 0) ? 0 : r%len;
15200 Jim_SetResultInt(interp, min+r);
15201 return JIM_OK;
15205 static const struct {
15206 const char *name;
15207 Jim_CmdProc cmdProc;
15208 } Jim_CoreCommandsTable[] = {
15209 {"alias", Jim_AliasCoreCommand},
15210 {"set", Jim_SetCoreCommand},
15211 {"unset", Jim_UnsetCoreCommand},
15212 {"puts", Jim_PutsCoreCommand},
15213 {"+", Jim_AddCoreCommand},
15214 {"*", Jim_MulCoreCommand},
15215 {"-", Jim_SubCoreCommand},
15216 {"/", Jim_DivCoreCommand},
15217 {"incr", Jim_IncrCoreCommand},
15218 {"while", Jim_WhileCoreCommand},
15219 {"loop", Jim_LoopCoreCommand},
15220 {"for", Jim_ForCoreCommand},
15221 {"foreach", Jim_ForeachCoreCommand},
15222 {"lmap", Jim_LmapCoreCommand},
15223 {"lassign", Jim_LassignCoreCommand},
15224 {"if", Jim_IfCoreCommand},
15225 {"switch", Jim_SwitchCoreCommand},
15226 {"list", Jim_ListCoreCommand},
15227 {"lindex", Jim_LindexCoreCommand},
15228 {"lset", Jim_LsetCoreCommand},
15229 {"lsearch", Jim_LsearchCoreCommand},
15230 {"llength", Jim_LlengthCoreCommand},
15231 {"lappend", Jim_LappendCoreCommand},
15232 {"linsert", Jim_LinsertCoreCommand},
15233 {"lreplace", Jim_LreplaceCoreCommand},
15234 {"lsort", Jim_LsortCoreCommand},
15235 {"append", Jim_AppendCoreCommand},
15236 {"debug", Jim_DebugCoreCommand},
15237 {"eval", Jim_EvalCoreCommand},
15238 {"uplevel", Jim_UplevelCoreCommand},
15239 {"expr", Jim_ExprCoreCommand},
15240 {"break", Jim_BreakCoreCommand},
15241 {"continue", Jim_ContinueCoreCommand},
15242 {"proc", Jim_ProcCoreCommand},
15243 {"concat", Jim_ConcatCoreCommand},
15244 {"return", Jim_ReturnCoreCommand},
15245 {"upvar", Jim_UpvarCoreCommand},
15246 {"global", Jim_GlobalCoreCommand},
15247 {"string", Jim_StringCoreCommand},
15248 {"time", Jim_TimeCoreCommand},
15249 {"exit", Jim_ExitCoreCommand},
15250 {"catch", Jim_CatchCoreCommand},
15251 #ifdef JIM_REFERENCES
15252 {"ref", Jim_RefCoreCommand},
15253 {"getref", Jim_GetrefCoreCommand},
15254 {"setref", Jim_SetrefCoreCommand},
15255 {"finalize", Jim_FinalizeCoreCommand},
15256 {"collect", Jim_CollectCoreCommand},
15257 #endif
15258 {"rename", Jim_RenameCoreCommand},
15259 {"dict", Jim_DictCoreCommand},
15260 {"subst", Jim_SubstCoreCommand},
15261 {"info", Jim_InfoCoreCommand},
15262 {"exists", Jim_ExistsCoreCommand},
15263 {"split", Jim_SplitCoreCommand},
15264 {"join", Jim_JoinCoreCommand},
15265 {"format", Jim_FormatCoreCommand},
15266 {"scan", Jim_ScanCoreCommand},
15267 {"error", Jim_ErrorCoreCommand},
15268 {"lrange", Jim_LrangeCoreCommand},
15269 {"lrepeat", Jim_LrepeatCoreCommand},
15270 {"env", Jim_EnvCoreCommand},
15271 {"source", Jim_SourceCoreCommand},
15272 {"lreverse", Jim_LreverseCoreCommand},
15273 {"range", Jim_RangeCoreCommand},
15274 {"rand", Jim_RandCoreCommand},
15275 {"tailcall", Jim_TailcallCoreCommand},
15276 {"local", Jim_LocalCoreCommand},
15277 {"upcall", Jim_UpcallCoreCommand},
15278 {"apply", Jim_ApplyCoreCommand},
15279 {NULL, NULL},
15282 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15284 int i = 0;
15286 while (Jim_CoreCommandsTable[i].name != NULL) {
15287 Jim_CreateCommand(interp,
15288 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15289 i++;
15293 /* -----------------------------------------------------------------------------
15294 * Interactive prompt
15295 * ---------------------------------------------------------------------------*/
15296 void Jim_MakeErrorMessage(Jim_Interp *interp)
15298 Jim_Obj *argv[2];
15300 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15301 argv[1] = interp->result;
15303 Jim_EvalObjVector(interp, 2, argv);
15306 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15307 const char *prefix, const char *const *tablePtr, const char *name)
15309 int count;
15310 char **tablePtrSorted;
15311 int i;
15313 for (count = 0; tablePtr[count]; count++) {
15316 if (name == NULL) {
15317 name = "option";
15320 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15321 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15322 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15323 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15324 for (i = 0; i < count; i++) {
15325 if (i + 1 == count && count > 1) {
15326 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15328 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15329 if (i + 1 != count) {
15330 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15333 Jim_Free(tablePtrSorted);
15336 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15337 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15339 const char *bad = "bad ";
15340 const char *const *entryPtr = NULL;
15341 int i;
15342 int match = -1;
15343 int arglen;
15344 const char *arg = Jim_GetString(objPtr, &arglen);
15346 *indexPtr = -1;
15348 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15349 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15350 /* Found an exact match */
15351 *indexPtr = i;
15352 return JIM_OK;
15354 if (flags & JIM_ENUM_ABBREV) {
15355 /* Accept an unambiguous abbreviation.
15356 * Note that '-' doesnt' consitute a valid abbreviation
15358 if (strncmp(arg, *entryPtr, arglen) == 0) {
15359 if (*arg == '-' && arglen == 1) {
15360 break;
15362 if (match >= 0) {
15363 bad = "ambiguous ";
15364 goto ambiguous;
15366 match = i;
15371 /* If we had an unambiguous partial match */
15372 if (match >= 0) {
15373 *indexPtr = match;
15374 return JIM_OK;
15377 ambiguous:
15378 if (flags & JIM_ERRMSG) {
15379 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15381 return JIM_ERR;
15384 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15386 int i;
15388 for (i = 0; i < (int)len; i++) {
15389 if (array[i] && strcmp(array[i], name) == 0) {
15390 return i;
15393 return -1;
15396 int Jim_IsDict(Jim_Obj *objPtr)
15398 return objPtr->typePtr == &dictObjType;
15401 int Jim_IsList(Jim_Obj *objPtr)
15403 return objPtr->typePtr == &listObjType;
15407 * Very simple printf-like formatting, designed for error messages.
15409 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15410 * The resulting string is created and set as the result.
15412 * Each '%s' should correspond to a regular string parameter.
15413 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15414 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15416 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15418 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15420 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15422 /* Initial space needed */
15423 int len = strlen(format);
15424 int extra = 0;
15425 int n = 0;
15426 const char *params[5];
15427 char *buf;
15428 va_list args;
15429 int i;
15431 va_start(args, format);
15433 for (i = 0; i < len && n < 5; i++) {
15434 int l;
15436 if (strncmp(format + i, "%s", 2) == 0) {
15437 params[n] = va_arg(args, char *);
15439 l = strlen(params[n]);
15441 else if (strncmp(format + i, "%#s", 3) == 0) {
15442 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15444 params[n] = Jim_GetString(objPtr, &l);
15446 else {
15447 if (format[i] == '%') {
15448 i++;
15450 continue;
15452 n++;
15453 extra += l;
15456 len += extra;
15457 buf = Jim_Alloc(len + 1);
15458 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15460 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15463 /* stubs */
15464 #ifndef jim_ext_package
15465 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15467 return JIM_OK;
15469 #endif
15470 #ifndef jim_ext_aio
15471 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15473 Jim_SetResultString(interp, "aio not enabled", -1);
15474 return NULL;
15476 #endif
15480 * Local Variables: ***
15481 * c-basic-offset: 4 ***
15482 * tab-width: 4 ***
15483 * End: ***