format: fix format %hd on some platforms
[jimtcl.git] / jim.c
blob084d5135e988f64c72c61f91d3feefc98b8553af
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 action);
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 and leave it ready for reuse */
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 if (aObjPtr == bObjPtr) {
2528 return 1;
2530 else {
2531 int Alen, Blen;
2532 const char *sA = Jim_GetString(aObjPtr, &Alen);
2533 const char *sB = Jim_GetString(bObjPtr, &Blen);
2535 return Alen == Blen && memcmp(sA, sB, Alen) == 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 Jim_SetResultFormatted(interp,
4744 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4745 ret < 0 ? "variable isn't" : "no such element in");
4747 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4748 /* Update the variable to have an unshared copy */
4749 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4752 return resObjPtr;
4755 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4756 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4758 SetDictSubstFromAny(interp, objPtr);
4760 return JimDictExpandArrayVariable(interp,
4761 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4762 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4765 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4767 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4769 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4770 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4773 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4775 JIM_NOTUSED(interp);
4777 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4778 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4779 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4780 dupPtr->typePtr = &dictSubstObjType;
4783 /* Note: The object *must* be in dict-sugar format */
4784 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4786 if (objPtr->typePtr != &dictSubstObjType) {
4787 Jim_Obj *varObjPtr, *keyObjPtr;
4789 if (objPtr->typePtr == &interpolatedObjType) {
4790 /* An interpolated object in dict-sugar form */
4792 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4793 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4795 Jim_IncrRefCount(varObjPtr);
4796 Jim_IncrRefCount(keyObjPtr);
4798 else {
4799 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4802 Jim_FreeIntRep(interp, objPtr);
4803 objPtr->typePtr = &dictSubstObjType;
4804 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4805 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4809 /* This function is used to expand [dict get] sugar in the form
4810 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4811 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4812 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4813 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4814 * the [dict]ionary contained in variable VARNAME. */
4815 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4817 Jim_Obj *resObjPtr = NULL;
4818 Jim_Obj *substKeyObjPtr = NULL;
4820 SetDictSubstFromAny(interp, objPtr);
4822 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4823 &substKeyObjPtr, JIM_NONE)
4824 != JIM_OK) {
4825 return NULL;
4827 Jim_IncrRefCount(substKeyObjPtr);
4828 resObjPtr =
4829 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4830 substKeyObjPtr, 0);
4831 Jim_DecrRefCount(interp, substKeyObjPtr);
4833 return resObjPtr;
4836 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4838 Jim_Obj *resultObjPtr;
4840 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4841 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4842 resultObjPtr->refCount--;
4843 return resultObjPtr;
4845 return NULL;
4848 /* -----------------------------------------------------------------------------
4849 * CallFrame
4850 * ---------------------------------------------------------------------------*/
4852 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4854 Jim_CallFrame *cf;
4856 if (interp->freeFramesList) {
4857 cf = interp->freeFramesList;
4858 interp->freeFramesList = cf->next;
4860 cf->argv = NULL;
4861 cf->argc = 0;
4862 cf->procArgsObjPtr = NULL;
4863 cf->procBodyObjPtr = NULL;
4864 cf->next = NULL;
4865 cf->staticVars = NULL;
4866 cf->localCommands = NULL;
4867 cf->tailcall = 0;
4868 cf->tailcallObj = NULL;
4869 cf->tailcallCmd = NULL;
4871 else {
4872 cf = Jim_Alloc(sizeof(*cf));
4873 memset(cf, 0, sizeof(*cf));
4875 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4878 cf->id = interp->callFrameEpoch++;
4879 cf->parent = parent;
4880 cf->level = parent ? parent->level + 1 : 0;
4881 cf->nsObj = nsObj;
4882 Jim_IncrRefCount(nsObj);
4884 return cf;
4887 /* Used to invalidate every caching related to callframe stability. */
4888 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
4890 cf->id = interp->callFrameEpoch++;
4893 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4895 /* Delete any local procs */
4896 if (localCommands) {
4897 Jim_Obj *cmdNameObj;
4899 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4900 Jim_HashEntry *he;
4901 Jim_Obj *fqObjName;
4903 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4905 he = Jim_FindHashEntry(&interp->commands, fqname);
4907 if (he) {
4908 Jim_Cmd *cmd = he->u.val;
4909 if (cmd->prevCmd) {
4910 Jim_Cmd *prevCmd = cmd->prevCmd;
4911 cmd->prevCmd = NULL;
4913 /* Delete the old command */
4914 JimDecrCmdRefCount(interp, cmd);
4916 /* And restore the original */
4917 he->u.val = prevCmd;
4919 else {
4920 Jim_DeleteHashEntry(&interp->commands, fqname);
4921 Jim_InterpIncrProcEpoch(interp);
4924 Jim_DecrRefCount(interp, cmdNameObj);
4925 JimFreeQualifiedName(interp, fqObjName);
4927 Jim_FreeStack(localCommands);
4928 Jim_Free(localCommands);
4930 return JIM_OK;
4934 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4935 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4936 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
4938 JimDeleteLocalProcs(interp, cf->localCommands);
4940 if (cf->procArgsObjPtr)
4941 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4942 if (cf->procBodyObjPtr)
4943 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4944 Jim_DecrRefCount(interp, cf->nsObj);
4945 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
4946 Jim_FreeHashTable(&cf->vars);
4947 else {
4948 int i;
4949 Jim_HashEntry **table = cf->vars.table, *he;
4951 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4952 he = table[i];
4953 while (he != NULL) {
4954 Jim_HashEntry *nextEntry = he->next;
4955 Jim_Var *varPtr = (void *)he->u.val;
4957 Jim_DecrRefCount(interp, varPtr->objPtr);
4958 Jim_Free(he->u.val);
4959 Jim_Free((void *)he->key); /* ATTENTION: const cast */
4960 Jim_Free(he);
4961 table[i] = NULL;
4962 he = nextEntry;
4965 cf->vars.used = 0;
4967 cf->next = interp->freeFramesList;
4968 interp->freeFramesList = cf;
4972 /* -----------------------------------------------------------------------------
4973 * References
4974 * ---------------------------------------------------------------------------*/
4975 #ifdef JIM_REFERENCES
4977 /* References HashTable Type.
4979 * Keys are unsigned long integers, dynamically allocated for now but in the
4980 * future it's worth to cache this 4 bytes objects. Values are pointers
4981 * to Jim_References. */
4982 static void JimReferencesHTValDestructor(void *interp, void *val)
4984 Jim_Reference *refPtr = (void *)val;
4986 Jim_DecrRefCount(interp, refPtr->objPtr);
4987 if (refPtr->finalizerCmdNamePtr != NULL) {
4988 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4990 Jim_Free(val);
4993 static unsigned int JimReferencesHTHashFunction(const void *key)
4995 /* Only the least significant bits are used. */
4996 const unsigned long *widePtr = key;
4997 unsigned int intValue = (unsigned int)*widePtr;
4999 return Jim_IntHashFunction(intValue);
5002 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5004 void *copy = Jim_Alloc(sizeof(unsigned long));
5006 JIM_NOTUSED(privdata);
5008 memcpy(copy, key, sizeof(unsigned long));
5009 return copy;
5012 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5014 JIM_NOTUSED(privdata);
5016 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5019 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5021 JIM_NOTUSED(privdata);
5023 Jim_Free(key);
5026 static const Jim_HashTableType JimReferencesHashTableType = {
5027 JimReferencesHTHashFunction, /* hash function */
5028 JimReferencesHTKeyDup, /* key dup */
5029 NULL, /* val dup */
5030 JimReferencesHTKeyCompare, /* key compare */
5031 JimReferencesHTKeyDestructor, /* key destructor */
5032 JimReferencesHTValDestructor /* val destructor */
5035 /* -----------------------------------------------------------------------------
5036 * Reference object type and References API
5037 * ---------------------------------------------------------------------------*/
5039 /* The string representation of references has two features in order
5040 * to make the GC faster. The first is that every reference starts
5041 * with a non common character '<', in order to make the string matching
5042 * faster. The second is that the reference string rep is 42 characters
5043 * in length, this allows to avoid to check every object with a string
5044 * repr < 42, and usually there aren't many of these objects. */
5046 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5048 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5050 const char *fmt = "<reference.<%s>.%020lu>";
5052 sprintf(buf, fmt, refPtr->tag, id);
5053 return JIM_REFERENCE_SPACE;
5056 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5058 static const Jim_ObjType referenceObjType = {
5059 "reference",
5060 NULL,
5061 NULL,
5062 UpdateStringOfReference,
5063 JIM_TYPE_REFERENCES,
5066 void UpdateStringOfReference(struct Jim_Obj *objPtr)
5068 char buf[JIM_REFERENCE_SPACE + 1];
5070 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5071 JimSetStringBytes(objPtr, buf);
5074 /* returns true if 'c' is a valid reference tag character.
5075 * i.e. inside the range [_a-zA-Z0-9] */
5076 static int isrefchar(int c)
5078 return (c == '_' || isalnum(c));
5081 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5083 unsigned long value;
5084 int i, len;
5085 const char *str, *start, *end;
5086 char refId[21];
5087 Jim_Reference *refPtr;
5088 Jim_HashEntry *he;
5089 char *endptr;
5091 /* Get the string representation */
5092 str = Jim_GetString(objPtr, &len);
5093 /* Check if it looks like a reference */
5094 if (len < JIM_REFERENCE_SPACE)
5095 goto badformat;
5096 /* Trim spaces */
5097 start = str;
5098 end = str + len - 1;
5099 while (*start == ' ')
5100 start++;
5101 while (*end == ' ' && end > start)
5102 end--;
5103 if (end - start + 1 != JIM_REFERENCE_SPACE)
5104 goto badformat;
5105 /* <reference.<1234567>.%020> */
5106 if (memcmp(start, "<reference.<", 12) != 0)
5107 goto badformat;
5108 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5109 goto badformat;
5110 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5111 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5112 if (!isrefchar(start[12 + i]))
5113 goto badformat;
5115 /* Extract info from the reference. */
5116 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5117 refId[20] = '\0';
5118 /* Try to convert the ID into an unsigned long */
5119 value = strtoul(refId, &endptr, 10);
5120 if (JimCheckConversion(refId, endptr) != JIM_OK)
5121 goto badformat;
5122 /* Check if the reference really exists! */
5123 he = Jim_FindHashEntry(&interp->references, &value);
5124 if (he == NULL) {
5125 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5126 return JIM_ERR;
5128 refPtr = he->u.val;
5129 /* Free the old internal repr and set the new one. */
5130 Jim_FreeIntRep(interp, objPtr);
5131 objPtr->typePtr = &referenceObjType;
5132 objPtr->internalRep.refValue.id = value;
5133 objPtr->internalRep.refValue.refPtr = refPtr;
5134 return JIM_OK;
5136 badformat:
5137 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5138 return JIM_ERR;
5141 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5142 * as finalizer command (or NULL if there is no finalizer).
5143 * The returned reference object has refcount = 0. */
5144 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5146 struct Jim_Reference *refPtr;
5147 unsigned long id;
5148 Jim_Obj *refObjPtr;
5149 const char *tag;
5150 int tagLen, i;
5152 /* Perform the Garbage Collection if needed. */
5153 Jim_CollectIfNeeded(interp);
5155 refPtr = Jim_Alloc(sizeof(*refPtr));
5156 refPtr->objPtr = objPtr;
5157 Jim_IncrRefCount(objPtr);
5158 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5159 if (cmdNamePtr)
5160 Jim_IncrRefCount(cmdNamePtr);
5161 id = interp->referenceNextId++;
5162 Jim_AddHashEntry(&interp->references, &id, refPtr);
5163 refObjPtr = Jim_NewObj(interp);
5164 refObjPtr->typePtr = &referenceObjType;
5165 refObjPtr->bytes = NULL;
5166 refObjPtr->internalRep.refValue.id = id;
5167 refObjPtr->internalRep.refValue.refPtr = refPtr;
5168 interp->referenceNextId++;
5169 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5170 * that does not pass the 'isrefchar' test is replaced with '_' */
5171 tag = Jim_GetString(tagPtr, &tagLen);
5172 if (tagLen > JIM_REFERENCE_TAGLEN)
5173 tagLen = JIM_REFERENCE_TAGLEN;
5174 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5175 if (i < tagLen && isrefchar(tag[i]))
5176 refPtr->tag[i] = tag[i];
5177 else
5178 refPtr->tag[i] = '_';
5180 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5181 return refObjPtr;
5184 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5186 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5187 return NULL;
5188 return objPtr->internalRep.refValue.refPtr;
5191 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5193 Jim_Reference *refPtr;
5195 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5196 return JIM_ERR;
5197 Jim_IncrRefCount(cmdNamePtr);
5198 if (refPtr->finalizerCmdNamePtr)
5199 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5200 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5201 return JIM_OK;
5204 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5206 Jim_Reference *refPtr;
5208 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5209 return JIM_ERR;
5210 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5211 return JIM_OK;
5214 /* -----------------------------------------------------------------------------
5215 * References Garbage Collection
5216 * ---------------------------------------------------------------------------*/
5218 /* This the hash table type for the "MARK" phase of the GC */
5219 static const Jim_HashTableType JimRefMarkHashTableType = {
5220 JimReferencesHTHashFunction, /* hash function */
5221 JimReferencesHTKeyDup, /* key dup */
5222 NULL, /* val dup */
5223 JimReferencesHTKeyCompare, /* key compare */
5224 JimReferencesHTKeyDestructor, /* key destructor */
5225 NULL /* val destructor */
5228 /* Performs the garbage collection. */
5229 int Jim_Collect(Jim_Interp *interp)
5231 int collected = 0;
5232 #ifndef JIM_BOOTSTRAP
5233 Jim_HashTable marks;
5234 Jim_HashTableIterator htiter;
5235 Jim_HashEntry *he;
5236 Jim_Obj *objPtr;
5238 /* Avoid recursive calls */
5239 if (interp->lastCollectId == -1) {
5240 /* Jim_Collect() already running. Return just now. */
5241 return 0;
5243 interp->lastCollectId = -1;
5245 /* Mark all the references found into the 'mark' hash table.
5246 * The references are searched in every live object that
5247 * is of a type that can contain references. */
5248 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5249 objPtr = interp->liveList;
5250 while (objPtr) {
5251 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5252 const char *str, *p;
5253 int len;
5255 /* If the object is of type reference, to get the
5256 * Id is simple... */
5257 if (objPtr->typePtr == &referenceObjType) {
5258 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5259 #ifdef JIM_DEBUG_GC
5260 printf("MARK (reference): %d refcount: %d" JIM_NL,
5261 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5262 #endif
5263 objPtr = objPtr->nextObjPtr;
5264 continue;
5266 /* Get the string repr of the object we want
5267 * to scan for references. */
5268 p = str = Jim_GetString(objPtr, &len);
5269 /* Skip objects too little to contain references. */
5270 if (len < JIM_REFERENCE_SPACE) {
5271 objPtr = objPtr->nextObjPtr;
5272 continue;
5274 /* Extract references from the object string repr. */
5275 while (1) {
5276 int i;
5277 unsigned long id;
5279 if ((p = strstr(p, "<reference.<")) == NULL)
5280 break;
5281 /* Check if it's a valid reference. */
5282 if (len - (p - str) < JIM_REFERENCE_SPACE)
5283 break;
5284 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5285 break;
5286 for (i = 21; i <= 40; i++)
5287 if (!isdigit(UCHAR(p[i])))
5288 break;
5289 /* Get the ID */
5290 id = strtoul(p + 21, NULL, 10);
5292 /* Ok, a reference for the given ID
5293 * was found. Mark it. */
5294 Jim_AddHashEntry(&marks, &id, NULL);
5295 #ifdef JIM_DEBUG_GC
5296 printf("MARK: %d" JIM_NL, (int)id);
5297 #endif
5298 p += JIM_REFERENCE_SPACE;
5301 objPtr = objPtr->nextObjPtr;
5304 /* Run the references hash table to destroy every reference that
5305 * is not referenced outside (not present in the mark HT). */
5306 JimInitHashTableIterator(&interp->references, &htiter);
5307 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5308 const unsigned long *refId;
5309 Jim_Reference *refPtr;
5311 refId = he->key;
5312 /* Check if in the mark phase we encountered
5313 * this reference. */
5314 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5315 #ifdef JIM_DEBUG_GC
5316 printf("COLLECTING %d" JIM_NL, (int)*refId);
5317 #endif
5318 collected++;
5319 /* Drop the reference, but call the
5320 * finalizer first if registered. */
5321 refPtr = he->u.val;
5322 if (refPtr->finalizerCmdNamePtr) {
5323 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5324 Jim_Obj *objv[3], *oldResult;
5326 JimFormatReference(refstr, refPtr, *refId);
5328 objv[0] = refPtr->finalizerCmdNamePtr;
5329 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5330 objv[2] = refPtr->objPtr;
5332 /* Drop the reference itself */
5333 /* Avoid the finaliser being freed here */
5334 Jim_IncrRefCount(objv[0]);
5335 /* Don't remove the reference from the hash table just yet
5336 * since that will free refPtr, and hence refPtr->objPtr
5339 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5340 oldResult = interp->result;
5341 Jim_IncrRefCount(oldResult);
5342 Jim_EvalObjVector(interp, 3, objv);
5343 Jim_SetResult(interp, oldResult);
5344 Jim_DecrRefCount(interp, oldResult);
5346 Jim_DecrRefCount(interp, objv[0]);
5348 Jim_DeleteHashEntry(&interp->references, refId);
5351 Jim_FreeHashTable(&marks);
5352 interp->lastCollectId = interp->referenceNextId;
5353 interp->lastCollectTime = time(NULL);
5354 #endif /* JIM_BOOTSTRAP */
5355 return collected;
5358 #define JIM_COLLECT_ID_PERIOD 5000
5359 #define JIM_COLLECT_TIME_PERIOD 300
5361 void Jim_CollectIfNeeded(Jim_Interp *interp)
5363 unsigned long elapsedId;
5364 int elapsedTime;
5366 elapsedId = interp->referenceNextId - interp->lastCollectId;
5367 elapsedTime = time(NULL) - interp->lastCollectTime;
5370 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5371 Jim_Collect(interp);
5374 #endif
5376 int Jim_IsBigEndian(void)
5378 union {
5379 unsigned short s;
5380 unsigned char c[2];
5381 } uval = {0x0102};
5383 return uval.c[0] == 1;
5386 /* -----------------------------------------------------------------------------
5387 * Interpreter related functions
5388 * ---------------------------------------------------------------------------*/
5390 Jim_Interp *Jim_CreateInterp(void)
5392 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5394 memset(i, 0, sizeof(*i));
5396 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5397 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5398 i->lastCollectTime = time(NULL);
5400 /* Note that we can create objects only after the
5401 * interpreter liveList and freeList pointers are
5402 * initialized to NULL. */
5403 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5404 #ifdef JIM_REFERENCES
5405 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5406 #endif
5407 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5408 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5409 i->emptyObj = Jim_NewEmptyStringObj(i);
5410 i->trueObj = Jim_NewIntObj(i, 1);
5411 i->falseObj = Jim_NewIntObj(i, 0);
5412 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5413 i->errorFileNameObj = i->emptyObj;
5414 i->result = i->emptyObj;
5415 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5416 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5417 i->errorProc = i->emptyObj;
5418 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5419 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5420 Jim_IncrRefCount(i->emptyObj);
5421 Jim_IncrRefCount(i->errorFileNameObj);
5422 Jim_IncrRefCount(i->result);
5423 Jim_IncrRefCount(i->stackTrace);
5424 Jim_IncrRefCount(i->unknown);
5425 Jim_IncrRefCount(i->currentScriptObj);
5426 Jim_IncrRefCount(i->nullScriptObj);
5427 Jim_IncrRefCount(i->errorProc);
5428 Jim_IncrRefCount(i->trueObj);
5429 Jim_IncrRefCount(i->falseObj);
5431 /* Initialize key variables every interpreter should contain */
5432 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5433 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5435 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5436 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5437 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5438 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5439 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5440 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5441 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5443 return i;
5446 void Jim_FreeInterp(Jim_Interp *i)
5448 Jim_CallFrame *cf = i->framePtr, *prevcf;
5449 Jim_Obj *objPtr, *nextObjPtr;
5451 /* Free the call frames list - must be done before i->commands is destroyed */
5452 while (cf) {
5453 prevcf = cf->parent;
5454 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5455 Jim_Free(cf);
5456 cf = prevcf;
5459 Jim_DecrRefCount(i, i->emptyObj);
5460 Jim_DecrRefCount(i, i->trueObj);
5461 Jim_DecrRefCount(i, i->falseObj);
5462 Jim_DecrRefCount(i, i->result);
5463 Jim_DecrRefCount(i, i->stackTrace);
5464 Jim_DecrRefCount(i, i->errorProc);
5465 Jim_DecrRefCount(i, i->unknown);
5466 Jim_DecrRefCount(i, i->errorFileNameObj);
5467 Jim_DecrRefCount(i, i->currentScriptObj);
5468 Jim_DecrRefCount(i, i->nullScriptObj);
5469 Jim_FreeHashTable(&i->commands);
5470 #ifdef JIM_REFERENCES
5471 Jim_FreeHashTable(&i->references);
5472 #endif
5473 Jim_FreeHashTable(&i->packages);
5474 Jim_Free(i->prngState);
5475 Jim_FreeHashTable(&i->assocData);
5477 /* Check that the live object list is empty, otherwise
5478 * there is a memory leak. */
5479 #ifdef JIM_MAINTAINER
5480 if (i->liveList != NULL) {
5481 printf(JIM_NL "-------------------------------------" JIM_NL);
5482 printf("Objects still in the free list:" JIM_NL);
5484 objPtr = i->liveList;
5486 while (objPtr) {
5487 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5489 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5490 printf("%p (%d) %-10s: '%.20s...'" JIM_NL,
5491 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5493 else {
5494 printf("%p (%d) %-10s: '%s'" JIM_NL,
5495 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5497 if (objPtr->typePtr == &sourceObjType) {
5498 printf("FILE %s LINE %d" JIM_NL,
5499 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5500 objPtr->internalRep.sourceValue.lineNumber);
5502 objPtr = objPtr->nextObjPtr;
5504 printf("-------------------------------------" JIM_NL JIM_NL);
5505 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5507 #endif
5509 /* Free all the freed objects. */
5510 objPtr = i->freeList;
5511 while (objPtr) {
5512 nextObjPtr = objPtr->nextObjPtr;
5513 Jim_Free(objPtr);
5514 objPtr = nextObjPtr;
5517 /* Free the interpreter structure. */
5518 Jim_Free(i);
5521 /* Returns the call frame relative to the level represented by
5522 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
5524 * This function accepts the 'level' argument in the form
5525 * of the commands [uplevel] and [upvar].
5527 * For a function accepting a relative integer as level suitable
5528 * for implementation of [info level ?level?] check the
5529 * JimGetCallFrameByInteger() function.
5531 * Returns NULL on error.
5533 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5535 long level;
5536 const char *str;
5537 Jim_CallFrame *framePtr;
5539 if (levelObjPtr) {
5540 str = Jim_String(levelObjPtr);
5541 if (str[0] == '#') {
5542 char *endptr;
5544 level = jim_strtol(str + 1, &endptr);
5545 if (str[1] == '\0' || endptr[0] != '\0') {
5546 level = -1;
5549 else {
5550 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5551 level = -1;
5553 else {
5554 /* Convert from a relative to an absolute level */
5555 level = interp->framePtr->level - level;
5559 else {
5560 str = "1"; /* Needed to format the error message. */
5561 level = interp->framePtr->level - 1;
5564 if (level == 0) {
5565 return interp->topFramePtr;
5567 if (level > 0) {
5568 /* Lookup */
5569 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5570 if (framePtr->level == level) {
5571 return framePtr;
5576 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5577 return NULL;
5580 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5581 * as a relative integer like in the [info level ?level?] command.
5583 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5585 long level;
5586 Jim_CallFrame *framePtr;
5588 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5589 if (level <= 0) {
5590 /* Convert from a relative to an absolute level */
5591 level = interp->framePtr->level + level;
5594 if (level == 0) {
5595 return interp->topFramePtr;
5598 /* Lookup */
5599 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5600 if (framePtr->level == level) {
5601 return framePtr;
5606 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5607 return NULL;
5610 static void JimResetStackTrace(Jim_Interp *interp)
5612 Jim_DecrRefCount(interp, interp->stackTrace);
5613 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5614 Jim_IncrRefCount(interp->stackTrace);
5617 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5619 int len;
5621 /* Increment reference first in case these are the same object */
5622 Jim_IncrRefCount(stackTraceObj);
5623 Jim_DecrRefCount(interp, interp->stackTrace);
5624 interp->stackTrace = stackTraceObj;
5625 interp->errorFlag = 1;
5627 /* This is a bit ugly.
5628 * If the filename of the last entry of the stack trace is empty,
5629 * the next stack level should be added.
5631 len = Jim_ListLength(interp, interp->stackTrace);
5632 if (len >= 3) {
5633 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5634 interp->addStackTrace = 1;
5639 /* Returns 1 if the stack trace information was used or 0 if not */
5640 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5641 Jim_Obj *fileNameObj, int linenr)
5643 if (strcmp(procname, "unknown") == 0) {
5644 procname = "";
5646 if (!*procname && !Jim_Length(fileNameObj)) {
5647 /* No useful info here */
5648 return;
5651 if (Jim_IsShared(interp->stackTrace)) {
5652 Jim_DecrRefCount(interp, interp->stackTrace);
5653 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5654 Jim_IncrRefCount(interp->stackTrace);
5657 /* If we have no procname but the previous element did, merge with that frame */
5658 if (!*procname && Jim_Length(fileNameObj)) {
5659 /* Just a filename. Check the previous entry */
5660 int len = Jim_ListLength(interp, interp->stackTrace);
5662 if (len >= 3) {
5663 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5664 if (Jim_Length(objPtr)) {
5665 /* Yes, the previous level had procname */
5666 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5667 if (Jim_Length(objPtr) == 0) {
5668 /* But no filename, so merge the new info with that frame */
5669 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5670 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5671 return;
5677 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5678 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5679 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5682 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5683 void *data)
5685 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5687 assocEntryPtr->delProc = delProc;
5688 assocEntryPtr->data = data;
5689 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5692 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5694 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5696 if (entryPtr != NULL) {
5697 AssocDataValue *assocEntryPtr = (AssocDataValue *) entryPtr->u.val;
5699 return assocEntryPtr->data;
5701 return NULL;
5704 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5706 return Jim_DeleteHashEntry(&interp->assocData, key);
5709 int Jim_GetExitCode(Jim_Interp *interp)
5711 return interp->exitCode;
5714 /* -----------------------------------------------------------------------------
5715 * Integer object
5716 * ---------------------------------------------------------------------------*/
5717 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5718 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5720 static const Jim_ObjType intObjType = {
5721 "int",
5722 NULL,
5723 NULL,
5724 UpdateStringOfInt,
5725 JIM_TYPE_NONE,
5728 /* A coerced double is closer to an int than a double.
5729 * It is an int value temporarily masquerading as a double value.
5730 * i.e. it has the same string value as an int and Jim_GetWide()
5731 * succeeds, but also Jim_GetDouble() returns the value directly.
5733 static const Jim_ObjType coercedDoubleObjType = {
5734 "coerced-double",
5735 NULL,
5736 NULL,
5737 UpdateStringOfInt,
5738 JIM_TYPE_NONE,
5742 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5744 char buf[JIM_INTEGER_SPACE + 1];
5745 jim_wide wideValue = JimWideValue(objPtr);
5746 int pos = 0;
5748 if (wideValue == 0) {
5749 buf[pos++] = '0';
5751 else {
5752 char tmp[JIM_INTEGER_SPACE];
5753 int num = 0;
5754 int i;
5756 if (wideValue < 0) {
5757 buf[pos++] = '-';
5758 /* -106 % 10 may be -6 or 4! */
5759 i = wideValue % 10;
5760 tmp[num++] = (i > 0) ? (10 - i) : -i;
5761 wideValue /= -10;
5764 while (wideValue) {
5765 tmp[num++] = wideValue % 10;
5766 wideValue /= 10;
5769 for (i = 0; i < num; i++) {
5770 buf[pos++] = '0' + tmp[num - i - 1];
5773 buf[pos] = 0;
5775 JimSetStringBytes(objPtr, buf);
5778 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5780 jim_wide wideValue;
5781 const char *str;
5783 if (objPtr->typePtr == &coercedDoubleObjType) {
5784 /* Simple switcheroo */
5785 objPtr->typePtr = &intObjType;
5786 return JIM_OK;
5789 /* Get the string representation */
5790 str = Jim_String(objPtr);
5791 /* Try to convert into a jim_wide */
5792 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5793 if (flags & JIM_ERRMSG) {
5794 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5796 return JIM_ERR;
5798 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5799 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5800 return JIM_ERR;
5802 /* Free the old internal repr and set the new one. */
5803 Jim_FreeIntRep(interp, objPtr);
5804 objPtr->typePtr = &intObjType;
5805 objPtr->internalRep.wideValue = wideValue;
5806 return JIM_OK;
5809 #ifdef JIM_OPTIMIZATION
5810 static int JimIsWide(Jim_Obj *objPtr)
5812 return objPtr->typePtr == &intObjType;
5814 #endif
5816 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5818 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5819 return JIM_ERR;
5820 *widePtr = JimWideValue(objPtr);
5821 return JIM_OK;
5824 /* Get a wide but does not set an error if the format is bad. */
5825 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5827 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5828 return JIM_ERR;
5829 *widePtr = JimWideValue(objPtr);
5830 return JIM_OK;
5833 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5835 jim_wide wideValue;
5836 int retval;
5838 retval = Jim_GetWide(interp, objPtr, &wideValue);
5839 if (retval == JIM_OK) {
5840 *longPtr = (long)wideValue;
5841 return JIM_OK;
5843 return JIM_ERR;
5846 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5848 Jim_Obj *objPtr;
5850 objPtr = Jim_NewObj(interp);
5851 objPtr->typePtr = &intObjType;
5852 objPtr->bytes = NULL;
5853 objPtr->internalRep.wideValue = wideValue;
5854 return objPtr;
5857 /* -----------------------------------------------------------------------------
5858 * Double object
5859 * ---------------------------------------------------------------------------*/
5860 #define JIM_DOUBLE_SPACE 30
5862 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5863 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5865 static const Jim_ObjType doubleObjType = {
5866 "double",
5867 NULL,
5868 NULL,
5869 UpdateStringOfDouble,
5870 JIM_TYPE_NONE,
5873 #ifndef HAVE_ISNAN
5874 #undef isnan
5875 #define isnan(X) ((X) != (X))
5876 #endif
5877 #ifndef HAVE_ISINF
5878 #undef isinf
5879 #define isinf(X) (1.0 / (X) == 0.0)
5880 #endif
5882 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5884 double value = objPtr->internalRep.doubleValue;
5886 if (isnan(value)) {
5887 JimSetStringBytes(objPtr, "NaN");
5888 return;
5890 if (isinf(value)) {
5891 if (value < 0) {
5892 JimSetStringBytes(objPtr, "-Inf");
5894 else {
5895 JimSetStringBytes(objPtr, "Inf");
5897 return;
5900 char buf[JIM_DOUBLE_SPACE + 1];
5901 int i;
5902 int len = sprintf(buf, "%.12g", value);
5904 /* Add a final ".0" if necessary */
5905 for (i = 0; i < len; i++) {
5906 if (buf[i] == '.' || buf[i] == 'e') {
5907 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5908 /* If 'buf' ends in e-0nn or e+0nn, remove
5909 * the 0 after the + or - and reduce the length by 1
5911 char *e = strchr(buf, 'e');
5912 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5913 /* Move it up */
5914 e += 2;
5915 memmove(e, e + 1, len - (e - buf));
5917 #endif
5918 break;
5921 if (buf[i] == '\0') {
5922 buf[i++] = '.';
5923 buf[i++] = '0';
5924 buf[i] = '\0';
5926 JimSetStringBytes(objPtr, buf);
5930 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5932 double doubleValue;
5933 jim_wide wideValue;
5934 const char *str;
5936 /* Preserve the string representation.
5937 * Needed so we can convert back to int without loss
5939 str = Jim_String(objPtr);
5941 #ifdef HAVE_LONG_LONG
5942 /* Assume a 53 bit mantissa */
5943 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5944 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5946 if (objPtr->typePtr == &intObjType
5947 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5948 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5950 /* Direct conversion to coerced double */
5951 objPtr->typePtr = &coercedDoubleObjType;
5952 return JIM_OK;
5954 else
5955 #endif
5956 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5957 /* Managed to convert to an int, so we can use this as a cooerced double */
5958 Jim_FreeIntRep(interp, objPtr);
5959 objPtr->typePtr = &coercedDoubleObjType;
5960 objPtr->internalRep.wideValue = wideValue;
5961 return JIM_OK;
5963 else {
5964 /* Try to convert into a double */
5965 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
5966 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
5967 return JIM_ERR;
5969 /* Free the old internal repr and set the new one. */
5970 Jim_FreeIntRep(interp, objPtr);
5972 objPtr->typePtr = &doubleObjType;
5973 objPtr->internalRep.doubleValue = doubleValue;
5974 return JIM_OK;
5977 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
5979 if (objPtr->typePtr == &coercedDoubleObjType) {
5980 *doublePtr = JimWideValue(objPtr);
5981 return JIM_OK;
5983 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
5984 return JIM_ERR;
5986 if (objPtr->typePtr == &coercedDoubleObjType) {
5987 *doublePtr = JimWideValue(objPtr);
5989 else {
5990 *doublePtr = objPtr->internalRep.doubleValue;
5992 return JIM_OK;
5995 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
5997 Jim_Obj *objPtr;
5999 objPtr = Jim_NewObj(interp);
6000 objPtr->typePtr = &doubleObjType;
6001 objPtr->bytes = NULL;
6002 objPtr->internalRep.doubleValue = doubleValue;
6003 return objPtr;
6006 /* -----------------------------------------------------------------------------
6007 * List object
6008 * ---------------------------------------------------------------------------*/
6009 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6010 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6011 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6012 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6013 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6014 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6016 /* Note that while the elements of the list may contain references,
6017 * the list object itself can't. This basically means that the
6018 * list object string representation as a whole can't contain references
6019 * that are not presents in the single elements. */
6020 static const Jim_ObjType listObjType = {
6021 "list",
6022 FreeListInternalRep,
6023 DupListInternalRep,
6024 UpdateStringOfList,
6025 JIM_TYPE_NONE,
6028 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6030 int i;
6032 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6033 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6035 Jim_Free(objPtr->internalRep.listValue.ele);
6038 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6040 int i;
6042 JIM_NOTUSED(interp);
6044 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6045 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6046 dupPtr->internalRep.listValue.ele =
6047 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6048 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6049 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6050 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6051 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6053 dupPtr->typePtr = &listObjType;
6056 /* The following function checks if a given string can be encoded
6057 * into a list element without any kind of quoting, surrounded by braces,
6058 * or using escapes to quote. */
6059 #define JIM_ELESTR_SIMPLE 0
6060 #define JIM_ELESTR_BRACE 1
6061 #define JIM_ELESTR_QUOTE 2
6062 static unsigned char ListElementQuotingType(const char *s, int len)
6064 int i, level, blevel, trySimple = 1;
6066 /* Try with the SIMPLE case */
6067 if (len == 0)
6068 return JIM_ELESTR_BRACE;
6069 if (s[0] == '"' || s[0] == '{') {
6070 trySimple = 0;
6071 goto testbrace;
6073 for (i = 0; i < len; i++) {
6074 switch (s[i]) {
6075 case ' ':
6076 case '$':
6077 case '"':
6078 case '[':
6079 case ']':
6080 case ';':
6081 case '\\':
6082 case '\r':
6083 case '\n':
6084 case '\t':
6085 case '\f':
6086 case '\v':
6087 trySimple = 0;
6088 case '{':
6089 case '}':
6090 goto testbrace;
6093 return JIM_ELESTR_SIMPLE;
6095 testbrace:
6096 /* Test if it's possible to do with braces */
6097 if (s[len - 1] == '\\')
6098 return JIM_ELESTR_QUOTE;
6099 level = 0;
6100 blevel = 0;
6101 for (i = 0; i < len; i++) {
6102 switch (s[i]) {
6103 case '{':
6104 level++;
6105 break;
6106 case '}':
6107 level--;
6108 if (level < 0)
6109 return JIM_ELESTR_QUOTE;
6110 break;
6111 case '[':
6112 blevel++;
6113 break;
6114 case ']':
6115 blevel--;
6116 break;
6117 case '\\':
6118 if (s[i + 1] == '\n')
6119 return JIM_ELESTR_QUOTE;
6120 else if (s[i + 1] != '\0')
6121 i++;
6122 break;
6125 if (blevel < 0) {
6126 return JIM_ELESTR_QUOTE;
6129 if (level == 0) {
6130 if (!trySimple)
6131 return JIM_ELESTR_BRACE;
6132 for (i = 0; i < len; i++) {
6133 switch (s[i]) {
6134 case ' ':
6135 case '$':
6136 case '"':
6137 case '[':
6138 case ']':
6139 case ';':
6140 case '\\':
6141 case '\r':
6142 case '\n':
6143 case '\t':
6144 case '\f':
6145 case '\v':
6146 return JIM_ELESTR_BRACE;
6147 break;
6150 return JIM_ELESTR_SIMPLE;
6152 return JIM_ELESTR_QUOTE;
6155 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6156 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6157 * scenario.
6158 * Returns the length of the result.
6160 static int BackslashQuoteString(const char *s, int len, char *q)
6162 char *p = q;
6164 while (len--) {
6165 switch (*s) {
6166 case ' ':
6167 case '$':
6168 case '"':
6169 case '[':
6170 case ']':
6171 case '{':
6172 case '}':
6173 case ';':
6174 case '\\':
6175 *p++ = '\\';
6176 *p++ = *s++;
6177 break;
6178 case '\n':
6179 *p++ = '\\';
6180 *p++ = 'n';
6181 s++;
6182 break;
6183 case '\r':
6184 *p++ = '\\';
6185 *p++ = 'r';
6186 s++;
6187 break;
6188 case '\t':
6189 *p++ = '\\';
6190 *p++ = 't';
6191 s++;
6192 break;
6193 case '\f':
6194 *p++ = '\\';
6195 *p++ = 'f';
6196 s++;
6197 break;
6198 case '\v':
6199 *p++ = '\\';
6200 *p++ = 'v';
6201 s++;
6202 break;
6203 default:
6204 *p++ = *s++;
6205 break;
6208 *p = '\0';
6210 return p - q;
6213 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6215 #define STATIC_QUOTING_LEN 32
6216 int i, bufLen, realLength;
6217 const char *strRep;
6218 char *p;
6219 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6221 /* Estimate the space needed. */
6222 if (objc > STATIC_QUOTING_LEN) {
6223 quotingType = Jim_Alloc(objc);
6225 else {
6226 quotingType = staticQuoting;
6228 bufLen = 0;
6229 for (i = 0; i < objc; i++) {
6230 int len;
6232 strRep = Jim_GetString(objv[i], &len);
6233 quotingType[i] = ListElementQuotingType(strRep, len);
6234 switch (quotingType[i]) {
6235 case JIM_ELESTR_SIMPLE:
6236 if (i != 0 || strRep[0] != '#') {
6237 bufLen += len;
6238 break;
6240 /* Special case '#' on first element needs braces */
6241 quotingType[i] = JIM_ELESTR_BRACE;
6242 /* fall through */
6243 case JIM_ELESTR_BRACE:
6244 bufLen += len + 2;
6245 break;
6246 case JIM_ELESTR_QUOTE:
6247 bufLen += len * 2;
6248 break;
6250 bufLen++; /* elements separator. */
6252 bufLen++;
6254 /* Generate the string rep. */
6255 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6256 realLength = 0;
6257 for (i = 0; i < objc; i++) {
6258 int len, qlen;
6260 strRep = Jim_GetString(objv[i], &len);
6262 switch (quotingType[i]) {
6263 case JIM_ELESTR_SIMPLE:
6264 memcpy(p, strRep, len);
6265 p += len;
6266 realLength += len;
6267 break;
6268 case JIM_ELESTR_BRACE:
6269 *p++ = '{';
6270 memcpy(p, strRep, len);
6271 p += len;
6272 *p++ = '}';
6273 realLength += len + 2;
6274 break;
6275 case JIM_ELESTR_QUOTE:
6276 if (i == 0 && strRep[0] == '#') {
6277 *p++ = '\\';
6278 realLength++;
6280 qlen = BackslashQuoteString(strRep, len, p);
6281 p += qlen;
6282 realLength += qlen;
6283 break;
6285 /* Add a separating space */
6286 if (i + 1 != objc) {
6287 *p++ = ' ';
6288 realLength++;
6291 *p = '\0'; /* nul term. */
6292 objPtr->length = realLength;
6294 if (quotingType != staticQuoting) {
6295 Jim_Free(quotingType);
6299 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6301 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6304 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6306 struct JimParserCtx parser;
6307 const char *str;
6308 int strLen;
6309 Jim_Obj *fileNameObj;
6310 int linenr;
6312 if (objPtr->typePtr == &listObjType) {
6313 return JIM_OK;
6316 /* Optimise dict -> list for unshared object. Note that this may only save a little time, but
6317 * it also preserves any source location of the dict elements
6318 * which can be very useful
6320 if (Jim_IsDict(objPtr) && !Jim_IsShared(objPtr)) {
6321 Jim_Obj **listObjPtrPtr;
6322 int len;
6323 int i;
6325 listObjPtrPtr = JimDictPairs(objPtr, &len);
6326 for (i = 0; i < len; i++) {
6327 Jim_IncrRefCount(listObjPtrPtr[i]);
6330 /* Now just switch the internal rep */
6331 Jim_FreeIntRep(interp, objPtr);
6332 objPtr->typePtr = &listObjType;
6333 objPtr->internalRep.listValue.len = len;
6334 objPtr->internalRep.listValue.maxLen = len;
6335 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6337 return JIM_OK;
6340 /* Try to preserve information about filename / line number */
6341 if (objPtr->typePtr == &sourceObjType) {
6342 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6343 linenr = objPtr->internalRep.sourceValue.lineNumber;
6345 else {
6346 fileNameObj = interp->emptyObj;
6347 linenr = 1;
6349 Jim_IncrRefCount(fileNameObj);
6351 /* Get the string representation */
6352 str = Jim_GetString(objPtr, &strLen);
6354 /* Free the old internal repr just now and initialize the
6355 * new one just now. The string->list conversion can't fail. */
6356 Jim_FreeIntRep(interp, objPtr);
6357 objPtr->typePtr = &listObjType;
6358 objPtr->internalRep.listValue.len = 0;
6359 objPtr->internalRep.listValue.maxLen = 0;
6360 objPtr->internalRep.listValue.ele = NULL;
6362 /* Convert into a list */
6363 if (strLen) {
6364 JimParserInit(&parser, str, strLen, linenr);
6365 while (!parser.eof) {
6366 Jim_Obj *elementPtr;
6368 JimParseList(&parser);
6369 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6370 continue;
6371 elementPtr = JimParserGetTokenObj(interp, &parser);
6372 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6373 ListAppendElement(objPtr, elementPtr);
6376 Jim_DecrRefCount(interp, fileNameObj);
6377 return JIM_OK;
6380 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6382 Jim_Obj *objPtr;
6384 objPtr = Jim_NewObj(interp);
6385 objPtr->typePtr = &listObjType;
6386 objPtr->bytes = NULL;
6387 objPtr->internalRep.listValue.ele = NULL;
6388 objPtr->internalRep.listValue.len = 0;
6389 objPtr->internalRep.listValue.maxLen = 0;
6391 if (len) {
6392 ListInsertElements(objPtr, 0, len, elements);
6395 return objPtr;
6398 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6399 * length of the vector. Note that the user of this function should make
6400 * sure that the list object can't shimmer while the vector returned
6401 * is in use, this vector is the one stored inside the internal representation
6402 * of the list object. This function is not exported, extensions should
6403 * always access to the List object elements using Jim_ListIndex(). */
6404 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6405 Jim_Obj ***listVec)
6407 *listLen = Jim_ListLength(interp, listObj);
6408 *listVec = listObj->internalRep.listValue.ele;
6411 /* Sorting uses ints, but commands may return wide */
6412 static int JimSign(jim_wide w)
6414 if (w == 0) {
6415 return 0;
6417 else if (w < 0) {
6418 return -1;
6420 return 1;
6423 /* ListSortElements type values */
6424 struct lsort_info {
6425 jmp_buf jmpbuf;
6426 Jim_Obj *command;
6427 Jim_Interp *interp;
6428 enum {
6429 JIM_LSORT_ASCII,
6430 JIM_LSORT_NOCASE,
6431 JIM_LSORT_INTEGER,
6432 JIM_LSORT_REAL,
6433 JIM_LSORT_COMMAND
6434 } type;
6435 int order;
6436 int index;
6437 int indexed;
6438 int unique;
6439 int (*subfn)(Jim_Obj **, Jim_Obj **);
6442 static struct lsort_info *sort_info;
6444 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6446 Jim_Obj *lObj, *rObj;
6448 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6449 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6450 longjmp(sort_info->jmpbuf, JIM_ERR);
6452 return sort_info->subfn(&lObj, &rObj);
6455 /* Sort the internal rep of a list. */
6456 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6458 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6461 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6463 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6466 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6468 jim_wide lhs = 0, rhs = 0;
6470 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6471 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6472 longjmp(sort_info->jmpbuf, JIM_ERR);
6475 return JimSign(lhs - rhs) * sort_info->order;
6478 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6480 double lhs = 0, rhs = 0;
6482 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6483 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6484 longjmp(sort_info->jmpbuf, JIM_ERR);
6486 if (lhs == rhs) {
6487 return 0;
6489 if (lhs > rhs) {
6490 return sort_info->order;
6492 return -sort_info->order;
6495 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6497 Jim_Obj *compare_script;
6498 int rc;
6500 jim_wide ret = 0;
6502 /* This must be a valid list */
6503 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6504 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6505 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6507 rc = Jim_EvalObj(sort_info->interp, compare_script);
6509 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6510 longjmp(sort_info->jmpbuf, rc);
6513 return JimSign(ret) * sort_info->order;
6516 /* Remove duplicate elements from the (sorted) list in-place, according to the
6517 * comparison function, comp.
6519 * Note that the last unique value is kept, not the first
6521 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6523 int src;
6524 int dst = 0;
6525 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6527 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6528 if (comp(&ele[dst], &ele[src]) == 0) {
6529 /* Match, so replace the dest with the current source */
6530 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6532 else {
6533 /* No match, so keep the current source and move to the next destination */
6534 dst++;
6536 ele[dst] = ele[src];
6538 /* At end of list, keep the final element */
6539 ele[++dst] = ele[src];
6541 /* Set the new length */
6542 listObjPtr->internalRep.listValue.len = dst;
6545 /* Sort a list *in place*. MUST be called with non-shared objects. */
6546 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6548 struct lsort_info *prev_info;
6550 typedef int (qsort_comparator) (const void *, const void *);
6551 int (*fn) (Jim_Obj **, Jim_Obj **);
6552 Jim_Obj **vector;
6553 int len;
6554 int rc;
6556 JimPanic((Jim_IsShared(listObjPtr), "Jim_ListSortElements called with shared object"));
6557 SetListFromAny(interp, listObjPtr);
6559 /* Allow lsort to be called reentrantly */
6560 prev_info = sort_info;
6561 sort_info = info;
6563 vector = listObjPtr->internalRep.listValue.ele;
6564 len = listObjPtr->internalRep.listValue.len;
6565 switch (info->type) {
6566 case JIM_LSORT_ASCII:
6567 fn = ListSortString;
6568 break;
6569 case JIM_LSORT_NOCASE:
6570 fn = ListSortStringNoCase;
6571 break;
6572 case JIM_LSORT_INTEGER:
6573 fn = ListSortInteger;
6574 break;
6575 case JIM_LSORT_REAL:
6576 fn = ListSortReal;
6577 break;
6578 case JIM_LSORT_COMMAND:
6579 fn = ListSortCommand;
6580 break;
6581 default:
6582 fn = NULL; /* avoid warning */
6583 JimPanic((1, "ListSort called with invalid sort type"));
6586 if (info->indexed) {
6587 /* Need to interpose a "list index" function */
6588 info->subfn = fn;
6589 fn = ListSortIndexHelper;
6592 if ((rc = setjmp(info->jmpbuf)) == 0) {
6593 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6595 if (info->unique && len > 1) {
6596 ListRemoveDuplicates(listObjPtr, fn);
6599 Jim_InvalidateStringRep(listObjPtr);
6601 sort_info = prev_info;
6603 return rc;
6606 /* This is the low-level function to insert elements into a list.
6607 * The higher-level Jim_ListInsertElements() performs shared object
6608 * check and invalidate the string repr. This version is used
6609 * in the internals of the List Object and is not exported.
6611 * NOTE: this function can be called only against objects
6612 * with internal type of List.
6614 * An insertion point (idx) of -1 means end-of-list.
6616 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6618 int currentLen = listPtr->internalRep.listValue.len;
6619 int requiredLen = currentLen + elemc;
6620 int i;
6621 Jim_Obj **point;
6623 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6624 if (requiredLen < 2) {
6625 /* Don't do allocations of under 4 pointers. */
6626 requiredLen = 4;
6628 else {
6629 requiredLen *= 2;
6632 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6633 sizeof(Jim_Obj *) * requiredLen);
6635 listPtr->internalRep.listValue.maxLen = requiredLen;
6637 if (idx < 0) {
6638 idx = currentLen;
6640 point = listPtr->internalRep.listValue.ele + idx;
6641 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6642 for (i = 0; i < elemc; ++i) {
6643 point[i] = elemVec[i];
6644 Jim_IncrRefCount(point[i]);
6646 listPtr->internalRep.listValue.len += elemc;
6649 /* Convenience call to ListInsertElements() to append a single element.
6651 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6653 ListInsertElements(listPtr, -1, 1, &objPtr);
6656 /* Appends every element of appendListPtr into listPtr.
6657 * Both have to be of the list type.
6658 * Convenience call to ListInsertElements()
6660 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6662 ListInsertElements(listPtr, -1,
6663 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6666 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6668 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6669 SetListFromAny(interp, listPtr);
6670 Jim_InvalidateStringRep(listPtr);
6671 ListAppendElement(listPtr, objPtr);
6674 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6676 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6677 SetListFromAny(interp, listPtr);
6678 SetListFromAny(interp, appendListPtr);
6679 Jim_InvalidateStringRep(listPtr);
6680 ListAppendList(listPtr, appendListPtr);
6683 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6685 SetListFromAny(interp, objPtr);
6686 return objPtr->internalRep.listValue.len;
6689 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6690 int objc, Jim_Obj *const *objVec)
6692 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6693 SetListFromAny(interp, listPtr);
6694 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6695 idx = listPtr->internalRep.listValue.len;
6696 else if (idx < 0)
6697 idx = 0;
6698 Jim_InvalidateStringRep(listPtr);
6699 ListInsertElements(listPtr, idx, objc, objVec);
6702 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6704 SetListFromAny(interp, listPtr);
6705 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6706 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6707 return NULL;
6709 if (idx < 0)
6710 idx = listPtr->internalRep.listValue.len + idx;
6711 return listPtr->internalRep.listValue.ele[idx];
6714 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6716 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6717 if (*objPtrPtr == NULL) {
6718 if (flags & JIM_ERRMSG) {
6719 Jim_SetResultString(interp, "list index out of range", -1);
6721 return JIM_ERR;
6723 return JIM_OK;
6726 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6727 Jim_Obj *newObjPtr, int flags)
6729 SetListFromAny(interp, listPtr);
6730 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6731 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6732 if (flags & JIM_ERRMSG) {
6733 Jim_SetResultString(interp, "list index out of range", -1);
6735 return JIM_ERR;
6737 if (idx < 0)
6738 idx = listPtr->internalRep.listValue.len + idx;
6739 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6740 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6741 Jim_IncrRefCount(newObjPtr);
6742 return JIM_OK;
6745 /* Modify the list stored into the variable named 'varNamePtr'
6746 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6747 * with the new element 'newObjptr'. */
6748 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6749 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6751 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6752 int shared, i, idx;
6754 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6755 if (objPtr == NULL)
6756 return JIM_ERR;
6757 if ((shared = Jim_IsShared(objPtr)))
6758 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6759 for (i = 0; i < indexc - 1; i++) {
6760 listObjPtr = objPtr;
6761 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6762 goto err;
6763 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6764 goto err;
6766 if (Jim_IsShared(objPtr)) {
6767 objPtr = Jim_DuplicateObj(interp, objPtr);
6768 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6770 Jim_InvalidateStringRep(listObjPtr);
6772 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6773 goto err;
6774 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6775 goto err;
6776 Jim_InvalidateStringRep(objPtr);
6777 Jim_InvalidateStringRep(varObjPtr);
6778 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6779 goto err;
6780 Jim_SetResult(interp, varObjPtr);
6781 return JIM_OK;
6782 err:
6783 if (shared) {
6784 Jim_FreeNewObj(interp, varObjPtr);
6786 return JIM_ERR;
6789 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6791 int i;
6792 int listLen = Jim_ListLength(interp, listObjPtr);
6793 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6795 for (i = 0; i < listLen; ) {
6796 Jim_Obj *objPtr;
6798 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
6799 Jim_AppendObj(interp, resObjPtr, objPtr);
6800 if (++i != listLen) {
6801 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6804 return resObjPtr;
6807 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6809 int i;
6811 /* If all the objects in objv are lists,
6812 * it's possible to return a list as result, that's the
6813 * concatenation of all the lists. */
6814 for (i = 0; i < objc; i++) {
6815 if (!Jim_IsList(objv[i]))
6816 break;
6818 if (i == objc) {
6819 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6821 for (i = 0; i < objc; i++)
6822 ListAppendList(objPtr, objv[i]);
6823 return objPtr;
6825 else {
6826 /* Else... we have to glue strings together */
6827 int len = 0, objLen;
6828 char *bytes, *p;
6830 /* Compute the length */
6831 for (i = 0; i < objc; i++) {
6832 Jim_GetString(objv[i], &objLen);
6833 len += objLen;
6835 if (objc)
6836 len += objc - 1;
6837 /* Create the string rep, and a string object holding it. */
6838 p = bytes = Jim_Alloc(len + 1);
6839 for (i = 0; i < objc; i++) {
6840 const char *s = Jim_GetString(objv[i], &objLen);
6842 /* Remove leading space */
6843 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n')) {
6844 s++;
6845 objLen--;
6846 len--;
6848 /* And trailing space */
6849 while (objLen && (s[objLen - 1] == ' ' ||
6850 s[objLen - 1] == '\n' || s[objLen - 1] == '\t')) {
6851 /* Handle trailing backslash-space case */
6852 if (objLen > 1 && s[objLen - 2] == '\\') {
6853 break;
6855 objLen--;
6856 len--;
6858 memcpy(p, s, objLen);
6859 p += objLen;
6860 if (objLen && i + 1 != objc) {
6861 *p++ = ' ';
6863 else if (i + 1 != objc) {
6864 /* Drop the space calcuated for this
6865 * element that is instead null. */
6866 len--;
6869 *p = '\0';
6870 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6874 /* Returns a list composed of the elements in the specified range.
6875 * first and start are directly accepted as Jim_Objects and
6876 * processed for the end?-index? case. */
6877 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6878 Jim_Obj *lastObjPtr)
6880 int first, last;
6881 int len, rangeLen;
6883 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6884 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6885 return NULL;
6886 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6887 first = JimRelToAbsIndex(len, first);
6888 last = JimRelToAbsIndex(len, last);
6889 JimRelToAbsRange(len, &first, &last, &rangeLen);
6890 if (first == 0 && last == len) {
6891 return listObjPtr;
6893 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6896 /* -----------------------------------------------------------------------------
6897 * Dict object
6898 * ---------------------------------------------------------------------------*/
6899 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6900 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6901 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6902 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6904 /* Dict HashTable Type.
6906 * Keys and Values are Jim objects. */
6908 static unsigned int JimObjectHTHashFunction(const void *key)
6910 int len;
6911 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6912 return Jim_GenHashFunction((const unsigned char *)str, len);
6915 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6917 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6920 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
6922 Jim_IncrRefCount((Jim_Obj *)val);
6923 return (void *)val;
6926 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6928 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6931 static const Jim_HashTableType JimDictHashTableType = {
6932 JimObjectHTHashFunction, /* hash function */
6933 JimObjectHTKeyValDup, /* key dup */
6934 JimObjectHTKeyValDup, /* val dup */
6935 JimObjectHTKeyCompare, /* key compare */
6936 JimObjectHTKeyValDestructor, /* key destructor */
6937 JimObjectHTKeyValDestructor /* val destructor */
6940 /* Note that while the elements of the dict may contain references,
6941 * the list object itself can't. This basically means that the
6942 * dict object string representation as a whole can't contain references
6943 * that are not presents in the single elements. */
6944 static const Jim_ObjType dictObjType = {
6945 "dict",
6946 FreeDictInternalRep,
6947 DupDictInternalRep,
6948 UpdateStringOfDict,
6949 JIM_TYPE_NONE,
6952 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6954 JIM_NOTUSED(interp);
6956 Jim_FreeHashTable(objPtr->internalRep.ptr);
6957 Jim_Free(objPtr->internalRep.ptr);
6960 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6962 Jim_HashTable *ht, *dupHt;
6963 Jim_HashTableIterator htiter;
6964 Jim_HashEntry *he;
6966 /* Create a new hash table */
6967 ht = srcPtr->internalRep.ptr;
6968 dupHt = Jim_Alloc(sizeof(*dupHt));
6969 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
6970 if (ht->size != 0)
6971 Jim_ExpandHashTable(dupHt, ht->size);
6972 /* Copy every element from the source to the dup hash table */
6973 JimInitHashTableIterator(ht, &htiter);
6974 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6975 Jim_AddHashEntry(dupHt, he->key, he->u.val);
6978 dupPtr->internalRep.ptr = dupHt;
6979 dupPtr->typePtr = &dictObjType;
6982 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
6984 Jim_HashTable *ht;
6985 Jim_HashTableIterator htiter;
6986 Jim_HashEntry *he;
6987 Jim_Obj **objv;
6988 int i;
6990 ht = dictPtr->internalRep.ptr;
6992 /* Turn the hash table into a flat vector of Jim_Objects. */
6993 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
6994 JimInitHashTableIterator(ht, &htiter);
6995 i = 0;
6996 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6997 objv[i++] = (Jim_Obj *)he->key;
6998 objv[i++] = he->u.val;
7000 *len = i;
7001 return objv;
7004 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7006 /* Turn the hash table into a flat vector of Jim_Objects. */
7007 int len;
7008 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7010 JimMakeListStringRep(objPtr, objv, len);
7012 Jim_Free(objv);
7015 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7017 int listlen;
7019 if (objPtr->typePtr == &dictObjType) {
7020 return JIM_OK;
7023 /* Get the string representation. Do this first so we don't
7024 * change order in case of fast conversion to dict.
7026 Jim_String(objPtr);
7028 /* For simplicity, convert a non-list object to a list and then to a dict */
7029 listlen = Jim_ListLength(interp, objPtr);
7030 if (listlen % 2) {
7031 Jim_SetResultString(interp, "missing value to go with key", -1);
7032 return JIM_ERR;
7034 else {
7035 /* Now it is easy to convert to a dict from a list, and it can't fail */
7036 Jim_HashTable *ht;
7037 int i;
7039 ht = Jim_Alloc(sizeof(*ht));
7040 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7042 for (i = 0; i < listlen; i += 2) {
7043 Jim_Obj *keyObjPtr;
7044 Jim_Obj *valObjPtr;
7046 Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
7047 Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
7049 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7052 Jim_FreeIntRep(interp, objPtr);
7053 objPtr->typePtr = &dictObjType;
7054 objPtr->internalRep.ptr = ht;
7056 return JIM_OK;
7060 /* Dict object API */
7062 /* Add an element to a dict. objPtr must be of the "dict" type.
7063 * The higer-level exported function is Jim_DictAddElement().
7064 * If an element with the specified key already exists, the value
7065 * associated is replaced with the new one.
7067 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7068 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7069 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7071 Jim_HashTable *ht = objPtr->internalRep.ptr;
7073 if (valueObjPtr == NULL) { /* unset */
7074 return Jim_DeleteHashEntry(ht, keyObjPtr);
7076 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7077 return JIM_OK;
7080 /* Add an element, higher-level interface for DictAddElement().
7081 * If valueObjPtr == NULL, the key is removed if it exists. */
7082 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7083 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7085 int retcode;
7087 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7088 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7089 return JIM_ERR;
7091 retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7092 Jim_InvalidateStringRep(objPtr);
7093 return retcode;
7096 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7098 Jim_Obj *objPtr;
7099 int i;
7101 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7103 objPtr = Jim_NewObj(interp);
7104 objPtr->typePtr = &dictObjType;
7105 objPtr->bytes = NULL;
7106 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7107 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7108 for (i = 0; i < len; i += 2)
7109 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7110 return objPtr;
7113 /* Return the value associated to the specified dict key
7114 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7116 * Sets *objPtrPtr to non-NULL only upon success.
7118 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7119 Jim_Obj **objPtrPtr, int flags)
7121 Jim_HashEntry *he;
7122 Jim_HashTable *ht;
7124 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7125 return -1;
7127 ht = dictPtr->internalRep.ptr;
7128 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7129 if (flags & JIM_ERRMSG) {
7130 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7132 return JIM_ERR;
7134 *objPtrPtr = he->u.val;
7135 return JIM_OK;
7138 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7139 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7141 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7142 return JIM_ERR;
7144 *objPtrPtr = JimDictPairs(dictPtr, len);
7146 return JIM_OK;
7150 /* Return the value associated to the specified dict keys */
7151 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7152 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7154 int i;
7156 if (keyc == 0) {
7157 *objPtrPtr = dictPtr;
7158 return JIM_OK;
7161 for (i = 0; i < keyc; i++) {
7162 Jim_Obj *objPtr;
7164 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7165 if (rc != JIM_OK) {
7166 return rc;
7168 dictPtr = objPtr;
7170 *objPtrPtr = dictPtr;
7171 return JIM_OK;
7174 /* Modify the dict stored into the variable named 'varNamePtr'
7175 * setting the element specified by the 'keyc' keys objects in 'keyv',
7176 * with the new value of the element 'newObjPtr'.
7178 * If newObjPtr == NULL the operation is to remove the given key
7179 * from the dictionary.
7181 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7182 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7184 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7185 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7187 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7188 int shared, i;
7190 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7191 if (objPtr == NULL) {
7192 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7193 /* Cannot remove a key from non existing var */
7194 return JIM_ERR;
7196 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7197 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7198 Jim_FreeNewObj(interp, varObjPtr);
7199 return JIM_ERR;
7202 if ((shared = Jim_IsShared(objPtr)))
7203 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7204 for (i = 0; i < keyc; i++) {
7205 dictObjPtr = objPtr;
7207 /* Check if it's a valid dictionary */
7208 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7209 goto err;
7212 if (i == keyc - 1) {
7213 /* Last key: Note that error on unset with missing last key is OK */
7214 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7215 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7216 goto err;
7219 break;
7222 /* Check if the given key exists. */
7223 Jim_InvalidateStringRep(dictObjPtr);
7224 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7225 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7226 /* This key exists at the current level.
7227 * Make sure it's not shared!. */
7228 if (Jim_IsShared(objPtr)) {
7229 objPtr = Jim_DuplicateObj(interp, objPtr);
7230 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7233 else {
7234 /* Key not found. If it's an [unset] operation
7235 * this is an error. Only the last key may not
7236 * exist. */
7237 if (newObjPtr == NULL) {
7238 goto err;
7240 /* Otherwise set an empty dictionary
7241 * as key's value. */
7242 objPtr = Jim_NewDictObj(interp, NULL, 0);
7243 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7246 Jim_InvalidateStringRep(objPtr);
7247 Jim_InvalidateStringRep(varObjPtr);
7248 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7249 goto err;
7251 Jim_SetResult(interp, varObjPtr);
7252 return JIM_OK;
7253 err:
7254 if (shared) {
7255 Jim_FreeNewObj(interp, varObjPtr);
7257 return JIM_ERR;
7260 /* -----------------------------------------------------------------------------
7261 * Index object
7262 * ---------------------------------------------------------------------------*/
7263 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7264 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7266 static const Jim_ObjType indexObjType = {
7267 "index",
7268 NULL,
7269 NULL,
7270 UpdateStringOfIndex,
7271 JIM_TYPE_NONE,
7274 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7276 if (objPtr->internalRep.intValue == -1) {
7277 JimSetStringBytes(objPtr, "end");
7279 else {
7280 char buf[JIM_INTEGER_SPACE + 1];
7281 if (objPtr->internalRep.intValue >= 0) {
7282 sprintf(buf, "%d", objPtr->internalRep.intValue);
7284 else {
7285 /* Must be <= -2 */
7286 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7288 JimSetStringBytes(objPtr, buf);
7292 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7294 int idx, end = 0;
7295 const char *str;
7296 char *endptr;
7298 /* Get the string representation */
7299 str = Jim_String(objPtr);
7301 /* Try to convert into an index */
7302 if (strncmp(str, "end", 3) == 0) {
7303 end = 1;
7304 str += 3;
7305 idx = 0;
7307 else {
7308 idx = jim_strtol(str, &endptr);
7310 if (endptr == str) {
7311 goto badindex;
7313 str = endptr;
7316 /* Now str may include or +<num> or -<num> */
7317 if (*str == '+' || *str == '-') {
7318 int sign = (*str == '+' ? 1 : -1);
7320 idx += sign * jim_strtol(++str, &endptr);
7321 if (str == endptr || *endptr) {
7322 goto badindex;
7324 str = endptr;
7326 /* The only thing left should be spaces */
7327 while (isspace(UCHAR(*str))) {
7328 str++;
7330 if (*str) {
7331 goto badindex;
7333 if (end) {
7334 if (idx > 0) {
7335 idx = INT_MAX;
7337 else {
7338 /* end-1 is repesented as -2 */
7339 idx--;
7342 else if (idx < 0) {
7343 idx = -INT_MAX;
7346 /* Free the old internal repr and set the new one. */
7347 Jim_FreeIntRep(interp, objPtr);
7348 objPtr->typePtr = &indexObjType;
7349 objPtr->internalRep.intValue = idx;
7350 return JIM_OK;
7352 badindex:
7353 Jim_SetResultFormatted(interp,
7354 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7355 return JIM_ERR;
7358 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7360 /* Avoid shimmering if the object is an integer. */
7361 if (objPtr->typePtr == &intObjType) {
7362 jim_wide val = JimWideValue(objPtr);
7364 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
7365 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
7366 return JIM_OK;
7369 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7370 return JIM_ERR;
7371 *indexPtr = objPtr->internalRep.intValue;
7372 return JIM_OK;
7375 /* -----------------------------------------------------------------------------
7376 * Return Code Object.
7377 * ---------------------------------------------------------------------------*/
7379 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7380 static const char * const jimReturnCodes[] = {
7381 "ok",
7382 "error",
7383 "return",
7384 "break",
7385 "continue",
7386 "signal",
7387 "exit",
7388 "eval",
7389 NULL
7392 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7394 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
7396 static const Jim_ObjType returnCodeObjType = {
7397 "return-code",
7398 NULL,
7399 NULL,
7400 NULL,
7401 JIM_TYPE_NONE,
7404 /* Converts a (standard) return code to a string. Returns "?" for
7405 * non-standard return codes.
7407 const char *Jim_ReturnCode(int code)
7409 if (code < 0 || code >= (int)jimReturnCodesSize) {
7410 return "?";
7412 else {
7413 return jimReturnCodes[code];
7417 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7419 int returnCode;
7420 jim_wide wideValue;
7422 /* Try to convert into an integer */
7423 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7424 returnCode = (int)wideValue;
7425 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7426 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7427 return JIM_ERR;
7429 /* Free the old internal repr and set the new one. */
7430 Jim_FreeIntRep(interp, objPtr);
7431 objPtr->typePtr = &returnCodeObjType;
7432 objPtr->internalRep.intValue = returnCode;
7433 return JIM_OK;
7436 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7438 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7439 return JIM_ERR;
7440 *intPtr = objPtr->internalRep.intValue;
7441 return JIM_OK;
7444 /* -----------------------------------------------------------------------------
7445 * Expression Parsing
7446 * ---------------------------------------------------------------------------*/
7447 static int JimParseExprOperator(struct JimParserCtx *pc);
7448 static int JimParseExprNumber(struct JimParserCtx *pc);
7449 static int JimParseExprIrrational(struct JimParserCtx *pc);
7451 /* Exrp's Stack machine operators opcodes. */
7453 /* Binary operators (numbers) */
7454 enum
7456 /* Continues on from the JIM_TT_ space */
7457 /* Operations */
7458 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7459 JIM_EXPROP_DIV,
7460 JIM_EXPROP_MOD,
7461 JIM_EXPROP_SUB,
7462 JIM_EXPROP_ADD,
7463 JIM_EXPROP_LSHIFT,
7464 JIM_EXPROP_RSHIFT,
7465 JIM_EXPROP_ROTL,
7466 JIM_EXPROP_ROTR,
7467 JIM_EXPROP_LT,
7468 JIM_EXPROP_GT,
7469 JIM_EXPROP_LTE,
7470 JIM_EXPROP_GTE,
7471 JIM_EXPROP_NUMEQ,
7472 JIM_EXPROP_NUMNE,
7473 JIM_EXPROP_BITAND, /* 35 */
7474 JIM_EXPROP_BITXOR,
7475 JIM_EXPROP_BITOR,
7477 /* Note must keep these together */
7478 JIM_EXPROP_LOGICAND, /* 38 */
7479 JIM_EXPROP_LOGICAND_LEFT,
7480 JIM_EXPROP_LOGICAND_RIGHT,
7482 /* and these */
7483 JIM_EXPROP_LOGICOR, /* 41 */
7484 JIM_EXPROP_LOGICOR_LEFT,
7485 JIM_EXPROP_LOGICOR_RIGHT,
7487 /* and these */
7488 /* Ternary operators */
7489 JIM_EXPROP_TERNARY, /* 44 */
7490 JIM_EXPROP_TERNARY_LEFT,
7491 JIM_EXPROP_TERNARY_RIGHT,
7493 /* and these */
7494 JIM_EXPROP_COLON, /* 47 */
7495 JIM_EXPROP_COLON_LEFT,
7496 JIM_EXPROP_COLON_RIGHT,
7498 JIM_EXPROP_POW, /* 50 */
7500 /* Binary operators (strings) */
7501 JIM_EXPROP_STREQ, /* 51 */
7502 JIM_EXPROP_STRNE,
7503 JIM_EXPROP_STRIN,
7504 JIM_EXPROP_STRNI,
7506 /* Unary operators (numbers) */
7507 JIM_EXPROP_NOT, /* 55 */
7508 JIM_EXPROP_BITNOT,
7509 JIM_EXPROP_UNARYMINUS,
7510 JIM_EXPROP_UNARYPLUS,
7512 /* Functions */
7513 JIM_EXPROP_FUNC_FIRST, /* 59 */
7514 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7515 JIM_EXPROP_FUNC_ABS,
7516 JIM_EXPROP_FUNC_DOUBLE,
7517 JIM_EXPROP_FUNC_ROUND,
7518 JIM_EXPROP_FUNC_RAND,
7519 JIM_EXPROP_FUNC_SRAND,
7521 /* math functions from libm */
7522 JIM_EXPROP_FUNC_SIN, /* 64 */
7523 JIM_EXPROP_FUNC_COS,
7524 JIM_EXPROP_FUNC_TAN,
7525 JIM_EXPROP_FUNC_ASIN,
7526 JIM_EXPROP_FUNC_ACOS,
7527 JIM_EXPROP_FUNC_ATAN,
7528 JIM_EXPROP_FUNC_SINH,
7529 JIM_EXPROP_FUNC_COSH,
7530 JIM_EXPROP_FUNC_TANH,
7531 JIM_EXPROP_FUNC_CEIL,
7532 JIM_EXPROP_FUNC_FLOOR,
7533 JIM_EXPROP_FUNC_EXP,
7534 JIM_EXPROP_FUNC_LOG,
7535 JIM_EXPROP_FUNC_LOG10,
7536 JIM_EXPROP_FUNC_SQRT,
7537 JIM_EXPROP_FUNC_POW,
7540 struct JimExprState
7542 Jim_Obj **stack;
7543 int stacklen;
7544 int opcode;
7545 int skip;
7548 /* Operators table */
7549 typedef struct Jim_ExprOperator
7551 const char *name;
7552 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7553 unsigned char precedence;
7554 unsigned char arity;
7555 unsigned char lazy;
7556 unsigned char namelen;
7557 } Jim_ExprOperator;
7559 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7561 Jim_IncrRefCount(obj);
7562 e->stack[e->stacklen++] = obj;
7565 static Jim_Obj *ExprPop(struct JimExprState *e)
7567 return e->stack[--e->stacklen];
7570 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7572 int intresult = 0;
7573 int rc = JIM_OK;
7574 Jim_Obj *A = ExprPop(e);
7575 double dA, dC = 0;
7576 jim_wide wA, wC = 0;
7578 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7579 intresult = 1;
7581 switch (e->opcode) {
7582 case JIM_EXPROP_FUNC_INT:
7583 wC = wA;
7584 break;
7585 case JIM_EXPROP_FUNC_ROUND:
7586 wC = wA;
7587 break;
7588 case JIM_EXPROP_FUNC_DOUBLE:
7589 dC = wA;
7590 intresult = 0;
7591 break;
7592 case JIM_EXPROP_FUNC_ABS:
7593 wC = wA >= 0 ? wA : -wA;
7594 break;
7595 case JIM_EXPROP_UNARYMINUS:
7596 wC = -wA;
7597 break;
7598 case JIM_EXPROP_UNARYPLUS:
7599 wC = wA;
7600 break;
7601 case JIM_EXPROP_NOT:
7602 wC = !wA;
7603 break;
7604 default:
7605 abort();
7608 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7609 switch (e->opcode) {
7610 case JIM_EXPROP_FUNC_INT:
7611 wC = dA;
7612 intresult = 1;
7613 break;
7614 case JIM_EXPROP_FUNC_ROUND:
7615 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7616 intresult = 1;
7617 break;
7618 case JIM_EXPROP_FUNC_DOUBLE:
7619 dC = dA;
7620 break;
7621 case JIM_EXPROP_FUNC_ABS:
7622 dC = dA >= 0 ? dA : -dA;
7623 break;
7624 case JIM_EXPROP_UNARYMINUS:
7625 dC = -dA;
7626 break;
7627 case JIM_EXPROP_UNARYPLUS:
7628 dC = dA;
7629 break;
7630 case JIM_EXPROP_NOT:
7631 wC = !dA;
7632 intresult = 1;
7633 break;
7634 default:
7635 abort();
7639 if (rc == JIM_OK) {
7640 if (intresult) {
7641 ExprPush(e, Jim_NewIntObj(interp, wC));
7643 else {
7644 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7648 Jim_DecrRefCount(interp, A);
7650 return rc;
7653 static double JimRandDouble(Jim_Interp *interp)
7655 unsigned long x;
7656 JimRandomBytes(interp, &x, sizeof(x));
7658 return (double)x / (unsigned long)~0;
7661 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7663 Jim_Obj *A = ExprPop(e);
7664 jim_wide wA;
7666 int rc = Jim_GetWide(interp, A, &wA);
7667 if (rc == JIM_OK) {
7668 switch (e->opcode) {
7669 case JIM_EXPROP_BITNOT:
7670 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7671 break;
7672 case JIM_EXPROP_FUNC_SRAND:
7673 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7674 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7675 break;
7676 default:
7677 abort();
7681 Jim_DecrRefCount(interp, A);
7683 return rc;
7686 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7688 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7690 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7692 return JIM_OK;
7695 #ifdef JIM_MATH_FUNCTIONS
7696 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7698 int rc;
7699 Jim_Obj *A = ExprPop(e);
7700 double dA, dC;
7702 rc = Jim_GetDouble(interp, A, &dA);
7703 if (rc == JIM_OK) {
7704 switch (e->opcode) {
7705 case JIM_EXPROP_FUNC_SIN:
7706 dC = sin(dA);
7707 break;
7708 case JIM_EXPROP_FUNC_COS:
7709 dC = cos(dA);
7710 break;
7711 case JIM_EXPROP_FUNC_TAN:
7712 dC = tan(dA);
7713 break;
7714 case JIM_EXPROP_FUNC_ASIN:
7715 dC = asin(dA);
7716 break;
7717 case JIM_EXPROP_FUNC_ACOS:
7718 dC = acos(dA);
7719 break;
7720 case JIM_EXPROP_FUNC_ATAN:
7721 dC = atan(dA);
7722 break;
7723 case JIM_EXPROP_FUNC_SINH:
7724 dC = sinh(dA);
7725 break;
7726 case JIM_EXPROP_FUNC_COSH:
7727 dC = cosh(dA);
7728 break;
7729 case JIM_EXPROP_FUNC_TANH:
7730 dC = tanh(dA);
7731 break;
7732 case JIM_EXPROP_FUNC_CEIL:
7733 dC = ceil(dA);
7734 break;
7735 case JIM_EXPROP_FUNC_FLOOR:
7736 dC = floor(dA);
7737 break;
7738 case JIM_EXPROP_FUNC_EXP:
7739 dC = exp(dA);
7740 break;
7741 case JIM_EXPROP_FUNC_LOG:
7742 dC = log(dA);
7743 break;
7744 case JIM_EXPROP_FUNC_LOG10:
7745 dC = log10(dA);
7746 break;
7747 case JIM_EXPROP_FUNC_SQRT:
7748 dC = sqrt(dA);
7749 break;
7750 default:
7751 abort();
7753 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7756 Jim_DecrRefCount(interp, A);
7758 return rc;
7760 #endif
7762 /* A binary operation on two ints */
7763 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7765 Jim_Obj *B = ExprPop(e);
7766 Jim_Obj *A = ExprPop(e);
7767 jim_wide wA, wB;
7768 int rc = JIM_ERR;
7770 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7771 jim_wide wC;
7773 rc = JIM_OK;
7775 switch (e->opcode) {
7776 case JIM_EXPROP_LSHIFT:
7777 wC = wA << wB;
7778 break;
7779 case JIM_EXPROP_RSHIFT:
7780 wC = wA >> wB;
7781 break;
7782 case JIM_EXPROP_BITAND:
7783 wC = wA & wB;
7784 break;
7785 case JIM_EXPROP_BITXOR:
7786 wC = wA ^ wB;
7787 break;
7788 case JIM_EXPROP_BITOR:
7789 wC = wA | wB;
7790 break;
7791 case JIM_EXPROP_MOD:
7792 if (wB == 0) {
7793 wC = 0;
7794 Jim_SetResultString(interp, "Division by zero", -1);
7795 rc = JIM_ERR;
7797 else {
7799 * From Tcl 8.x
7801 * This code is tricky: C doesn't guarantee much
7802 * about the quotient or remainder, but Tcl does.
7803 * The remainder always has the same sign as the
7804 * divisor and a smaller absolute value.
7806 int negative = 0;
7808 if (wB < 0) {
7809 wB = -wB;
7810 wA = -wA;
7811 negative = 1;
7813 wC = wA % wB;
7814 if (wC < 0) {
7815 wC += wB;
7817 if (negative) {
7818 wC = -wC;
7821 break;
7822 case JIM_EXPROP_ROTL:
7823 case JIM_EXPROP_ROTR:{
7824 /* uint32_t would be better. But not everyone has inttypes.h? */
7825 unsigned long uA = (unsigned long)wA;
7826 unsigned long uB = (unsigned long)wB;
7827 const unsigned int S = sizeof(unsigned long) * 8;
7829 /* Shift left by the word size or more is undefined. */
7830 uB %= S;
7832 if (e->opcode == JIM_EXPROP_ROTR) {
7833 uB = S - uB;
7835 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7836 break;
7838 default:
7839 abort();
7841 ExprPush(e, Jim_NewIntObj(interp, wC));
7845 Jim_DecrRefCount(interp, A);
7846 Jim_DecrRefCount(interp, B);
7848 return rc;
7852 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7853 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7855 int intresult = 0;
7856 int rc = JIM_OK;
7857 double dA, dB, dC = 0;
7858 jim_wide wA, wB, wC = 0;
7860 Jim_Obj *B = ExprPop(e);
7861 Jim_Obj *A = ExprPop(e);
7863 if ((A->typePtr != &doubleObjType || A->bytes) &&
7864 (B->typePtr != &doubleObjType || B->bytes) &&
7865 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7867 /* Both are ints */
7869 intresult = 1;
7871 switch (e->opcode) {
7872 case JIM_EXPROP_POW:
7873 case JIM_EXPROP_FUNC_POW:
7874 wC = JimPowWide(wA, wB);
7875 break;
7876 case JIM_EXPROP_ADD:
7877 wC = wA + wB;
7878 break;
7879 case JIM_EXPROP_SUB:
7880 wC = wA - wB;
7881 break;
7882 case JIM_EXPROP_MUL:
7883 wC = wA * wB;
7884 break;
7885 case JIM_EXPROP_DIV:
7886 if (wB == 0) {
7887 Jim_SetResultString(interp, "Division by zero", -1);
7888 rc = JIM_ERR;
7890 else {
7892 * From Tcl 8.x
7894 * This code is tricky: C doesn't guarantee much
7895 * about the quotient or remainder, but Tcl does.
7896 * The remainder always has the same sign as the
7897 * divisor and a smaller absolute value.
7899 if (wB < 0) {
7900 wB = -wB;
7901 wA = -wA;
7903 wC = wA / wB;
7904 if (wA % wB < 0) {
7905 wC--;
7908 break;
7909 case JIM_EXPROP_LT:
7910 wC = wA < wB;
7911 break;
7912 case JIM_EXPROP_GT:
7913 wC = wA > wB;
7914 break;
7915 case JIM_EXPROP_LTE:
7916 wC = wA <= wB;
7917 break;
7918 case JIM_EXPROP_GTE:
7919 wC = wA >= wB;
7920 break;
7921 case JIM_EXPROP_NUMEQ:
7922 wC = wA == wB;
7923 break;
7924 case JIM_EXPROP_NUMNE:
7925 wC = wA != wB;
7926 break;
7927 default:
7928 abort();
7931 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7932 switch (e->opcode) {
7933 case JIM_EXPROP_POW:
7934 case JIM_EXPROP_FUNC_POW:
7935 #ifdef JIM_MATH_FUNCTIONS
7936 dC = pow(dA, dB);
7937 #else
7938 Jim_SetResultString(interp, "unsupported", -1);
7939 rc = JIM_ERR;
7940 #endif
7941 break;
7942 case JIM_EXPROP_ADD:
7943 dC = dA + dB;
7944 break;
7945 case JIM_EXPROP_SUB:
7946 dC = dA - dB;
7947 break;
7948 case JIM_EXPROP_MUL:
7949 dC = dA * dB;
7950 break;
7951 case JIM_EXPROP_DIV:
7952 if (dB == 0) {
7953 #ifdef INFINITY
7954 dC = dA < 0 ? -INFINITY : INFINITY;
7955 #else
7956 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7957 #endif
7959 else {
7960 dC = dA / dB;
7962 break;
7963 case JIM_EXPROP_LT:
7964 wC = dA < dB;
7965 intresult = 1;
7966 break;
7967 case JIM_EXPROP_GT:
7968 wC = dA > dB;
7969 intresult = 1;
7970 break;
7971 case JIM_EXPROP_LTE:
7972 wC = dA <= dB;
7973 intresult = 1;
7974 break;
7975 case JIM_EXPROP_GTE:
7976 wC = dA >= dB;
7977 intresult = 1;
7978 break;
7979 case JIM_EXPROP_NUMEQ:
7980 wC = dA == dB;
7981 intresult = 1;
7982 break;
7983 case JIM_EXPROP_NUMNE:
7984 wC = dA != dB;
7985 intresult = 1;
7986 break;
7987 default:
7988 abort();
7991 else {
7992 /* Handle the string case */
7994 /* REVISIT: Could optimise the eq/ne case by checking lengths */
7995 int i = Jim_StringCompareObj(interp, A, B, 0);
7997 intresult = 1;
7999 switch (e->opcode) {
8000 case JIM_EXPROP_LT:
8001 wC = i < 0;
8002 break;
8003 case JIM_EXPROP_GT:
8004 wC = i > 0;
8005 break;
8006 case JIM_EXPROP_LTE:
8007 wC = i <= 0;
8008 break;
8009 case JIM_EXPROP_GTE:
8010 wC = i >= 0;
8011 break;
8012 case JIM_EXPROP_NUMEQ:
8013 wC = i == 0;
8014 break;
8015 case JIM_EXPROP_NUMNE:
8016 wC = i != 0;
8017 break;
8018 default:
8019 rc = JIM_ERR;
8020 break;
8024 if (rc == JIM_OK) {
8025 if (intresult) {
8026 ExprPush(e, Jim_NewIntObj(interp, wC));
8028 else {
8029 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8033 Jim_DecrRefCount(interp, A);
8034 Jim_DecrRefCount(interp, B);
8036 return rc;
8039 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8041 int listlen;
8042 int i;
8044 listlen = Jim_ListLength(interp, listObjPtr);
8045 for (i = 0; i < listlen; i++) {
8046 Jim_Obj *objPtr;
8048 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
8050 if (Jim_StringEqObj(objPtr, valObj)) {
8051 return 1;
8054 return 0;
8057 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8059 Jim_Obj *B = ExprPop(e);
8060 Jim_Obj *A = ExprPop(e);
8062 jim_wide wC;
8064 switch (e->opcode) {
8065 case JIM_EXPROP_STREQ:
8066 case JIM_EXPROP_STRNE:
8067 wC = Jim_StringEqObj(A, B);
8068 if (e->opcode == JIM_EXPROP_STRNE) {
8069 wC = !wC;
8071 break;
8072 case JIM_EXPROP_STRIN:
8073 wC = JimSearchList(interp, B, A);
8074 break;
8075 case JIM_EXPROP_STRNI:
8076 wC = !JimSearchList(interp, B, A);
8077 break;
8078 default:
8079 abort();
8081 ExprPush(e, Jim_NewIntObj(interp, wC));
8083 Jim_DecrRefCount(interp, A);
8084 Jim_DecrRefCount(interp, B);
8086 return JIM_OK;
8089 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8091 long l;
8092 double d;
8094 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8095 return l != 0;
8097 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8098 return d != 0;
8100 return -1;
8103 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8105 Jim_Obj *skip = ExprPop(e);
8106 Jim_Obj *A = ExprPop(e);
8107 int rc = JIM_OK;
8109 switch (ExprBool(interp, A)) {
8110 case 0:
8111 /* false, so skip RHS opcodes with a 0 result */
8112 e->skip = JimWideValue(skip);
8113 ExprPush(e, Jim_NewIntObj(interp, 0));
8114 break;
8116 case 1:
8117 /* true so continue */
8118 break;
8120 case -1:
8121 /* Invalid */
8122 rc = JIM_ERR;
8124 Jim_DecrRefCount(interp, A);
8125 Jim_DecrRefCount(interp, skip);
8127 return rc;
8130 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8132 Jim_Obj *skip = ExprPop(e);
8133 Jim_Obj *A = ExprPop(e);
8134 int rc = JIM_OK;
8136 switch (ExprBool(interp, A)) {
8137 case 0:
8138 /* false, so do nothing */
8139 break;
8141 case 1:
8142 /* true so skip RHS opcodes with a 1 result */
8143 e->skip = JimWideValue(skip);
8144 ExprPush(e, Jim_NewIntObj(interp, 1));
8145 break;
8147 case -1:
8148 /* Invalid */
8149 rc = JIM_ERR;
8150 break;
8152 Jim_DecrRefCount(interp, A);
8153 Jim_DecrRefCount(interp, skip);
8155 return rc;
8158 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8160 Jim_Obj *A = ExprPop(e);
8161 int rc = JIM_OK;
8163 switch (ExprBool(interp, A)) {
8164 case 0:
8165 ExprPush(e, Jim_NewIntObj(interp, 0));
8166 break;
8168 case 1:
8169 ExprPush(e, Jim_NewIntObj(interp, 1));
8170 break;
8172 case -1:
8173 /* Invalid */
8174 rc = JIM_ERR;
8175 break;
8177 Jim_DecrRefCount(interp, A);
8179 return rc;
8182 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8184 Jim_Obj *skip = ExprPop(e);
8185 Jim_Obj *A = ExprPop(e);
8186 int rc = JIM_OK;
8188 /* Repush A */
8189 ExprPush(e, A);
8191 switch (ExprBool(interp, A)) {
8192 case 0:
8193 /* false, skip RHS opcodes */
8194 e->skip = JimWideValue(skip);
8195 /* Push a dummy value */
8196 ExprPush(e, Jim_NewIntObj(interp, 0));
8197 break;
8199 case 1:
8200 /* true so do nothing */
8201 break;
8203 case -1:
8204 /* Invalid */
8205 rc = JIM_ERR;
8206 break;
8208 Jim_DecrRefCount(interp, A);
8209 Jim_DecrRefCount(interp, skip);
8211 return rc;
8214 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8216 Jim_Obj *skip = ExprPop(e);
8217 Jim_Obj *B = ExprPop(e);
8218 Jim_Obj *A = ExprPop(e);
8220 /* No need to check for A as non-boolean */
8221 if (ExprBool(interp, A)) {
8222 /* true, so skip RHS opcodes */
8223 e->skip = JimWideValue(skip);
8224 /* Repush B as the answer */
8225 ExprPush(e, B);
8228 Jim_DecrRefCount(interp, skip);
8229 Jim_DecrRefCount(interp, A);
8230 Jim_DecrRefCount(interp, B);
8231 return JIM_OK;
8234 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8236 return JIM_OK;
8239 enum
8241 LAZY_NONE,
8242 LAZY_OP,
8243 LAZY_LEFT,
8244 LAZY_RIGHT
8247 /* name - precedence - arity - opcode
8249 * This array *must* be kept in sync with the JIM_EXPROP enum.
8251 * The following macro pre-computes the string length at compile time.
8253 #define OPRINIT(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8255 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8256 OPRINIT("*", 110, 2, JimExprOpBin, LAZY_NONE),
8257 OPRINIT("/", 110, 2, JimExprOpBin, LAZY_NONE),
8258 OPRINIT("%", 110, 2, JimExprOpIntBin, LAZY_NONE),
8260 OPRINIT("-", 100, 2, JimExprOpBin, LAZY_NONE),
8261 OPRINIT("+", 100, 2, JimExprOpBin, LAZY_NONE),
8263 OPRINIT("<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8264 OPRINIT(">>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8266 OPRINIT("<<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8267 OPRINIT(">>>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8269 OPRINIT("<", 80, 2, JimExprOpBin, LAZY_NONE),
8270 OPRINIT(">", 80, 2, JimExprOpBin, LAZY_NONE),
8271 OPRINIT("<=", 80, 2, JimExprOpBin, LAZY_NONE),
8272 OPRINIT(">=", 80, 2, JimExprOpBin, LAZY_NONE),
8274 OPRINIT("==", 70, 2, JimExprOpBin, LAZY_NONE),
8275 OPRINIT("!=", 70, 2, JimExprOpBin, LAZY_NONE),
8277 OPRINIT("&", 50, 2, JimExprOpIntBin, LAZY_NONE),
8278 OPRINIT("^", 49, 2, JimExprOpIntBin, LAZY_NONE),
8279 OPRINIT("|", 48, 2, JimExprOpIntBin, LAZY_NONE),
8281 OPRINIT("&&", 10, 2, NULL, LAZY_OP),
8282 OPRINIT(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8283 OPRINIT(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8285 OPRINIT("||", 9, 2, NULL, LAZY_OP),
8286 OPRINIT(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8287 OPRINIT(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8289 OPRINIT("?", 5, 2, JimExprOpNull, LAZY_OP),
8290 OPRINIT(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8291 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8293 OPRINIT(":", 5, 2, JimExprOpNull, LAZY_OP),
8294 OPRINIT(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8295 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8297 OPRINIT("**", 250, 2, JimExprOpBin, LAZY_NONE),
8299 OPRINIT("eq", 60, 2, JimExprOpStrBin, LAZY_NONE),
8300 OPRINIT("ne", 60, 2, JimExprOpStrBin, LAZY_NONE),
8302 OPRINIT("in", 55, 2, JimExprOpStrBin, LAZY_NONE),
8303 OPRINIT("ni", 55, 2, JimExprOpStrBin, LAZY_NONE),
8305 OPRINIT("!", 150, 1, JimExprOpNumUnary, LAZY_NONE),
8306 OPRINIT("~", 150, 1, JimExprOpIntUnary, LAZY_NONE),
8307 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8308 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8312 OPRINIT("int", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8313 OPRINIT("abs", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8314 OPRINIT("double", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8315 OPRINIT("round", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8316 OPRINIT("rand", 200, 0, JimExprOpNone, LAZY_NONE),
8317 OPRINIT("srand", 200, 1, JimExprOpIntUnary, LAZY_NONE),
8319 #ifdef JIM_MATH_FUNCTIONS
8320 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8321 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8322 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8323 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8324 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8325 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8326 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8327 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8328 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8329 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8330 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8331 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8332 OPRINIT("log", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8333 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8334 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8335 OPRINIT("pow", 200, 2, JimExprOpBin, LAZY_NONE),
8336 #endif
8338 #undef OPRINIT
8340 #define JIM_EXPR_OPERATORS_NUM \
8341 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8343 static int JimParseExpression(struct JimParserCtx *pc)
8345 /* Discard spaces and quoted newline */
8346 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8347 if (*pc->p == '\n') {
8348 pc->linenr++;
8350 pc->p++;
8351 pc->len--;
8354 /* Common case */
8355 pc->tline = pc->linenr;
8356 pc->tstart = pc->p;
8358 if (pc->len == 0) {
8359 pc->tend = pc->p;
8360 pc->tt = JIM_TT_EOL;
8361 pc->eof = 1;
8362 return JIM_OK;
8364 switch (*(pc->p)) {
8365 case '(':
8366 pc->tt = JIM_TT_SUBEXPR_START;
8367 goto singlechar;
8368 case ')':
8369 pc->tt = JIM_TT_SUBEXPR_END;
8370 goto singlechar;
8371 case ',':
8372 pc->tt = JIM_TT_SUBEXPR_COMMA;
8373 singlechar:
8374 pc->tend = pc->p;
8375 pc->p++;
8376 pc->len--;
8377 break;
8378 case '[':
8379 return JimParseCmd(pc);
8380 case '$':
8381 if (JimParseVar(pc) == JIM_ERR)
8382 return JimParseExprOperator(pc);
8383 else {
8384 /* Don't allow expr sugar in expressions */
8385 if (pc->tt == JIM_TT_EXPRSUGAR) {
8386 return JIM_ERR;
8388 return JIM_OK;
8390 break;
8391 case '0':
8392 case '1':
8393 case '2':
8394 case '3':
8395 case '4':
8396 case '5':
8397 case '6':
8398 case '7':
8399 case '8':
8400 case '9':
8401 case '.':
8402 return JimParseExprNumber(pc);
8403 case '"':
8404 return JimParseQuote(pc);
8405 case '{':
8406 return JimParseBrace(pc);
8408 case 'N':
8409 case 'I':
8410 case 'n':
8411 case 'i':
8412 if (JimParseExprIrrational(pc) == JIM_ERR)
8413 return JimParseExprOperator(pc);
8414 break;
8415 default:
8416 return JimParseExprOperator(pc);
8417 break;
8419 return JIM_OK;
8422 static int JimParseExprNumber(struct JimParserCtx *pc)
8424 char *end;
8426 /* Assume an integer for now */
8427 pc->tt = JIM_TT_EXPR_INT;
8429 jim_strtoull(pc->p, (char **)&pc->p);
8430 /* Tried as an integer, but perhaps it parses as a double */
8431 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8432 /* Some stupid compilers insist they are cleverer that
8433 * we are. Even a (void) cast doesn't prevent this warning!
8435 if (strtod(pc->tstart, &end)) { /* nothing */ }
8436 if (end == pc->tstart)
8437 return JIM_ERR;
8438 if (end > pc->p) {
8439 /* Yes, double captured more chars */
8440 pc->tt = JIM_TT_EXPR_DOUBLE;
8441 pc->p = end;
8444 pc->tend = pc->p - 1;
8445 pc->len -= (pc->p - pc->tstart);
8446 return JIM_OK;
8449 static int JimParseExprIrrational(struct JimParserCtx *pc)
8451 const char *Tokens[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8452 const char **token;
8454 for (token = Tokens; *token != NULL; token++) {
8455 int len = strlen(*token);
8457 if (strncmp(*token, pc->p, len) == 0) {
8458 pc->tend = pc->p + len - 1;
8459 pc->p += len;
8460 pc->len -= len;
8461 pc->tt = JIM_TT_EXPR_DOUBLE;
8462 return JIM_OK;
8465 return JIM_ERR;
8468 static int JimParseExprOperator(struct JimParserCtx *pc)
8470 int i;
8471 int bestIdx = -1, bestLen = 0;
8473 /* Try to get the longest match. */
8474 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8475 const char * const opname = Jim_ExprOperators[i].name;
8476 const int oplen = Jim_ExprOperators[i].namelen;
8478 if (opname == NULL || opname[0] != pc->p[0]) {
8479 continue;
8482 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8483 bestIdx = i + JIM_TT_EXPR_OP;
8484 bestLen = oplen;
8487 if (bestIdx == -1) {
8488 return JIM_ERR;
8491 /* Validate paretheses around function arguments */
8492 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8493 const char *p = pc->p + bestLen;
8494 int len = pc->len - bestLen;
8496 while (len && isspace(UCHAR(*p))) {
8497 len--;
8498 p++;
8500 if (*p != '(') {
8501 return JIM_ERR;
8504 pc->tend = pc->p + bestLen - 1;
8505 pc->p += bestLen;
8506 pc->len -= bestLen;
8508 pc->tt = bestIdx;
8509 return JIM_OK;
8512 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8514 static Jim_ExprOperator dummy_op;
8515 if (opcode < JIM_TT_EXPR_OP) {
8516 return &dummy_op;
8518 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8521 const char *jim_tt_name(int type)
8523 static const char * const tt_names[JIM_TT_EXPR_OP] =
8524 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8525 "DBL", "$()" };
8526 if (type < JIM_TT_EXPR_OP) {
8527 return tt_names[type];
8529 else {
8530 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8531 static char buf[20];
8533 if (op->name) {
8534 return op->name;
8536 sprintf(buf, "(%d)", type);
8537 return buf;
8541 /* -----------------------------------------------------------------------------
8542 * Expression Object
8543 * ---------------------------------------------------------------------------*/
8544 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8545 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8546 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8548 static const Jim_ObjType exprObjType = {
8549 "expression",
8550 FreeExprInternalRep,
8551 DupExprInternalRep,
8552 NULL,
8553 JIM_TYPE_REFERENCES,
8556 /* Expr bytecode structure */
8557 typedef struct ExprByteCode
8559 ScriptToken *token; /* Tokens array. */
8560 int len; /* Length as number of tokens. */
8561 int inUse; /* Used for sharing. */
8562 } ExprByteCode;
8564 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8566 int i;
8568 for (i = 0; i < expr->len; i++) {
8569 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8571 Jim_Free(expr->token);
8572 Jim_Free(expr);
8575 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8577 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8579 if (expr) {
8580 if (--expr->inUse != 0) {
8581 return;
8584 ExprFreeByteCode(interp, expr);
8588 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8590 JIM_NOTUSED(interp);
8591 JIM_NOTUSED(srcPtr);
8593 /* Just returns an simple string. */
8594 dupPtr->typePtr = NULL;
8597 /* Check if an expr program looks correct. */
8598 static int ExprCheckCorrectness(ExprByteCode * expr)
8600 int i;
8601 int stacklen = 0;
8602 int ternary = 0;
8604 /* Try to check if there are stack underflows,
8605 * and make sure at the end of the program there is
8606 * a single result on the stack. */
8607 for (i = 0; i < expr->len; i++) {
8608 ScriptToken *t = &expr->token[i];
8609 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8611 stacklen -= op->arity;
8612 if (stacklen < 0) {
8613 break;
8615 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8616 ternary++;
8618 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8619 ternary--;
8622 /* All operations and operands add one to the stack */
8623 stacklen++;
8625 if (stacklen != 1 || ternary != 0) {
8626 return JIM_ERR;
8628 return JIM_OK;
8631 /* This procedure converts every occurrence of || and && opereators
8632 * in lazy unary versions.
8634 * a b || is converted into:
8636 * a <offset> |L b |R
8638 * a b && is converted into:
8640 * a <offset> &L b &R
8642 * "|L" checks if 'a' is true:
8643 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8644 * the opcode just after |R.
8645 * 2) if it is false does nothing.
8646 * "|R" checks if 'b' is true:
8647 * 1) if it is true pushes 1, otherwise pushes 0.
8649 * "&L" checks if 'a' is true:
8650 * 1) if it is true does nothing.
8651 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8652 * the opcode just after &R
8653 * "&R" checks if 'a' is true:
8654 * if it is true pushes 1, otherwise pushes 0.
8656 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8658 int i;
8660 int leftindex, arity, offset;
8662 /* Search for the end of the first operator */
8663 leftindex = expr->len - 1;
8665 arity = 1;
8666 while (arity) {
8667 ScriptToken *tt = &expr->token[leftindex];
8669 if (tt->type >= JIM_TT_EXPR_OP) {
8670 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8672 arity--;
8673 if (--leftindex < 0) {
8674 return JIM_ERR;
8677 leftindex++;
8679 /* Move them up */
8680 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8681 sizeof(*expr->token) * (expr->len - leftindex));
8682 expr->len += 2;
8683 offset = (expr->len - leftindex) - 1;
8685 /* Now we rely on the fact the the left and right version have opcodes
8686 * 1 and 2 after the main opcode respectively
8688 expr->token[leftindex + 1].type = t->type + 1;
8689 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8691 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8692 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8694 /* Now add the 'R' operator */
8695 expr->token[expr->len].objPtr = interp->emptyObj;
8696 expr->token[expr->len].type = t->type + 2;
8697 expr->len++;
8699 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8700 for (i = leftindex - 1; i > 0; i--) {
8701 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8702 if (op->lazy == LAZY_LEFT) {
8703 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8704 JimWideValue(expr->token[i - 1].objPtr) += 2;
8708 return JIM_OK;
8711 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8713 struct ScriptToken *token = &expr->token[expr->len];
8714 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8716 if (op->lazy == LAZY_OP) {
8717 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8718 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8719 return JIM_ERR;
8722 else {
8723 token->objPtr = interp->emptyObj;
8724 token->type = t->type;
8725 expr->len++;
8727 return JIM_OK;
8731 * Returns the index of the COLON_LEFT to the left of 'right_index'
8732 * taking into account nesting.
8734 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8736 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8738 int ternary_count = 1;
8740 right_index--;
8742 while (right_index > 1) {
8743 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8744 ternary_count--;
8746 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8747 ternary_count++;
8749 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8750 return right_index;
8752 right_index--;
8755 /*notreached*/
8756 return -1;
8760 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8762 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8763 * Otherwise returns 0.
8765 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8767 int i = right_index - 1;
8768 int ternary_count = 1;
8770 while (i > 1) {
8771 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8772 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8773 *prev_right_index = i - 2;
8774 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8775 return 1;
8778 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8779 if (ternary_count == 0) {
8780 return 0;
8782 ternary_count++;
8784 i--;
8786 return 0;
8790 * ExprTernaryReorderExpression description
8791 * ========================================
8793 * ?: is right-to-left associative which doesn't work with the stack-based
8794 * expression engine. The fix is to reorder the bytecode.
8796 * The expression:
8798 * expr 1?2:0?3:4
8800 * Has initial bytecode:
8802 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8803 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8805 * The fix involves simulating this expression instead:
8807 * expr 1?2:(0?3:4)
8809 * With the following bytecode:
8811 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8812 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8814 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8815 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8816 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8817 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8819 * ExprTernaryReorderExpression works thus as follows :
8820 * - start from the end of the stack
8821 * - while walking towards the beginning of the stack
8822 * if token=JIM_EXPROP_COLON_RIGHT then
8823 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8824 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8825 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8826 * if all found then
8827 * perform the rotation
8828 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8829 * end if
8830 * end if
8832 * Note: care has to be taken for nested ternary constructs!!!
8834 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8836 int i;
8838 for (i = expr->len - 1; i > 1; i--) {
8839 int prev_right_index;
8840 int prev_left_index;
8841 int j;
8842 ScriptToken tmp;
8844 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8845 continue;
8848 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8849 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8850 continue;
8854 ** rotate tokens down
8856 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8857 ** | | |
8858 ** | V V
8859 ** | [...] : ...
8860 ** | | |
8861 ** | V V
8862 ** | [...] : ...
8863 ** | | |
8864 ** | V V
8865 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8867 tmp = expr->token[prev_right_index];
8868 for (j = prev_right_index; j < i; j++) {
8869 expr->token[j] = expr->token[j + 1];
8871 expr->token[i] = tmp;
8873 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8875 * This is 'colon left increment' = i - prev_right_index
8877 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8878 * [prev_left_index-1] : skip_count
8881 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8883 /* Adjust for i-- in the loop */
8884 i++;
8888 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8890 Jim_Stack stack;
8891 ExprByteCode *expr;
8892 int ok = 1;
8893 int i;
8894 int prevtt = JIM_TT_NONE;
8895 int have_ternary = 0;
8897 /* -1 for EOL */
8898 int count = tokenlist->count - 1;
8900 expr = Jim_Alloc(sizeof(*expr));
8901 expr->inUse = 1;
8902 expr->len = 0;
8904 Jim_InitStack(&stack);
8906 /* Need extra bytecodes for lazy operators.
8907 * Also check for the ternary operator
8909 for (i = 0; i < tokenlist->count; i++) {
8910 ParseToken *t = &tokenlist->list[i];
8911 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8913 if (op->lazy == LAZY_OP) {
8914 count += 2;
8915 /* Ternary is a lazy op but also needs reordering */
8916 if (t->type == JIM_EXPROP_TERNARY) {
8917 have_ternary = 1;
8922 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8924 for (i = 0; i < tokenlist->count && ok; i++) {
8925 ParseToken *t = &tokenlist->list[i];
8927 /* Next token will be stored here */
8928 struct ScriptToken *token = &expr->token[expr->len];
8930 if (t->type == JIM_TT_EOL) {
8931 break;
8934 switch (t->type) {
8935 case JIM_TT_STR:
8936 case JIM_TT_ESC:
8937 case JIM_TT_VAR:
8938 case JIM_TT_DICTSUGAR:
8939 case JIM_TT_EXPRSUGAR:
8940 case JIM_TT_CMD:
8941 token->type = t->type;
8942 strexpr:
8943 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8944 if (t->type == JIM_TT_CMD) {
8945 /* Only commands need source info */
8946 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8948 expr->len++;
8949 break;
8951 case JIM_TT_EXPR_INT:
8952 case JIM_TT_EXPR_DOUBLE:
8954 char *endptr;
8955 if (t->type == JIM_TT_EXPR_INT) {
8956 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8958 else {
8959 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8961 if (endptr != t->token + t->len) {
8962 /* Conversion failed, so just store it as a string */
8963 Jim_FreeNewObj(interp, token->objPtr);
8964 token->type = JIM_TT_STR;
8965 goto strexpr;
8967 token->type = t->type;
8968 expr->len++;
8970 break;
8972 case JIM_TT_SUBEXPR_START:
8973 Jim_StackPush(&stack, t);
8974 prevtt = JIM_TT_NONE;
8975 continue;
8977 case JIM_TT_SUBEXPR_COMMA:
8978 /* Simple approach. Comma is simply ignored */
8979 continue;
8981 case JIM_TT_SUBEXPR_END:
8982 ok = 0;
8983 while (Jim_StackLen(&stack)) {
8984 ParseToken *tt = Jim_StackPop(&stack);
8986 if (tt->type == JIM_TT_SUBEXPR_START) {
8987 ok = 1;
8988 break;
8991 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8992 goto err;
8995 if (!ok) {
8996 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
8997 goto err;
8999 break;
9002 default:{
9003 /* Must be an operator */
9004 const struct Jim_ExprOperator *op;
9005 ParseToken *tt;
9007 /* Convert -/+ to unary minus or unary plus if necessary */
9008 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9009 if (t->type == JIM_EXPROP_SUB) {
9010 t->type = JIM_EXPROP_UNARYMINUS;
9012 else if (t->type == JIM_EXPROP_ADD) {
9013 t->type = JIM_EXPROP_UNARYPLUS;
9017 op = JimExprOperatorInfoByOpcode(t->type);
9019 /* Now handle precedence */
9020 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9021 const struct Jim_ExprOperator *tt_op =
9022 JimExprOperatorInfoByOpcode(tt->type);
9024 /* Note that right-to-left associativity of ?: operator is handled later */
9026 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9027 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9028 ok = 0;
9029 goto err;
9031 Jim_StackPop(&stack);
9033 else {
9034 break;
9037 Jim_StackPush(&stack, t);
9038 break;
9041 prevtt = t->type;
9044 /* Reduce any remaining subexpr */
9045 while (Jim_StackLen(&stack)) {
9046 ParseToken *tt = Jim_StackPop(&stack);
9048 if (tt->type == JIM_TT_SUBEXPR_START) {
9049 ok = 0;
9050 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9051 goto err;
9053 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9054 ok = 0;
9055 goto err;
9059 if (have_ternary) {
9060 ExprTernaryReorderExpression(interp, expr);
9063 err:
9064 /* Free the stack used for the compilation. */
9065 Jim_FreeStack(&stack);
9067 for (i = 0; i < expr->len; i++) {
9068 Jim_IncrRefCount(expr->token[i].objPtr);
9071 if (!ok) {
9072 ExprFreeByteCode(interp, expr);
9073 return NULL;
9076 return expr;
9080 /* This method takes the string representation of an expression
9081 * and generates a program for the Expr's stack-based VM. */
9082 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9084 int exprTextLen;
9085 const char *exprText;
9086 struct JimParserCtx parser;
9087 struct ExprByteCode *expr;
9088 ParseTokenList tokenlist;
9089 int line;
9090 Jim_Obj *fileNameObj;
9091 int rc = JIM_ERR;
9093 /* Try to get information about filename / line number */
9094 if (objPtr->typePtr == &sourceObjType) {
9095 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9096 line = objPtr->internalRep.sourceValue.lineNumber;
9098 else {
9099 fileNameObj = interp->emptyObj;
9100 line = 1;
9102 Jim_IncrRefCount(fileNameObj);
9104 exprText = Jim_GetString(objPtr, &exprTextLen);
9106 /* Initially tokenise the expression into tokenlist */
9107 ScriptTokenListInit(&tokenlist);
9109 JimParserInit(&parser, exprText, exprTextLen, line);
9110 while (!parser.eof) {
9111 if (JimParseExpression(&parser) != JIM_OK) {
9112 ScriptTokenListFree(&tokenlist);
9113 invalidexpr:
9114 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9115 expr = NULL;
9116 goto err;
9119 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9120 parser.tline);
9123 #ifdef DEBUG_SHOW_EXPR_TOKENS
9125 int i;
9126 printf("==== Expr Tokens ====\n");
9127 for (i = 0; i < tokenlist.count; i++) {
9128 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9129 tokenlist.list[i].len, tokenlist.list[i].token);
9132 #endif
9134 /* Now create the expression bytecode from the tokenlist */
9135 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9137 /* No longer need the token list */
9138 ScriptTokenListFree(&tokenlist);
9140 if (!expr) {
9141 goto err;
9144 #ifdef DEBUG_SHOW_EXPR
9146 int i;
9148 printf("==== Expr ====\n");
9149 for (i = 0; i < expr->len; i++) {
9150 ScriptToken *t = &expr->token[i];
9152 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9155 #endif
9157 /* Check program correctness. */
9158 if (ExprCheckCorrectness(expr) != JIM_OK) {
9159 ExprFreeByteCode(interp, expr);
9160 goto invalidexpr;
9163 rc = JIM_OK;
9165 err:
9166 /* Free the old internal rep and set the new one. */
9167 Jim_DecrRefCount(interp, fileNameObj);
9168 Jim_FreeIntRep(interp, objPtr);
9169 Jim_SetIntRepPtr(objPtr, expr);
9170 objPtr->typePtr = &exprObjType;
9171 return rc;
9174 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9176 if (objPtr->typePtr != &exprObjType) {
9177 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9178 return NULL;
9181 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9184 #ifdef JIM_OPTIMIZATION
9185 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9187 if (token->type == JIM_TT_EXPR_INT)
9188 return token->objPtr;
9189 else if (token->type == JIM_TT_VAR)
9190 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9191 else if (token->type == JIM_TT_DICTSUGAR)
9192 return JimExpandDictSugar(interp, token->objPtr);
9193 else
9194 return NULL;
9196 #endif
9198 /* -----------------------------------------------------------------------------
9199 * Expressions evaluation.
9200 * Jim uses a specialized stack-based virtual machine for expressions,
9201 * that takes advantage of the fact that expr's operators
9202 * can't be redefined.
9204 * Jim_EvalExpression() uses the bytecode compiled by
9205 * SetExprFromAny() method of the "expression" object.
9207 * On success a Tcl Object containing the result of the evaluation
9208 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9209 * returned.
9210 * On error the function returns a retcode != to JIM_OK and set a suitable
9211 * error on the interp.
9212 * ---------------------------------------------------------------------------*/
9213 #define JIM_EE_STATICSTACK_LEN 10
9215 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9217 ExprByteCode *expr;
9218 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9219 int i;
9220 int retcode = JIM_OK;
9221 struct JimExprState e;
9223 expr = JimGetExpression(interp, exprObjPtr);
9224 if (!expr) {
9225 return JIM_ERR; /* error in expression. */
9228 #ifdef JIM_OPTIMIZATION
9229 /* Check for one of the following common expressions used by while/for
9231 * CONST
9232 * $a
9233 * !$a
9234 * $a < CONST, $a < $b
9235 * $a <= CONST, $a <= $b
9236 * $a > CONST, $a > $b
9237 * $a >= CONST, $a >= $b
9238 * $a != CONST, $a != $b
9239 * $a == CONST, $a == $b
9242 Jim_Obj *objPtr;
9244 /* STEP 1 -- Check if there are the conditions to run the specialized
9245 * version of while */
9247 switch (expr->len) {
9248 case 1:
9249 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9250 if (objPtr) {
9251 Jim_IncrRefCount(objPtr);
9252 *exprResultPtrPtr = objPtr;
9253 return JIM_OK;
9255 break;
9257 case 2:
9258 if (expr->token[1].type == JIM_EXPROP_NOT) {
9259 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9261 if (objPtr && JimIsWide(objPtr)) {
9262 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9263 Jim_IncrRefCount(*exprResultPtrPtr);
9264 return JIM_OK;
9267 break;
9269 case 3:
9270 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9271 if (objPtr && JimIsWide(objPtr)) {
9272 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9273 if (objPtr2 && JimIsWide(objPtr2)) {
9274 jim_wide wideValueA = JimWideValue(objPtr);
9275 jim_wide wideValueB = JimWideValue(objPtr2);
9276 int cmpRes;
9277 switch (expr->token[2].type) {
9278 case JIM_EXPROP_LT:
9279 cmpRes = wideValueA < wideValueB;
9280 break;
9281 case JIM_EXPROP_LTE:
9282 cmpRes = wideValueA <= wideValueB;
9283 break;
9284 case JIM_EXPROP_GT:
9285 cmpRes = wideValueA > wideValueB;
9286 break;
9287 case JIM_EXPROP_GTE:
9288 cmpRes = wideValueA >= wideValueB;
9289 break;
9290 case JIM_EXPROP_NUMEQ:
9291 cmpRes = wideValueA == wideValueB;
9292 break;
9293 case JIM_EXPROP_NUMNE:
9294 cmpRes = wideValueA != wideValueB;
9295 break;
9296 default:
9297 goto noopt;
9299 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9300 Jim_IncrRefCount(*exprResultPtrPtr);
9301 return JIM_OK;
9304 break;
9307 noopt:
9308 #endif
9310 /* In order to avoid that the internal repr gets freed due to
9311 * shimmering of the exprObjPtr's object, we make the internal rep
9312 * shared. */
9313 expr->inUse++;
9315 /* The stack-based expr VM itself */
9317 /* Stack allocation. Expr programs have the feature that
9318 * a program of length N can't require a stack longer than
9319 * N. */
9320 if (expr->len > JIM_EE_STATICSTACK_LEN)
9321 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9322 else
9323 e.stack = staticStack;
9325 e.stacklen = 0;
9327 /* Execute every instruction */
9328 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9329 Jim_Obj *objPtr;
9331 switch (expr->token[i].type) {
9332 case JIM_TT_EXPR_INT:
9333 case JIM_TT_EXPR_DOUBLE:
9334 case JIM_TT_STR:
9335 ExprPush(&e, expr->token[i].objPtr);
9336 break;
9338 case JIM_TT_VAR:
9339 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9340 if (objPtr) {
9341 ExprPush(&e, objPtr);
9343 else {
9344 retcode = JIM_ERR;
9346 break;
9348 case JIM_TT_DICTSUGAR:
9349 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9350 if (objPtr) {
9351 ExprPush(&e, objPtr);
9353 else {
9354 retcode = JIM_ERR;
9356 break;
9358 case JIM_TT_ESC:
9359 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9360 if (retcode == JIM_OK) {
9361 ExprPush(&e, objPtr);
9363 break;
9365 case JIM_TT_CMD:
9366 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9367 if (retcode == JIM_OK) {
9368 ExprPush(&e, Jim_GetResult(interp));
9370 break;
9372 default:{
9373 /* Find and execute the operation */
9374 e.skip = 0;
9375 e.opcode = expr->token[i].type;
9377 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9378 /* Skip some opcodes if necessary */
9379 i += e.skip;
9380 continue;
9385 expr->inUse--;
9387 if (retcode == JIM_OK) {
9388 *exprResultPtrPtr = ExprPop(&e);
9390 else {
9391 for (i = 0; i < e.stacklen; i++) {
9392 Jim_DecrRefCount(interp, e.stack[i]);
9395 if (e.stack != staticStack) {
9396 Jim_Free(e.stack);
9398 return retcode;
9401 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9403 int retcode;
9404 jim_wide wideValue;
9405 double doubleValue;
9406 Jim_Obj *exprResultPtr;
9408 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9409 if (retcode != JIM_OK)
9410 return retcode;
9412 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9413 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9414 Jim_DecrRefCount(interp, exprResultPtr);
9415 return JIM_ERR;
9417 else {
9418 Jim_DecrRefCount(interp, exprResultPtr);
9419 *boolPtr = doubleValue != 0;
9420 return JIM_OK;
9423 *boolPtr = wideValue != 0;
9425 Jim_DecrRefCount(interp, exprResultPtr);
9426 return JIM_OK;
9429 /* -----------------------------------------------------------------------------
9430 * ScanFormat String Object
9431 * ---------------------------------------------------------------------------*/
9433 /* This Jim_Obj will held a parsed representation of a format string passed to
9434 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9435 * to be parsed in its entirely first and then, if correct, can be used for
9436 * scanning. To avoid endless re-parsing, the parsed representation will be
9437 * stored in an internal representation and re-used for performance reason. */
9439 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9440 * scanformat string. This part will later be used to extract information
9441 * out from the string to be parsed by Jim_ScanString */
9443 typedef struct ScanFmtPartDescr
9445 char *arg; /* Specification of a CHARSET conversion */
9446 char *prefix; /* Prefix to be scanned literally before conversion */
9447 size_t width; /* Maximal width of input to be converted */
9448 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9449 char type; /* Type of conversion (e.g. c, d, f) */
9450 char modifier; /* Modify type (e.g. l - long, h - short */
9451 } ScanFmtPartDescr;
9453 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9454 * string parsed and separated in part descriptions. Furthermore it contains
9455 * the original string representation of the scanformat string to allow for
9456 * fast update of the Jim_Obj's string representation part.
9458 * As an add-on the internal object representation adds some scratch pad area
9459 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9460 * memory for purpose of string scanning.
9462 * The error member points to a static allocated string in case of a mal-
9463 * formed scanformat string or it contains '0' (NULL) in case of a valid
9464 * parse representation.
9466 * The whole memory of the internal representation is allocated as a single
9467 * area of memory that will be internally separated. So freeing and duplicating
9468 * of such an object is cheap */
9470 typedef struct ScanFmtStringObj
9472 jim_wide size; /* Size of internal repr in bytes */
9473 char *stringRep; /* Original string representation */
9474 size_t count; /* Number of ScanFmtPartDescr contained */
9475 size_t convCount; /* Number of conversions that will assign */
9476 size_t maxPos; /* Max position index if XPG3 is used */
9477 const char *error; /* Ptr to error text (NULL if no error */
9478 char *scratch; /* Some scratch pad used by Jim_ScanString */
9479 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9480 } ScanFmtStringObj;
9483 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9484 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9485 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9487 static const Jim_ObjType scanFmtStringObjType = {
9488 "scanformatstring",
9489 FreeScanFmtInternalRep,
9490 DupScanFmtInternalRep,
9491 UpdateStringOfScanFmt,
9492 JIM_TYPE_NONE,
9495 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9497 JIM_NOTUSED(interp);
9498 Jim_Free((char *)objPtr->internalRep.ptr);
9499 objPtr->internalRep.ptr = 0;
9502 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9504 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9505 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9507 JIM_NOTUSED(interp);
9508 memcpy(newVec, srcPtr->internalRep.ptr, size);
9509 dupPtr->internalRep.ptr = newVec;
9510 dupPtr->typePtr = &scanFmtStringObjType;
9513 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9515 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9518 /* SetScanFmtFromAny will parse a given string and create the internal
9519 * representation of the format specification. In case of an error
9520 * the error data member of the internal representation will be set
9521 * to an descriptive error text and the function will be left with
9522 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9523 * specification */
9525 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9527 ScanFmtStringObj *fmtObj;
9528 char *buffer;
9529 int maxCount, i, approxSize, lastPos = -1;
9530 const char *fmt = objPtr->bytes;
9531 int maxFmtLen = objPtr->length;
9532 const char *fmtEnd = fmt + maxFmtLen;
9533 int curr;
9535 Jim_FreeIntRep(interp, objPtr);
9536 /* Count how many conversions could take place maximally */
9537 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9538 if (fmt[i] == '%')
9539 ++maxCount;
9540 /* Calculate an approximation of the memory necessary */
9541 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9542 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9543 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9544 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9545 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9546 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9547 +1; /* safety byte */
9548 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9549 memset(fmtObj, 0, approxSize);
9550 fmtObj->size = approxSize;
9551 fmtObj->maxPos = 0;
9552 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9553 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9554 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9555 buffer = fmtObj->stringRep + maxFmtLen + 1;
9556 objPtr->internalRep.ptr = fmtObj;
9557 objPtr->typePtr = &scanFmtStringObjType;
9558 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9559 int width = 0, skip;
9560 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9562 fmtObj->count++;
9563 descr->width = 0; /* Assume width unspecified */
9564 /* Overread and store any "literal" prefix */
9565 if (*fmt != '%' || fmt[1] == '%') {
9566 descr->type = 0;
9567 descr->prefix = &buffer[i];
9568 for (; fmt < fmtEnd; ++fmt) {
9569 if (*fmt == '%') {
9570 if (fmt[1] != '%')
9571 break;
9572 ++fmt;
9574 buffer[i++] = *fmt;
9576 buffer[i++] = 0;
9578 /* Skip the conversion introducing '%' sign */
9579 ++fmt;
9580 /* End reached due to non-conversion literal only? */
9581 if (fmt >= fmtEnd)
9582 goto done;
9583 descr->pos = 0; /* Assume "natural" positioning */
9584 if (*fmt == '*') {
9585 descr->pos = -1; /* Okay, conversion will not be assigned */
9586 ++fmt;
9588 else
9589 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9590 /* Check if next token is a number (could be width or pos */
9591 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9592 fmt += skip;
9593 /* Was the number a XPG3 position specifier? */
9594 if (descr->pos != -1 && *fmt == '$') {
9595 int prev;
9597 ++fmt;
9598 descr->pos = width;
9599 width = 0;
9600 /* Look if "natural" postioning and XPG3 one was mixed */
9601 if ((lastPos == 0 && descr->pos > 0)
9602 || (lastPos > 0 && descr->pos == 0)) {
9603 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9604 return JIM_ERR;
9606 /* Look if this position was already used */
9607 for (prev = 0; prev < curr; ++prev) {
9608 if (fmtObj->descr[prev].pos == -1)
9609 continue;
9610 if (fmtObj->descr[prev].pos == descr->pos) {
9611 fmtObj->error =
9612 "variable is assigned by multiple \"%n$\" conversion specifiers";
9613 return JIM_ERR;
9616 /* Try to find a width after the XPG3 specifier */
9617 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9618 descr->width = width;
9619 fmt += skip;
9621 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9622 fmtObj->maxPos = descr->pos;
9624 else {
9625 /* Number was not a XPG3, so it has to be a width */
9626 descr->width = width;
9629 /* If positioning mode was undetermined yet, fix this */
9630 if (lastPos == -1)
9631 lastPos = descr->pos;
9632 /* Handle CHARSET conversion type ... */
9633 if (*fmt == '[') {
9634 int swapped = 1, beg = i, end, j;
9636 descr->type = '[';
9637 descr->arg = &buffer[i];
9638 ++fmt;
9639 if (*fmt == '^')
9640 buffer[i++] = *fmt++;
9641 if (*fmt == ']')
9642 buffer[i++] = *fmt++;
9643 while (*fmt && *fmt != ']')
9644 buffer[i++] = *fmt++;
9645 if (*fmt != ']') {
9646 fmtObj->error = "unmatched [ in format string";
9647 return JIM_ERR;
9649 end = i;
9650 buffer[i++] = 0;
9651 /* In case a range fence was given "backwards", swap it */
9652 while (swapped) {
9653 swapped = 0;
9654 for (j = beg + 1; j < end - 1; ++j) {
9655 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9656 char tmp = buffer[j - 1];
9658 buffer[j - 1] = buffer[j + 1];
9659 buffer[j + 1] = tmp;
9660 swapped = 1;
9665 else {
9666 /* Remember any valid modifier if given */
9667 if (strchr("hlL", *fmt) != 0)
9668 descr->modifier = tolower((int)*fmt++);
9670 descr->type = *fmt;
9671 if (strchr("efgcsndoxui", *fmt) == 0) {
9672 fmtObj->error = "bad scan conversion character";
9673 return JIM_ERR;
9675 else if (*fmt == 'c' && descr->width != 0) {
9676 fmtObj->error = "field width may not be specified in %c " "conversion";
9677 return JIM_ERR;
9679 else if (*fmt == 'u' && descr->modifier == 'l') {
9680 fmtObj->error = "unsigned wide not supported";
9681 return JIM_ERR;
9684 curr++;
9686 done:
9687 return JIM_OK;
9690 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9692 #define FormatGetCnvCount(_fo_) \
9693 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9694 #define FormatGetMaxPos(_fo_) \
9695 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9696 #define FormatGetError(_fo_) \
9697 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9699 /* JimScanAString is used to scan an unspecified string that ends with
9700 * next WS, or a string that is specified via a charset.
9703 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9705 char *buffer = Jim_StrDup(str);
9706 char *p = buffer;
9708 while (*str) {
9709 int c;
9710 int n;
9712 if (!sdescr && isspace(UCHAR(*str)))
9713 break; /* EOS via WS if unspecified */
9715 n = utf8_tounicode(str, &c);
9716 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9717 break;
9718 while (n--)
9719 *p++ = *str++;
9721 *p = 0;
9722 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9725 /* ScanOneEntry will scan one entry out of the string passed as argument.
9726 * It use the sscanf() function for this task. After extracting and
9727 * converting of the value, the count of scanned characters will be
9728 * returned of -1 in case of no conversion tool place and string was
9729 * already scanned thru */
9731 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9732 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9734 const char *tok;
9735 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9736 size_t scanned = 0;
9737 size_t anchor = pos;
9738 int i;
9739 Jim_Obj *tmpObj = NULL;
9741 /* First pessimistically assume, we will not scan anything :-) */
9742 *valObjPtr = 0;
9743 if (descr->prefix) {
9744 /* There was a prefix given before the conversion, skip it and adjust
9745 * the string-to-be-parsed accordingly */
9746 /* XXX: Should be checking strLen, not str[pos] */
9747 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9748 /* If prefix require, skip WS */
9749 if (isspace(UCHAR(descr->prefix[i])))
9750 while (pos < strLen && isspace(UCHAR(str[pos])))
9751 ++pos;
9752 else if (descr->prefix[i] != str[pos])
9753 break; /* Prefix do not match here, leave the loop */
9754 else
9755 ++pos; /* Prefix matched so far, next round */
9757 if (pos >= strLen) {
9758 return -1; /* All of str consumed: EOF condition */
9760 else if (descr->prefix[i] != 0)
9761 return 0; /* Not whole prefix consumed, no conversion possible */
9763 /* For all but following conversion, skip leading WS */
9764 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9765 while (isspace(UCHAR(str[pos])))
9766 ++pos;
9767 /* Determine how much skipped/scanned so far */
9768 scanned = pos - anchor;
9770 /* %c is a special, simple case. no width */
9771 if (descr->type == 'n') {
9772 /* Return pseudo conversion means: how much scanned so far? */
9773 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9775 else if (pos >= strLen) {
9776 /* Cannot scan anything, as str is totally consumed */
9777 return -1;
9779 else if (descr->type == 'c') {
9780 int c;
9781 scanned += utf8_tounicode(&str[pos], &c);
9782 *valObjPtr = Jim_NewIntObj(interp, c);
9783 return scanned;
9785 else {
9786 /* Processing of conversions follows ... */
9787 if (descr->width > 0) {
9788 /* Do not try to scan as fas as possible but only the given width.
9789 * To ensure this, we copy the part that should be scanned. */
9790 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9791 size_t tLen = descr->width > sLen ? sLen : descr->width;
9793 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9794 tok = tmpObj->bytes;
9796 else {
9797 /* As no width was given, simply refer to the original string */
9798 tok = &str[pos];
9800 switch (descr->type) {
9801 case 'd':
9802 case 'o':
9803 case 'x':
9804 case 'u':
9805 case 'i':{
9806 char *endp; /* Position where the number finished */
9807 jim_wide w;
9809 int base = descr->type == 'o' ? 8
9810 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9812 /* Try to scan a number with the given base */
9813 if (base == 0) {
9814 w = jim_strtoull(tok, &endp);
9816 else {
9817 w = strtoull(tok, &endp, base);
9820 if (endp != tok) {
9821 /* There was some number sucessfully scanned! */
9822 *valObjPtr = Jim_NewIntObj(interp, w);
9824 /* Adjust the number-of-chars scanned so far */
9825 scanned += endp - tok;
9827 else {
9828 /* Nothing was scanned. We have to determine if this
9829 * happened due to e.g. prefix mismatch or input str
9830 * exhausted */
9831 scanned = *tok ? 0 : -1;
9833 break;
9835 case 's':
9836 case '[':{
9837 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9838 scanned += Jim_Length(*valObjPtr);
9839 break;
9841 case 'e':
9842 case 'f':
9843 case 'g':{
9844 char *endp;
9845 double value = strtod(tok, &endp);
9847 if (endp != tok) {
9848 /* There was some number sucessfully scanned! */
9849 *valObjPtr = Jim_NewDoubleObj(interp, value);
9850 /* Adjust the number-of-chars scanned so far */
9851 scanned += endp - tok;
9853 else {
9854 /* Nothing was scanned. We have to determine if this
9855 * happened due to e.g. prefix mismatch or input str
9856 * exhausted */
9857 scanned = *tok ? 0 : -1;
9859 break;
9862 /* If a substring was allocated (due to pre-defined width) do not
9863 * forget to free it */
9864 if (tmpObj) {
9865 Jim_FreeNewObj(interp, tmpObj);
9868 return scanned;
9871 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9872 * string and returns all converted (and not ignored) values in a list back
9873 * to the caller. If an error occured, a NULL pointer will be returned */
9875 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9877 size_t i, pos;
9878 int scanned = 1;
9879 const char *str = Jim_String(strObjPtr);
9880 int strLen = Jim_Utf8Length(interp, strObjPtr);
9881 Jim_Obj *resultList = 0;
9882 Jim_Obj **resultVec = 0;
9883 int resultc;
9884 Jim_Obj *emptyStr = 0;
9885 ScanFmtStringObj *fmtObj;
9887 /* This should never happen. The format object should already be of the correct type */
9888 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9890 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9891 /* Check if format specification was valid */
9892 if (fmtObj->error != 0) {
9893 if (flags & JIM_ERRMSG)
9894 Jim_SetResultString(interp, fmtObj->error, -1);
9895 return 0;
9897 /* Allocate a new "shared" empty string for all unassigned conversions */
9898 emptyStr = Jim_NewEmptyStringObj(interp);
9899 Jim_IncrRefCount(emptyStr);
9900 /* Create a list and fill it with empty strings up to max specified XPG3 */
9901 resultList = Jim_NewListObj(interp, NULL, 0);
9902 if (fmtObj->maxPos > 0) {
9903 for (i = 0; i < fmtObj->maxPos; ++i)
9904 Jim_ListAppendElement(interp, resultList, emptyStr);
9905 JimListGetElements(interp, resultList, &resultc, &resultVec);
9907 /* Now handle every partial format description */
9908 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9909 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9910 Jim_Obj *value = 0;
9912 /* Only last type may be "literal" w/o conversion - skip it! */
9913 if (descr->type == 0)
9914 continue;
9915 /* As long as any conversion could be done, we will proceed */
9916 if (scanned > 0)
9917 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9918 /* In case our first try results in EOF, we will leave */
9919 if (scanned == -1 && i == 0)
9920 goto eof;
9921 /* Advance next pos-to-be-scanned for the amount scanned already */
9922 pos += scanned;
9924 /* value == 0 means no conversion took place so take empty string */
9925 if (value == 0)
9926 value = Jim_NewEmptyStringObj(interp);
9927 /* If value is a non-assignable one, skip it */
9928 if (descr->pos == -1) {
9929 Jim_FreeNewObj(interp, value);
9931 else if (descr->pos == 0)
9932 /* Otherwise append it to the result list if no XPG3 was given */
9933 Jim_ListAppendElement(interp, resultList, value);
9934 else if (resultVec[descr->pos - 1] == emptyStr) {
9935 /* But due to given XPG3, put the value into the corr. slot */
9936 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9937 Jim_IncrRefCount(value);
9938 resultVec[descr->pos - 1] = value;
9940 else {
9941 /* Otherwise, the slot was already used - free obj and ERROR */
9942 Jim_FreeNewObj(interp, value);
9943 goto err;
9946 Jim_DecrRefCount(interp, emptyStr);
9947 return resultList;
9948 eof:
9949 Jim_DecrRefCount(interp, emptyStr);
9950 Jim_FreeNewObj(interp, resultList);
9951 return (Jim_Obj *)EOF;
9952 err:
9953 Jim_DecrRefCount(interp, emptyStr);
9954 Jim_FreeNewObj(interp, resultList);
9955 return 0;
9958 /* -----------------------------------------------------------------------------
9959 * Pseudo Random Number Generation
9960 * ---------------------------------------------------------------------------*/
9961 /* Initialize the sbox with the numbers from 0 to 255 */
9962 static void JimPrngInit(Jim_Interp *interp)
9964 #define PRNG_SEED_SIZE 256
9965 int i;
9966 unsigned int *seed;
9967 time_t t = time(NULL);
9969 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9971 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9972 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9973 seed[i] = (rand() ^ t ^ clock());
9975 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9976 Jim_Free(seed);
9979 /* Generates N bytes of random data */
9980 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9982 Jim_PrngState *prng;
9983 unsigned char *destByte = (unsigned char *)dest;
9984 unsigned int si, sj, x;
9986 /* initialization, only needed the first time */
9987 if (interp->prngState == NULL)
9988 JimPrngInit(interp);
9989 prng = interp->prngState;
9990 /* generates 'len' bytes of pseudo-random numbers */
9991 for (x = 0; x < len; x++) {
9992 prng->i = (prng->i + 1) & 0xff;
9993 si = prng->sbox[prng->i];
9994 prng->j = (prng->j + si) & 0xff;
9995 sj = prng->sbox[prng->j];
9996 prng->sbox[prng->i] = sj;
9997 prng->sbox[prng->j] = si;
9998 *destByte++ = prng->sbox[(si + sj) & 0xff];
10002 /* Re-seed the generator with user-provided bytes */
10003 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10005 int i;
10006 Jim_PrngState *prng;
10008 /* initialization, only needed the first time */
10009 if (interp->prngState == NULL)
10010 JimPrngInit(interp);
10011 prng = interp->prngState;
10013 /* Set the sbox[i] with i */
10014 for (i = 0; i < 256; i++)
10015 prng->sbox[i] = i;
10016 /* Now use the seed to perform a random permutation of the sbox */
10017 for (i = 0; i < seedLen; i++) {
10018 unsigned char t;
10020 t = prng->sbox[i & 0xFF];
10021 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10022 prng->sbox[seed[i]] = t;
10024 prng->i = prng->j = 0;
10026 /* discard at least the first 256 bytes of stream.
10027 * borrow the seed buffer for this
10029 for (i = 0; i < 256; i += seedLen) {
10030 JimRandomBytes(interp, seed, seedLen);
10034 /* [incr] */
10035 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10037 jim_wide wideValue, increment = 1;
10038 Jim_Obj *intObjPtr;
10040 if (argc != 2 && argc != 3) {
10041 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10042 return JIM_ERR;
10044 if (argc == 3) {
10045 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10046 return JIM_ERR;
10048 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10049 if (!intObjPtr) {
10050 /* Set missing variable to 0 */
10051 wideValue = 0;
10053 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10054 return JIM_ERR;
10056 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10057 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10058 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10059 Jim_FreeNewObj(interp, intObjPtr);
10060 return JIM_ERR;
10063 else {
10064 /* Can do it the quick way */
10065 Jim_InvalidateStringRep(intObjPtr);
10066 JimWideValue(intObjPtr) = wideValue + increment;
10068 /* The following step is required in order to invalidate the
10069 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10070 if (argv[1]->typePtr != &variableObjType) {
10071 /* Note that this can't fail since GetVariable already succeeded */
10072 Jim_SetVariable(interp, argv[1], intObjPtr);
10075 Jim_SetResult(interp, intObjPtr);
10076 return JIM_OK;
10080 /* -----------------------------------------------------------------------------
10081 * Eval
10082 * ---------------------------------------------------------------------------*/
10083 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10084 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10086 /* Handle calls to the [unknown] command */
10087 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10089 int retcode;
10091 /* If JimUnknown() is recursively called too many times...
10092 * done here
10094 if (interp->unknown_called > 50) {
10095 return JIM_ERR;
10098 /* The object interp->unknown just contains
10099 * the "unknown" string, it is used in order to
10100 * avoid to lookup the unknown command every time
10101 * but instead to cache the result. */
10103 /* If the [unknown] command does not exist ... */
10104 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10105 return JIM_ERR;
10107 interp->unknown_called++;
10108 /* XXX: Are we losing fileNameObj and linenr? */
10109 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10110 interp->unknown_called--;
10112 return retcode;
10115 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10117 int retcode;
10118 Jim_Cmd *cmdPtr;
10120 #if 0
10121 printf("invoke");
10122 int j;
10123 for (j = 0; j < objc; j++) {
10124 printf(" '%s'", Jim_String(objv[j]));
10126 printf("\n");
10127 #endif
10129 if (interp->framePtr->tailcallCmd) {
10130 /* Special tailcall command was pre-resolved */
10131 cmdPtr = interp->framePtr->tailcallCmd;
10132 interp->framePtr->tailcallCmd = NULL;
10134 else {
10135 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10136 if (cmdPtr == NULL) {
10137 return JimUnknown(interp, objc, objv);
10139 JimIncrCmdRefCount(cmdPtr);
10142 if (interp->evalDepth == interp->maxEvalDepth) {
10143 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10144 retcode = JIM_ERR;
10145 goto out;
10147 interp->evalDepth++;
10149 /* Call it -- Make sure result is an empty object. */
10150 Jim_SetEmptyResult(interp);
10151 if (cmdPtr->isproc) {
10152 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10154 else {
10155 interp->cmdPrivData = cmdPtr->u.native.privData;
10156 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10158 interp->evalDepth--;
10160 out:
10161 JimDecrCmdRefCount(interp, cmdPtr);
10163 return retcode;
10166 /* Eval the object vector 'objv' composed of 'objc' elements.
10167 * Every element is used as single argument.
10168 * Jim_EvalObj() will call this function every time its object
10169 * argument is of "list" type, with no string representation.
10171 * This is possible because the string representation of a
10172 * list object generated by the UpdateStringOfList is made
10173 * in a way that ensures that every list element is a different
10174 * command argument. */
10175 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10177 int i, retcode;
10179 /* Incr refcount of arguments. */
10180 for (i = 0; i < objc; i++)
10181 Jim_IncrRefCount(objv[i]);
10183 retcode = JimInvokeCommand(interp, objc, objv);
10185 /* Decr refcount of arguments and return the retcode */
10186 for (i = 0; i < objc; i++)
10187 Jim_DecrRefCount(interp, objv[i]);
10189 return retcode;
10193 * Invokes 'prefix' as a command with the objv array as arguments.
10195 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10197 int ret;
10198 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10200 nargv[0] = prefix;
10201 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10202 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10203 Jim_Free(nargv);
10204 return ret;
10207 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, ScriptObj *script)
10209 int rc = retcode;
10211 if (rc == JIM_ERR && !interp->errorFlag) {
10212 /* This is the first error, so save the file/line information and reset the stack */
10213 interp->errorFlag = 1;
10214 Jim_IncrRefCount(script->fileNameObj);
10215 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10216 interp->errorFileNameObj = script->fileNameObj;
10217 interp->errorLine = script->linenr;
10219 JimResetStackTrace(interp);
10220 /* Always add a level where the error first occurs */
10221 interp->addStackTrace++;
10224 /* Now if this is an "interesting" level, add it to the stack trace */
10225 if (rc == JIM_ERR && interp->addStackTrace > 0) {
10226 /* Add the stack info for the current level */
10228 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10230 /* Note: if we didn't have a filename for this level,
10231 * don't clear the addStackTrace flag
10232 * so we can pick it up at the next level
10234 if (Jim_Length(script->fileNameObj)) {
10235 interp->addStackTrace = 0;
10238 Jim_DecrRefCount(interp, interp->errorProc);
10239 interp->errorProc = interp->emptyObj;
10240 Jim_IncrRefCount(interp->errorProc);
10242 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
10243 /* Propagate the addStackTrace value through 'return -code error' */
10245 else {
10246 interp->addStackTrace = 0;
10250 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10252 Jim_Obj *objPtr;
10254 switch (token->type) {
10255 case JIM_TT_STR:
10256 case JIM_TT_ESC:
10257 objPtr = token->objPtr;
10258 break;
10259 case JIM_TT_VAR:
10260 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10261 break;
10262 case JIM_TT_DICTSUGAR:
10263 objPtr = JimExpandDictSugar(interp, token->objPtr);
10264 break;
10265 case JIM_TT_EXPRSUGAR:
10266 objPtr = JimExpandExprSugar(interp, token->objPtr);
10267 break;
10268 case JIM_TT_CMD:
10269 switch (Jim_EvalObj(interp, token->objPtr)) {
10270 case JIM_OK:
10271 case JIM_RETURN:
10272 objPtr = interp->result;
10273 break;
10274 case JIM_BREAK:
10275 /* Stop substituting */
10276 return JIM_BREAK;
10277 case JIM_CONTINUE:
10278 /* just skip this one */
10279 return JIM_CONTINUE;
10280 default:
10281 return JIM_ERR;
10283 break;
10284 default:
10285 JimPanic((1,
10286 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10287 objPtr = NULL;
10288 break;
10290 if (objPtr) {
10291 *objPtrPtr = objPtr;
10292 return JIM_OK;
10294 return JIM_ERR;
10297 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10298 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10299 * The returned object has refcount = 0.
10301 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10303 int totlen = 0, i;
10304 Jim_Obj **intv;
10305 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10306 Jim_Obj *objPtr;
10307 char *s;
10309 if (tokens <= JIM_EVAL_SINTV_LEN)
10310 intv = sintv;
10311 else
10312 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10314 /* Compute every token forming the argument
10315 * in the intv objects vector. */
10316 for (i = 0; i < tokens; i++) {
10317 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10318 case JIM_OK:
10319 case JIM_RETURN:
10320 break;
10321 case JIM_BREAK:
10322 if (flags & JIM_SUBST_FLAG) {
10323 /* Stop here */
10324 tokens = i;
10325 continue;
10327 /* XXX: Should probably set an error about break outside loop */
10328 /* fall through to error */
10329 case JIM_CONTINUE:
10330 if (flags & JIM_SUBST_FLAG) {
10331 intv[i] = NULL;
10332 continue;
10334 /* XXX: Ditto continue outside loop */
10335 /* fall through to error */
10336 default:
10337 while (i--) {
10338 Jim_DecrRefCount(interp, intv[i]);
10340 if (intv != sintv) {
10341 Jim_Free(intv);
10343 return NULL;
10345 Jim_IncrRefCount(intv[i]);
10346 Jim_String(intv[i]);
10347 totlen += intv[i]->length;
10350 /* Fast path return for a single token */
10351 if (tokens == 1 && intv[0] && intv == sintv) {
10352 Jim_DecrRefCount(interp, intv[0]);
10353 return intv[0];
10356 /* Concatenate every token in an unique
10357 * object. */
10358 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10360 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10361 && token[2].type == JIM_TT_VAR) {
10362 /* May be able to do fast interpolated object -> dictSubst */
10363 objPtr->typePtr = &interpolatedObjType;
10364 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10365 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10366 Jim_IncrRefCount(intv[2]);
10369 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10370 objPtr->length = totlen;
10371 for (i = 0; i < tokens; i++) {
10372 if (intv[i]) {
10373 memcpy(s, intv[i]->bytes, intv[i]->length);
10374 s += intv[i]->length;
10375 Jim_DecrRefCount(interp, intv[i]);
10378 objPtr->bytes[totlen] = '\0';
10379 /* Free the intv vector if not static. */
10380 if (intv != sintv) {
10381 Jim_Free(intv);
10384 return objPtr;
10388 /* listPtr *must* be a list.
10389 * The contents of the list is evaluated with the first element as the command and
10390 * the remaining elements as the arguments.
10392 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10394 int retcode = JIM_OK;
10396 if (listPtr->internalRep.listValue.len) {
10397 Jim_IncrRefCount(listPtr);
10398 retcode = JimInvokeCommand(interp,
10399 listPtr->internalRep.listValue.len,
10400 listPtr->internalRep.listValue.ele);
10401 Jim_DecrRefCount(interp, listPtr);
10403 return retcode;
10406 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10408 SetListFromAny(interp, listPtr);
10409 return JimEvalObjList(interp, listPtr);
10412 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10414 int i;
10415 ScriptObj *script;
10416 ScriptToken *token;
10417 int retcode = JIM_OK;
10418 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10419 Jim_Obj *prevScriptObj;
10421 /* If the object is of type "list", with no string rep we can call
10422 * a specialized version of Jim_EvalObj() */
10423 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10424 return JimEvalObjList(interp, scriptObjPtr);
10427 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10428 script = Jim_GetScript(interp, scriptObjPtr);
10430 /* Reset the interpreter result. This is useful to
10431 * return the empty result in the case of empty program. */
10432 Jim_SetEmptyResult(interp);
10434 token = script->token;
10436 #ifdef JIM_OPTIMIZATION
10437 /* Check for one of the following common scripts used by for, while
10439 * {}
10440 * incr a
10442 if (script->len == 0) {
10443 Jim_DecrRefCount(interp, scriptObjPtr);
10444 return JIM_OK;
10446 if (script->len == 3
10447 && token[1].objPtr->typePtr == &commandObjType
10448 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10449 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10450 && token[2].objPtr->typePtr == &variableObjType) {
10452 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10454 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10455 JimWideValue(objPtr)++;
10456 Jim_InvalidateStringRep(objPtr);
10457 Jim_DecrRefCount(interp, scriptObjPtr);
10458 Jim_SetResult(interp, objPtr);
10459 return JIM_OK;
10462 #endif
10464 /* Now we have to make sure the internal repr will not be
10465 * freed on shimmering.
10467 * Think for example to this:
10469 * set x {llength $x; ... some more code ...}; eval $x
10471 * In order to preserve the internal rep, we increment the
10472 * inUse field of the script internal rep structure. */
10473 script->inUse++;
10475 /* Stash the current script */
10476 prevScriptObj = interp->currentScriptObj;
10477 interp->currentScriptObj = scriptObjPtr;
10479 interp->errorFlag = 0;
10480 argv = sargv;
10482 /* Execute every command sequentially until the end of the script
10483 * or an error occurs.
10485 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10486 int argc;
10487 int j;
10489 /* First token of the line is always JIM_TT_LINE */
10490 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10491 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10493 /* Allocate the arguments vector if required */
10494 if (argc > JIM_EVAL_SARGV_LEN)
10495 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10497 /* Skip the JIM_TT_LINE token */
10498 i++;
10500 /* Populate the arguments objects.
10501 * If an error occurs, retcode will be set and
10502 * 'j' will be set to the number of args expanded
10504 for (j = 0; j < argc; j++) {
10505 long wordtokens = 1;
10506 int expand = 0;
10507 Jim_Obj *wordObjPtr = NULL;
10509 if (token[i].type == JIM_TT_WORD) {
10510 wordtokens = JimWideValue(token[i++].objPtr);
10511 if (wordtokens < 0) {
10512 expand = 1;
10513 wordtokens = -wordtokens;
10517 if (wordtokens == 1) {
10518 /* Fast path if the token does not
10519 * need interpolation */
10521 switch (token[i].type) {
10522 case JIM_TT_ESC:
10523 case JIM_TT_STR:
10524 wordObjPtr = token[i].objPtr;
10525 break;
10526 case JIM_TT_VAR:
10527 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10528 break;
10529 case JIM_TT_EXPRSUGAR:
10530 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10531 break;
10532 case JIM_TT_DICTSUGAR:
10533 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10534 break;
10535 case JIM_TT_CMD:
10536 retcode = Jim_EvalObj(interp, token[i].objPtr);
10537 if (retcode == JIM_OK) {
10538 wordObjPtr = Jim_GetResult(interp);
10540 break;
10541 default:
10542 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10545 else {
10546 /* For interpolation we call a helper
10547 * function to do the work for us. */
10548 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10551 if (!wordObjPtr) {
10552 if (retcode == JIM_OK) {
10553 retcode = JIM_ERR;
10555 break;
10558 Jim_IncrRefCount(wordObjPtr);
10559 i += wordtokens;
10561 if (!expand) {
10562 argv[j] = wordObjPtr;
10564 else {
10565 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10566 int len = Jim_ListLength(interp, wordObjPtr);
10567 int newargc = argc + len - 1;
10568 int k;
10570 if (len > 1) {
10571 if (argv == sargv) {
10572 if (newargc > JIM_EVAL_SARGV_LEN) {
10573 argv = Jim_Alloc(sizeof(*argv) * newargc);
10574 memcpy(argv, sargv, sizeof(*argv) * j);
10577 else {
10578 /* Need to realloc to make room for (len - 1) more entries */
10579 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10583 /* Now copy in the expanded version */
10584 for (k = 0; k < len; k++) {
10585 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10586 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10589 /* The original object reference is no longer needed,
10590 * after the expansion it is no longer present on
10591 * the argument vector, but the single elements are
10592 * in its place. */
10593 Jim_DecrRefCount(interp, wordObjPtr);
10595 /* And update the indexes */
10596 j--;
10597 argc += len - 1;
10601 if (retcode == JIM_OK && argc) {
10602 /* Invoke the command */
10603 retcode = JimInvokeCommand(interp, argc, argv);
10604 /* Check for a signal after each command */
10605 if (Jim_CheckSignal(interp)) {
10606 retcode = JIM_SIGNAL;
10610 /* Finished with the command, so decrement ref counts of each argument */
10611 while (j-- > 0) {
10612 Jim_DecrRefCount(interp, argv[j]);
10615 if (argv != sargv) {
10616 Jim_Free(argv);
10617 argv = sargv;
10621 /* Possibly add to the error stack trace */
10622 JimAddErrorToStack(interp, retcode, script);
10624 /* Restore the current script */
10625 interp->currentScriptObj = prevScriptObj;
10627 /* Note that we don't have to decrement inUse, because the
10628 * following code transfers our use of the reference again to
10629 * the script object. */
10630 Jim_FreeIntRep(interp, scriptObjPtr);
10631 scriptObjPtr->typePtr = &scriptObjType;
10632 Jim_SetIntRepPtr(scriptObjPtr, script);
10633 Jim_DecrRefCount(interp, scriptObjPtr);
10635 return retcode;
10638 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10640 int retcode;
10641 /* If argObjPtr begins with '&', do an automatic upvar */
10642 const char *varname = Jim_String(argNameObj);
10643 if (*varname == '&') {
10644 /* First check that the target variable exists */
10645 Jim_Obj *objPtr;
10646 Jim_CallFrame *savedCallFrame = interp->framePtr;
10648 interp->framePtr = interp->framePtr->parent;
10649 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10650 interp->framePtr = savedCallFrame;
10651 if (!objPtr) {
10652 return JIM_ERR;
10655 /* It exists, so perform the binding. */
10656 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10657 Jim_IncrRefCount(objPtr);
10658 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10659 Jim_DecrRefCount(interp, objPtr);
10661 else {
10662 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10664 return retcode;
10668 * Sets the interp result to be an error message indicating the required proc args.
10670 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10672 /* Create a nice error message, consistent with Tcl 8.5 */
10673 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10674 int i;
10676 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10677 Jim_AppendString(interp, argmsg, " ", 1);
10679 if (i == cmd->u.proc.argsPos) {
10680 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10681 /* Renamed args */
10682 Jim_AppendString(interp, argmsg, "?", 1);
10683 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10684 Jim_AppendString(interp, argmsg, " ...?", -1);
10686 else {
10687 /* We have plain args */
10688 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10691 else {
10692 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10693 Jim_AppendString(interp, argmsg, "?", 1);
10694 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10695 Jim_AppendString(interp, argmsg, "?", 1);
10697 else {
10698 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10699 if (*arg == '&') {
10700 arg++;
10702 Jim_AppendString(interp, argmsg, arg, -1);
10706 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10707 Jim_FreeNewObj(interp, argmsg);
10710 #ifdef jim_ext_namespace
10712 * [namespace eval]
10714 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10716 Jim_CallFrame *callFramePtr;
10717 int retcode;
10719 /* Create a new callframe */
10720 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10721 callFramePtr->argv = &interp->emptyObj;
10722 callFramePtr->argc = 0;
10723 callFramePtr->procArgsObjPtr = NULL;
10724 callFramePtr->procBodyObjPtr = scriptObj;
10725 callFramePtr->staticVars = NULL;
10726 callFramePtr->fileNameObj = interp->emptyObj;
10727 callFramePtr->line = 0;
10728 Jim_IncrRefCount(scriptObj);
10729 interp->framePtr = callFramePtr;
10731 /* Check if there are too nested calls */
10732 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10733 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10734 retcode = JIM_ERR;
10736 else {
10737 /* Eval the body */
10738 retcode = Jim_EvalObj(interp, scriptObj);
10741 /* Destroy the callframe */
10742 interp->framePtr = interp->framePtr->parent;
10743 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10745 return retcode;
10747 #endif
10749 /* Call a procedure implemented in Tcl.
10750 * It's possible to speed-up a lot this function, currently
10751 * the callframes are not cached, but allocated and
10752 * destroied every time. What is expecially costly is
10753 * to create/destroy the local vars hash table every time.
10755 * This can be fixed just implementing callframes caching
10756 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10757 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10759 Jim_CallFrame *callFramePtr;
10760 int i, d, retcode, optargs;
10761 ScriptObj *script;
10763 /* Check arity */
10764 if (argc - 1 < cmd->u.proc.reqArity ||
10765 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10766 JimSetProcWrongArgs(interp, argv[0], cmd);
10767 return JIM_ERR;
10770 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10771 /* Optimise for procedure with no body - useful for optional debugging */
10772 return JIM_OK;
10775 /* Check if there are too nested calls */
10776 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10777 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10778 return JIM_ERR;
10781 /* Create a new callframe */
10782 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10783 callFramePtr->argv = argv;
10784 callFramePtr->argc = argc;
10785 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10786 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10787 callFramePtr->staticVars = cmd->u.proc.staticVars;
10789 /* Remember where we were called from. */
10790 script = Jim_GetScript(interp, interp->currentScriptObj);
10791 callFramePtr->fileNameObj = script->fileNameObj;
10792 callFramePtr->line = script->linenr;
10794 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10795 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10796 interp->framePtr = callFramePtr;
10798 /* How many optional args are available */
10799 optargs = (argc - 1 - cmd->u.proc.reqArity);
10801 /* Step 'i' along the actual args, and step 'd' along the formal args */
10802 i = 1;
10803 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10804 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10805 if (d == cmd->u.proc.argsPos) {
10806 /* assign $args */
10807 Jim_Obj *listObjPtr;
10808 int argsLen = 0;
10809 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10810 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10812 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10814 /* It is possible to rename args. */
10815 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10816 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10818 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10819 if (retcode != JIM_OK) {
10820 goto badargset;
10823 i += argsLen;
10824 continue;
10827 /* Optional or required? */
10828 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10829 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10831 else {
10832 /* Ran out, so use the default */
10833 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10835 if (retcode != JIM_OK) {
10836 goto badargset;
10840 /* Eval the body */
10841 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10843 badargset:
10845 /* Free the callframe */
10846 interp->framePtr = interp->framePtr->parent;
10847 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10849 if (interp->framePtr->tailcallObj) {
10850 /* If a tailcall is already being executed, merge this tailcall with that one */
10851 if (interp->framePtr->tailcall++ == 0) {
10852 /* No current tailcall in this frame, so invoke the tailcall command */
10853 do {
10854 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10856 interp->framePtr->tailcallObj = NULL;
10858 if (retcode == JIM_EVAL) {
10859 retcode = Jim_EvalObjList(interp, tailcallObj);
10860 if (retcode == JIM_RETURN) {
10861 /* If the result of the tailcall is 'return', push
10862 * it up to the caller
10864 interp->returnLevel++;
10867 Jim_DecrRefCount(interp, tailcallObj);
10868 } while (interp->framePtr->tailcallObj);
10870 /* If the tailcall chain finished early, may need to manually discard the command */
10871 if (interp->framePtr->tailcallCmd) {
10872 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10873 interp->framePtr->tailcallCmd = NULL;
10876 interp->framePtr->tailcall--;
10879 /* Handle the JIM_RETURN return code */
10880 if (retcode == JIM_RETURN) {
10881 if (--interp->returnLevel <= 0) {
10882 retcode = interp->returnCode;
10883 interp->returnCode = JIM_OK;
10884 interp->returnLevel = 0;
10887 else if (retcode == JIM_ERR) {
10888 interp->addStackTrace++;
10889 Jim_DecrRefCount(interp, interp->errorProc);
10890 interp->errorProc = argv[0];
10891 Jim_IncrRefCount(interp->errorProc);
10894 return retcode;
10897 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10899 int retval;
10900 Jim_Obj *scriptObjPtr;
10902 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10903 Jim_IncrRefCount(scriptObjPtr);
10905 if (filename) {
10906 Jim_Obj *prevScriptObj;
10908 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10910 prevScriptObj = interp->currentScriptObj;
10911 interp->currentScriptObj = scriptObjPtr;
10913 retval = Jim_EvalObj(interp, scriptObjPtr);
10915 interp->currentScriptObj = prevScriptObj;
10917 else {
10918 retval = Jim_EvalObj(interp, scriptObjPtr);
10920 Jim_DecrRefCount(interp, scriptObjPtr);
10921 return retval;
10924 int Jim_Eval(Jim_Interp *interp, const char *script)
10926 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10929 /* Execute script in the scope of the global level */
10930 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10932 int retval;
10933 Jim_CallFrame *savedFramePtr = interp->framePtr;
10935 interp->framePtr = interp->topFramePtr;
10936 retval = Jim_Eval(interp, script);
10937 interp->framePtr = savedFramePtr;
10939 return retval;
10942 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10944 int retval;
10945 Jim_CallFrame *savedFramePtr = interp->framePtr;
10947 interp->framePtr = interp->topFramePtr;
10948 retval = Jim_EvalFile(interp, filename);
10949 interp->framePtr = savedFramePtr;
10951 return retval;
10954 #include <sys/stat.h>
10956 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10958 FILE *fp;
10959 char *buf;
10960 Jim_Obj *scriptObjPtr;
10961 Jim_Obj *prevScriptObj;
10962 struct stat sb;
10963 int retcode;
10964 int readlen;
10965 struct JimParseResult result;
10967 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10968 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10969 return JIM_ERR;
10971 if (sb.st_size == 0) {
10972 fclose(fp);
10973 return JIM_OK;
10976 buf = Jim_Alloc(sb.st_size + 1);
10977 readlen = fread(buf, 1, sb.st_size, fp);
10978 if (ferror(fp)) {
10979 fclose(fp);
10980 Jim_Free(buf);
10981 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10982 return JIM_ERR;
10984 fclose(fp);
10985 buf[readlen] = 0;
10987 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10988 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
10989 Jim_IncrRefCount(scriptObjPtr);
10991 /* Now check the script for unmatched braces, etc. */
10992 if (SetScriptFromAny(interp, scriptObjPtr, &result) == JIM_ERR) {
10993 const char *msg;
10994 char linebuf[20];
10996 switch (result.missing) {
10997 case '[':
10998 msg = "unmatched \"[\"";
10999 break;
11000 case '{':
11001 msg = "missing close-brace";
11002 break;
11003 case '"':
11004 default:
11005 msg = "missing quote";
11006 break;
11009 snprintf(linebuf, sizeof(linebuf), "%d", result.line);
11011 Jim_SetResultFormatted(interp, "%s in \"%s\" at line %s",
11012 msg, filename, linebuf);
11013 Jim_DecrRefCount(interp, scriptObjPtr);
11014 return JIM_ERR;
11017 prevScriptObj = interp->currentScriptObj;
11018 interp->currentScriptObj = scriptObjPtr;
11020 retcode = Jim_EvalObj(interp, scriptObjPtr);
11022 /* Handle the JIM_RETURN return code */
11023 if (retcode == JIM_RETURN) {
11024 if (--interp->returnLevel <= 0) {
11025 retcode = interp->returnCode;
11026 interp->returnCode = JIM_OK;
11027 interp->returnLevel = 0;
11030 if (retcode == JIM_ERR) {
11031 /* EvalFile changes context, so add a stack frame here */
11032 interp->addStackTrace++;
11035 interp->currentScriptObj = prevScriptObj;
11037 Jim_DecrRefCount(interp, scriptObjPtr);
11039 return retcode;
11042 /* -----------------------------------------------------------------------------
11043 * Subst
11044 * ---------------------------------------------------------------------------*/
11045 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11047 pc->tstart = pc->p;
11048 pc->tline = pc->linenr;
11050 if (pc->len == 0) {
11051 pc->tend = pc->p;
11052 pc->tt = JIM_TT_EOL;
11053 pc->eof = 1;
11054 return;
11056 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11057 JimParseCmd(pc);
11058 return;
11060 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11061 if (JimParseVar(pc) == JIM_OK) {
11062 return;
11064 /* Not a var, so treat as a string */
11065 pc->tstart = pc->p;
11066 flags |= JIM_SUBST_NOVAR;
11068 while (pc->len) {
11069 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11070 break;
11072 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11073 break;
11075 if (*pc->p == '\\' && pc->len > 1) {
11076 pc->p++;
11077 pc->len--;
11079 pc->p++;
11080 pc->len--;
11082 pc->tend = pc->p - 1;
11083 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11086 /* The subst object type reuses most of the data structures and functions
11087 * of the script object. Script's data structures are a bit more complex
11088 * for what is needed for [subst]itution tasks, but the reuse helps to
11089 * deal with a single data structure at the cost of some more memory
11090 * usage for substitutions. */
11092 /* This method takes the string representation of an object
11093 * as a Tcl string where to perform [subst]itution, and generates
11094 * the pre-parsed internal representation. */
11095 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11097 int scriptTextLen;
11098 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11099 struct JimParserCtx parser;
11100 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11101 ParseTokenList tokenlist;
11103 /* Initially parse the subst into tokens (in tokenlist) */
11104 ScriptTokenListInit(&tokenlist);
11106 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11107 while (1) {
11108 JimParseSubst(&parser, flags);
11109 if (parser.eof) {
11110 /* Note that subst doesn't need the EOL token */
11111 break;
11113 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11114 parser.tline);
11117 /* Create the "real" subst/script tokens from the initial token list */
11118 script->inUse = 1;
11119 script->substFlags = flags;
11120 script->fileNameObj = interp->emptyObj;
11121 Jim_IncrRefCount(script->fileNameObj);
11122 SubstObjAddTokens(interp, script, &tokenlist);
11124 /* No longer need the token list */
11125 ScriptTokenListFree(&tokenlist);
11127 #ifdef DEBUG_SHOW_SUBST
11129 int i;
11131 printf("==== Subst ====\n");
11132 for (i = 0; i < script->len; i++) {
11133 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11134 Jim_String(script->token[i].objPtr));
11137 #endif
11139 /* Free the old internal rep and set the new one. */
11140 Jim_FreeIntRep(interp, objPtr);
11141 Jim_SetIntRepPtr(objPtr, script);
11142 objPtr->typePtr = &scriptObjType;
11143 return JIM_OK;
11146 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11148 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11149 SetSubstFromAny(interp, objPtr, flags);
11150 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11153 /* Performs commands,variables,blackslashes substitution,
11154 * storing the result object (with refcount 0) into
11155 * resObjPtrPtr. */
11156 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11158 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11160 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11161 /* In order to preserve the internal rep, we increment the
11162 * inUse field of the script internal rep structure. */
11163 script->inUse++;
11165 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11167 script->inUse--;
11168 Jim_DecrRefCount(interp, substObjPtr);
11169 if (*resObjPtrPtr == NULL) {
11170 return JIM_ERR;
11172 return JIM_OK;
11175 /* -----------------------------------------------------------------------------
11176 * Core commands utility functions
11177 * ---------------------------------------------------------------------------*/
11178 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11180 Jim_Obj *objPtr;
11181 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11183 if (*msg) {
11184 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11186 Jim_IncrRefCount(listObjPtr);
11187 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11188 Jim_DecrRefCount(interp, listObjPtr);
11190 Jim_IncrRefCount(objPtr);
11191 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11192 Jim_DecrRefCount(interp, objPtr);
11196 * May add the key and/or value to the list.
11198 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11199 Jim_HashEntry *he, int type);
11201 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11204 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11205 * invoke the callback to add entries to a list.
11206 * Returns the list.
11208 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11209 JimHashtableIteratorCallbackType *callback, int type)
11211 Jim_HashEntry *he;
11212 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11214 /* Check for the non-pattern case. We can do this much more efficiently. */
11215 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11216 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11217 if (he) {
11218 callback(interp, listObjPtr, he, type);
11221 else {
11222 Jim_HashTableIterator htiter;
11223 JimInitHashTableIterator(ht, &htiter);
11224 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11225 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11226 callback(interp, listObjPtr, he, type);
11230 return listObjPtr;
11233 /* Keep these in order */
11234 #define JIM_CMDLIST_COMMANDS 0
11235 #define JIM_CMDLIST_PROCS 1
11236 #define JIM_CMDLIST_CHANNELS 2
11239 * Adds matching command names (procs, channels) to the list.
11241 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11242 Jim_HashEntry *he, int type)
11244 Jim_Cmd *cmdPtr = (Jim_Cmd *)he->u.val;
11245 Jim_Obj *objPtr;
11247 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11248 /* not a proc */
11249 return;
11252 objPtr = Jim_NewStringObj(interp, he->key, -1);
11253 Jim_IncrRefCount(objPtr);
11255 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11256 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11258 Jim_DecrRefCount(interp, objPtr);
11261 /* type is JIM_CMDLIST_xxx */
11262 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11264 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11267 /* Keep these in order */
11268 #define JIM_VARLIST_GLOBALS 0
11269 #define JIM_VARLIST_LOCALS 1
11270 #define JIM_VARLIST_VARS 2
11272 #define JIM_VARLIST_VALUES 0x1000
11275 * Adds matching variable names to the list.
11277 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11278 Jim_HashEntry *he, int type)
11280 Jim_Var *varPtr = (Jim_Var *)he->u.val;
11282 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11283 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11284 if (type & JIM_VARLIST_VALUES) {
11285 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11290 /* mode is JIM_VARLIST_xxx */
11291 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11293 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11294 /* For [info locals], if we are at top level an emtpy list
11295 * is returned. I don't agree, but we aim at compatibility (SS) */
11296 return interp->emptyObj;
11298 else {
11299 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11300 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11304 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11305 Jim_Obj **objPtrPtr, int info_level_cmd)
11307 Jim_CallFrame *targetCallFrame;
11309 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11310 if (targetCallFrame == NULL) {
11311 return JIM_ERR;
11313 /* No proc call at toplevel callframe */
11314 if (targetCallFrame == interp->topFramePtr) {
11315 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11316 return JIM_ERR;
11318 if (info_level_cmd) {
11319 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11321 else {
11322 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11324 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11325 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11326 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11327 *objPtrPtr = listObj;
11329 return JIM_OK;
11332 /* -----------------------------------------------------------------------------
11333 * Core commands
11334 * ---------------------------------------------------------------------------*/
11336 /* fake [puts] -- not the real puts, just for debugging. */
11337 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11339 if (argc != 2 && argc != 3) {
11340 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11341 return JIM_ERR;
11343 if (argc == 3) {
11344 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11345 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11346 return JIM_ERR;
11348 else {
11349 fputs(Jim_String(argv[2]), stdout);
11352 else {
11353 puts(Jim_String(argv[1]));
11355 return JIM_OK;
11358 /* Helper for [+] and [*] */
11359 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11361 jim_wide wideValue, res;
11362 double doubleValue, doubleRes;
11363 int i;
11365 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11367 for (i = 1; i < argc; i++) {
11368 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11369 goto trydouble;
11370 if (op == JIM_EXPROP_ADD)
11371 res += wideValue;
11372 else
11373 res *= wideValue;
11375 Jim_SetResultInt(interp, res);
11376 return JIM_OK;
11377 trydouble:
11378 doubleRes = (double)res;
11379 for (; i < argc; i++) {
11380 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11381 return JIM_ERR;
11382 if (op == JIM_EXPROP_ADD)
11383 doubleRes += doubleValue;
11384 else
11385 doubleRes *= doubleValue;
11387 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11388 return JIM_OK;
11391 /* Helper for [-] and [/] */
11392 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11394 jim_wide wideValue, res = 0;
11395 double doubleValue, doubleRes = 0;
11396 int i = 2;
11398 if (argc < 2) {
11399 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11400 return JIM_ERR;
11402 else if (argc == 2) {
11403 /* The arity = 2 case is different. For [- x] returns -x,
11404 * while [/ x] returns 1/x. */
11405 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11406 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11407 return JIM_ERR;
11409 else {
11410 if (op == JIM_EXPROP_SUB)
11411 doubleRes = -doubleValue;
11412 else
11413 doubleRes = 1.0 / doubleValue;
11414 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11415 return JIM_OK;
11418 if (op == JIM_EXPROP_SUB) {
11419 res = -wideValue;
11420 Jim_SetResultInt(interp, res);
11422 else {
11423 doubleRes = 1.0 / wideValue;
11424 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11426 return JIM_OK;
11428 else {
11429 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11430 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11431 != JIM_OK) {
11432 return JIM_ERR;
11434 else {
11435 goto trydouble;
11439 for (i = 2; i < argc; i++) {
11440 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11441 doubleRes = (double)res;
11442 goto trydouble;
11444 if (op == JIM_EXPROP_SUB)
11445 res -= wideValue;
11446 else
11447 res /= wideValue;
11449 Jim_SetResultInt(interp, res);
11450 return JIM_OK;
11451 trydouble:
11452 for (; i < argc; i++) {
11453 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11454 return JIM_ERR;
11455 if (op == JIM_EXPROP_SUB)
11456 doubleRes -= doubleValue;
11457 else
11458 doubleRes /= doubleValue;
11460 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11461 return JIM_OK;
11465 /* [+] */
11466 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11468 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11471 /* [*] */
11472 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11474 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11477 /* [-] */
11478 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11480 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11483 /* [/] */
11484 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11486 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11489 /* [set] */
11490 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11492 if (argc != 2 && argc != 3) {
11493 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11494 return JIM_ERR;
11496 if (argc == 2) {
11497 Jim_Obj *objPtr;
11499 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11500 if (!objPtr)
11501 return JIM_ERR;
11502 Jim_SetResult(interp, objPtr);
11503 return JIM_OK;
11505 /* argc == 3 case. */
11506 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11507 return JIM_ERR;
11508 Jim_SetResult(interp, argv[2]);
11509 return JIM_OK;
11512 /* [unset]
11514 * unset ?-nocomplain? ?--? ?varName ...?
11516 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11518 int i = 1;
11519 int complain = 1;
11521 while (i < argc) {
11522 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11523 i++;
11524 break;
11526 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11527 complain = 0;
11528 i++;
11529 continue;
11531 break;
11534 while (i < argc) {
11535 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11536 && complain) {
11537 return JIM_ERR;
11539 i++;
11541 return JIM_OK;
11544 /* [while] */
11545 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11547 if (argc != 3) {
11548 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11549 return JIM_ERR;
11552 /* The general purpose implementation of while starts here */
11553 while (1) {
11554 int boolean, retval;
11556 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11557 return retval;
11558 if (!boolean)
11559 break;
11561 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11562 switch (retval) {
11563 case JIM_BREAK:
11564 goto out;
11565 break;
11566 case JIM_CONTINUE:
11567 continue;
11568 break;
11569 default:
11570 return retval;
11574 out:
11575 Jim_SetEmptyResult(interp);
11576 return JIM_OK;
11579 /* [for] */
11580 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11582 int retval;
11583 int boolean = 1;
11584 Jim_Obj *varNamePtr = NULL;
11585 Jim_Obj *stopVarNamePtr = NULL;
11587 if (argc != 5) {
11588 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11589 return JIM_ERR;
11592 /* Do the initialisation */
11593 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11594 return retval;
11597 /* And do the first test now. Better for optimisation
11598 * if we can do next/test at the bottom of the loop
11600 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11602 /* Ready to do the body as follows:
11603 * while (1) {
11604 * body // check retcode
11605 * next // check retcode
11606 * test // check retcode/test bool
11610 #ifdef JIM_OPTIMIZATION
11611 /* Check if the for is on the form:
11612 * for ... {$i < CONST} {incr i}
11613 * for ... {$i < $j} {incr i}
11615 if (retval == JIM_OK && boolean) {
11616 ScriptObj *incrScript;
11617 ExprByteCode *expr;
11618 jim_wide stop, currentVal;
11619 Jim_Obj *objPtr;
11620 int cmpOffset;
11622 /* Do it only if there aren't shared arguments */
11623 expr = JimGetExpression(interp, argv[2]);
11624 incrScript = Jim_GetScript(interp, argv[3]);
11626 /* Ensure proper lengths to start */
11627 if (incrScript->len != 3 || !expr || expr->len != 3) {
11628 goto evalstart;
11630 /* Ensure proper token types. */
11631 if (incrScript->token[1].type != JIM_TT_ESC ||
11632 expr->token[0].type != JIM_TT_VAR ||
11633 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11634 goto evalstart;
11637 if (expr->token[2].type == JIM_EXPROP_LT) {
11638 cmpOffset = 0;
11640 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11641 cmpOffset = 1;
11643 else {
11644 goto evalstart;
11647 /* Update command must be incr */
11648 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11649 goto evalstart;
11652 /* incr, expression must be about the same variable */
11653 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11654 goto evalstart;
11657 /* Get the stop condition (must be a variable or integer) */
11658 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11659 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11660 goto evalstart;
11663 else {
11664 stopVarNamePtr = expr->token[1].objPtr;
11665 Jim_IncrRefCount(stopVarNamePtr);
11666 /* Keep the compiler happy */
11667 stop = 0;
11670 /* Initialization */
11671 varNamePtr = expr->token[0].objPtr;
11672 Jim_IncrRefCount(varNamePtr);
11674 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11675 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11676 goto testcond;
11679 /* --- OPTIMIZED FOR --- */
11680 while (retval == JIM_OK) {
11681 /* === Check condition === */
11682 /* Note that currentVal is already set here */
11684 /* Immediate or Variable? get the 'stop' value if the latter. */
11685 if (stopVarNamePtr) {
11686 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11687 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11688 goto testcond;
11692 if (currentVal >= stop + cmpOffset) {
11693 break;
11696 /* Eval body */
11697 retval = Jim_EvalObj(interp, argv[4]);
11698 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11699 retval = JIM_OK;
11701 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11703 /* Increment */
11704 if (objPtr == NULL) {
11705 retval = JIM_ERR;
11706 goto out;
11708 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11709 currentVal = ++JimWideValue(objPtr);
11710 Jim_InvalidateStringRep(objPtr);
11712 else {
11713 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11714 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11715 ++currentVal)) != JIM_OK) {
11716 goto evalnext;
11721 goto out;
11723 evalstart:
11724 #endif
11726 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11727 /* Body */
11728 retval = Jim_EvalObj(interp, argv[4]);
11730 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11731 /* increment */
11732 evalnext:
11733 retval = Jim_EvalObj(interp, argv[3]);
11734 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11735 /* test */
11736 testcond:
11737 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11741 out:
11742 if (stopVarNamePtr) {
11743 Jim_DecrRefCount(interp, stopVarNamePtr);
11745 if (varNamePtr) {
11746 Jim_DecrRefCount(interp, varNamePtr);
11749 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11750 Jim_SetEmptyResult(interp);
11751 return JIM_OK;
11754 return retval;
11757 /* [loop] */
11758 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11760 int retval;
11761 jim_wide i;
11762 jim_wide limit;
11763 jim_wide incr = 1;
11764 Jim_Obj *bodyObjPtr;
11766 if (argc != 5 && argc != 6) {
11767 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11768 return JIM_ERR;
11771 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11772 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11773 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11774 return JIM_ERR;
11776 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11778 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11780 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11781 retval = Jim_EvalObj(interp, bodyObjPtr);
11782 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11783 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11785 retval = JIM_OK;
11787 /* Increment */
11788 i += incr;
11790 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11791 if (argv[1]->typePtr != &variableObjType) {
11792 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11793 return JIM_ERR;
11796 JimWideValue(objPtr) = i;
11797 Jim_InvalidateStringRep(objPtr);
11799 /* The following step is required in order to invalidate the
11800 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11801 if (argv[1]->typePtr != &variableObjType) {
11802 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11803 retval = JIM_ERR;
11804 break;
11808 else {
11809 objPtr = Jim_NewIntObj(interp, i);
11810 retval = Jim_SetVariable(interp, argv[1], objPtr);
11811 if (retval != JIM_OK) {
11812 Jim_FreeNewObj(interp, objPtr);
11818 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11819 Jim_SetEmptyResult(interp);
11820 return JIM_OK;
11822 return retval;
11825 /* List iterators make it easy to iterate over a list.
11826 * At some point iterators will be expanded to support generators.
11828 typedef struct {
11829 Jim_Obj *objPtr;
11830 int idx;
11831 } Jim_ListIter;
11834 * Initialise the iterator at the start of the list.
11836 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11838 iter->objPtr = objPtr;
11839 iter->idx = 0;
11843 * Returns the next object from the list, or NULL on end-of-list.
11845 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11847 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11848 return NULL;
11850 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11854 * Returns 1 if end-of-list has been reached.
11856 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11858 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11861 /* foreach + lmap implementation. */
11862 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11864 int result = JIM_ERR;
11865 int i, numargs;
11866 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11867 Jim_ListIter *iters;
11868 Jim_Obj *script;
11869 Jim_Obj *resultObj;
11871 if (argc < 4 || argc % 2 != 0) {
11872 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11873 return JIM_ERR;
11875 script = argv[argc - 1]; /* Last argument is a script */
11876 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11878 if (numargs == 2) {
11879 iters = twoiters;
11881 else {
11882 iters = Jim_Alloc(numargs * sizeof(*iters));
11884 for (i = 0; i < numargs; i++) {
11885 JimListIterInit(&iters[i], argv[i + 1]);
11886 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11887 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11888 return JIM_ERR;
11892 if (doMap) {
11893 resultObj = Jim_NewListObj(interp, NULL, 0);
11895 else {
11896 resultObj = interp->emptyObj;
11898 Jim_IncrRefCount(resultObj);
11900 while (1) {
11901 /* Have we expired all lists? */
11902 for (i = 0; i < numargs; i += 2) {
11903 if (!JimListIterDone(interp, &iters[i + 1])) {
11904 break;
11907 if (i == numargs) {
11908 /* All done */
11909 break;
11912 /* For each list */
11913 for (i = 0; i < numargs; i += 2) {
11914 Jim_Obj *varName;
11916 /* foreach var */
11917 JimListIterInit(&iters[i], argv[i + 1]);
11918 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11919 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11920 if (!valObj) {
11921 /* Ran out, so store the empty string */
11922 valObj = interp->emptyObj;
11924 /* Avoid shimmering */
11925 Jim_IncrRefCount(valObj);
11926 result = Jim_SetVariable(interp, varName, valObj);
11927 Jim_DecrRefCount(interp, valObj);
11928 if (result != JIM_OK) {
11929 goto err;
11933 switch (result = Jim_EvalObj(interp, script)) {
11934 case JIM_OK:
11935 if (doMap) {
11936 Jim_ListAppendElement(interp, resultObj, interp->result);
11938 break;
11939 case JIM_CONTINUE:
11940 break;
11941 case JIM_BREAK:
11942 goto out;
11943 default:
11944 goto err;
11947 out:
11948 result = JIM_OK;
11949 Jim_SetResult(interp, resultObj);
11950 err:
11951 Jim_DecrRefCount(interp, resultObj);
11952 if (numargs > 2) {
11953 Jim_Free(iters);
11955 return result;
11958 /* [foreach] */
11959 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11961 return JimForeachMapHelper(interp, argc, argv, 0);
11964 /* [lmap] */
11965 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11967 return JimForeachMapHelper(interp, argc, argv, 1);
11970 /* [lassign] */
11971 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11973 int result = JIM_ERR;
11974 int i;
11975 Jim_ListIter iter;
11976 Jim_Obj *resultObj;
11978 if (argc < 2) {
11979 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11980 return JIM_ERR;
11983 JimListIterInit(&iter, argv[1]);
11985 for (i = 2; i < argc; i++) {
11986 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11987 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11988 if (result != JIM_OK) {
11989 return result;
11993 resultObj = Jim_NewListObj(interp, NULL, 0);
11994 while (!JimListIterDone(interp, &iter)) {
11995 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
11998 Jim_SetResult(interp, resultObj);
12000 return JIM_OK;
12003 /* [if] */
12004 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12006 int boolean, retval, current = 1, falsebody = 0;
12008 if (argc >= 3) {
12009 while (1) {
12010 /* Far not enough arguments given! */
12011 if (current >= argc)
12012 goto err;
12013 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12014 != JIM_OK)
12015 return retval;
12016 /* There lacks something, isn't it? */
12017 if (current >= argc)
12018 goto err;
12019 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12020 current++;
12021 /* Tsk tsk, no then-clause? */
12022 if (current >= argc)
12023 goto err;
12024 if (boolean)
12025 return Jim_EvalObj(interp, argv[current]);
12026 /* Ok: no else-clause follows */
12027 if (++current >= argc) {
12028 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12029 return JIM_OK;
12031 falsebody = current++;
12032 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12033 /* IIICKS - else-clause isn't last cmd? */
12034 if (current != argc - 1)
12035 goto err;
12036 return Jim_EvalObj(interp, argv[current]);
12038 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12039 /* Ok: elseif follows meaning all the stuff
12040 * again (how boring...) */
12041 continue;
12042 /* OOPS - else-clause is not last cmd? */
12043 else if (falsebody != argc - 1)
12044 goto err;
12045 return Jim_EvalObj(interp, argv[falsebody]);
12047 return JIM_OK;
12049 err:
12050 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12051 return JIM_ERR;
12055 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12056 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12057 Jim_Obj *stringObj, int nocase)
12059 Jim_Obj *parms[4];
12060 int argc = 0;
12061 long eq;
12062 int rc;
12064 parms[argc++] = commandObj;
12065 if (nocase) {
12066 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12068 parms[argc++] = patternObj;
12069 parms[argc++] = stringObj;
12071 rc = Jim_EvalObjVector(interp, argc, parms);
12073 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12074 eq = -rc;
12077 return eq;
12080 enum
12081 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12083 /* [switch] */
12084 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12086 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12087 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12088 Jim_Obj *script = 0;
12090 if (argc < 3) {
12091 wrongnumargs:
12092 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12093 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12094 return JIM_ERR;
12096 for (opt = 1; opt < argc; ++opt) {
12097 const char *option = Jim_String(argv[opt]);
12099 if (*option != '-')
12100 break;
12101 else if (strncmp(option, "--", 2) == 0) {
12102 ++opt;
12103 break;
12105 else if (strncmp(option, "-exact", 2) == 0)
12106 matchOpt = SWITCH_EXACT;
12107 else if (strncmp(option, "-glob", 2) == 0)
12108 matchOpt = SWITCH_GLOB;
12109 else if (strncmp(option, "-regexp", 2) == 0)
12110 matchOpt = SWITCH_RE;
12111 else if (strncmp(option, "-command", 2) == 0) {
12112 matchOpt = SWITCH_CMD;
12113 if ((argc - opt) < 2)
12114 goto wrongnumargs;
12115 command = argv[++opt];
12117 else {
12118 Jim_SetResultFormatted(interp,
12119 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12120 argv[opt]);
12121 return JIM_ERR;
12123 if ((argc - opt) < 2)
12124 goto wrongnumargs;
12126 strObj = argv[opt++];
12127 patCount = argc - opt;
12128 if (patCount == 1) {
12129 Jim_Obj **vector;
12131 JimListGetElements(interp, argv[opt], &patCount, &vector);
12132 caseList = vector;
12134 else
12135 caseList = &argv[opt];
12136 if (patCount == 0 || patCount % 2 != 0)
12137 goto wrongnumargs;
12138 for (i = 0; script == 0 && i < patCount; i += 2) {
12139 Jim_Obj *patObj = caseList[i];
12141 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12142 || i < (patCount - 2)) {
12143 switch (matchOpt) {
12144 case SWITCH_EXACT:
12145 if (Jim_StringEqObj(strObj, patObj))
12146 script = caseList[i + 1];
12147 break;
12148 case SWITCH_GLOB:
12149 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12150 script = caseList[i + 1];
12151 break;
12152 case SWITCH_RE:
12153 command = Jim_NewStringObj(interp, "regexp", -1);
12154 /* Fall thru intentionally */
12155 case SWITCH_CMD:{
12156 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12158 /* After the execution of a command we need to
12159 * make sure to reconvert the object into a list
12160 * again. Only for the single-list style [switch]. */
12161 if (argc - opt == 1) {
12162 Jim_Obj **vector;
12164 JimListGetElements(interp, argv[opt], &patCount, &vector);
12165 caseList = vector;
12167 /* command is here already decref'd */
12168 if (rc < 0) {
12169 return -rc;
12171 if (rc)
12172 script = caseList[i + 1];
12173 break;
12177 else {
12178 script = caseList[i + 1];
12181 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12182 script = caseList[i + 1];
12183 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12184 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12185 return JIM_ERR;
12187 Jim_SetEmptyResult(interp);
12188 if (script) {
12189 return Jim_EvalObj(interp, script);
12191 return JIM_OK;
12194 /* [list] */
12195 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12197 Jim_Obj *listObjPtr;
12199 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12200 Jim_SetResult(interp, listObjPtr);
12201 return JIM_OK;
12204 /* [lindex] */
12205 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12207 Jim_Obj *objPtr, *listObjPtr;
12208 int i;
12209 int idx;
12211 if (argc < 3) {
12212 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
12213 return JIM_ERR;
12215 objPtr = argv[1];
12216 Jim_IncrRefCount(objPtr);
12217 for (i = 2; i < argc; i++) {
12218 listObjPtr = objPtr;
12219 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12220 Jim_DecrRefCount(interp, listObjPtr);
12221 return JIM_ERR;
12223 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12224 /* Returns an empty object if the index
12225 * is out of range. */
12226 Jim_DecrRefCount(interp, listObjPtr);
12227 Jim_SetEmptyResult(interp);
12228 return JIM_OK;
12230 Jim_IncrRefCount(objPtr);
12231 Jim_DecrRefCount(interp, listObjPtr);
12233 Jim_SetResult(interp, objPtr);
12234 Jim_DecrRefCount(interp, objPtr);
12235 return JIM_OK;
12238 /* [llength] */
12239 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12241 if (argc != 2) {
12242 Jim_WrongNumArgs(interp, 1, argv, "list");
12243 return JIM_ERR;
12245 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12246 return JIM_OK;
12249 /* [lsearch] */
12250 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12252 static const char * const options[] = {
12253 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12254 NULL
12256 enum
12257 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12258 OPT_COMMAND };
12259 int i;
12260 int opt_bool = 0;
12261 int opt_not = 0;
12262 int opt_nocase = 0;
12263 int opt_all = 0;
12264 int opt_inline = 0;
12265 int opt_match = OPT_EXACT;
12266 int listlen;
12267 int rc = JIM_OK;
12268 Jim_Obj *listObjPtr = NULL;
12269 Jim_Obj *commandObj = NULL;
12271 if (argc < 3) {
12272 wrongargs:
12273 Jim_WrongNumArgs(interp, 1, argv,
12274 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12275 return JIM_ERR;
12278 for (i = 1; i < argc - 2; i++) {
12279 int option;
12281 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12282 return JIM_ERR;
12284 switch (option) {
12285 case OPT_BOOL:
12286 opt_bool = 1;
12287 opt_inline = 0;
12288 break;
12289 case OPT_NOT:
12290 opt_not = 1;
12291 break;
12292 case OPT_NOCASE:
12293 opt_nocase = 1;
12294 break;
12295 case OPT_INLINE:
12296 opt_inline = 1;
12297 opt_bool = 0;
12298 break;
12299 case OPT_ALL:
12300 opt_all = 1;
12301 break;
12302 case OPT_COMMAND:
12303 if (i >= argc - 2) {
12304 goto wrongargs;
12306 commandObj = argv[++i];
12307 /* fallthru */
12308 case OPT_EXACT:
12309 case OPT_GLOB:
12310 case OPT_REGEXP:
12311 opt_match = option;
12312 break;
12316 argv += i;
12318 if (opt_all) {
12319 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12321 if (opt_match == OPT_REGEXP) {
12322 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12324 if (commandObj) {
12325 Jim_IncrRefCount(commandObj);
12328 listlen = Jim_ListLength(interp, argv[0]);
12329 for (i = 0; i < listlen; i++) {
12330 Jim_Obj *objPtr;
12331 int eq = 0;
12333 Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
12334 switch (opt_match) {
12335 case OPT_EXACT:
12336 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12337 break;
12339 case OPT_GLOB:
12340 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12341 break;
12343 case OPT_REGEXP:
12344 case OPT_COMMAND:
12345 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12346 if (eq < 0) {
12347 if (listObjPtr) {
12348 Jim_FreeNewObj(interp, listObjPtr);
12350 rc = JIM_ERR;
12351 goto done;
12353 break;
12356 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12357 if (!eq && opt_bool && opt_not && !opt_all) {
12358 continue;
12361 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12362 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12363 Jim_Obj *resultObj;
12365 if (opt_bool) {
12366 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12368 else if (!opt_inline) {
12369 resultObj = Jim_NewIntObj(interp, i);
12371 else {
12372 resultObj = objPtr;
12375 if (opt_all) {
12376 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12378 else {
12379 Jim_SetResult(interp, resultObj);
12380 goto done;
12385 if (opt_all) {
12386 Jim_SetResult(interp, listObjPtr);
12388 else {
12389 /* No match */
12390 if (opt_bool) {
12391 Jim_SetResultBool(interp, opt_not);
12393 else if (!opt_inline) {
12394 Jim_SetResultInt(interp, -1);
12398 done:
12399 if (commandObj) {
12400 Jim_DecrRefCount(interp, commandObj);
12402 return rc;
12405 /* [lappend] */
12406 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12408 Jim_Obj *listObjPtr;
12409 int shared, i;
12411 if (argc < 2) {
12412 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12413 return JIM_ERR;
12415 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12416 if (!listObjPtr) {
12417 /* Create the list if it does not exists */
12418 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12419 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12420 Jim_FreeNewObj(interp, listObjPtr);
12421 return JIM_ERR;
12424 shared = Jim_IsShared(listObjPtr);
12425 if (shared)
12426 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12427 for (i = 2; i < argc; i++)
12428 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12429 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12430 if (shared)
12431 Jim_FreeNewObj(interp, listObjPtr);
12432 return JIM_ERR;
12434 Jim_SetResult(interp, listObjPtr);
12435 return JIM_OK;
12438 /* [linsert] */
12439 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12441 int idx, len;
12442 Jim_Obj *listPtr;
12444 if (argc < 3) {
12445 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12446 return JIM_ERR;
12448 listPtr = argv[1];
12449 if (Jim_IsShared(listPtr))
12450 listPtr = Jim_DuplicateObj(interp, listPtr);
12451 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12452 goto err;
12453 len = Jim_ListLength(interp, listPtr);
12454 if (idx >= len)
12455 idx = len;
12456 else if (idx < 0)
12457 idx = len + idx + 1;
12458 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12459 Jim_SetResult(interp, listPtr);
12460 return JIM_OK;
12461 err:
12462 if (listPtr != argv[1]) {
12463 Jim_FreeNewObj(interp, listPtr);
12465 return JIM_ERR;
12468 /* [lreplace] */
12469 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12471 int first, last, len, rangeLen;
12472 Jim_Obj *listObj;
12473 Jim_Obj *newListObj;
12475 if (argc < 4) {
12476 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12477 return JIM_ERR;
12479 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12480 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12481 return JIM_ERR;
12484 listObj = argv[1];
12485 len = Jim_ListLength(interp, listObj);
12487 first = JimRelToAbsIndex(len, first);
12488 last = JimRelToAbsIndex(len, last);
12489 JimRelToAbsRange(len, &first, &last, &rangeLen);
12491 /* Now construct a new list which consists of:
12492 * <elements before first> <supplied elements> <elements after last>
12495 /* Check to see if trying to replace past the end of the list */
12496 if (first < len) {
12497 /* OK. Not past the end */
12499 else if (len == 0) {
12500 /* Special for empty list, adjust first to 0 */
12501 first = 0;
12503 else {
12504 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12505 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12506 return JIM_ERR;
12509 /* Add the first set of elements */
12510 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12512 /* Add supplied elements */
12513 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12515 /* Add the remaining elements */
12516 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12518 Jim_SetResult(interp, newListObj);
12519 return JIM_OK;
12522 /* [lset] */
12523 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12525 if (argc < 3) {
12526 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12527 return JIM_ERR;
12529 else if (argc == 3) {
12530 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12531 return JIM_ERR;
12532 Jim_SetResult(interp, argv[2]);
12533 return JIM_OK;
12535 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1])
12536 == JIM_ERR)
12537 return JIM_ERR;
12538 return JIM_OK;
12541 /* [lsort] */
12542 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12544 static const char * const options[] = {
12545 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12547 enum
12548 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12549 Jim_Obj *resObj;
12550 int i;
12551 int retCode;
12553 struct lsort_info info;
12555 if (argc < 2) {
12556 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12557 return JIM_ERR;
12560 info.type = JIM_LSORT_ASCII;
12561 info.order = 1;
12562 info.indexed = 0;
12563 info.unique = 0;
12564 info.command = NULL;
12565 info.interp = interp;
12567 for (i = 1; i < (argc - 1); i++) {
12568 int option;
12570 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12571 != JIM_OK)
12572 return JIM_ERR;
12573 switch (option) {
12574 case OPT_ASCII:
12575 info.type = JIM_LSORT_ASCII;
12576 break;
12577 case OPT_NOCASE:
12578 info.type = JIM_LSORT_NOCASE;
12579 break;
12580 case OPT_INTEGER:
12581 info.type = JIM_LSORT_INTEGER;
12582 break;
12583 case OPT_REAL:
12584 info.type = JIM_LSORT_REAL;
12585 break;
12586 case OPT_INCREASING:
12587 info.order = 1;
12588 break;
12589 case OPT_DECREASING:
12590 info.order = -1;
12591 break;
12592 case OPT_UNIQUE:
12593 info.unique = 1;
12594 break;
12595 case OPT_COMMAND:
12596 if (i >= (argc - 2)) {
12597 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12598 return JIM_ERR;
12600 info.type = JIM_LSORT_COMMAND;
12601 info.command = argv[i + 1];
12602 i++;
12603 break;
12604 case OPT_INDEX:
12605 if (i >= (argc - 2)) {
12606 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12607 return JIM_ERR;
12609 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12610 return JIM_ERR;
12612 info.indexed = 1;
12613 i++;
12614 break;
12617 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12618 retCode = ListSortElements(interp, resObj, &info);
12619 if (retCode == JIM_OK) {
12620 Jim_SetResult(interp, resObj);
12622 else {
12623 Jim_FreeNewObj(interp, resObj);
12625 return retCode;
12628 /* [append] */
12629 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12631 Jim_Obj *stringObjPtr;
12632 int i;
12634 if (argc < 2) {
12635 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12636 return JIM_ERR;
12638 if (argc == 2) {
12639 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12640 if (!stringObjPtr)
12641 return JIM_ERR;
12643 else {
12644 int freeobj = 0;
12645 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12646 if (!stringObjPtr) {
12647 /* Create the string if it doesn't exist */
12648 stringObjPtr = Jim_NewEmptyStringObj(interp);
12649 freeobj = 1;
12651 else if (Jim_IsShared(stringObjPtr)) {
12652 freeobj = 1;
12653 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12655 for (i = 2; i < argc; i++) {
12656 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12658 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12659 if (freeobj) {
12660 Jim_FreeNewObj(interp, stringObjPtr);
12662 return JIM_ERR;
12665 Jim_SetResult(interp, stringObjPtr);
12666 return JIM_OK;
12669 /* [debug] */
12670 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12672 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12673 static const char * const options[] = {
12674 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12675 "exprbc", "show",
12676 NULL
12678 enum
12680 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12681 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12683 int option;
12685 if (argc < 2) {
12686 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12687 return JIM_ERR;
12689 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12690 return JIM_ERR;
12691 if (option == OPT_REFCOUNT) {
12692 if (argc != 3) {
12693 Jim_WrongNumArgs(interp, 2, argv, "object");
12694 return JIM_ERR;
12696 Jim_SetResultInt(interp, argv[2]->refCount);
12697 return JIM_OK;
12699 else if (option == OPT_OBJCOUNT) {
12700 int freeobj = 0, liveobj = 0;
12701 char buf[256];
12702 Jim_Obj *objPtr;
12704 if (argc != 2) {
12705 Jim_WrongNumArgs(interp, 2, argv, "");
12706 return JIM_ERR;
12708 /* Count the number of free objects. */
12709 objPtr = interp->freeList;
12710 while (objPtr) {
12711 freeobj++;
12712 objPtr = objPtr->nextObjPtr;
12714 /* Count the number of live objects. */
12715 objPtr = interp->liveList;
12716 while (objPtr) {
12717 liveobj++;
12718 objPtr = objPtr->nextObjPtr;
12720 /* Set the result string and return. */
12721 sprintf(buf, "free %d used %d", freeobj, liveobj);
12722 Jim_SetResultString(interp, buf, -1);
12723 return JIM_OK;
12725 else if (option == OPT_OBJECTS) {
12726 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12728 /* Count the number of live objects. */
12729 objPtr = interp->liveList;
12730 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12731 while (objPtr) {
12732 char buf[128];
12733 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12735 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12736 sprintf(buf, "%p", objPtr);
12737 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12738 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12739 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12740 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12741 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12742 objPtr = objPtr->nextObjPtr;
12744 Jim_SetResult(interp, listObjPtr);
12745 return JIM_OK;
12747 else if (option == OPT_INVSTR) {
12748 Jim_Obj *objPtr;
12750 if (argc != 3) {
12751 Jim_WrongNumArgs(interp, 2, argv, "object");
12752 return JIM_ERR;
12754 objPtr = argv[2];
12755 if (objPtr->typePtr != NULL)
12756 Jim_InvalidateStringRep(objPtr);
12757 Jim_SetEmptyResult(interp);
12758 return JIM_OK;
12760 else if (option == OPT_SHOW) {
12761 const char *s;
12762 int len, charlen;
12764 if (argc != 3) {
12765 Jim_WrongNumArgs(interp, 2, argv, "object");
12766 return JIM_ERR;
12768 s = Jim_GetString(argv[2], &len);
12769 #ifdef JIM_UTF8
12770 charlen = utf8_strlen(s, len);
12771 #else
12772 charlen = len;
12773 #endif
12774 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12775 printf("chars (%d): <<%s>>\n", charlen, s);
12776 printf("bytes (%d):", len);
12777 while (len--) {
12778 printf(" %02x", (unsigned char)*s++);
12780 printf("\n");
12781 return JIM_OK;
12783 else if (option == OPT_SCRIPTLEN) {
12784 ScriptObj *script;
12786 if (argc != 3) {
12787 Jim_WrongNumArgs(interp, 2, argv, "script");
12788 return JIM_ERR;
12790 script = Jim_GetScript(interp, argv[2]);
12791 Jim_SetResultInt(interp, script->len);
12792 return JIM_OK;
12794 else if (option == OPT_EXPRLEN) {
12795 ExprByteCode *expr;
12797 if (argc != 3) {
12798 Jim_WrongNumArgs(interp, 2, argv, "expression");
12799 return JIM_ERR;
12801 expr = JimGetExpression(interp, argv[2]);
12802 if (expr == NULL)
12803 return JIM_ERR;
12804 Jim_SetResultInt(interp, expr->len);
12805 return JIM_OK;
12807 else if (option == OPT_EXPRBC) {
12808 Jim_Obj *objPtr;
12809 ExprByteCode *expr;
12810 int i;
12812 if (argc != 3) {
12813 Jim_WrongNumArgs(interp, 2, argv, "expression");
12814 return JIM_ERR;
12816 expr = JimGetExpression(interp, argv[2]);
12817 if (expr == NULL)
12818 return JIM_ERR;
12819 objPtr = Jim_NewListObj(interp, NULL, 0);
12820 for (i = 0; i < expr->len; i++) {
12821 const char *type;
12822 const Jim_ExprOperator *op;
12823 Jim_Obj *obj = expr->token[i].objPtr;
12825 switch (expr->token[i].type) {
12826 case JIM_TT_EXPR_INT:
12827 type = "int";
12828 break;
12829 case JIM_TT_EXPR_DOUBLE:
12830 type = "double";
12831 break;
12832 case JIM_TT_CMD:
12833 type = "command";
12834 break;
12835 case JIM_TT_VAR:
12836 type = "variable";
12837 break;
12838 case JIM_TT_DICTSUGAR:
12839 type = "dictsugar";
12840 break;
12841 case JIM_TT_EXPRSUGAR:
12842 type = "exprsugar";
12843 break;
12844 case JIM_TT_ESC:
12845 type = "subst";
12846 break;
12847 case JIM_TT_STR:
12848 type = "string";
12849 break;
12850 default:
12851 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12852 if (op == NULL) {
12853 type = "private";
12855 else {
12856 type = "operator";
12858 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12859 break;
12861 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12862 Jim_ListAppendElement(interp, objPtr, obj);
12864 Jim_SetResult(interp, objPtr);
12865 return JIM_OK;
12867 else {
12868 Jim_SetResultString(interp,
12869 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12870 return JIM_ERR;
12872 /* unreached */
12873 #endif /* JIM_BOOTSTRAP */
12874 #if !defined(JIM_DEBUG_COMMAND)
12875 Jim_SetResultString(interp, "unsupported", -1);
12876 return JIM_ERR;
12877 #endif
12880 /* [eval] */
12881 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12883 int rc;
12885 if (argc < 2) {
12886 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12887 return JIM_ERR;
12890 if (argc == 2) {
12891 rc = Jim_EvalObj(interp, argv[1]);
12893 else {
12894 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12897 if (rc == JIM_ERR) {
12898 /* eval is "interesting", so add a stack frame here */
12899 interp->addStackTrace++;
12901 return rc;
12904 /* [uplevel] */
12905 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12907 if (argc >= 2) {
12908 int retcode;
12909 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12910 int savedTailcall;
12911 const char *str;
12913 /* Save the old callframe pointer */
12914 savedCallFrame = interp->framePtr;
12916 /* Lookup the target frame pointer */
12917 str = Jim_String(argv[1]);
12918 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12919 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12920 argc--;
12921 argv++;
12923 else {
12924 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12926 if (targetCallFrame == NULL) {
12927 return JIM_ERR;
12929 if (argc < 2) {
12930 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12931 return JIM_ERR;
12933 /* Eval the code in the target callframe. */
12934 interp->framePtr = targetCallFrame;
12935 /* Can't merge tailcalls across upcall */
12936 savedTailcall = interp->framePtr->tailcall;
12937 interp->framePtr->tailcall = 0;
12938 if (argc == 2) {
12939 retcode = Jim_EvalObj(interp, argv[1]);
12941 else {
12942 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12944 interp->framePtr->tailcall = savedTailcall;
12945 interp->framePtr = savedCallFrame;
12946 return retcode;
12948 else {
12949 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12950 return JIM_ERR;
12954 /* [expr] */
12955 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12957 Jim_Obj *exprResultPtr;
12958 int retcode;
12960 if (argc == 2) {
12961 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12963 else if (argc > 2) {
12964 Jim_Obj *objPtr;
12966 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12967 Jim_IncrRefCount(objPtr);
12968 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12969 Jim_DecrRefCount(interp, objPtr);
12971 else {
12972 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12973 return JIM_ERR;
12975 if (retcode != JIM_OK)
12976 return retcode;
12977 Jim_SetResult(interp, exprResultPtr);
12978 Jim_DecrRefCount(interp, exprResultPtr);
12979 return JIM_OK;
12982 /* [break] */
12983 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12985 if (argc != 1) {
12986 Jim_WrongNumArgs(interp, 1, argv, "");
12987 return JIM_ERR;
12989 return JIM_BREAK;
12992 /* [continue] */
12993 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12995 if (argc != 1) {
12996 Jim_WrongNumArgs(interp, 1, argv, "");
12997 return JIM_ERR;
12999 return JIM_CONTINUE;
13002 /* [return] */
13003 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13005 int i;
13006 Jim_Obj *stackTraceObj = NULL;
13007 Jim_Obj *errorCodeObj = NULL;
13008 int returnCode = JIM_OK;
13009 long level = 1;
13011 for (i = 1; i < argc - 1; i += 2) {
13012 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13013 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13014 return JIM_ERR;
13017 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13018 stackTraceObj = argv[i + 1];
13020 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13021 errorCodeObj = argv[i + 1];
13023 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13024 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13025 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13026 return JIM_ERR;
13029 else {
13030 break;
13034 if (i != argc - 1 && i != argc) {
13035 Jim_WrongNumArgs(interp, 1, argv,
13036 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13039 /* If a stack trace is supplied and code is error, set the stack trace */
13040 if (stackTraceObj && returnCode == JIM_ERR) {
13041 JimSetStackTrace(interp, stackTraceObj);
13043 /* If an error code list is supplied, set the global $errorCode */
13044 if (errorCodeObj && returnCode == JIM_ERR) {
13045 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13047 interp->returnCode = returnCode;
13048 interp->returnLevel = level;
13050 if (i == argc - 1) {
13051 Jim_SetResult(interp, argv[i]);
13053 return JIM_RETURN;
13056 /* [tailcall] */
13057 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13059 if (interp->framePtr->level == 0) {
13060 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13061 return JIM_ERR;
13063 else if (argc >= 2) {
13064 /* Need to resolve the tailcall command in the current context */
13065 Jim_CallFrame *cf = interp->framePtr->parent;
13067 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13068 if (cmdPtr == NULL) {
13069 return JIM_ERR;
13072 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13074 /* And stash this pre-resolved command */
13075 JimIncrCmdRefCount(cmdPtr);
13076 cf->tailcallCmd = cmdPtr;
13078 /* And stash the command list */
13079 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13081 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13082 Jim_IncrRefCount(cf->tailcallObj);
13084 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13085 return JIM_EVAL;
13087 return JIM_OK;
13090 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13092 Jim_Obj *cmdList;
13093 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13095 /* prefixListObj is a list to which the args need to be appended */
13096 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13097 ListInsertElements(cmdList, -1, argc - 1, argv + 1);
13099 return JimEvalObjList(interp, cmdList);
13102 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13104 Jim_Obj *prefixListObj = privData;
13105 Jim_DecrRefCount(interp, prefixListObj);
13108 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13110 Jim_Obj *prefixListObj;
13111 const char *newname;
13113 if (argc < 3) {
13114 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13115 return JIM_ERR;
13118 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13119 Jim_IncrRefCount(prefixListObj);
13120 newname = Jim_String(argv[1]);
13121 if (newname[0] == ':' && newname[1] == ':') {
13122 while (*++newname == ':') {
13126 Jim_SetResult(interp, argv[1]);
13128 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13131 /* [proc] */
13132 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13134 Jim_Cmd *cmd;
13136 if (argc != 4 && argc != 5) {
13137 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13138 return JIM_ERR;
13141 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13142 return JIM_ERR;
13145 if (argc == 4) {
13146 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13148 else {
13149 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13152 if (cmd) {
13153 /* Add the new command */
13154 Jim_Obj *qualifiedCmdNameObj;
13155 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13157 JimCreateCommand(interp, cmdname, cmd);
13159 /* Calculate and set the namespace for this proc */
13160 JimUpdateProcNamespace(interp, cmd, cmdname);
13162 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13164 /* Unlike Tcl, set the name of the proc as the result */
13165 Jim_SetResult(interp, argv[1]);
13166 return JIM_OK;
13168 return JIM_ERR;
13171 /* [local] */
13172 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13174 int retcode;
13176 if (argc < 2) {
13177 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13178 return JIM_ERR;
13181 /* Evaluate the arguments with 'local' in force */
13182 interp->local++;
13183 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13184 interp->local--;
13187 /* If OK, and the result is a proc, add it to the list of local procs */
13188 if (retcode == 0) {
13189 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13191 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13192 return JIM_ERR;
13194 if (interp->framePtr->localCommands == NULL) {
13195 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13196 Jim_InitStack(interp->framePtr->localCommands);
13198 Jim_IncrRefCount(cmdNameObj);
13199 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13202 return retcode;
13205 /* [upcall] */
13206 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13208 if (argc < 2) {
13209 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13210 return JIM_ERR;
13212 else {
13213 int retcode;
13215 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13216 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13217 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13218 return JIM_ERR;
13220 /* OK. Mark this command as being in an upcall */
13221 cmdPtr->u.proc.upcall++;
13222 JimIncrCmdRefCount(cmdPtr);
13224 /* Invoke the command as normal */
13225 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13227 /* No longer in an upcall */
13228 cmdPtr->u.proc.upcall--;
13229 JimDecrCmdRefCount(interp, cmdPtr);
13231 return retcode;
13235 /* [apply] */
13236 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13238 if (argc < 2) {
13239 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13240 return JIM_ERR;
13242 else {
13243 int ret;
13244 Jim_Cmd *cmd;
13245 Jim_Obj *argListObjPtr;
13246 Jim_Obj *bodyObjPtr;
13247 Jim_Obj *nsObj = NULL;
13248 Jim_Obj **nargv;
13250 int len = Jim_ListLength(interp, argv[1]);
13251 if (len != 2 && len != 3) {
13252 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13253 return JIM_ERR;
13256 if (len == 3) {
13257 #ifdef jim_ext_namespace
13258 /* Need to canonicalise the given namespace. */
13259 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13260 #else
13261 Jim_SetResultString(interp, "namespaces not enabled", -1);
13262 return JIM_ERR;
13263 #endif
13265 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13266 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13268 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13270 if (cmd) {
13271 /* Create a new argv array with a dummy argv[0], for error messages */
13272 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13273 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13274 Jim_IncrRefCount(nargv[0]);
13275 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13276 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13277 Jim_DecrRefCount(interp, nargv[0]);
13278 Jim_Free(nargv);
13280 JimDecrCmdRefCount(interp, cmd);
13281 return ret;
13283 return JIM_ERR;
13288 /* [concat] */
13289 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13291 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13292 return JIM_OK;
13295 /* [upvar] */
13296 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13298 int i;
13299 Jim_CallFrame *targetCallFrame;
13301 /* Lookup the target frame pointer */
13302 if (argc > 3 && (argc % 2 == 0)) {
13303 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13304 argc--;
13305 argv++;
13307 else {
13308 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13310 if (targetCallFrame == NULL) {
13311 return JIM_ERR;
13314 /* Check for arity */
13315 if (argc < 3) {
13316 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13317 return JIM_ERR;
13320 /* Now... for every other/local couple: */
13321 for (i = 1; i < argc; i += 2) {
13322 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13323 return JIM_ERR;
13325 return JIM_OK;
13328 /* [global] */
13329 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13331 int i;
13333 if (argc < 2) {
13334 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13335 return JIM_ERR;
13337 /* Link every var to the toplevel having the same name */
13338 if (interp->framePtr->level == 0)
13339 return JIM_OK; /* global at toplevel... */
13340 for (i = 1; i < argc; i++) {
13341 /* global ::blah does nothing */
13342 const char *name = Jim_String(argv[i]);
13343 if (name[0] != ':' || name[1] != ':') {
13344 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13345 return JIM_ERR;
13348 return JIM_OK;
13351 /* does the [string map] operation. On error NULL is returned,
13352 * otherwise a new string object with the result, having refcount = 0,
13353 * is returned. */
13354 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13355 Jim_Obj *objPtr, int nocase)
13357 int numMaps;
13358 const char *str, *noMatchStart = NULL;
13359 int strLen, i;
13360 Jim_Obj *resultObjPtr;
13362 numMaps = Jim_ListLength(interp, mapListObjPtr);
13363 if (numMaps % 2) {
13364 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13365 return NULL;
13368 str = Jim_String(objPtr);
13369 strLen = Jim_Utf8Length(interp, objPtr);
13371 /* Map it */
13372 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13373 while (strLen) {
13374 for (i = 0; i < numMaps; i += 2) {
13375 Jim_Obj *objPtr;
13376 const char *k;
13377 int kl;
13379 Jim_ListIndex(interp, mapListObjPtr, i, &objPtr, JIM_NONE);
13380 k = Jim_String(objPtr);
13381 kl = Jim_Utf8Length(interp, objPtr);
13383 if (strLen >= kl && kl) {
13384 int rc;
13385 rc = JimStringCompareLen(str, k, kl, nocase);
13386 if (rc == 0) {
13387 if (noMatchStart) {
13388 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13389 noMatchStart = NULL;
13391 Jim_ListIndex(interp, mapListObjPtr, i + 1, &objPtr, JIM_NONE);
13392 Jim_AppendObj(interp, resultObjPtr, objPtr);
13393 str += utf8_index(str, kl);
13394 strLen -= kl;
13395 break;
13399 if (i == numMaps) { /* no match */
13400 int c;
13401 if (noMatchStart == NULL)
13402 noMatchStart = str;
13403 str += utf8_tounicode(str, &c);
13404 strLen--;
13407 if (noMatchStart) {
13408 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13410 return resultObjPtr;
13413 /* [string] */
13414 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13416 int len;
13417 int opt_case = 1;
13418 int option;
13419 static const char * const options[] = {
13420 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13421 "map", "repeat", "reverse", "index", "first", "last",
13422 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13424 enum
13426 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13427 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
13428 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13430 static const char * const nocase_options[] = {
13431 "-nocase", NULL
13433 static const char * const nocase_length_options[] = {
13434 "-nocase", "-length", NULL
13437 if (argc < 2) {
13438 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13439 return JIM_ERR;
13441 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13442 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13443 return JIM_ERR;
13445 switch (option) {
13446 case OPT_LENGTH:
13447 case OPT_BYTELENGTH:
13448 if (argc != 3) {
13449 Jim_WrongNumArgs(interp, 2, argv, "string");
13450 return JIM_ERR;
13452 if (option == OPT_LENGTH) {
13453 len = Jim_Utf8Length(interp, argv[2]);
13455 else {
13456 len = Jim_Length(argv[2]);
13458 Jim_SetResultInt(interp, len);
13459 return JIM_OK;
13461 case OPT_COMPARE:
13462 case OPT_EQUAL:
13464 /* n is the number of remaining option args */
13465 long opt_length = -1;
13466 int n = argc - 4;
13467 int i = 2;
13468 while (n > 0) {
13469 int subopt;
13470 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13471 JIM_ENUM_ABBREV) != JIM_OK) {
13472 badcompareargs:
13473 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13474 return JIM_ERR;
13476 if (subopt == 0) {
13477 /* -nocase */
13478 opt_case = 0;
13479 n--;
13481 else {
13482 /* -length */
13483 if (n < 2) {
13484 goto badcompareargs;
13486 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13487 return JIM_ERR;
13489 n -= 2;
13492 if (n) {
13493 goto badcompareargs;
13495 argv += argc - 2;
13496 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13497 /* Fast version - [string equal], case sensitive, no length */
13498 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13500 else {
13501 if (opt_length >= 0) {
13502 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13504 else {
13505 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13507 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13509 return JIM_OK;
13512 case OPT_MATCH:
13513 if (argc != 4 &&
13514 (argc != 5 ||
13515 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13516 JIM_ENUM_ABBREV) != JIM_OK)) {
13517 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13518 return JIM_ERR;
13520 if (opt_case == 0) {
13521 argv++;
13523 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13524 return JIM_OK;
13526 case OPT_MAP:{
13527 Jim_Obj *objPtr;
13529 if (argc != 4 &&
13530 (argc != 5 ||
13531 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13532 JIM_ENUM_ABBREV) != JIM_OK)) {
13533 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13534 return JIM_ERR;
13537 if (opt_case == 0) {
13538 argv++;
13540 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13541 if (objPtr == NULL) {
13542 return JIM_ERR;
13544 Jim_SetResult(interp, objPtr);
13545 return JIM_OK;
13548 case OPT_RANGE:
13549 case OPT_BYTERANGE:{
13550 Jim_Obj *objPtr;
13552 if (argc != 5) {
13553 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13554 return JIM_ERR;
13556 if (option == OPT_RANGE) {
13557 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13559 else
13561 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13564 if (objPtr == NULL) {
13565 return JIM_ERR;
13567 Jim_SetResult(interp, objPtr);
13568 return JIM_OK;
13571 case OPT_REPLACE:{
13572 Jim_Obj *objPtr;
13574 if (argc != 5 && argc != 6) {
13575 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13576 return JIM_ERR;
13578 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13579 if (objPtr == NULL) {
13580 return JIM_ERR;
13582 Jim_SetResult(interp, objPtr);
13583 return JIM_OK;
13587 case OPT_REPEAT:{
13588 Jim_Obj *objPtr;
13589 jim_wide count;
13591 if (argc != 4) {
13592 Jim_WrongNumArgs(interp, 2, argv, "string count");
13593 return JIM_ERR;
13595 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13596 return JIM_ERR;
13598 objPtr = Jim_NewStringObj(interp, "", 0);
13599 if (count > 0) {
13600 while (count--) {
13601 Jim_AppendObj(interp, objPtr, argv[2]);
13604 Jim_SetResult(interp, objPtr);
13605 return JIM_OK;
13608 case OPT_REVERSE:{
13609 char *buf, *p;
13610 const char *str;
13611 int len;
13612 int i;
13614 if (argc != 3) {
13615 Jim_WrongNumArgs(interp, 2, argv, "string");
13616 return JIM_ERR;
13619 str = Jim_GetString(argv[2], &len);
13620 buf = Jim_Alloc(len + 1);
13621 p = buf + len;
13622 *p = 0;
13623 for (i = 0; i < len; ) {
13624 int c;
13625 int l = utf8_tounicode(str, &c);
13626 memcpy(p - l, str, l);
13627 p -= l;
13628 i += l;
13629 str += l;
13631 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13632 return JIM_OK;
13635 case OPT_INDEX:{
13636 int idx;
13637 const char *str;
13639 if (argc != 4) {
13640 Jim_WrongNumArgs(interp, 2, argv, "string index");
13641 return JIM_ERR;
13643 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13644 return JIM_ERR;
13646 str = Jim_String(argv[2]);
13647 len = Jim_Utf8Length(interp, argv[2]);
13648 if (idx != INT_MIN && idx != INT_MAX) {
13649 idx = JimRelToAbsIndex(len, idx);
13651 if (idx < 0 || idx >= len || str == NULL) {
13652 Jim_SetResultString(interp, "", 0);
13654 else if (len == Jim_Length(argv[2])) {
13655 /* ASCII optimisation */
13656 Jim_SetResultString(interp, str + idx, 1);
13658 else {
13659 int c;
13660 int i = utf8_index(str, idx);
13661 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13663 return JIM_OK;
13666 case OPT_FIRST:
13667 case OPT_LAST:{
13668 int idx = 0, l1, l2;
13669 const char *s1, *s2;
13671 if (argc != 4 && argc != 5) {
13672 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13673 return JIM_ERR;
13675 s1 = Jim_String(argv[2]);
13676 s2 = Jim_String(argv[3]);
13677 l1 = Jim_Utf8Length(interp, argv[2]);
13678 l2 = Jim_Utf8Length(interp, argv[3]);
13679 if (argc == 5) {
13680 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13681 return JIM_ERR;
13683 idx = JimRelToAbsIndex(l2, idx);
13685 else if (option == OPT_LAST) {
13686 idx = l2;
13688 if (option == OPT_FIRST) {
13689 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13691 else {
13692 #ifdef JIM_UTF8
13693 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13694 #else
13695 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13696 #endif
13698 return JIM_OK;
13701 case OPT_TRIM:
13702 case OPT_TRIMLEFT:
13703 case OPT_TRIMRIGHT:{
13704 Jim_Obj *trimchars;
13706 if (argc != 3 && argc != 4) {
13707 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13708 return JIM_ERR;
13710 trimchars = (argc == 4 ? argv[3] : NULL);
13711 if (option == OPT_TRIM) {
13712 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13714 else if (option == OPT_TRIMLEFT) {
13715 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13717 else if (option == OPT_TRIMRIGHT) {
13718 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13720 return JIM_OK;
13723 case OPT_TOLOWER:
13724 case OPT_TOUPPER:
13725 case OPT_TOTITLE:
13726 if (argc != 3) {
13727 Jim_WrongNumArgs(interp, 2, argv, "string");
13728 return JIM_ERR;
13730 if (option == OPT_TOLOWER) {
13731 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13733 else if (option == OPT_TOUPPER) {
13734 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13736 else {
13737 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13739 return JIM_OK;
13741 case OPT_IS:
13742 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13743 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13745 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13746 return JIM_ERR;
13748 return JIM_OK;
13751 /* [time] */
13752 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13754 long i, count = 1;
13755 jim_wide start, elapsed;
13756 char buf[60];
13757 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13759 if (argc < 2) {
13760 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13761 return JIM_ERR;
13763 if (argc == 3) {
13764 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13765 return JIM_ERR;
13767 if (count < 0)
13768 return JIM_OK;
13769 i = count;
13770 start = JimClock();
13771 while (i-- > 0) {
13772 int retval;
13774 retval = Jim_EvalObj(interp, argv[1]);
13775 if (retval != JIM_OK) {
13776 return retval;
13779 elapsed = JimClock() - start;
13780 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13781 Jim_SetResultString(interp, buf, -1);
13782 return JIM_OK;
13785 /* [exit] */
13786 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13788 long exitCode = 0;
13790 if (argc > 2) {
13791 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13792 return JIM_ERR;
13794 if (argc == 2) {
13795 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13796 return JIM_ERR;
13798 interp->exitCode = exitCode;
13799 return JIM_EXIT;
13802 /* [catch] */
13803 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13805 int exitCode = 0;
13806 int i;
13807 int sig = 0;
13809 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13810 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13811 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13813 /* Reset the error code before catch.
13814 * Note that this is not strictly correct.
13816 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13818 for (i = 1; i < argc - 1; i++) {
13819 const char *arg = Jim_String(argv[i]);
13820 jim_wide option;
13821 int ignore;
13823 /* It's a pity we can't use Jim_GetEnum here :-( */
13824 if (strcmp(arg, "--") == 0) {
13825 i++;
13826 break;
13828 if (*arg != '-') {
13829 break;
13832 if (strncmp(arg, "-no", 3) == 0) {
13833 arg += 3;
13834 ignore = 1;
13836 else {
13837 arg++;
13838 ignore = 0;
13841 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13842 option = -1;
13844 if (option < 0) {
13845 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13847 if (option < 0) {
13848 goto wrongargs;
13851 if (ignore) {
13852 ignore_mask |= (1 << option);
13854 else {
13855 ignore_mask &= ~(1 << option);
13859 argc -= i;
13860 if (argc < 1 || argc > 3) {
13861 wrongargs:
13862 Jim_WrongNumArgs(interp, 1, argv,
13863 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13864 return JIM_ERR;
13866 argv += i;
13868 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13869 sig++;
13872 interp->signal_level += sig;
13873 if (Jim_CheckSignal(interp)) {
13874 /* If a signal is set, don't even try to execute the body */
13875 exitCode = JIM_SIGNAL;
13877 else {
13878 exitCode = Jim_EvalObj(interp, argv[0]);
13879 /* Don't want any caught error included in a later stack trace */
13880 interp->errorFlag = 0;
13882 interp->signal_level -= sig;
13884 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13885 if (exitCode >= 0 && exitCode < max_ignore_code && ((1 << exitCode) & ignore_mask)) {
13886 /* Not caught, pass it up */
13887 return exitCode;
13890 if (sig && exitCode == JIM_SIGNAL) {
13891 /* Catch the signal at this level */
13892 if (interp->signal_set_result) {
13893 interp->signal_set_result(interp, interp->sigmask);
13895 else {
13896 Jim_SetResultInt(interp, interp->sigmask);
13898 interp->sigmask = 0;
13901 if (argc >= 2) {
13902 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13903 return JIM_ERR;
13905 if (argc == 3) {
13906 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13908 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13909 Jim_ListAppendElement(interp, optListObj,
13910 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13911 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13912 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13913 if (exitCode == JIM_ERR) {
13914 Jim_Obj *errorCode;
13915 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13916 -1));
13917 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13919 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13920 if (errorCode) {
13921 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13922 Jim_ListAppendElement(interp, optListObj, errorCode);
13925 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13926 return JIM_ERR;
13930 Jim_SetResultInt(interp, exitCode);
13931 return JIM_OK;
13934 #ifdef JIM_REFERENCES
13936 /* [ref] */
13937 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13939 if (argc != 3 && argc != 4) {
13940 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13941 return JIM_ERR;
13943 if (argc == 3) {
13944 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13946 else {
13947 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13949 return JIM_OK;
13952 /* [getref] */
13953 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13955 Jim_Reference *refPtr;
13957 if (argc != 2) {
13958 Jim_WrongNumArgs(interp, 1, argv, "reference");
13959 return JIM_ERR;
13961 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13962 return JIM_ERR;
13963 Jim_SetResult(interp, refPtr->objPtr);
13964 return JIM_OK;
13967 /* [setref] */
13968 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13970 Jim_Reference *refPtr;
13972 if (argc != 3) {
13973 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13974 return JIM_ERR;
13976 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13977 return JIM_ERR;
13978 Jim_IncrRefCount(argv[2]);
13979 Jim_DecrRefCount(interp, refPtr->objPtr);
13980 refPtr->objPtr = argv[2];
13981 Jim_SetResult(interp, argv[2]);
13982 return JIM_OK;
13985 /* [collect] */
13986 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13988 if (argc != 1) {
13989 Jim_WrongNumArgs(interp, 1, argv, "");
13990 return JIM_ERR;
13992 Jim_SetResultInt(interp, Jim_Collect(interp));
13994 /* Free all the freed objects. */
13995 while (interp->freeList) {
13996 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13997 Jim_Free(interp->freeList);
13998 interp->freeList = nextObjPtr;
14001 return JIM_OK;
14004 /* [finalize] reference ?newValue? */
14005 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14007 if (argc != 2 && argc != 3) {
14008 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14009 return JIM_ERR;
14011 if (argc == 2) {
14012 Jim_Obj *cmdNamePtr;
14014 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14015 return JIM_ERR;
14016 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14017 Jim_SetResult(interp, cmdNamePtr);
14019 else {
14020 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14021 return JIM_ERR;
14022 Jim_SetResult(interp, argv[2]);
14024 return JIM_OK;
14027 /* [info references] */
14028 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14030 Jim_Obj *listObjPtr;
14031 Jim_HashTableIterator htiter;
14032 Jim_HashEntry *he;
14034 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14036 JimInitHashTableIterator(&interp->references, &htiter);
14037 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14038 char buf[JIM_REFERENCE_SPACE + 1];
14039 Jim_Reference *refPtr = he->u.val;
14040 const unsigned long *refId = he->key;
14042 JimFormatReference(buf, refPtr, *refId);
14043 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14045 Jim_SetResult(interp, listObjPtr);
14046 return JIM_OK;
14048 #endif
14050 /* [rename] */
14051 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14053 if (argc != 3) {
14054 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14055 return JIM_ERR;
14058 if (JimValidName(interp, "new procedure", argv[2])) {
14059 return JIM_ERR;
14062 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14065 #define JIM_DICTMATCH_VALUES 0x0001
14067 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14069 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14071 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14072 if (type & JIM_DICTMATCH_VALUES) {
14073 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->u.val);
14078 * Like JimHashtablePatternMatch, but for dictionaries.
14080 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14081 JimDictMatchCallbackType *callback, int type)
14083 Jim_HashEntry *he;
14084 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14086 /* Check for the non-pattern case. We can do this much more efficiently. */
14087 Jim_HashTableIterator htiter;
14088 JimInitHashTableIterator(ht, &htiter);
14089 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14090 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14091 callback(interp, listObjPtr, he, type);
14095 return listObjPtr;
14099 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14101 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14102 return JIM_ERR;
14104 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14105 return JIM_OK;
14108 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14110 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14111 return JIM_ERR;
14113 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14114 return JIM_OK;
14117 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14119 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14120 return -1;
14122 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14125 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14127 Jim_HashTable *ht;
14128 unsigned int i;
14130 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14131 return JIM_ERR;
14134 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14136 /* Note that this uses internal knowledge of the hash table */
14137 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14139 for (i = 0; i < ht->size; i++) {
14140 Jim_HashEntry *he = he = ht->table[i];
14142 if (he) {
14143 printf("%d: ", i);
14145 while (he) {
14146 printf(" %s", Jim_String(he->key));
14147 he = he->next;
14149 printf("\n");
14152 return JIM_OK;
14155 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14157 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14159 Jim_AppendString(interp, prefixObj, " ", 1);
14160 Jim_AppendString(interp, prefixObj, subcmd, -1);
14162 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14165 /* [dict] */
14166 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14168 Jim_Obj *objPtr;
14169 int option;
14170 static const char * const options[] = {
14171 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14172 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14173 "replace", "update", NULL
14175 enum
14177 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14178 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14179 OPT_REPLACE, OPT_UPDATE,
14182 if (argc < 2) {
14183 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14184 return JIM_ERR;
14187 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14188 return JIM_ERR;
14191 switch (option) {
14192 case OPT_GET:
14193 if (argc < 3) {
14194 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14195 return JIM_ERR;
14197 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14198 JIM_ERRMSG) != JIM_OK) {
14199 return JIM_ERR;
14201 Jim_SetResult(interp, objPtr);
14202 return JIM_OK;
14204 case OPT_SET:
14205 if (argc < 5) {
14206 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14207 return JIM_ERR;
14209 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14211 case OPT_EXISTS:
14212 if (argc < 4) {
14213 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14214 return JIM_ERR;
14216 else {
14217 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14218 if (rc < 0) {
14219 return JIM_ERR;
14221 Jim_SetResultBool(interp, rc == JIM_OK);
14222 return JIM_OK;
14225 case OPT_UNSET:
14226 if (argc < 4) {
14227 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14228 return JIM_ERR;
14230 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14231 return JIM_ERR;
14233 return JIM_OK;
14235 case OPT_KEYS:
14236 if (argc != 3 && argc != 4) {
14237 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14238 return JIM_ERR;
14240 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14242 case OPT_SIZE:
14243 if (argc != 3) {
14244 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14245 return JIM_ERR;
14247 else if (Jim_DictSize(interp, argv[2]) < 0) {
14248 return JIM_ERR;
14250 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14251 return JIM_OK;
14253 case OPT_MERGE:
14254 if (argc == 2) {
14255 return JIM_OK;
14257 if (Jim_DictSize(interp, argv[2]) < 0) {
14258 return JIM_ERR;
14260 /* Handle as ensemble */
14261 break;
14263 case OPT_UPDATE:
14264 if (argc < 6 || argc % 2) {
14265 /* Better error message */
14266 argc = 2;
14268 break;
14270 case OPT_CREATE:
14271 if (argc % 2) {
14272 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14273 return JIM_ERR;
14275 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14276 Jim_SetResult(interp, objPtr);
14277 return JIM_OK;
14279 case OPT_INFO:
14280 if (argc != 3) {
14281 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14282 return JIM_ERR;
14284 return Jim_DictInfo(interp, argv[2]);
14286 /* Handle command as an ensemble */
14287 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14290 /* [subst] */
14291 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14293 static const char * const options[] = {
14294 "-nobackslashes", "-nocommands", "-novariables", NULL
14296 enum
14297 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14298 int i;
14299 int flags = JIM_SUBST_FLAG;
14300 Jim_Obj *objPtr;
14302 if (argc < 2) {
14303 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14304 return JIM_ERR;
14306 for (i = 1; i < (argc - 1); i++) {
14307 int option;
14309 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14310 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14311 return JIM_ERR;
14313 switch (option) {
14314 case OPT_NOBACKSLASHES:
14315 flags |= JIM_SUBST_NOESC;
14316 break;
14317 case OPT_NOCOMMANDS:
14318 flags |= JIM_SUBST_NOCMD;
14319 break;
14320 case OPT_NOVARIABLES:
14321 flags |= JIM_SUBST_NOVAR;
14322 break;
14325 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14326 return JIM_ERR;
14328 Jim_SetResult(interp, objPtr);
14329 return JIM_OK;
14332 /* [info] */
14333 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14335 int cmd;
14336 Jim_Obj *objPtr;
14337 int mode = 0;
14339 static const char * const commands[] = {
14340 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14341 "vars", "version", "patchlevel", "complete", "args", "hostname",
14342 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14343 "references", "alias", NULL
14345 enum
14346 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14347 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14348 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14349 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14352 #ifdef jim_ext_namespace
14353 int nons = 0;
14355 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14356 /* This is for internal use only */
14357 argc--;
14358 argv++;
14359 nons = 1;
14361 #endif
14363 if (argc < 2) {
14364 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14365 return JIM_ERR;
14367 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14368 != JIM_OK) {
14369 return JIM_ERR;
14372 /* Test for the the most common commands first, just in case it makes a difference */
14373 switch (cmd) {
14374 case INFO_EXISTS:
14375 if (argc != 3) {
14376 Jim_WrongNumArgs(interp, 2, argv, "varName");
14377 return JIM_ERR;
14379 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14380 break;
14382 case INFO_ALIAS:{
14383 Jim_Cmd *cmdPtr;
14385 if (argc != 3) {
14386 Jim_WrongNumArgs(interp, 2, argv, "command");
14387 return JIM_ERR;
14389 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14390 return JIM_ERR;
14392 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14393 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14394 return JIM_ERR;
14396 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14397 return JIM_OK;
14400 case INFO_CHANNELS:
14401 mode++; /* JIM_CMDLIST_CHANNELS */
14402 #ifndef jim_ext_aio
14403 Jim_SetResultString(interp, "aio not enabled", -1);
14404 return JIM_ERR;
14405 #endif
14406 case INFO_PROCS:
14407 mode++; /* JIM_CMDLIST_PROCS */
14408 case INFO_COMMANDS:
14409 /* mode 0 => JIM_CMDLIST_COMMANDS */
14410 if (argc != 2 && argc != 3) {
14411 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14412 return JIM_ERR;
14414 #ifdef jim_ext_namespace
14415 if (!nons) {
14416 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14417 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14420 #endif
14421 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14422 break;
14424 case INFO_VARS:
14425 mode++; /* JIM_VARLIST_VARS */
14426 case INFO_LOCALS:
14427 mode++; /* JIM_VARLIST_LOCALS */
14428 case INFO_GLOBALS:
14429 /* mode 0 => JIM_VARLIST_GLOBALS */
14430 if (argc != 2 && argc != 3) {
14431 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14432 return JIM_ERR;
14434 #ifdef jim_ext_namespace
14435 if (!nons) {
14436 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14437 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14440 #endif
14441 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14442 break;
14444 case INFO_SCRIPT:
14445 if (argc != 2) {
14446 Jim_WrongNumArgs(interp, 2, argv, "");
14447 return JIM_ERR;
14449 Jim_SetResult(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileNameObj);
14450 break;
14452 case INFO_SOURCE:{
14453 int line;
14454 Jim_Obj *resObjPtr;
14455 Jim_Obj *fileNameObj;
14457 if (argc != 3) {
14458 Jim_WrongNumArgs(interp, 2, argv, "source");
14459 return JIM_ERR;
14461 if (argv[2]->typePtr == &sourceObjType) {
14462 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14463 line = argv[2]->internalRep.sourceValue.lineNumber;
14465 else if (argv[2]->typePtr == &scriptObjType) {
14466 ScriptObj *script = Jim_GetScript(interp, argv[2]);
14467 fileNameObj = script->fileNameObj;
14468 line = script->firstline;
14470 else {
14471 fileNameObj = interp->emptyObj;
14472 line = 1;
14474 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14475 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14476 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14477 Jim_SetResult(interp, resObjPtr);
14478 break;
14481 case INFO_STACKTRACE:
14482 Jim_SetResult(interp, interp->stackTrace);
14483 break;
14485 case INFO_LEVEL:
14486 case INFO_FRAME:
14487 switch (argc) {
14488 case 2:
14489 Jim_SetResultInt(interp, interp->framePtr->level);
14490 break;
14492 case 3:
14493 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14494 return JIM_ERR;
14496 Jim_SetResult(interp, objPtr);
14497 break;
14499 default:
14500 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14501 return JIM_ERR;
14503 break;
14505 case INFO_BODY:
14506 case INFO_STATICS:
14507 case INFO_ARGS:{
14508 Jim_Cmd *cmdPtr;
14510 if (argc != 3) {
14511 Jim_WrongNumArgs(interp, 2, argv, "procname");
14512 return JIM_ERR;
14514 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14515 return JIM_ERR;
14517 if (!cmdPtr->isproc) {
14518 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14519 return JIM_ERR;
14521 switch (cmd) {
14522 case INFO_BODY:
14523 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14524 break;
14525 case INFO_ARGS:
14526 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14527 break;
14528 case INFO_STATICS:
14529 if (cmdPtr->u.proc.staticVars) {
14530 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14531 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14532 NULL, JimVariablesMatch, mode));
14534 break;
14536 break;
14539 case INFO_VERSION:
14540 case INFO_PATCHLEVEL:{
14541 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14543 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14544 Jim_SetResultString(interp, buf, -1);
14545 break;
14548 case INFO_COMPLETE:
14549 if (argc != 3 && argc != 4) {
14550 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14551 return JIM_ERR;
14553 else {
14554 int len;
14555 const char *s = Jim_GetString(argv[2], &len);
14556 char missing;
14558 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14559 if (missing != ' ' && argc == 4) {
14560 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14563 break;
14565 case INFO_HOSTNAME:
14566 /* Redirect to os.gethostname if it exists */
14567 return Jim_Eval(interp, "os.gethostname");
14569 case INFO_NAMEOFEXECUTABLE:
14570 /* Redirect to Tcl proc */
14571 return Jim_Eval(interp, "{info nameofexecutable}");
14573 case INFO_RETURNCODES:
14574 if (argc == 2) {
14575 int i;
14576 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14578 for (i = 0; jimReturnCodes[i]; i++) {
14579 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14580 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14581 jimReturnCodes[i], -1));
14584 Jim_SetResult(interp, listObjPtr);
14586 else if (argc == 3) {
14587 long code;
14588 const char *name;
14590 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14591 return JIM_ERR;
14593 name = Jim_ReturnCode(code);
14594 if (*name == '?') {
14595 Jim_SetResultInt(interp, code);
14597 else {
14598 Jim_SetResultString(interp, name, -1);
14601 else {
14602 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14603 return JIM_ERR;
14605 break;
14606 case INFO_REFERENCES:
14607 #ifdef JIM_REFERENCES
14608 return JimInfoReferences(interp, argc, argv);
14609 #else
14610 Jim_SetResultString(interp, "not supported", -1);
14611 return JIM_ERR;
14612 #endif
14614 return JIM_OK;
14617 /* [exists] */
14618 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14620 Jim_Obj *objPtr;
14621 int result = 0;
14623 static const char * const options[] = {
14624 "-command", "-proc", "-alias", "-var", NULL
14626 enum
14628 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14630 int option;
14632 if (argc == 2) {
14633 option = OPT_VAR;
14634 objPtr = argv[1];
14636 else if (argc == 3) {
14637 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14638 return JIM_ERR;
14640 objPtr = argv[2];
14642 else {
14643 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14644 return JIM_ERR;
14647 if (option == OPT_VAR) {
14648 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14650 else {
14651 /* Now different kinds of commands */
14652 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14654 if (cmd) {
14655 switch (option) {
14656 case OPT_COMMAND:
14657 result = 1;
14658 break;
14660 case OPT_ALIAS:
14661 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14662 break;
14664 case OPT_PROC:
14665 result = cmd->isproc;
14666 break;
14670 Jim_SetResultBool(interp, result);
14671 return JIM_OK;
14674 /* [split] */
14675 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14677 const char *str, *splitChars, *noMatchStart;
14678 int splitLen, strLen;
14679 Jim_Obj *resObjPtr;
14680 int c;
14681 int len;
14683 if (argc != 2 && argc != 3) {
14684 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14685 return JIM_ERR;
14688 str = Jim_GetString(argv[1], &len);
14689 if (len == 0) {
14690 return JIM_OK;
14692 strLen = Jim_Utf8Length(interp, argv[1]);
14694 /* Init */
14695 if (argc == 2) {
14696 splitChars = " \n\t\r";
14697 splitLen = 4;
14699 else {
14700 splitChars = Jim_String(argv[2]);
14701 splitLen = Jim_Utf8Length(interp, argv[2]);
14704 noMatchStart = str;
14705 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14707 /* Split */
14708 if (splitLen) {
14709 Jim_Obj *objPtr;
14710 while (strLen--) {
14711 const char *sc = splitChars;
14712 int scLen = splitLen;
14713 int sl = utf8_tounicode(str, &c);
14714 while (scLen--) {
14715 int pc;
14716 sc += utf8_tounicode(sc, &pc);
14717 if (c == pc) {
14718 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14719 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14720 noMatchStart = str + sl;
14721 break;
14724 str += sl;
14726 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14727 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14729 else {
14730 /* This handles the special case of splitchars eq {}
14731 * Optimise by sharing common (ASCII) characters
14733 Jim_Obj **commonObj = NULL;
14734 #define NUM_COMMON (128 - 9)
14735 while (strLen--) {
14736 int n = utf8_tounicode(str, &c);
14737 #ifdef JIM_OPTIMIZATION
14738 if (c >= 9 && c < 128) {
14739 /* Common ASCII char. Note that 9 is the tab character */
14740 c -= 9;
14741 if (!commonObj) {
14742 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14743 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14745 if (!commonObj[c]) {
14746 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14748 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14749 str++;
14750 continue;
14752 #endif
14753 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14754 str += n;
14756 Jim_Free(commonObj);
14759 Jim_SetResult(interp, resObjPtr);
14760 return JIM_OK;
14763 /* [join] */
14764 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14766 const char *joinStr;
14767 int joinStrLen;
14769 if (argc != 2 && argc != 3) {
14770 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14771 return JIM_ERR;
14773 /* Init */
14774 if (argc == 2) {
14775 joinStr = " ";
14776 joinStrLen = 1;
14778 else {
14779 joinStr = Jim_GetString(argv[2], &joinStrLen);
14781 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14782 return JIM_OK;
14785 /* [format] */
14786 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14788 Jim_Obj *objPtr;
14790 if (argc < 2) {
14791 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14792 return JIM_ERR;
14794 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14795 if (objPtr == NULL)
14796 return JIM_ERR;
14797 Jim_SetResult(interp, objPtr);
14798 return JIM_OK;
14801 /* [scan] */
14802 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14804 Jim_Obj *listPtr, **outVec;
14805 int outc, i;
14807 if (argc < 3) {
14808 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14809 return JIM_ERR;
14811 if (argv[2]->typePtr != &scanFmtStringObjType)
14812 SetScanFmtFromAny(interp, argv[2]);
14813 if (FormatGetError(argv[2]) != 0) {
14814 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14815 return JIM_ERR;
14817 if (argc > 3) {
14818 int maxPos = FormatGetMaxPos(argv[2]);
14819 int count = FormatGetCnvCount(argv[2]);
14821 if (maxPos > argc - 3) {
14822 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14823 return JIM_ERR;
14825 else if (count > argc - 3) {
14826 Jim_SetResultString(interp, "different numbers of variable names and "
14827 "field specifiers", -1);
14828 return JIM_ERR;
14830 else if (count < argc - 3) {
14831 Jim_SetResultString(interp, "variable is not assigned by any "
14832 "conversion specifiers", -1);
14833 return JIM_ERR;
14836 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14837 if (listPtr == 0)
14838 return JIM_ERR;
14839 if (argc > 3) {
14840 int rc = JIM_OK;
14841 int count = 0;
14843 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14844 int len = Jim_ListLength(interp, listPtr);
14846 if (len != 0) {
14847 JimListGetElements(interp, listPtr, &outc, &outVec);
14848 for (i = 0; i < outc; ++i) {
14849 if (Jim_Length(outVec[i]) > 0) {
14850 ++count;
14851 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14852 rc = JIM_ERR;
14857 Jim_FreeNewObj(interp, listPtr);
14859 else {
14860 count = -1;
14862 if (rc == JIM_OK) {
14863 Jim_SetResultInt(interp, count);
14865 return rc;
14867 else {
14868 if (listPtr == (Jim_Obj *)EOF) {
14869 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14870 return JIM_OK;
14872 Jim_SetResult(interp, listPtr);
14874 return JIM_OK;
14877 /* [error] */
14878 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14880 if (argc != 2 && argc != 3) {
14881 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14882 return JIM_ERR;
14884 Jim_SetResult(interp, argv[1]);
14885 if (argc == 3) {
14886 JimSetStackTrace(interp, argv[2]);
14887 return JIM_ERR;
14889 interp->addStackTrace++;
14890 return JIM_ERR;
14893 /* [lrange] */
14894 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14896 Jim_Obj *objPtr;
14898 if (argc != 4) {
14899 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14900 return JIM_ERR;
14902 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14903 return JIM_ERR;
14904 Jim_SetResult(interp, objPtr);
14905 return JIM_OK;
14908 /* [lrepeat] */
14909 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14911 Jim_Obj *objPtr;
14912 long count;
14914 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14915 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14916 return JIM_ERR;
14919 if (count == 0 || argc == 2) {
14920 return JIM_OK;
14923 argc -= 2;
14924 argv += 2;
14926 objPtr = Jim_NewListObj(interp, argv, argc);
14927 while (--count) {
14928 ListInsertElements(objPtr, -1, argc, argv);
14931 Jim_SetResult(interp, objPtr);
14932 return JIM_OK;
14935 char **Jim_GetEnviron(void)
14937 #if defined(HAVE__NSGETENVIRON)
14938 return *_NSGetEnviron();
14939 #else
14940 #if !defined(NO_ENVIRON_EXTERN)
14941 extern char **environ;
14942 #endif
14944 return environ;
14945 #endif
14948 void Jim_SetEnviron(char **env)
14950 #if defined(HAVE__NSGETENVIRON)
14951 *_NSGetEnviron() = env;
14952 #else
14953 #if !defined(NO_ENVIRON_EXTERN)
14954 extern char **environ;
14955 #endif
14957 environ = env;
14958 #endif
14961 /* [env] */
14962 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14964 const char *key;
14965 const char *val;
14967 if (argc == 1) {
14968 char **e = Jim_GetEnviron();
14970 int i;
14971 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14973 for (i = 0; e[i]; i++) {
14974 const char *equals = strchr(e[i], '=');
14976 if (equals) {
14977 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
14978 equals - e[i]));
14979 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
14983 Jim_SetResult(interp, listObjPtr);
14984 return JIM_OK;
14987 if (argc < 2) {
14988 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
14989 return JIM_ERR;
14991 key = Jim_String(argv[1]);
14992 val = getenv(key);
14993 if (val == NULL) {
14994 if (argc < 3) {
14995 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
14996 return JIM_ERR;
14998 val = Jim_String(argv[2]);
15000 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15001 return JIM_OK;
15004 /* [source] */
15005 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15007 int retval;
15009 if (argc != 2) {
15010 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15011 return JIM_ERR;
15013 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15014 if (retval == JIM_RETURN)
15015 return JIM_OK;
15016 return retval;
15019 /* [lreverse] */
15020 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15022 Jim_Obj *revObjPtr, **ele;
15023 int len;
15025 if (argc != 2) {
15026 Jim_WrongNumArgs(interp, 1, argv, "list");
15027 return JIM_ERR;
15029 JimListGetElements(interp, argv[1], &len, &ele);
15030 len--;
15031 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15032 while (len >= 0)
15033 ListAppendElement(revObjPtr, ele[len--]);
15034 Jim_SetResult(interp, revObjPtr);
15035 return JIM_OK;
15038 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15040 jim_wide len;
15042 if (step == 0)
15043 return -1;
15044 if (start == end)
15045 return 0;
15046 else if (step > 0 && start > end)
15047 return -1;
15048 else if (step < 0 && end > start)
15049 return -1;
15050 len = end - start;
15051 if (len < 0)
15052 len = -len; /* abs(len) */
15053 if (step < 0)
15054 step = -step; /* abs(step) */
15055 len = 1 + ((len - 1) / step);
15056 /* We can truncate safely to INT_MAX, the range command
15057 * will always return an error for a such long range
15058 * because Tcl lists can't be so long. */
15059 if (len > INT_MAX)
15060 len = INT_MAX;
15061 return (int)((len < 0) ? -1 : len);
15064 /* [range] */
15065 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15067 jim_wide start = 0, end, step = 1;
15068 int len, i;
15069 Jim_Obj *objPtr;
15071 if (argc < 2 || argc > 4) {
15072 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15073 return JIM_ERR;
15075 if (argc == 2) {
15076 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15077 return JIM_ERR;
15079 else {
15080 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15081 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15082 return JIM_ERR;
15083 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15084 return JIM_ERR;
15086 if ((len = JimRangeLen(start, end, step)) == -1) {
15087 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15088 return JIM_ERR;
15090 objPtr = Jim_NewListObj(interp, NULL, 0);
15091 for (i = 0; i < len; i++)
15092 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15093 Jim_SetResult(interp, objPtr);
15094 return JIM_OK;
15097 /* [rand] */
15098 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15100 jim_wide min = 0, max = 0, len, maxMul;
15102 if (argc < 1 || argc > 3) {
15103 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15104 return JIM_ERR;
15106 if (argc == 1) {
15107 max = JIM_WIDE_MAX;
15108 } else if (argc == 2) {
15109 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15110 return JIM_ERR;
15111 } else if (argc == 3) {
15112 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15113 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15114 return JIM_ERR;
15116 len = max-min;
15117 if (len < 0) {
15118 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15119 return JIM_ERR;
15121 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15122 while (1) {
15123 jim_wide r;
15125 JimRandomBytes(interp, &r, sizeof(jim_wide));
15126 if (r < 0 || r >= maxMul) continue;
15127 r = (len == 0) ? 0 : r%len;
15128 Jim_SetResultInt(interp, min+r);
15129 return JIM_OK;
15133 static const struct {
15134 const char *name;
15135 Jim_CmdProc cmdProc;
15136 } Jim_CoreCommandsTable[] = {
15137 {"alias", Jim_AliasCoreCommand},
15138 {"set", Jim_SetCoreCommand},
15139 {"unset", Jim_UnsetCoreCommand},
15140 {"puts", Jim_PutsCoreCommand},
15141 {"+", Jim_AddCoreCommand},
15142 {"*", Jim_MulCoreCommand},
15143 {"-", Jim_SubCoreCommand},
15144 {"/", Jim_DivCoreCommand},
15145 {"incr", Jim_IncrCoreCommand},
15146 {"while", Jim_WhileCoreCommand},
15147 {"loop", Jim_LoopCoreCommand},
15148 {"for", Jim_ForCoreCommand},
15149 {"foreach", Jim_ForeachCoreCommand},
15150 {"lmap", Jim_LmapCoreCommand},
15151 {"lassign", Jim_LassignCoreCommand},
15152 {"if", Jim_IfCoreCommand},
15153 {"switch", Jim_SwitchCoreCommand},
15154 {"list", Jim_ListCoreCommand},
15155 {"lindex", Jim_LindexCoreCommand},
15156 {"lset", Jim_LsetCoreCommand},
15157 {"lsearch", Jim_LsearchCoreCommand},
15158 {"llength", Jim_LlengthCoreCommand},
15159 {"lappend", Jim_LappendCoreCommand},
15160 {"linsert", Jim_LinsertCoreCommand},
15161 {"lreplace", Jim_LreplaceCoreCommand},
15162 {"lsort", Jim_LsortCoreCommand},
15163 {"append", Jim_AppendCoreCommand},
15164 {"debug", Jim_DebugCoreCommand},
15165 {"eval", Jim_EvalCoreCommand},
15166 {"uplevel", Jim_UplevelCoreCommand},
15167 {"expr", Jim_ExprCoreCommand},
15168 {"break", Jim_BreakCoreCommand},
15169 {"continue", Jim_ContinueCoreCommand},
15170 {"proc", Jim_ProcCoreCommand},
15171 {"concat", Jim_ConcatCoreCommand},
15172 {"return", Jim_ReturnCoreCommand},
15173 {"upvar", Jim_UpvarCoreCommand},
15174 {"global", Jim_GlobalCoreCommand},
15175 {"string", Jim_StringCoreCommand},
15176 {"time", Jim_TimeCoreCommand},
15177 {"exit", Jim_ExitCoreCommand},
15178 {"catch", Jim_CatchCoreCommand},
15179 #ifdef JIM_REFERENCES
15180 {"ref", Jim_RefCoreCommand},
15181 {"getref", Jim_GetrefCoreCommand},
15182 {"setref", Jim_SetrefCoreCommand},
15183 {"finalize", Jim_FinalizeCoreCommand},
15184 {"collect", Jim_CollectCoreCommand},
15185 #endif
15186 {"rename", Jim_RenameCoreCommand},
15187 {"dict", Jim_DictCoreCommand},
15188 {"subst", Jim_SubstCoreCommand},
15189 {"info", Jim_InfoCoreCommand},
15190 {"exists", Jim_ExistsCoreCommand},
15191 {"split", Jim_SplitCoreCommand},
15192 {"join", Jim_JoinCoreCommand},
15193 {"format", Jim_FormatCoreCommand},
15194 {"scan", Jim_ScanCoreCommand},
15195 {"error", Jim_ErrorCoreCommand},
15196 {"lrange", Jim_LrangeCoreCommand},
15197 {"lrepeat", Jim_LrepeatCoreCommand},
15198 {"env", Jim_EnvCoreCommand},
15199 {"source", Jim_SourceCoreCommand},
15200 {"lreverse", Jim_LreverseCoreCommand},
15201 {"range", Jim_RangeCoreCommand},
15202 {"rand", Jim_RandCoreCommand},
15203 {"tailcall", Jim_TailcallCoreCommand},
15204 {"local", Jim_LocalCoreCommand},
15205 {"upcall", Jim_UpcallCoreCommand},
15206 {"apply", Jim_ApplyCoreCommand},
15207 {NULL, NULL},
15210 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15212 int i = 0;
15214 while (Jim_CoreCommandsTable[i].name != NULL) {
15215 Jim_CreateCommand(interp,
15216 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15217 i++;
15221 /* -----------------------------------------------------------------------------
15222 * Interactive prompt
15223 * ---------------------------------------------------------------------------*/
15224 void Jim_MakeErrorMessage(Jim_Interp *interp)
15226 Jim_Obj *argv[2];
15228 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15229 argv[1] = interp->result;
15231 Jim_EvalObjVector(interp, 2, argv);
15234 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15235 const char *prefix, const char *const *tablePtr, const char *name)
15237 int count;
15238 char **tablePtrSorted;
15239 int i;
15241 for (count = 0; tablePtr[count]; count++) {
15244 if (name == NULL) {
15245 name = "option";
15248 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15249 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15250 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15251 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15252 for (i = 0; i < count; i++) {
15253 if (i + 1 == count && count > 1) {
15254 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15256 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15257 if (i + 1 != count) {
15258 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15261 Jim_Free(tablePtrSorted);
15264 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15265 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15267 const char *bad = "bad ";
15268 const char *const *entryPtr = NULL;
15269 int i;
15270 int match = -1;
15271 int arglen;
15272 const char *arg = Jim_GetString(objPtr, &arglen);
15274 *indexPtr = -1;
15276 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15277 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15278 /* Found an exact match */
15279 *indexPtr = i;
15280 return JIM_OK;
15282 if (flags & JIM_ENUM_ABBREV) {
15283 /* Accept an unambiguous abbreviation.
15284 * Note that '-' doesnt' consitute a valid abbreviation
15286 if (strncmp(arg, *entryPtr, arglen) == 0) {
15287 if (*arg == '-' && arglen == 1) {
15288 break;
15290 if (match >= 0) {
15291 bad = "ambiguous ";
15292 goto ambiguous;
15294 match = i;
15299 /* If we had an unambiguous partial match */
15300 if (match >= 0) {
15301 *indexPtr = match;
15302 return JIM_OK;
15305 ambiguous:
15306 if (flags & JIM_ERRMSG) {
15307 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15309 return JIM_ERR;
15312 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15314 int i;
15316 for (i = 0; i < (int)len; i++) {
15317 if (array[i] && strcmp(array[i], name) == 0) {
15318 return i;
15321 return -1;
15324 int Jim_IsDict(Jim_Obj *objPtr)
15326 return objPtr->typePtr == &dictObjType;
15329 int Jim_IsList(Jim_Obj *objPtr)
15331 return objPtr->typePtr == &listObjType;
15335 * Very simple printf-like formatting, designed for error messages.
15337 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15338 * The resulting string is created and set as the result.
15340 * Each '%s' should correspond to a regular string parameter.
15341 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15342 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15344 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15346 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15348 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15350 /* Initial space needed */
15351 int len = strlen(format);
15352 int extra = 0;
15353 int n = 0;
15354 const char *params[5];
15355 char *buf;
15356 va_list args;
15357 int i;
15359 va_start(args, format);
15361 for (i = 0; i < len && n < 5; i++) {
15362 int l;
15364 if (strncmp(format + i, "%s", 2) == 0) {
15365 params[n] = va_arg(args, char *);
15367 l = strlen(params[n]);
15369 else if (strncmp(format + i, "%#s", 3) == 0) {
15370 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15372 params[n] = Jim_GetString(objPtr, &l);
15374 else {
15375 if (format[i] == '%') {
15376 i++;
15378 continue;
15380 n++;
15381 extra += l;
15384 len += extra;
15385 buf = Jim_Alloc(len + 1);
15386 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15388 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15391 /* stubs */
15392 #ifndef jim_ext_package
15393 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15395 return JIM_OK;
15397 #endif
15398 #ifndef jim_ext_aio
15399 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15401 Jim_SetResultString(interp, "aio not enabled", -1);
15402 return NULL;
15404 #endif
15408 * Local Variables: ***
15409 * c-basic-offset: 4 ***
15410 * tab-width: 4 ***
15411 * End: ***