expr: fix crash on invalid ternary order
[jimtcl.git] / jim.c
blob71c5d55732010e5d49fad91f21390622969b5e27
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
44 #ifndef _GNU_SOURCE
45 #define _GNU_SOURCE /* Mostly just for environ */
46 #endif
48 #include <stdio.h>
49 #include <stdlib.h>
51 #include <string.h>
52 #include <stdarg.h>
53 #include <ctype.h>
54 #include <limits.h>
55 #include <assert.h>
56 #include <errno.h>
57 #include <time.h>
58 #include <setjmp.h>
60 #include "jim.h"
61 #include "jimautoconf.h"
62 #include "utf8.h"
64 #ifdef HAVE_SYS_TIME_H
65 #include <sys/time.h>
66 #endif
67 #ifdef HAVE_BACKTRACE
68 #include <execinfo.h>
69 #endif
70 #ifdef HAVE_CRT_EXTERNS_H
71 #include <crt_externs.h>
72 #endif
74 /* For INFINITY, even if math functions are not enabled */
75 #include <math.h>
77 /* We may decide to switch to using $[...] after all, so leave it as an option */
78 /*#define EXPRSUGAR_BRACKET*/
80 /* For the no-autoconf case */
81 #ifndef TCL_LIBRARY
82 #define TCL_LIBRARY "."
83 #endif
84 #ifndef TCL_PLATFORM_OS
85 #define TCL_PLATFORM_OS "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PLATFORM
88 #define TCL_PLATFORM_PLATFORM "unknown"
89 #endif
90 #ifndef TCL_PLATFORM_PATH_SEPARATOR
91 #define TCL_PLATFORM_PATH_SEPARATOR ":"
92 #endif
94 /*#define DEBUG_SHOW_SCRIPT*/
95 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
96 /*#define DEBUG_SHOW_SUBST*/
97 /*#define DEBUG_SHOW_EXPR*/
98 /*#define DEBUG_SHOW_EXPR_TOKENS*/
99 /*#define JIM_DEBUG_GC*/
100 #ifdef JIM_MAINTAINER
101 #define JIM_DEBUG_COMMAND
102 #define JIM_DEBUG_PANIC
103 #endif
104 /* Enable this (in conjunction with valgrind) to help debug
105 * reference counting issues
107 /*#define JIM_DISABLE_OBJECT_POOL*/
109 /* Maximum size of an integer */
110 #define JIM_INTEGER_SPACE 24
112 const char *jim_tt_name(int type);
114 #ifdef JIM_DEBUG_PANIC
115 static void JimPanicDump(int fail_condition, const char *fmt, ...);
116 #define JimPanic(X) JimPanicDump X
117 #else
118 #define JimPanic(X)
119 #endif
121 #ifdef JIM_OPTIMIZATION
122 #define JIM_IF_OPTIM(X) X
123 #else
124 #define JIM_IF_OPTIM(X)
125 #endif
127 /* -----------------------------------------------------------------------------
128 * Global variables
129 * ---------------------------------------------------------------------------*/
131 /* A shared empty string for the objects string representation.
132 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
133 static char JimEmptyStringRep[] = "";
135 /* -----------------------------------------------------------------------------
136 * Required prototypes of not exported functions
137 * ---------------------------------------------------------------------------*/
138 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
139 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
140 int flags);
141 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
142 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
143 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
144 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
145 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
146 const char *prefix, const char *const *tablePtr, const char *name);
147 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
148 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
149 static int JimSign(jim_wide w);
150 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
151 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
152 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
155 /* Fast access to the int (wide) value of an object which is known to be of int type */
156 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
158 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
160 static int utf8_tounicode_case(const char *s, int *uc, int upper)
162 int l = utf8_tounicode(s, uc);
163 if (upper) {
164 *uc = utf8_upper(*uc);
166 return l;
169 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
170 #define JIM_CHARSET_SCAN 2
171 #define JIM_CHARSET_GLOB 0
174 * pattern points to a string like "[^a-z\ub5]"
176 * The pattern may contain trailing chars, which are ignored.
178 * The pattern is matched against unicode char 'c'.
180 * If (flags & JIM_NOCASE), case is ignored when matching.
181 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
182 * of the charset, per scan, rather than glob/string match.
184 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
185 * or the null character if the ']' is missing.
187 * Returns NULL on no match.
189 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
191 int not = 0;
192 int pchar;
193 int match = 0;
194 int nocase = 0;
196 if (flags & JIM_NOCASE) {
197 nocase++;
198 c = utf8_upper(c);
201 if (flags & JIM_CHARSET_SCAN) {
202 if (*pattern == '^') {
203 not++;
204 pattern++;
207 /* Special case. If the first char is ']', it is part of the set */
208 if (*pattern == ']') {
209 goto first;
213 while (*pattern && *pattern != ']') {
214 /* Exact match */
215 if (pattern[0] == '\\') {
216 first:
217 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
219 else {
220 /* Is this a range? a-z */
221 int start;
222 int end;
224 pattern += utf8_tounicode_case(pattern, &start, nocase);
225 if (pattern[0] == '-' && pattern[1]) {
226 /* skip '-' */
227 pattern += utf8_tounicode(pattern, &pchar);
228 pattern += utf8_tounicode_case(pattern, &end, nocase);
230 /* Handle reversed range too */
231 if ((c >= start && c <= end) || (c >= end && c <= start)) {
232 match = 1;
234 continue;
236 pchar = start;
239 if (pchar == c) {
240 match = 1;
243 if (not) {
244 match = !match;
247 return match ? pattern : NULL;
250 /* Glob-style pattern matching. */
252 /* Note: string *must* be valid UTF-8 sequences
254 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
256 int c;
257 int pchar;
258 while (*pattern) {
259 switch (pattern[0]) {
260 case '*':
261 while (pattern[1] == '*') {
262 pattern++;
264 pattern++;
265 if (!pattern[0]) {
266 return 1; /* match */
268 while (*string) {
269 /* Recursive call - Does the remaining pattern match anywhere? */
270 if (JimGlobMatch(pattern, string, nocase))
271 return 1; /* match */
272 string += utf8_tounicode(string, &c);
274 return 0; /* no match */
276 case '?':
277 string += utf8_tounicode(string, &c);
278 break;
280 case '[': {
281 string += utf8_tounicode(string, &c);
282 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
283 if (!pattern) {
284 return 0;
286 if (!*pattern) {
287 /* Ran out of pattern (no ']') */
288 continue;
290 break;
292 case '\\':
293 if (pattern[1]) {
294 pattern++;
296 /* fall through */
297 default:
298 string += utf8_tounicode_case(string, &c, nocase);
299 utf8_tounicode_case(pattern, &pchar, nocase);
300 if (pchar != c) {
301 return 0;
303 break;
305 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
306 if (!*string) {
307 while (*pattern == '*') {
308 pattern++;
310 break;
313 if (!*pattern && !*string) {
314 return 1;
316 return 0;
320 * string comparison. Works on binary data.
322 * Returns -1, 0 or 1
324 * Note that the lengths are byte lengths, not char lengths.
326 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
328 if (l1 < l2) {
329 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
331 else if (l2 < l1) {
332 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
334 else {
335 return JimSign(memcmp(s1, s2, l1));
340 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
341 * (or end of string if 'maxchars' is -1).
343 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
345 * Note: does not support embedded nulls.
347 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
349 while (*s1 && *s2 && maxchars) {
350 int c1, c2;
351 s1 += utf8_tounicode_case(s1, &c1, nocase);
352 s2 += utf8_tounicode_case(s2, &c2, nocase);
353 if (c1 != c2) {
354 return JimSign(c1 - c2);
356 maxchars--;
358 if (!maxchars) {
359 return 0;
361 /* One string or both terminated */
362 if (*s1) {
363 return 1;
365 if (*s2) {
366 return -1;
368 return 0;
371 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
372 * The index of the first occurrence of s1 in s2 is returned.
373 * If s1 is not found inside s2, -1 is returned. */
374 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
376 int i;
377 int l1bytelen;
379 if (!l1 || !l2 || l1 > l2) {
380 return -1;
382 if (idx < 0)
383 idx = 0;
384 s2 += utf8_index(s2, idx);
386 l1bytelen = utf8_index(s1, l1);
388 for (i = idx; i <= l2 - l1; i++) {
389 int c;
390 if (memcmp(s2, s1, l1bytelen) == 0) {
391 return i;
393 s2 += utf8_tounicode(s2, &c);
395 return -1;
399 * Note: Lengths and return value are in bytes, not chars.
401 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
403 const char *p;
405 if (!l1 || !l2 || l1 > l2)
406 return -1;
408 /* Now search for the needle */
409 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
410 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
411 return p - s2;
414 return -1;
417 #ifdef JIM_UTF8
419 * Note: Lengths and return value are in chars.
421 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
423 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
424 if (n > 0) {
425 n = utf8_strlen(s2, n);
427 return n;
429 #endif
432 * After an strtol()/strtod()-like conversion,
433 * check whether something was converted and that
434 * the only thing left is white space.
436 * Returns JIM_OK or JIM_ERR.
438 static int JimCheckConversion(const char *str, const char *endptr)
440 if (str[0] == '\0' || str == endptr) {
441 return JIM_ERR;
444 if (endptr[0] != '\0') {
445 while (*endptr) {
446 if (!isspace(UCHAR(*endptr))) {
447 return JIM_ERR;
449 endptr++;
452 return JIM_OK;
455 /* Parses the front of a number to determine it's sign and base
456 * Returns the index to start parsing according to the given base
458 static int JimNumberBase(const char *str, int *base, int *sign)
460 int i = 0;
462 *base = 10;
464 while (isspace(UCHAR(str[i]))) {
465 i++;
468 if (str[i] == '-') {
469 *sign = -1;
470 i++;
472 else {
473 if (str[i] == '+') {
474 i++;
476 *sign = 1;
479 if (str[i] != '0') {
480 /* base 10 */
481 return 0;
484 /* We have 0<x>, so see if we can convert it */
485 switch (str[i + 1]) {
486 case 'x': case 'X': *base = 16; break;
487 case 'o': case 'O': *base = 8; break;
488 case 'b': case 'B': *base = 2; break;
489 default: return 0;
491 i += 2;
492 /* Ensure that (e.g.) 0x-5 fails to parse */
493 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
494 /* Parse according to this base */
495 return i;
497 /* Parse as base 10 */
498 *base = 10;
499 return 0;
502 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
503 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
505 static long jim_strtol(const char *str, char **endptr)
507 int sign;
508 int base;
509 int i = JimNumberBase(str, &base, &sign);
511 if (base != 10) {
512 long value = strtol(str + i, endptr, base);
513 if (endptr == NULL || *endptr != str + i) {
514 return value * sign;
518 /* Can just do a regular base-10 conversion */
519 return strtol(str, endptr, 10);
523 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
524 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
526 static jim_wide jim_strtoull(const char *str, char **endptr)
528 #ifdef HAVE_LONG_LONG
529 int sign;
530 int base;
531 int i = JimNumberBase(str, &base, &sign);
533 if (base != 10) {
534 jim_wide value = strtoull(str + i, endptr, base);
535 if (endptr == NULL || *endptr != str + i) {
536 return value * sign;
540 /* Can just do a regular base-10 conversion */
541 return strtoull(str, endptr, 10);
542 #else
543 return (unsigned long)jim_strtol(str, endptr);
544 #endif
547 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
549 char *endptr;
551 if (base) {
552 *widePtr = strtoull(str, &endptr, base);
554 else {
555 *widePtr = jim_strtoull(str, &endptr);
558 return JimCheckConversion(str, endptr);
561 int Jim_StringToDouble(const char *str, double *doublePtr)
563 char *endptr;
565 /* Callers can check for underflow via ERANGE */
566 errno = 0;
568 *doublePtr = strtod(str, &endptr);
570 return JimCheckConversion(str, endptr);
573 static jim_wide JimPowWide(jim_wide b, jim_wide e)
575 jim_wide res = 1;
577 /* Special cases */
578 if (b == 1) {
579 /* 1 ^ any = 1 */
580 return 1;
582 if (e < 0) {
583 if (b != -1) {
584 return 0;
586 /* Only special case is -1 ^ -n
587 * -1^-1 = -1
588 * -1^-2 = 1
589 * i.e. same as +ve n
591 e = -e;
593 while (e)
595 if (e & 1) {
596 res *= b;
598 e >>= 1;
599 b *= b;
601 return res;
604 /* -----------------------------------------------------------------------------
605 * Special functions
606 * ---------------------------------------------------------------------------*/
607 #ifdef JIM_DEBUG_PANIC
608 static void JimPanicDump(int condition, const char *fmt, ...)
610 va_list ap;
612 if (!condition) {
613 return;
616 va_start(ap, fmt);
618 fprintf(stderr, "\nJIM INTERPRETER PANIC: ");
619 vfprintf(stderr, fmt, ap);
620 fprintf(stderr, "\n\n");
621 va_end(ap);
623 #ifdef HAVE_BACKTRACE
625 void *array[40];
626 int size, i;
627 char **strings;
629 size = backtrace(array, 40);
630 strings = backtrace_symbols(array, size);
631 for (i = 0; i < size; i++)
632 fprintf(stderr, "[backtrace] %s\n", strings[i]);
633 fprintf(stderr, "[backtrace] Include the above lines and the output\n");
634 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report.\n");
636 #endif
638 exit(1);
640 #endif
642 /* -----------------------------------------------------------------------------
643 * Memory allocation
644 * ---------------------------------------------------------------------------*/
646 void *Jim_Alloc(int size)
648 return size ? malloc(size) : NULL;
651 void Jim_Free(void *ptr)
653 free(ptr);
656 void *Jim_Realloc(void *ptr, int size)
658 return realloc(ptr, size);
661 char *Jim_StrDup(const char *s)
663 return strdup(s);
666 char *Jim_StrDupLen(const char *s, int l)
668 char *copy = Jim_Alloc(l + 1);
670 memcpy(copy, s, l + 1);
671 copy[l] = 0; /* Just to be sure, original could be substring */
672 return copy;
675 /* -----------------------------------------------------------------------------
676 * Time related functions
677 * ---------------------------------------------------------------------------*/
679 /* Returns current time in microseconds */
680 static jim_wide JimClock(void)
682 struct timeval tv;
684 gettimeofday(&tv, NULL);
685 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
688 /* -----------------------------------------------------------------------------
689 * Hash Tables
690 * ---------------------------------------------------------------------------*/
692 /* -------------------------- private prototypes ---------------------------- */
693 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
694 static unsigned int JimHashTableNextPower(unsigned int size);
695 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
697 /* -------------------------- hash functions -------------------------------- */
699 /* Thomas Wang's 32 bit Mix Function */
700 unsigned int Jim_IntHashFunction(unsigned int key)
702 key += ~(key << 15);
703 key ^= (key >> 10);
704 key += (key << 3);
705 key ^= (key >> 6);
706 key += ~(key << 11);
707 key ^= (key >> 16);
708 return key;
711 /* Generic hash function (we are using to multiply by 9 and add the byte
712 * as Tcl) */
713 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
715 unsigned int h = 0;
717 while (len--)
718 h += (h << 3) + *buf++;
719 return h;
722 /* ----------------------------- API implementation ------------------------- */
724 /* reset a hashtable already initialized */
725 static void JimResetHashTable(Jim_HashTable *ht)
727 ht->table = NULL;
728 ht->size = 0;
729 ht->sizemask = 0;
730 ht->used = 0;
731 ht->collisions = 0;
732 #ifdef JIM_RANDOMISE_HASH
733 /* This is initialised to a random value to avoid a hash collision attack.
734 * See: n.runs-SA-2011.004
736 ht->uniq = (rand() ^ time(NULL) ^ clock());
737 #else
738 ht->uniq = 0;
739 #endif
742 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
744 iter->ht = ht;
745 iter->index = -1;
746 iter->entry = NULL;
747 iter->nextEntry = NULL;
750 /* Initialize the hash table */
751 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
753 JimResetHashTable(ht);
754 ht->type = type;
755 ht->privdata = privDataPtr;
756 return JIM_OK;
759 /* Resize the table to the minimal size that contains all the elements,
760 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
761 void Jim_ResizeHashTable(Jim_HashTable *ht)
763 int minimal = ht->used;
765 if (minimal < JIM_HT_INITIAL_SIZE)
766 minimal = JIM_HT_INITIAL_SIZE;
767 Jim_ExpandHashTable(ht, minimal);
770 /* Expand or create the hashtable */
771 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
773 Jim_HashTable n; /* the new hashtable */
774 unsigned int realsize = JimHashTableNextPower(size), i;
776 /* the size is invalid if it is smaller than the number of
777 * elements already inside the hashtable */
778 if (size <= ht->used)
779 return;
781 Jim_InitHashTable(&n, ht->type, ht->privdata);
782 n.size = realsize;
783 n.sizemask = realsize - 1;
784 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
785 /* Keep the same 'uniq' as the original */
786 n.uniq = ht->uniq;
788 /* Initialize all the pointers to NULL */
789 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
791 /* Copy all the elements from the old to the new table:
792 * note that if the old hash table is empty ht->used is zero,
793 * so Jim_ExpandHashTable just creates an empty hash table. */
794 n.used = ht->used;
795 for (i = 0; ht->used > 0; i++) {
796 Jim_HashEntry *he, *nextHe;
798 if (ht->table[i] == NULL)
799 continue;
801 /* For each hash entry on this slot... */
802 he = ht->table[i];
803 while (he) {
804 unsigned int h;
806 nextHe = he->next;
807 /* Get the new element index */
808 h = Jim_HashKey(ht, he->key) & n.sizemask;
809 he->next = n.table[h];
810 n.table[h] = he;
811 ht->used--;
812 /* Pass to the next element */
813 he = nextHe;
816 assert(ht->used == 0);
817 Jim_Free(ht->table);
819 /* Remap the new hashtable in the old */
820 *ht = n;
823 /* Add an element to the target hash table */
824 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
826 Jim_HashEntry *entry;
828 /* Get the index of the new element, or -1 if
829 * the element already exists. */
830 entry = JimInsertHashEntry(ht, key, 0);
831 if (entry == NULL)
832 return JIM_ERR;
834 /* Set the hash entry fields. */
835 Jim_SetHashKey(ht, entry, key);
836 Jim_SetHashVal(ht, entry, val);
837 return JIM_OK;
840 /* Add an element, discarding the old if the key already exists */
841 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
843 int existed;
844 Jim_HashEntry *entry;
846 /* Get the index of the new element, or -1 if
847 * the element already exists. */
848 entry = JimInsertHashEntry(ht, key, 1);
849 if (entry->key) {
850 /* It already exists, so only replace the value.
851 * Note if both a destructor and a duplicate function exist,
852 * need to dup before destroy. perhaps they are the same
853 * reference counted object
855 if (ht->type->valDestructor && ht->type->valDup) {
856 void *newval = ht->type->valDup(ht->privdata, val);
857 ht->type->valDestructor(ht->privdata, entry->u.val);
858 entry->u.val = newval;
860 else {
861 Jim_FreeEntryVal(ht, entry);
862 Jim_SetHashVal(ht, entry, val);
864 existed = 1;
866 else {
867 /* Doesn't exist, so set the key */
868 Jim_SetHashKey(ht, entry, key);
869 Jim_SetHashVal(ht, entry, val);
870 existed = 0;
873 return existed;
876 /* Search and remove an element */
877 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
879 unsigned int h;
880 Jim_HashEntry *he, *prevHe;
882 if (ht->used == 0)
883 return JIM_ERR;
884 h = Jim_HashKey(ht, key) & ht->sizemask;
885 he = ht->table[h];
887 prevHe = NULL;
888 while (he) {
889 if (Jim_CompareHashKeys(ht, key, he->key)) {
890 /* Unlink the element from the list */
891 if (prevHe)
892 prevHe->next = he->next;
893 else
894 ht->table[h] = he->next;
895 Jim_FreeEntryKey(ht, he);
896 Jim_FreeEntryVal(ht, he);
897 Jim_Free(he);
898 ht->used--;
899 return JIM_OK;
901 prevHe = he;
902 he = he->next;
904 return JIM_ERR; /* not found */
907 /* Destroy an entire hash table and leave it ready for reuse */
908 int Jim_FreeHashTable(Jim_HashTable *ht)
910 unsigned int i;
912 /* Free all the elements */
913 for (i = 0; ht->used > 0; i++) {
914 Jim_HashEntry *he, *nextHe;
916 if ((he = ht->table[i]) == NULL)
917 continue;
918 while (he) {
919 nextHe = he->next;
920 Jim_FreeEntryKey(ht, he);
921 Jim_FreeEntryVal(ht, he);
922 Jim_Free(he);
923 ht->used--;
924 he = nextHe;
927 /* Free the table and the allocated cache structure */
928 Jim_Free(ht->table);
929 /* Re-initialize the table */
930 JimResetHashTable(ht);
931 return JIM_OK; /* never fails */
934 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
936 Jim_HashEntry *he;
937 unsigned int h;
939 if (ht->used == 0)
940 return NULL;
941 h = Jim_HashKey(ht, key) & ht->sizemask;
942 he = ht->table[h];
943 while (he) {
944 if (Jim_CompareHashKeys(ht, key, he->key))
945 return he;
946 he = he->next;
948 return NULL;
951 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
953 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
954 JimInitHashTableIterator(ht, iter);
955 return iter;
958 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
960 while (1) {
961 if (iter->entry == NULL) {
962 iter->index++;
963 if (iter->index >= (signed)iter->ht->size)
964 break;
965 iter->entry = iter->ht->table[iter->index];
967 else {
968 iter->entry = iter->nextEntry;
970 if (iter->entry) {
971 /* We need to save the 'next' here, the iterator user
972 * may delete the entry we are returning. */
973 iter->nextEntry = iter->entry->next;
974 return iter->entry;
977 return NULL;
980 /* ------------------------- private functions ------------------------------ */
982 /* Expand the hash table if needed */
983 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
985 /* If the hash table is empty expand it to the intial size,
986 * if the table is "full" dobule its size. */
987 if (ht->size == 0)
988 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
989 if (ht->size == ht->used)
990 Jim_ExpandHashTable(ht, ht->size * 2);
993 /* Our hash table capability is a power of two */
994 static unsigned int JimHashTableNextPower(unsigned int size)
996 unsigned int i = JIM_HT_INITIAL_SIZE;
998 if (size >= 2147483648U)
999 return 2147483648U;
1000 while (1) {
1001 if (i >= size)
1002 return i;
1003 i *= 2;
1007 /* Returns the index of a free slot that can be populated with
1008 * a hash entry for the given 'key'.
1009 * If the key already exists, -1 is returned. */
1010 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
1012 unsigned int h;
1013 Jim_HashEntry *he;
1015 /* Expand the hashtable if needed */
1016 JimExpandHashTableIfNeeded(ht);
1018 /* Compute the key hash value */
1019 h = Jim_HashKey(ht, key) & ht->sizemask;
1020 /* Search if this slot does not already contain the given key */
1021 he = ht->table[h];
1022 while (he) {
1023 if (Jim_CompareHashKeys(ht, key, he->key))
1024 return replace ? he : NULL;
1025 he = he->next;
1028 /* Allocates the memory and stores key */
1029 he = Jim_Alloc(sizeof(*he));
1030 he->next = ht->table[h];
1031 ht->table[h] = he;
1032 ht->used++;
1033 he->key = NULL;
1035 return he;
1038 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1040 static unsigned int JimStringCopyHTHashFunction(const void *key)
1042 return Jim_GenHashFunction(key, strlen(key));
1045 static void *JimStringCopyHTDup(void *privdata, const void *key)
1047 return Jim_StrDup(key);
1050 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1052 return strcmp(key1, key2) == 0;
1055 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1057 Jim_Free(key);
1060 static const Jim_HashTableType JimPackageHashTableType = {
1061 JimStringCopyHTHashFunction, /* hash function */
1062 JimStringCopyHTDup, /* key dup */
1063 NULL, /* val dup */
1064 JimStringCopyHTKeyCompare, /* key compare */
1065 JimStringCopyHTKeyDestructor, /* key destructor */
1066 NULL /* val destructor */
1069 typedef struct AssocDataValue
1071 Jim_InterpDeleteProc *delProc;
1072 void *data;
1073 } AssocDataValue;
1075 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1077 AssocDataValue *assocPtr = (AssocDataValue *) data;
1079 if (assocPtr->delProc != NULL)
1080 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1081 Jim_Free(data);
1084 static const Jim_HashTableType JimAssocDataHashTableType = {
1085 JimStringCopyHTHashFunction, /* hash function */
1086 JimStringCopyHTDup, /* key dup */
1087 NULL, /* val dup */
1088 JimStringCopyHTKeyCompare, /* key compare */
1089 JimStringCopyHTKeyDestructor, /* key destructor */
1090 JimAssocDataHashTableValueDestructor /* val destructor */
1093 /* -----------------------------------------------------------------------------
1094 * Stack - This is a simple generic stack implementation. It is used for
1095 * example in the 'expr' expression compiler.
1096 * ---------------------------------------------------------------------------*/
1097 void Jim_InitStack(Jim_Stack *stack)
1099 stack->len = 0;
1100 stack->maxlen = 0;
1101 stack->vector = NULL;
1104 void Jim_FreeStack(Jim_Stack *stack)
1106 Jim_Free(stack->vector);
1109 int Jim_StackLen(Jim_Stack *stack)
1111 return stack->len;
1114 void Jim_StackPush(Jim_Stack *stack, void *element)
1116 int neededLen = stack->len + 1;
1118 if (neededLen > stack->maxlen) {
1119 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1120 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1122 stack->vector[stack->len] = element;
1123 stack->len++;
1126 void *Jim_StackPop(Jim_Stack *stack)
1128 if (stack->len == 0)
1129 return NULL;
1130 stack->len--;
1131 return stack->vector[stack->len];
1134 void *Jim_StackPeek(Jim_Stack *stack)
1136 if (stack->len == 0)
1137 return NULL;
1138 return stack->vector[stack->len - 1];
1141 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1143 int i;
1145 for (i = 0; i < stack->len; i++)
1146 freeFunc(stack->vector[i]);
1149 /* -----------------------------------------------------------------------------
1150 * Tcl Parser
1151 * ---------------------------------------------------------------------------*/
1153 /* Token types */
1154 #define JIM_TT_NONE 0 /* No token returned */
1155 #define JIM_TT_STR 1 /* simple string */
1156 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1157 #define JIM_TT_VAR 3 /* var substitution */
1158 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1159 #define JIM_TT_CMD 5 /* command substitution */
1160 /* Note: Keep these three together for TOKEN_IS_SEP() */
1161 #define JIM_TT_SEP 6 /* word separator (white space) */
1162 #define JIM_TT_EOL 7 /* line separator */
1163 #define JIM_TT_EOF 8 /* end of script */
1165 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1166 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1168 /* Additional token types needed for expressions */
1169 #define JIM_TT_SUBEXPR_START 11
1170 #define JIM_TT_SUBEXPR_END 12
1171 #define JIM_TT_SUBEXPR_COMMA 13
1172 #define JIM_TT_EXPR_INT 14
1173 #define JIM_TT_EXPR_DOUBLE 15
1174 #define JIM_TT_EXPR_BOOLEAN 16
1176 #define JIM_TT_EXPRSUGAR 17 /* $(expression) */
1178 /* Operator token types start here */
1179 #define JIM_TT_EXPR_OP 20
1181 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1182 /* Can this token start an expression? */
1183 #define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA)
1184 /* Is this token an expression operator? */
1185 #define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP)
1188 * Results of missing quotes, braces, etc. from parsing.
1190 struct JimParseMissing {
1191 int ch; /* At end of parse, ' ' if complete or '{', '[', '"', '\\' , '{' if incomplete */
1192 int line; /* Line number starting the missing token */
1195 /* Parser context structure. The same context is used both to parse
1196 * Tcl scripts and lists. */
1197 struct JimParserCtx
1199 const char *p; /* Pointer to the point of the program we are parsing */
1200 int len; /* Remaining length */
1201 int linenr; /* Current line number */
1202 const char *tstart;
1203 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1204 int tline; /* Line number of the returned token */
1205 int tt; /* Token type */
1206 int eof; /* Non zero if EOF condition is true. */
1207 int inquote; /* Parsing a quoted string */
1208 int comment; /* Non zero if the next chars may be a comment. */
1209 struct JimParseMissing missing; /* Details of any missing quotes, etc. */
1212 static int JimParseScript(struct JimParserCtx *pc);
1213 static int JimParseSep(struct JimParserCtx *pc);
1214 static int JimParseEol(struct JimParserCtx *pc);
1215 static int JimParseCmd(struct JimParserCtx *pc);
1216 static int JimParseQuote(struct JimParserCtx *pc);
1217 static int JimParseVar(struct JimParserCtx *pc);
1218 static int JimParseBrace(struct JimParserCtx *pc);
1219 static int JimParseStr(struct JimParserCtx *pc);
1220 static int JimParseComment(struct JimParserCtx *pc);
1221 static void JimParseSubCmd(struct JimParserCtx *pc);
1222 static int JimParseSubQuote(struct JimParserCtx *pc);
1223 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1225 /* Initialize a parser context.
1226 * 'prg' is a pointer to the program text, linenr is the line
1227 * number of the first line contained in the program. */
1228 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1230 pc->p = prg;
1231 pc->len = len;
1232 pc->tstart = NULL;
1233 pc->tend = NULL;
1234 pc->tline = 0;
1235 pc->tt = JIM_TT_NONE;
1236 pc->eof = 0;
1237 pc->inquote = 0;
1238 pc->linenr = linenr;
1239 pc->comment = 1;
1240 pc->missing.ch = ' ';
1241 pc->missing.line = linenr;
1244 static int JimParseScript(struct JimParserCtx *pc)
1246 while (1) { /* the while is used to reiterate with continue if needed */
1247 if (!pc->len) {
1248 pc->tstart = pc->p;
1249 pc->tend = pc->p - 1;
1250 pc->tline = pc->linenr;
1251 pc->tt = JIM_TT_EOL;
1252 pc->eof = 1;
1253 return JIM_OK;
1255 switch (*(pc->p)) {
1256 case '\\':
1257 if (*(pc->p + 1) == '\n' && !pc->inquote) {
1258 return JimParseSep(pc);
1260 pc->comment = 0;
1261 return JimParseStr(pc);
1262 case ' ':
1263 case '\t':
1264 case '\r':
1265 case '\f':
1266 if (!pc->inquote)
1267 return JimParseSep(pc);
1268 pc->comment = 0;
1269 return JimParseStr(pc);
1270 case '\n':
1271 case ';':
1272 pc->comment = 1;
1273 if (!pc->inquote)
1274 return JimParseEol(pc);
1275 return JimParseStr(pc);
1276 case '[':
1277 pc->comment = 0;
1278 return JimParseCmd(pc);
1279 case '$':
1280 pc->comment = 0;
1281 if (JimParseVar(pc) == JIM_ERR) {
1282 /* An orphan $. Create as a separate token */
1283 pc->tstart = pc->tend = pc->p++;
1284 pc->len--;
1285 pc->tt = JIM_TT_ESC;
1287 return JIM_OK;
1288 case '#':
1289 if (pc->comment) {
1290 JimParseComment(pc);
1291 continue;
1293 return JimParseStr(pc);
1294 default:
1295 pc->comment = 0;
1296 return JimParseStr(pc);
1298 return JIM_OK;
1302 static int JimParseSep(struct JimParserCtx *pc)
1304 pc->tstart = pc->p;
1305 pc->tline = pc->linenr;
1306 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1307 if (*pc->p == '\n') {
1308 break;
1310 if (*pc->p == '\\') {
1311 pc->p++;
1312 pc->len--;
1313 pc->linenr++;
1315 pc->p++;
1316 pc->len--;
1318 pc->tend = pc->p - 1;
1319 pc->tt = JIM_TT_SEP;
1320 return JIM_OK;
1323 static int JimParseEol(struct JimParserCtx *pc)
1325 pc->tstart = pc->p;
1326 pc->tline = pc->linenr;
1327 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1328 if (*pc->p == '\n')
1329 pc->linenr++;
1330 pc->p++;
1331 pc->len--;
1333 pc->tend = pc->p - 1;
1334 pc->tt = JIM_TT_EOL;
1335 return JIM_OK;
1339 ** Here are the rules for parsing:
1340 ** {braced expression}
1341 ** - Count open and closing braces
1342 ** - Backslash escapes meaning of braces
1344 ** "quoted expression"
1345 ** - First double quote at start of word terminates the expression
1346 ** - Backslash escapes quote and bracket
1347 ** - [commands brackets] are counted/nested
1348 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1350 ** [command expression]
1351 ** - Count open and closing brackets
1352 ** - Backslash escapes quote, bracket and brace
1353 ** - [commands brackets] are counted/nested
1354 ** - "quoted expressions" are parsed according to quoting rules
1355 ** - {braced expressions} are parsed according to brace rules
1357 ** For everything, backslash escapes the next char, newline increments current line
1361 * Parses a braced expression starting at pc->p.
1363 * Positions the parser at the end of the braced expression,
1364 * sets pc->tend and possibly pc->missing.
1366 static void JimParseSubBrace(struct JimParserCtx *pc)
1368 int level = 1;
1370 /* Skip the brace */
1371 pc->p++;
1372 pc->len--;
1373 while (pc->len) {
1374 switch (*pc->p) {
1375 case '\\':
1376 if (pc->len > 1) {
1377 if (*++pc->p == '\n') {
1378 pc->linenr++;
1380 pc->len--;
1382 break;
1384 case '{':
1385 level++;
1386 break;
1388 case '}':
1389 if (--level == 0) {
1390 pc->tend = pc->p - 1;
1391 pc->p++;
1392 pc->len--;
1393 return;
1395 break;
1397 case '\n':
1398 pc->linenr++;
1399 break;
1401 pc->p++;
1402 pc->len--;
1404 pc->missing.ch = '{';
1405 pc->missing.line = pc->tline;
1406 pc->tend = pc->p - 1;
1410 * Parses a quoted expression starting at pc->p.
1412 * Positions the parser at the end of the quoted expression,
1413 * sets pc->tend and possibly pc->missing.
1415 * Returns the type of the token of the string,
1416 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1417 * or JIM_TT_STR.
1419 static int JimParseSubQuote(struct JimParserCtx *pc)
1421 int tt = JIM_TT_STR;
1422 int line = pc->tline;
1424 /* Skip the quote */
1425 pc->p++;
1426 pc->len--;
1427 while (pc->len) {
1428 switch (*pc->p) {
1429 case '\\':
1430 if (pc->len > 1) {
1431 if (*++pc->p == '\n') {
1432 pc->linenr++;
1434 pc->len--;
1435 tt = JIM_TT_ESC;
1437 break;
1439 case '"':
1440 pc->tend = pc->p - 1;
1441 pc->p++;
1442 pc->len--;
1443 return tt;
1445 case '[':
1446 JimParseSubCmd(pc);
1447 tt = JIM_TT_ESC;
1448 continue;
1450 case '\n':
1451 pc->linenr++;
1452 break;
1454 case '$':
1455 tt = JIM_TT_ESC;
1456 break;
1458 pc->p++;
1459 pc->len--;
1461 pc->missing.ch = '"';
1462 pc->missing.line = line;
1463 pc->tend = pc->p - 1;
1464 return tt;
1468 * Parses a [command] expression starting at pc->p.
1470 * Positions the parser at the end of the command expression,
1471 * sets pc->tend and possibly pc->missing.
1473 static void JimParseSubCmd(struct JimParserCtx *pc)
1475 int level = 1;
1476 int startofword = 1;
1477 int line = pc->tline;
1479 /* Skip the bracket */
1480 pc->p++;
1481 pc->len--;
1482 while (pc->len) {
1483 switch (*pc->p) {
1484 case '\\':
1485 if (pc->len > 1) {
1486 if (*++pc->p == '\n') {
1487 pc->linenr++;
1489 pc->len--;
1491 break;
1493 case '[':
1494 level++;
1495 break;
1497 case ']':
1498 if (--level == 0) {
1499 pc->tend = pc->p - 1;
1500 pc->p++;
1501 pc->len--;
1502 return;
1504 break;
1506 case '"':
1507 if (startofword) {
1508 JimParseSubQuote(pc);
1509 continue;
1511 break;
1513 case '{':
1514 JimParseSubBrace(pc);
1515 startofword = 0;
1516 continue;
1518 case '\n':
1519 pc->linenr++;
1520 break;
1522 startofword = isspace(UCHAR(*pc->p));
1523 pc->p++;
1524 pc->len--;
1526 pc->missing.ch = '[';
1527 pc->missing.line = line;
1528 pc->tend = pc->p - 1;
1531 static int JimParseBrace(struct JimParserCtx *pc)
1533 pc->tstart = pc->p + 1;
1534 pc->tline = pc->linenr;
1535 pc->tt = JIM_TT_STR;
1536 JimParseSubBrace(pc);
1537 return JIM_OK;
1540 static int JimParseCmd(struct JimParserCtx *pc)
1542 pc->tstart = pc->p + 1;
1543 pc->tline = pc->linenr;
1544 pc->tt = JIM_TT_CMD;
1545 JimParseSubCmd(pc);
1546 return JIM_OK;
1549 static int JimParseQuote(struct JimParserCtx *pc)
1551 pc->tstart = pc->p + 1;
1552 pc->tline = pc->linenr;
1553 pc->tt = JimParseSubQuote(pc);
1554 return JIM_OK;
1557 static int JimParseVar(struct JimParserCtx *pc)
1559 /* skip the $ */
1560 pc->p++;
1561 pc->len--;
1563 #ifdef EXPRSUGAR_BRACKET
1564 if (*pc->p == '[') {
1565 /* Parse $[...] expr shorthand syntax */
1566 JimParseCmd(pc);
1567 pc->tt = JIM_TT_EXPRSUGAR;
1568 return JIM_OK;
1570 #endif
1572 pc->tstart = pc->p;
1573 pc->tt = JIM_TT_VAR;
1574 pc->tline = pc->linenr;
1576 if (*pc->p == '{') {
1577 pc->tstart = ++pc->p;
1578 pc->len--;
1580 while (pc->len && *pc->p != '}') {
1581 if (*pc->p == '\n') {
1582 pc->linenr++;
1584 pc->p++;
1585 pc->len--;
1587 pc->tend = pc->p - 1;
1588 if (pc->len) {
1589 pc->p++;
1590 pc->len--;
1593 else {
1594 while (1) {
1595 /* Skip double colon, but not single colon! */
1596 if (pc->p[0] == ':' && pc->p[1] == ':') {
1597 while (*pc->p == ':') {
1598 pc->p++;
1599 pc->len--;
1601 continue;
1603 /* Note that any char >= 0x80 must be part of a utf-8 char.
1604 * We consider all unicode points outside of ASCII as letters
1606 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1607 pc->p++;
1608 pc->len--;
1609 continue;
1611 break;
1613 /* Parse [dict get] syntax sugar. */
1614 if (*pc->p == '(') {
1615 int count = 1;
1616 const char *paren = NULL;
1618 pc->tt = JIM_TT_DICTSUGAR;
1620 while (count && pc->len) {
1621 pc->p++;
1622 pc->len--;
1623 if (*pc->p == '\\' && pc->len >= 1) {
1624 pc->p++;
1625 pc->len--;
1627 else if (*pc->p == '(') {
1628 count++;
1630 else if (*pc->p == ')') {
1631 paren = pc->p;
1632 count--;
1635 if (count == 0) {
1636 pc->p++;
1637 pc->len--;
1639 else if (paren) {
1640 /* Did not find a matching paren. Back up */
1641 paren++;
1642 pc->len += (pc->p - paren);
1643 pc->p = paren;
1645 #ifndef EXPRSUGAR_BRACKET
1646 if (*pc->tstart == '(') {
1647 pc->tt = JIM_TT_EXPRSUGAR;
1649 #endif
1651 pc->tend = pc->p - 1;
1653 /* Check if we parsed just the '$' character.
1654 * That's not a variable so an error is returned
1655 * to tell the state machine to consider this '$' just
1656 * a string. */
1657 if (pc->tstart == pc->p) {
1658 pc->p--;
1659 pc->len++;
1660 return JIM_ERR;
1662 return JIM_OK;
1665 static int JimParseStr(struct JimParserCtx *pc)
1667 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1668 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1669 /* Starting a new word */
1670 if (*pc->p == '{') {
1671 return JimParseBrace(pc);
1673 if (*pc->p == '"') {
1674 pc->inquote = 1;
1675 pc->p++;
1676 pc->len--;
1677 /* In case the end quote is missing */
1678 pc->missing.line = pc->tline;
1681 pc->tstart = pc->p;
1682 pc->tline = pc->linenr;
1683 while (1) {
1684 if (pc->len == 0) {
1685 if (pc->inquote) {
1686 pc->missing.ch = '"';
1688 pc->tend = pc->p - 1;
1689 pc->tt = JIM_TT_ESC;
1690 return JIM_OK;
1692 switch (*pc->p) {
1693 case '\\':
1694 if (!pc->inquote && *(pc->p + 1) == '\n') {
1695 pc->tend = pc->p - 1;
1696 pc->tt = JIM_TT_ESC;
1697 return JIM_OK;
1699 if (pc->len >= 2) {
1700 if (*(pc->p + 1) == '\n') {
1701 pc->linenr++;
1703 pc->p++;
1704 pc->len--;
1706 else if (pc->len == 1) {
1707 /* End of script with trailing backslash */
1708 pc->missing.ch = '\\';
1710 break;
1711 case '(':
1712 /* If the following token is not '$' just keep going */
1713 if (pc->len > 1 && pc->p[1] != '$') {
1714 break;
1716 /* fall through */
1717 case ')':
1718 /* Only need a separate ')' token if the previous was a var */
1719 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1720 if (pc->p == pc->tstart) {
1721 /* At the start of the token, so just return this char */
1722 pc->p++;
1723 pc->len--;
1725 pc->tend = pc->p - 1;
1726 pc->tt = JIM_TT_ESC;
1727 return JIM_OK;
1729 break;
1731 case '$':
1732 case '[':
1733 pc->tend = pc->p - 1;
1734 pc->tt = JIM_TT_ESC;
1735 return JIM_OK;
1736 case ' ':
1737 case '\t':
1738 case '\n':
1739 case '\r':
1740 case '\f':
1741 case ';':
1742 if (!pc->inquote) {
1743 pc->tend = pc->p - 1;
1744 pc->tt = JIM_TT_ESC;
1745 return JIM_OK;
1747 else if (*pc->p == '\n') {
1748 pc->linenr++;
1750 break;
1751 case '"':
1752 if (pc->inquote) {
1753 pc->tend = pc->p - 1;
1754 pc->tt = JIM_TT_ESC;
1755 pc->p++;
1756 pc->len--;
1757 pc->inquote = 0;
1758 return JIM_OK;
1760 break;
1762 pc->p++;
1763 pc->len--;
1765 return JIM_OK; /* unreached */
1768 static int JimParseComment(struct JimParserCtx *pc)
1770 while (*pc->p) {
1771 if (*pc->p == '\\') {
1772 pc->p++;
1773 pc->len--;
1774 if (pc->len == 0) {
1775 pc->missing.ch = '\\';
1776 return JIM_OK;
1778 if (*pc->p == '\n') {
1779 pc->linenr++;
1782 else if (*pc->p == '\n') {
1783 pc->p++;
1784 pc->len--;
1785 pc->linenr++;
1786 break;
1788 pc->p++;
1789 pc->len--;
1791 return JIM_OK;
1794 /* xdigitval and odigitval are helper functions for JimEscape() */
1795 static int xdigitval(int c)
1797 if (c >= '0' && c <= '9')
1798 return c - '0';
1799 if (c >= 'a' && c <= 'f')
1800 return c - 'a' + 10;
1801 if (c >= 'A' && c <= 'F')
1802 return c - 'A' + 10;
1803 return -1;
1806 static int odigitval(int c)
1808 if (c >= '0' && c <= '7')
1809 return c - '0';
1810 return -1;
1813 /* Perform Tcl escape substitution of 's', storing the result
1814 * string into 'dest'. The escaped string is guaranteed to
1815 * be the same length or shorted than the source string.
1816 * Slen is the length of the string at 's'.
1818 * The function returns the length of the resulting string. */
1819 static int JimEscape(char *dest, const char *s, int slen)
1821 char *p = dest;
1822 int i, len;
1824 for (i = 0; i < slen; i++) {
1825 switch (s[i]) {
1826 case '\\':
1827 switch (s[i + 1]) {
1828 case 'a':
1829 *p++ = 0x7;
1830 i++;
1831 break;
1832 case 'b':
1833 *p++ = 0x8;
1834 i++;
1835 break;
1836 case 'f':
1837 *p++ = 0xc;
1838 i++;
1839 break;
1840 case 'n':
1841 *p++ = 0xa;
1842 i++;
1843 break;
1844 case 'r':
1845 *p++ = 0xd;
1846 i++;
1847 break;
1848 case 't':
1849 *p++ = 0x9;
1850 i++;
1851 break;
1852 case 'u':
1853 case 'U':
1854 case 'x':
1855 /* A unicode or hex sequence.
1856 * \x Expect 1-2 hex chars and convert to hex.
1857 * \u Expect 1-4 hex chars and convert to utf-8.
1858 * \U Expect 1-8 hex chars and convert to utf-8.
1859 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1860 * An invalid sequence means simply the escaped char.
1863 unsigned val = 0;
1864 int k;
1865 int maxchars = 2;
1867 i++;
1869 if (s[i] == 'U') {
1870 maxchars = 8;
1872 else if (s[i] == 'u') {
1873 if (s[i + 1] == '{') {
1874 maxchars = 6;
1875 i++;
1877 else {
1878 maxchars = 4;
1882 for (k = 0; k < maxchars; k++) {
1883 int c = xdigitval(s[i + k + 1]);
1884 if (c == -1) {
1885 break;
1887 val = (val << 4) | c;
1889 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1890 if (s[i] == '{') {
1891 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1892 /* Back up */
1893 i--;
1894 k = 0;
1896 else {
1897 /* Skip the closing brace */
1898 k++;
1901 if (k) {
1902 /* Got a valid sequence, so convert */
1903 if (s[i] == 'x') {
1904 *p++ = val;
1906 else {
1907 p += utf8_fromunicode(p, val);
1909 i += k;
1910 break;
1912 /* Not a valid codepoint, just an escaped char */
1913 *p++ = s[i];
1915 break;
1916 case 'v':
1917 *p++ = 0xb;
1918 i++;
1919 break;
1920 case '\0':
1921 *p++ = '\\';
1922 i++;
1923 break;
1924 case '\n':
1925 /* Replace all spaces and tabs after backslash newline with a single space*/
1926 *p++ = ' ';
1927 do {
1928 i++;
1929 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1930 break;
1931 case '0':
1932 case '1':
1933 case '2':
1934 case '3':
1935 case '4':
1936 case '5':
1937 case '6':
1938 case '7':
1939 /* octal escape */
1941 int val = 0;
1942 int c = odigitval(s[i + 1]);
1944 val = c;
1945 c = odigitval(s[i + 2]);
1946 if (c == -1) {
1947 *p++ = val;
1948 i++;
1949 break;
1951 val = (val * 8) + c;
1952 c = odigitval(s[i + 3]);
1953 if (c == -1) {
1954 *p++ = val;
1955 i += 2;
1956 break;
1958 val = (val * 8) + c;
1959 *p++ = val;
1960 i += 3;
1962 break;
1963 default:
1964 *p++ = s[i + 1];
1965 i++;
1966 break;
1968 break;
1969 default:
1970 *p++ = s[i];
1971 break;
1974 len = p - dest;
1975 *p = '\0';
1976 return len;
1979 /* Returns a dynamically allocated copy of the current token in the
1980 * parser context. The function performs conversion of escapes if
1981 * the token is of type JIM_TT_ESC.
1983 * Note that after the conversion, tokens that are grouped with
1984 * braces in the source code, are always recognizable from the
1985 * identical string obtained in a different way from the type.
1987 * For example the string:
1989 * {*}$a
1991 * will return as first token "*", of type JIM_TT_STR
1993 * While the string:
1995 * *$a
1997 * will return as first token "*", of type JIM_TT_ESC
1999 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
2001 const char *start, *end;
2002 char *token;
2003 int len;
2005 start = pc->tstart;
2006 end = pc->tend;
2007 if (start > end) {
2008 len = 0;
2009 token = Jim_Alloc(1);
2010 token[0] = '\0';
2012 else {
2013 len = (end - start) + 1;
2014 token = Jim_Alloc(len + 1);
2015 if (pc->tt != JIM_TT_ESC) {
2016 /* No escape conversion needed? Just copy it. */
2017 memcpy(token, start, len);
2018 token[len] = '\0';
2020 else {
2021 /* Else convert the escape chars. */
2022 len = JimEscape(token, start, len);
2026 return Jim_NewStringObjNoAlloc(interp, token, len);
2029 /* -----------------------------------------------------------------------------
2030 * Tcl Lists parsing
2031 * ---------------------------------------------------------------------------*/
2032 static int JimParseListSep(struct JimParserCtx *pc);
2033 static int JimParseListStr(struct JimParserCtx *pc);
2034 static int JimParseListQuote(struct JimParserCtx *pc);
2036 static int JimParseList(struct JimParserCtx *pc)
2038 if (isspace(UCHAR(*pc->p))) {
2039 return JimParseListSep(pc);
2041 switch (*pc->p) {
2042 case '"':
2043 return JimParseListQuote(pc);
2045 case '{':
2046 return JimParseBrace(pc);
2048 default:
2049 if (pc->len) {
2050 return JimParseListStr(pc);
2052 break;
2055 pc->tstart = pc->tend = pc->p;
2056 pc->tline = pc->linenr;
2057 pc->tt = JIM_TT_EOL;
2058 pc->eof = 1;
2059 return JIM_OK;
2062 static int JimParseListSep(struct JimParserCtx *pc)
2064 pc->tstart = pc->p;
2065 pc->tline = pc->linenr;
2066 while (isspace(UCHAR(*pc->p))) {
2067 if (*pc->p == '\n') {
2068 pc->linenr++;
2070 pc->p++;
2071 pc->len--;
2073 pc->tend = pc->p - 1;
2074 pc->tt = JIM_TT_SEP;
2075 return JIM_OK;
2078 static int JimParseListQuote(struct JimParserCtx *pc)
2080 pc->p++;
2081 pc->len--;
2083 pc->tstart = pc->p;
2084 pc->tline = pc->linenr;
2085 pc->tt = JIM_TT_STR;
2087 while (pc->len) {
2088 switch (*pc->p) {
2089 case '\\':
2090 pc->tt = JIM_TT_ESC;
2091 if (--pc->len == 0) {
2092 /* Trailing backslash */
2093 pc->tend = pc->p;
2094 return JIM_OK;
2096 pc->p++;
2097 break;
2098 case '\n':
2099 pc->linenr++;
2100 break;
2101 case '"':
2102 pc->tend = pc->p - 1;
2103 pc->p++;
2104 pc->len--;
2105 return JIM_OK;
2107 pc->p++;
2108 pc->len--;
2111 pc->tend = pc->p - 1;
2112 return JIM_OK;
2115 static int JimParseListStr(struct JimParserCtx *pc)
2117 pc->tstart = pc->p;
2118 pc->tline = pc->linenr;
2119 pc->tt = JIM_TT_STR;
2121 while (pc->len) {
2122 if (isspace(UCHAR(*pc->p))) {
2123 pc->tend = pc->p - 1;
2124 return JIM_OK;
2126 if (*pc->p == '\\') {
2127 if (--pc->len == 0) {
2128 /* Trailing backslash */
2129 pc->tend = pc->p;
2130 return JIM_OK;
2132 pc->tt = JIM_TT_ESC;
2133 pc->p++;
2135 pc->p++;
2136 pc->len--;
2138 pc->tend = pc->p - 1;
2139 return JIM_OK;
2142 /* -----------------------------------------------------------------------------
2143 * Jim_Obj related functions
2144 * ---------------------------------------------------------------------------*/
2146 /* Return a new initialized object. */
2147 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2149 Jim_Obj *objPtr;
2151 /* -- Check if there are objects in the free list -- */
2152 if (interp->freeList != NULL) {
2153 /* -- Unlink the object from the free list -- */
2154 objPtr = interp->freeList;
2155 interp->freeList = objPtr->nextObjPtr;
2157 else {
2158 /* -- No ready to use objects: allocate a new one -- */
2159 objPtr = Jim_Alloc(sizeof(*objPtr));
2162 /* Object is returned with refCount of 0. Every
2163 * kind of GC implemented should take care to don't try
2164 * to scan objects with refCount == 0. */
2165 objPtr->refCount = 0;
2166 /* All the other fields are left not initialized to save time.
2167 * The caller will probably want to set them to the right
2168 * value anyway. */
2170 /* -- Put the object into the live list -- */
2171 objPtr->prevObjPtr = NULL;
2172 objPtr->nextObjPtr = interp->liveList;
2173 if (interp->liveList)
2174 interp->liveList->prevObjPtr = objPtr;
2175 interp->liveList = objPtr;
2177 return objPtr;
2180 /* Free an object. Actually objects are never freed, but
2181 * just moved to the free objects list, where they will be
2182 * reused by Jim_NewObj(). */
2183 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2185 /* Check if the object was already freed, panic. */
2186 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2187 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2189 /* Free the internal representation */
2190 Jim_FreeIntRep(interp, objPtr);
2191 /* Free the string representation */
2192 if (objPtr->bytes != NULL) {
2193 if (objPtr->bytes != JimEmptyStringRep)
2194 Jim_Free(objPtr->bytes);
2196 /* Unlink the object from the live objects list */
2197 if (objPtr->prevObjPtr)
2198 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2199 if (objPtr->nextObjPtr)
2200 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2201 if (interp->liveList == objPtr)
2202 interp->liveList = objPtr->nextObjPtr;
2203 #ifdef JIM_DISABLE_OBJECT_POOL
2204 Jim_Free(objPtr);
2205 #else
2206 /* Link the object into the free objects list */
2207 objPtr->prevObjPtr = NULL;
2208 objPtr->nextObjPtr = interp->freeList;
2209 if (interp->freeList)
2210 interp->freeList->prevObjPtr = objPtr;
2211 interp->freeList = objPtr;
2212 objPtr->refCount = -1;
2213 #endif
2216 /* Invalidate the string representation of an object. */
2217 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2219 if (objPtr->bytes != NULL) {
2220 if (objPtr->bytes != JimEmptyStringRep)
2221 Jim_Free(objPtr->bytes);
2223 objPtr->bytes = NULL;
2226 /* Duplicate an object. The returned object has refcount = 0. */
2227 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2229 Jim_Obj *dupPtr;
2231 dupPtr = Jim_NewObj(interp);
2232 if (objPtr->bytes == NULL) {
2233 /* Object does not have a valid string representation. */
2234 dupPtr->bytes = NULL;
2236 else if (objPtr->length == 0) {
2237 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2238 dupPtr->bytes = JimEmptyStringRep;
2239 dupPtr->length = 0;
2240 dupPtr->typePtr = NULL;
2241 return dupPtr;
2243 else {
2244 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2245 dupPtr->length = objPtr->length;
2246 /* Copy the null byte too */
2247 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2250 /* By default, the new object has the same type as the old object */
2251 dupPtr->typePtr = objPtr->typePtr;
2252 if (objPtr->typePtr != NULL) {
2253 if (objPtr->typePtr->dupIntRepProc == NULL) {
2254 dupPtr->internalRep = objPtr->internalRep;
2256 else {
2257 /* The dup proc may set a different type, e.g. NULL */
2258 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2261 return dupPtr;
2264 /* Return the string representation for objPtr. If the object's
2265 * string representation is invalid, calls the updateStringProc method to create
2266 * a new one from the internal representation of the object.
2268 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2270 if (objPtr->bytes == NULL) {
2271 /* Invalid string repr. Generate it. */
2272 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2273 objPtr->typePtr->updateStringProc(objPtr);
2275 if (lenPtr)
2276 *lenPtr = objPtr->length;
2277 return objPtr->bytes;
2280 /* Just returns the length of the object's string rep */
2281 int Jim_Length(Jim_Obj *objPtr)
2283 if (objPtr->bytes == NULL) {
2284 /* Invalid string repr. Generate it. */
2285 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2286 objPtr->typePtr->updateStringProc(objPtr);
2288 return objPtr->length;
2291 /* Just returns object's string rep */
2292 const char *Jim_String(Jim_Obj *objPtr)
2294 if (objPtr->bytes == NULL) {
2295 /* Invalid string repr. Generate it. */
2296 JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value."));
2297 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2298 objPtr->typePtr->updateStringProc(objPtr);
2300 return objPtr->bytes;
2303 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2305 objPtr->bytes = Jim_StrDup(str);
2306 objPtr->length = strlen(str);
2309 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2310 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2312 static const Jim_ObjType dictSubstObjType = {
2313 "dict-substitution",
2314 FreeDictSubstInternalRep,
2315 DupDictSubstInternalRep,
2316 NULL,
2317 JIM_TYPE_NONE,
2320 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2322 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2325 static const Jim_ObjType interpolatedObjType = {
2326 "interpolated",
2327 FreeInterpolatedInternalRep,
2328 NULL,
2329 NULL,
2330 JIM_TYPE_NONE,
2333 /* -----------------------------------------------------------------------------
2334 * String Object
2335 * ---------------------------------------------------------------------------*/
2336 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2337 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2339 static const Jim_ObjType stringObjType = {
2340 "string",
2341 NULL,
2342 DupStringInternalRep,
2343 NULL,
2344 JIM_TYPE_REFERENCES,
2347 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2349 JIM_NOTUSED(interp);
2351 /* This is a bit subtle: the only caller of this function
2352 * should be Jim_DuplicateObj(), that will copy the
2353 * string representaion. After the copy, the duplicated
2354 * object will not have more room in the buffer than
2355 * srcPtr->length bytes. So we just set it to length. */
2356 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2357 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2360 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2362 if (objPtr->typePtr != &stringObjType) {
2363 /* Get a fresh string representation. */
2364 if (objPtr->bytes == NULL) {
2365 /* Invalid string repr. Generate it. */
2366 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2367 objPtr->typePtr->updateStringProc(objPtr);
2369 /* Free any other internal representation. */
2370 Jim_FreeIntRep(interp, objPtr);
2371 /* Set it as string, i.e. just set the maxLength field. */
2372 objPtr->typePtr = &stringObjType;
2373 objPtr->internalRep.strValue.maxLength = objPtr->length;
2374 /* Don't know the utf-8 length yet */
2375 objPtr->internalRep.strValue.charLength = -1;
2377 return JIM_OK;
2381 * Returns the length of the object string in chars, not bytes.
2383 * These may be different for a utf-8 string.
2385 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2387 #ifdef JIM_UTF8
2388 SetStringFromAny(interp, objPtr);
2390 if (objPtr->internalRep.strValue.charLength < 0) {
2391 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2393 return objPtr->internalRep.strValue.charLength;
2394 #else
2395 return Jim_Length(objPtr);
2396 #endif
2399 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2400 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2402 Jim_Obj *objPtr = Jim_NewObj(interp);
2404 /* Need to find out how many bytes the string requires */
2405 if (len == -1)
2406 len = strlen(s);
2407 /* Alloc/Set the string rep. */
2408 if (len == 0) {
2409 objPtr->bytes = JimEmptyStringRep;
2411 else {
2412 objPtr->bytes = Jim_Alloc(len + 1);
2413 memcpy(objPtr->bytes, s, len);
2414 objPtr->bytes[len] = '\0';
2416 objPtr->length = len;
2418 /* No typePtr field for the vanilla string object. */
2419 objPtr->typePtr = NULL;
2420 return objPtr;
2423 /* charlen is in characters -- see also Jim_NewStringObj() */
2424 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2426 #ifdef JIM_UTF8
2427 /* Need to find out how many bytes the string requires */
2428 int bytelen = utf8_index(s, charlen);
2430 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2432 /* Remember the utf8 length, so set the type */
2433 objPtr->typePtr = &stringObjType;
2434 objPtr->internalRep.strValue.maxLength = bytelen;
2435 objPtr->internalRep.strValue.charLength = charlen;
2437 return objPtr;
2438 #else
2439 return Jim_NewStringObj(interp, s, charlen);
2440 #endif
2443 /* This version does not try to duplicate the 's' pointer, but
2444 * use it directly. */
2445 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2447 Jim_Obj *objPtr = Jim_NewObj(interp);
2449 objPtr->bytes = s;
2450 objPtr->length = (len == -1) ? strlen(s) : len;
2451 objPtr->typePtr = NULL;
2452 return objPtr;
2455 /* Low-level string append. Use it only against unshared objects
2456 * of type "string". */
2457 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2459 int needlen;
2461 if (len == -1)
2462 len = strlen(str);
2463 needlen = objPtr->length + len;
2464 if (objPtr->internalRep.strValue.maxLength < needlen ||
2465 objPtr->internalRep.strValue.maxLength == 0) {
2466 needlen *= 2;
2467 /* Inefficient to malloc() for less than 8 bytes */
2468 if (needlen < 7) {
2469 needlen = 7;
2471 if (objPtr->bytes == JimEmptyStringRep) {
2472 objPtr->bytes = Jim_Alloc(needlen + 1);
2474 else {
2475 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2477 objPtr->internalRep.strValue.maxLength = needlen;
2479 memcpy(objPtr->bytes + objPtr->length, str, len);
2480 objPtr->bytes[objPtr->length + len] = '\0';
2482 if (objPtr->internalRep.strValue.charLength >= 0) {
2483 /* Update the utf-8 char length */
2484 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2486 objPtr->length += len;
2489 /* Higher level API to append strings to objects.
2490 * Object must not be unshared for each of these.
2492 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2494 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2495 SetStringFromAny(interp, objPtr);
2496 StringAppendString(objPtr, str, len);
2499 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2501 int len;
2502 const char *str = Jim_GetString(appendObjPtr, &len);
2503 Jim_AppendString(interp, objPtr, str, len);
2506 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2508 va_list ap;
2510 SetStringFromAny(interp, objPtr);
2511 va_start(ap, objPtr);
2512 while (1) {
2513 const char *s = va_arg(ap, const char *);
2515 if (s == NULL)
2516 break;
2517 Jim_AppendString(interp, objPtr, s, -1);
2519 va_end(ap);
2522 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2524 if (aObjPtr == bObjPtr) {
2525 return 1;
2527 else {
2528 int Alen, Blen;
2529 const char *sA = Jim_GetString(aObjPtr, &Alen);
2530 const char *sB = Jim_GetString(bObjPtr, &Blen);
2532 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2537 * Note. Does not support embedded nulls in either the pattern or the object.
2539 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2541 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2545 * Note: does not support embedded nulls for the nocase option.
2547 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2549 int l1, l2;
2550 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2551 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2553 if (nocase) {
2554 /* Do a character compare for nocase */
2555 return JimStringCompareLen(s1, s2, -1, nocase);
2557 return JimStringCompare(s1, l1, s2, l2);
2561 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2563 * Note: does not support embedded nulls
2565 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2567 const char *s1 = Jim_String(firstObjPtr);
2568 const char *s2 = Jim_String(secondObjPtr);
2570 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2573 /* Convert a range, as returned by Jim_GetRange(), into
2574 * an absolute index into an object of the specified length.
2575 * This function may return negative values, or values
2576 * greater than or equal to the length of the list if the index
2577 * is out of range. */
2578 static int JimRelToAbsIndex(int len, int idx)
2580 if (idx < 0)
2581 return len + idx;
2582 return idx;
2585 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2586 * into a form suitable for implementation of commands like [string range] and [lrange].
2588 * The resulting range is guaranteed to address valid elements of
2589 * the structure.
2591 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2593 int rangeLen;
2595 if (*firstPtr > *lastPtr) {
2596 rangeLen = 0;
2598 else {
2599 rangeLen = *lastPtr - *firstPtr + 1;
2600 if (rangeLen) {
2601 if (*firstPtr < 0) {
2602 rangeLen += *firstPtr;
2603 *firstPtr = 0;
2605 if (*lastPtr >= len) {
2606 rangeLen -= (*lastPtr - (len - 1));
2607 *lastPtr = len - 1;
2611 if (rangeLen < 0)
2612 rangeLen = 0;
2614 *rangeLenPtr = rangeLen;
2617 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2618 int len, int *first, int *last, int *range)
2620 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2621 return JIM_ERR;
2623 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2624 return JIM_ERR;
2626 *first = JimRelToAbsIndex(len, *first);
2627 *last = JimRelToAbsIndex(len, *last);
2628 JimRelToAbsRange(len, first, last, range);
2629 return JIM_OK;
2632 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2633 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2635 int first, last;
2636 const char *str;
2637 int rangeLen;
2638 int bytelen;
2640 str = Jim_GetString(strObjPtr, &bytelen);
2642 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2643 return NULL;
2646 if (first == 0 && rangeLen == bytelen) {
2647 return strObjPtr;
2649 return Jim_NewStringObj(interp, str + first, rangeLen);
2652 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2653 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2655 #ifdef JIM_UTF8
2656 int first, last;
2657 const char *str;
2658 int len, rangeLen;
2659 int bytelen;
2661 str = Jim_GetString(strObjPtr, &bytelen);
2662 len = Jim_Utf8Length(interp, strObjPtr);
2664 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2665 return NULL;
2668 if (first == 0 && rangeLen == len) {
2669 return strObjPtr;
2671 if (len == bytelen) {
2672 /* ASCII optimisation */
2673 return Jim_NewStringObj(interp, str + first, rangeLen);
2675 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2676 #else
2677 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2678 #endif
2681 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2682 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2684 int first, last;
2685 const char *str;
2686 int len, rangeLen;
2687 Jim_Obj *objPtr;
2689 len = Jim_Utf8Length(interp, strObjPtr);
2691 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2692 return NULL;
2695 if (last < first) {
2696 return strObjPtr;
2699 str = Jim_String(strObjPtr);
2701 /* Before part */
2702 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2704 /* Replacement */
2705 if (newStrObj) {
2706 Jim_AppendObj(interp, objPtr, newStrObj);
2709 /* After part */
2710 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2712 return objPtr;
2716 * Note: does not support embedded nulls.
2718 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2720 while (*str) {
2721 int c;
2722 str += utf8_tounicode(str, &c);
2723 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2725 *dest = 0;
2729 * Note: does not support embedded nulls.
2731 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2733 char *buf;
2734 int len;
2735 const char *str;
2737 SetStringFromAny(interp, strObjPtr);
2739 str = Jim_GetString(strObjPtr, &len);
2741 #ifdef JIM_UTF8
2742 /* Case mapping can change the utf-8 length of the string.
2743 * But at worst it will be by one extra byte per char
2745 len *= 2;
2746 #endif
2747 buf = Jim_Alloc(len + 1);
2748 JimStrCopyUpperLower(buf, str, 0);
2749 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2753 * Note: does not support embedded nulls.
2755 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2757 char *buf;
2758 const char *str;
2759 int len;
2761 if (strObjPtr->typePtr != &stringObjType) {
2762 SetStringFromAny(interp, strObjPtr);
2765 str = Jim_GetString(strObjPtr, &len);
2767 #ifdef JIM_UTF8
2768 /* Case mapping can change the utf-8 length of the string.
2769 * But at worst it will be by one extra byte per char
2771 len *= 2;
2772 #endif
2773 buf = Jim_Alloc(len + 1);
2774 JimStrCopyUpperLower(buf, str, 1);
2775 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2779 * Note: does not support embedded nulls.
2781 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2783 char *buf, *p;
2784 int len;
2785 int c;
2786 const char *str;
2788 str = Jim_GetString(strObjPtr, &len);
2789 if (len == 0) {
2790 return strObjPtr;
2792 #ifdef JIM_UTF8
2793 /* Case mapping can change the utf-8 length of the string.
2794 * But at worst it will be by one extra byte per char
2796 len *= 2;
2797 #endif
2798 buf = p = Jim_Alloc(len + 1);
2800 str += utf8_tounicode(str, &c);
2801 p += utf8_getchars(p, utf8_title(c));
2803 JimStrCopyUpperLower(p, str, 0);
2805 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2808 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2809 * for unicode character 'c'.
2810 * Returns the position if found or NULL if not
2812 static const char *utf8_memchr(const char *str, int len, int c)
2814 #ifdef JIM_UTF8
2815 while (len) {
2816 int sc;
2817 int n = utf8_tounicode(str, &sc);
2818 if (sc == c) {
2819 return str;
2821 str += n;
2822 len -= n;
2824 return NULL;
2825 #else
2826 return memchr(str, c, len);
2827 #endif
2831 * Searches for the first non-trim char in string (str, len)
2833 * If none is found, returns just past the last char.
2835 * Lengths are in bytes.
2837 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2839 while (len) {
2840 int c;
2841 int n = utf8_tounicode(str, &c);
2843 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2844 /* Not a trim char, so stop */
2845 break;
2847 str += n;
2848 len -= n;
2850 return str;
2854 * Searches backwards for a non-trim char in string (str, len).
2856 * Returns a pointer to just after the non-trim char, or NULL if not found.
2858 * Lengths are in bytes.
2860 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2862 str += len;
2864 while (len) {
2865 int c;
2866 int n = utf8_prev_len(str, len);
2868 len -= n;
2869 str -= n;
2871 n = utf8_tounicode(str, &c);
2873 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2874 return str + n;
2878 return NULL;
2881 static const char default_trim_chars[] = " \t\n\r";
2882 /* sizeof() here includes the null byte */
2883 static int default_trim_chars_len = sizeof(default_trim_chars);
2885 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2887 int len;
2888 const char *str = Jim_GetString(strObjPtr, &len);
2889 const char *trimchars = default_trim_chars;
2890 int trimcharslen = default_trim_chars_len;
2891 const char *newstr;
2893 if (trimcharsObjPtr) {
2894 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2897 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2898 if (newstr == str) {
2899 return strObjPtr;
2902 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2905 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2907 int len;
2908 const char *trimchars = default_trim_chars;
2909 int trimcharslen = default_trim_chars_len;
2910 const char *nontrim;
2912 if (trimcharsObjPtr) {
2913 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2916 SetStringFromAny(interp, strObjPtr);
2918 len = Jim_Length(strObjPtr);
2919 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2921 if (nontrim == NULL) {
2922 /* All trim, so return a zero-length string */
2923 return Jim_NewEmptyStringObj(interp);
2925 if (nontrim == strObjPtr->bytes + len) {
2926 /* All non-trim, so return the original object */
2927 return strObjPtr;
2930 if (Jim_IsShared(strObjPtr)) {
2931 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2933 else {
2934 /* Can modify this string in place */
2935 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2936 strObjPtr->length = (nontrim - strObjPtr->bytes);
2939 return strObjPtr;
2942 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2944 /* First trim left. */
2945 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2947 /* Now trim right */
2948 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2950 /* Note: refCount check is needed since objPtr may be emptyObj */
2951 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2952 /* We don't want this object to be leaked */
2953 Jim_FreeNewObj(interp, objPtr);
2956 return strObjPtr;
2959 /* Some platforms don't have isascii - need a non-macro version */
2960 #ifdef HAVE_ISASCII
2961 #define jim_isascii isascii
2962 #else
2963 static int jim_isascii(int c)
2965 return !(c & ~0x7f);
2967 #endif
2969 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2971 static const char * const strclassnames[] = {
2972 "integer", "alpha", "alnum", "ascii", "digit",
2973 "double", "lower", "upper", "space", "xdigit",
2974 "control", "print", "graph", "punct", "boolean",
2975 NULL
2977 enum {
2978 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2979 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2980 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2982 int strclass;
2983 int len;
2984 int i;
2985 const char *str;
2986 int (*isclassfunc)(int c) = NULL;
2988 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2989 return JIM_ERR;
2992 str = Jim_GetString(strObjPtr, &len);
2993 if (len == 0) {
2994 Jim_SetResultBool(interp, !strict);
2995 return JIM_OK;
2998 switch (strclass) {
2999 case STR_IS_INTEGER:
3001 jim_wide w;
3002 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3003 return JIM_OK;
3006 case STR_IS_DOUBLE:
3008 double d;
3009 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3010 return JIM_OK;
3013 case STR_IS_BOOLEAN:
3015 int b;
3016 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3017 return JIM_OK;
3020 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3021 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3022 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3023 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3024 case STR_IS_LOWER: isclassfunc = islower; break;
3025 case STR_IS_UPPER: isclassfunc = isupper; break;
3026 case STR_IS_SPACE: isclassfunc = isspace; break;
3027 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3028 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3029 case STR_IS_PRINT: isclassfunc = isprint; break;
3030 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3031 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3032 default:
3033 return JIM_ERR;
3036 for (i = 0; i < len; i++) {
3037 if (!isclassfunc(UCHAR(str[i]))) {
3038 Jim_SetResultBool(interp, 0);
3039 return JIM_OK;
3042 Jim_SetResultBool(interp, 1);
3043 return JIM_OK;
3046 /* -----------------------------------------------------------------------------
3047 * Compared String Object
3048 * ---------------------------------------------------------------------------*/
3050 /* This is strange object that allows comparison of a C literal string
3051 * with a Jim object in a very short time if the same comparison is done
3052 * multiple times. For example every time the [if] command is executed,
3053 * Jim has to check if a given argument is "else".
3054 * If the code has no errors, this comparison is true most of the time,
3055 * so we can cache the pointer of the string of the last matching
3056 * comparison inside the object. Because most C compilers perform literal sharing,
3057 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3058 * this works pretty well even if comparisons are at different places
3059 * inside the C code. */
3061 static const Jim_ObjType comparedStringObjType = {
3062 "compared-string",
3063 NULL,
3064 NULL,
3065 NULL,
3066 JIM_TYPE_REFERENCES,
3069 /* The only way this object is exposed to the API is via the following
3070 * function. Returns true if the string and the object string repr.
3071 * are the same, otherwise zero is returned.
3073 * Note: this isn't binary safe, but it hardly needs to be.*/
3074 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3076 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3077 return 1;
3079 else {
3080 const char *objStr = Jim_String(objPtr);
3082 if (strcmp(str, objStr) != 0)
3083 return 0;
3085 if (objPtr->typePtr != &comparedStringObjType) {
3086 Jim_FreeIntRep(interp, objPtr);
3087 objPtr->typePtr = &comparedStringObjType;
3089 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3090 return 1;
3094 static int qsortCompareStringPointers(const void *a, const void *b)
3096 char *const *sa = (char *const *)a;
3097 char *const *sb = (char *const *)b;
3099 return strcmp(*sa, *sb);
3103 /* -----------------------------------------------------------------------------
3104 * Source Object
3106 * This object is just a string from the language point of view, but
3107 * the internal representation contains the filename and line number
3108 * where this token was read. This information is used by
3109 * Jim_EvalObj() if the object passed happens to be of type "source".
3111 * This allows propagation of the information about line numbers and file
3112 * names and gives error messages with absolute line numbers.
3114 * Note that this object uses the internal representation of the Jim_Object,
3115 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3117 * Also the object will be converted to something else if the given
3118 * token it represents in the source file is not something to be
3119 * evaluated (not a script), and will be specialized in some other way,
3120 * so the time overhead is also almost zero.
3121 * ---------------------------------------------------------------------------*/
3123 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3124 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3126 static const Jim_ObjType sourceObjType = {
3127 "source",
3128 FreeSourceInternalRep,
3129 DupSourceInternalRep,
3130 NULL,
3131 JIM_TYPE_REFERENCES,
3134 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3136 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3139 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3141 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3142 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3145 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3146 Jim_Obj *fileNameObj, int lineNumber)
3148 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3149 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3150 Jim_IncrRefCount(fileNameObj);
3151 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3152 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3153 objPtr->typePtr = &sourceObjType;
3156 /* -----------------------------------------------------------------------------
3157 * ScriptLine Object
3159 * This object is used only in the Script internal represenation.
3160 * For each line of the script, it holds the number of tokens on the line
3161 * and the source line number.
3163 static const Jim_ObjType scriptLineObjType = {
3164 "scriptline",
3165 NULL,
3166 NULL,
3167 NULL,
3168 JIM_NONE,
3171 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3173 Jim_Obj *objPtr;
3175 #ifdef DEBUG_SHOW_SCRIPT
3176 char buf[100];
3177 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3178 objPtr = Jim_NewStringObj(interp, buf, -1);
3179 #else
3180 objPtr = Jim_NewEmptyStringObj(interp);
3181 #endif
3182 objPtr->typePtr = &scriptLineObjType;
3183 objPtr->internalRep.scriptLineValue.argc = argc;
3184 objPtr->internalRep.scriptLineValue.line = line;
3186 return objPtr;
3189 /* -----------------------------------------------------------------------------
3190 * Script Object
3192 * This object holds the parsed internal representation of a script.
3193 * This representation is help within an allocated ScriptObj (see below)
3195 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3196 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3198 static const Jim_ObjType scriptObjType = {
3199 "script",
3200 FreeScriptInternalRep,
3201 DupScriptInternalRep,
3202 NULL,
3203 JIM_TYPE_REFERENCES,
3206 /* Each token of a script is represented by a ScriptToken.
3207 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3208 * can be specialized by commands operating on it.
3210 typedef struct ScriptToken
3212 Jim_Obj *objPtr;
3213 int type;
3214 } ScriptToken;
3216 /* This is the script object internal representation. An array of
3217 * ScriptToken structures, including a pre-computed representation of the
3218 * command length and arguments.
3220 * For example the script:
3222 * puts hello
3223 * set $i $x$y [foo]BAR
3225 * will produce a ScriptObj with the following ScriptToken's:
3227 * LIN 2
3228 * ESC puts
3229 * ESC hello
3230 * LIN 4
3231 * ESC set
3232 * VAR i
3233 * WRD 2
3234 * VAR x
3235 * VAR y
3236 * WRD 2
3237 * CMD foo
3238 * ESC BAR
3240 * "puts hello" has two args (LIN 2), composed of single tokens.
3241 * (Note that the WRD token is omitted for the common case of a single token.)
3243 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3244 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3246 * The precomputation of the command structure makes Jim_Eval() faster,
3247 * and simpler because there aren't dynamic lengths / allocations.
3249 * -- {expand}/{*} handling --
3251 * Expand is handled in a special way.
3253 * If a "word" begins with {*}, the word token count is -ve.
3255 * For example the command:
3257 * list {*}{a b}
3259 * Will produce the following cmdstruct array:
3261 * LIN 2
3262 * ESC list
3263 * WRD -1
3264 * STR a b
3266 * Note that the 'LIN' token also contains the source information for the
3267 * first word of the line for error reporting purposes
3269 * -- the substFlags field of the structure --
3271 * The scriptObj structure is used to represent both "script" objects
3272 * and "subst" objects. In the second case, there are no LIN and WRD
3273 * tokens. Instead SEP and EOL tokens are added as-is.
3274 * In addition, the field 'substFlags' is used to represent the flags used to turn
3275 * the string into the internal representation.
3276 * If these flags do not match what the application requires,
3277 * the scriptObj is created again. For example the script:
3279 * subst -nocommands $string
3280 * subst -novariables $string
3282 * Will (re)create the internal representation of the $string object
3283 * two times.
3285 typedef struct ScriptObj
3287 ScriptToken *token; /* Tokens array. */
3288 Jim_Obj *fileNameObj; /* Filename */
3289 int len; /* Length of token[] */
3290 int substFlags; /* flags used for the compilation of "subst" objects */
3291 int inUse; /* Used to share a ScriptObj. Currently
3292 only used by Jim_EvalObj() as protection against
3293 shimmering of the currently evaluated object. */
3294 int firstline; /* Line number of the first line */
3295 int linenr; /* Error line number, if any */
3296 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3297 } ScriptObj;
3299 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3300 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3301 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3303 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3305 int i;
3306 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3308 if (--script->inUse != 0)
3309 return;
3310 for (i = 0; i < script->len; i++) {
3311 Jim_DecrRefCount(interp, script->token[i].objPtr);
3313 Jim_Free(script->token);
3314 Jim_DecrRefCount(interp, script->fileNameObj);
3315 Jim_Free(script);
3318 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3320 JIM_NOTUSED(interp);
3321 JIM_NOTUSED(srcPtr);
3323 /* Just return a simple string. We don't try to preserve the source info
3324 * since in practice scripts are never duplicated
3326 dupPtr->typePtr = NULL;
3329 /* A simple parse token.
3330 * As the script is parsed, the created tokens point into the script string rep.
3332 typedef struct
3334 const char *token; /* Pointer to the start of the token */
3335 int len; /* Length of this token */
3336 int type; /* Token type */
3337 int line; /* Line number */
3338 } ParseToken;
3340 /* A list of parsed tokens representing a script.
3341 * Tokens are added to this list as the script is parsed.
3342 * It grows as needed.
3344 typedef struct
3346 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3347 ParseToken *list; /* Array of tokens */
3348 int size; /* Current size of the list */
3349 int count; /* Number of entries used */
3350 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3351 } ParseTokenList;
3353 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3355 tokenlist->list = tokenlist->static_list;
3356 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3357 tokenlist->count = 0;
3360 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3362 if (tokenlist->list != tokenlist->static_list) {
3363 Jim_Free(tokenlist->list);
3368 * Adds the new token to the tokenlist.
3369 * The token has the given length, type and line number.
3370 * The token list is resized as necessary.
3372 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3373 int line)
3375 ParseToken *t;
3377 if (tokenlist->count == tokenlist->size) {
3378 /* Resize the list */
3379 tokenlist->size *= 2;
3380 if (tokenlist->list != tokenlist->static_list) {
3381 tokenlist->list =
3382 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3384 else {
3385 /* The list needs to become allocated */
3386 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3387 memcpy(tokenlist->list, tokenlist->static_list,
3388 tokenlist->count * sizeof(*tokenlist->list));
3391 t = &tokenlist->list[tokenlist->count++];
3392 t->token = token;
3393 t->len = len;
3394 t->type = type;
3395 t->line = line;
3398 /* Counts the number of adjoining non-separator tokens.
3400 * Returns -ve if the first token is the expansion
3401 * operator (in which case the count doesn't include
3402 * that token).
3404 static int JimCountWordTokens(ParseToken *t)
3406 int expand = 1;
3407 int count = 0;
3409 /* Is the first word {*} or {expand}? */
3410 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3411 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3412 /* Create an expand token */
3413 expand = -1;
3414 t++;
3418 /* Now count non-separator words */
3419 while (!TOKEN_IS_SEP(t->type)) {
3420 t++;
3421 count++;
3424 return count * expand;
3428 * Create a script/subst object from the given token.
3430 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3432 Jim_Obj *objPtr;
3434 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3435 /* Convert backlash escapes. The result will never be longer than the original */
3436 int len = t->len;
3437 char *str = Jim_Alloc(len + 1);
3438 len = JimEscape(str, t->token, len);
3439 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3441 else {
3442 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3443 * with a single space.
3445 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3447 return objPtr;
3451 * Takes a tokenlist and creates the allocated list of script tokens
3452 * in script->token, of length script->len.
3454 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3455 * as required.
3457 * Also sets script->line to the line number of the first token
3459 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3460 ParseTokenList *tokenlist)
3462 int i;
3463 struct ScriptToken *token;
3464 /* Number of tokens so far for the current command */
3465 int lineargs = 0;
3466 /* This is the first token for the current command */
3467 ScriptToken *linefirst;
3468 int count;
3469 int linenr;
3471 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3472 printf("==== Tokens ====\n");
3473 for (i = 0; i < tokenlist->count; i++) {
3474 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3475 tokenlist->list[i].len, tokenlist->list[i].token);
3477 #endif
3479 /* May need up to one extra script token for each EOL in the worst case */
3480 count = tokenlist->count;
3481 for (i = 0; i < tokenlist->count; i++) {
3482 if (tokenlist->list[i].type == JIM_TT_EOL) {
3483 count++;
3486 linenr = script->firstline = tokenlist->list[0].line;
3488 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3490 /* This is the first token for the current command */
3491 linefirst = token++;
3493 for (i = 0; i < tokenlist->count; ) {
3494 /* Look ahead to find out how many tokens make up the next word */
3495 int wordtokens;
3497 /* Skip any leading separators */
3498 while (tokenlist->list[i].type == JIM_TT_SEP) {
3499 i++;
3502 wordtokens = JimCountWordTokens(tokenlist->list + i);
3504 if (wordtokens == 0) {
3505 /* None, so at end of line */
3506 if (lineargs) {
3507 linefirst->type = JIM_TT_LINE;
3508 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3509 Jim_IncrRefCount(linefirst->objPtr);
3511 /* Reset for new line */
3512 lineargs = 0;
3513 linefirst = token++;
3515 i++;
3516 continue;
3518 else if (wordtokens != 1) {
3519 /* More than 1, or {*}, so insert a WORD token */
3520 token->type = JIM_TT_WORD;
3521 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3522 Jim_IncrRefCount(token->objPtr);
3523 token++;
3524 if (wordtokens < 0) {
3525 /* Skip the expand token */
3526 i++;
3527 wordtokens = -wordtokens - 1;
3528 lineargs--;
3532 if (lineargs == 0) {
3533 /* First real token on the line, so record the line number */
3534 linenr = tokenlist->list[i].line;
3536 lineargs++;
3538 /* Add each non-separator word token to the line */
3539 while (wordtokens--) {
3540 const ParseToken *t = &tokenlist->list[i++];
3542 token->type = t->type;
3543 token->objPtr = JimMakeScriptObj(interp, t);
3544 Jim_IncrRefCount(token->objPtr);
3546 /* Every object is initially a string of type 'source', but the
3547 * internal type may be specialized during execution of the
3548 * script. */
3549 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3550 token++;
3554 if (lineargs == 0) {
3555 token--;
3558 script->len = token - script->token;
3560 JimPanic((script->len >= count, "allocated script array is too short"));
3562 #ifdef DEBUG_SHOW_SCRIPT
3563 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3564 for (i = 0; i < script->len; i++) {
3565 const ScriptToken *t = &script->token[i];
3566 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3568 #endif
3572 /* Parses the given string object to determine if it represents a complete script.
3574 * This is useful for interactive shells implementation, for [info complete].
3576 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3577 * '{' on scripts incomplete missing one or more '}' to be balanced.
3578 * '[' on scripts incomplete missing one or more ']' to be balanced.
3579 * '"' on scripts incomplete missing a '"' char.
3580 * '\\' on scripts with a trailing backslash.
3582 * If the script is complete, 1 is returned, otherwise 0.
3584 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3586 ScriptObj *script = JimGetScript(interp, scriptObj);
3587 if (stateCharPtr) {
3588 *stateCharPtr = script->missing;
3590 return (script->missing == ' ');
3594 * Sets an appropriate error message for a missing script/expression terminator.
3596 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3598 * Note that a trailing backslash is not considered to be an error.
3600 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3602 const char *msg;
3604 switch (ch) {
3605 case '\\':
3606 case ' ':
3607 return JIM_OK;
3609 case '[':
3610 msg = "unmatched \"[\"";
3611 break;
3612 case '{':
3613 msg = "missing close-brace";
3614 break;
3615 case '"':
3616 default:
3617 msg = "missing quote";
3618 break;
3621 Jim_SetResultString(interp, msg, -1);
3622 return JIM_ERR;
3626 * Similar to ScriptObjAddTokens(), but for subst objects.
3628 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3629 ParseTokenList *tokenlist)
3631 int i;
3632 struct ScriptToken *token;
3634 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3636 for (i = 0; i < tokenlist->count; i++) {
3637 const ParseToken *t = &tokenlist->list[i];
3639 /* Create a token for 't' */
3640 token->type = t->type;
3641 token->objPtr = JimMakeScriptObj(interp, t);
3642 Jim_IncrRefCount(token->objPtr);
3643 token++;
3646 script->len = i;
3649 /* This method takes the string representation of an object
3650 * as a Tcl script, and generates the pre-parsed internal representation
3651 * of the script.
3653 * On parse error, sets an error message and returns JIM_ERR
3654 * (Note: the object is still converted to a script, even if an error occurs)
3656 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3658 int scriptTextLen;
3659 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3660 struct JimParserCtx parser;
3661 struct ScriptObj *script;
3662 ParseTokenList tokenlist;
3663 int line = 1;
3665 /* Try to get information about filename / line number */
3666 if (objPtr->typePtr == &sourceObjType) {
3667 line = objPtr->internalRep.sourceValue.lineNumber;
3670 /* Initially parse the script into tokens (in tokenlist) */
3671 ScriptTokenListInit(&tokenlist);
3673 JimParserInit(&parser, scriptText, scriptTextLen, line);
3674 while (!parser.eof) {
3675 JimParseScript(&parser);
3676 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3677 parser.tline);
3680 /* Add a final EOF token */
3681 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3683 /* Create the "real" script tokens from the parsed tokens */
3684 script = Jim_Alloc(sizeof(*script));
3685 memset(script, 0, sizeof(*script));
3686 script->inUse = 1;
3687 if (objPtr->typePtr == &sourceObjType) {
3688 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3690 else {
3691 script->fileNameObj = interp->emptyObj;
3693 Jim_IncrRefCount(script->fileNameObj);
3694 script->missing = parser.missing.ch;
3695 script->linenr = parser.missing.line;
3697 ScriptObjAddTokens(interp, script, &tokenlist);
3699 /* No longer need the token list */
3700 ScriptTokenListFree(&tokenlist);
3702 /* Free the old internal rep and set the new one. */
3703 Jim_FreeIntRep(interp, objPtr);
3704 Jim_SetIntRepPtr(objPtr, script);
3705 objPtr->typePtr = &scriptObjType;
3708 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3711 * Returns the parsed script.
3712 * Note that if there is any possibility that the script is not valid,
3713 * call JimScriptValid() to check
3715 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3717 if (objPtr == interp->emptyObj) {
3718 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3719 objPtr = interp->nullScriptObj;
3722 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3723 JimSetScriptFromAny(interp, objPtr);
3726 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3730 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3731 * and leaves an error message in the interp result.
3734 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3736 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3737 JimAddErrorToStack(interp, script);
3738 return 0;
3740 return 1;
3744 /* -----------------------------------------------------------------------------
3745 * Commands
3746 * ---------------------------------------------------------------------------*/
3747 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3749 cmdPtr->inUse++;
3752 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3754 if (--cmdPtr->inUse == 0) {
3755 if (cmdPtr->isproc) {
3756 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3757 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3758 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3759 if (cmdPtr->u.proc.staticVars) {
3760 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3761 Jim_Free(cmdPtr->u.proc.staticVars);
3764 else {
3765 /* native (C) */
3766 if (cmdPtr->u.native.delProc) {
3767 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3770 if (cmdPtr->prevCmd) {
3771 /* Delete any pushed command too */
3772 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3774 Jim_Free(cmdPtr);
3778 /* Variables HashTable Type.
3780 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3783 /* Variables HashTable Type.
3785 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3786 static void JimVariablesHTValDestructor(void *interp, void *val)
3788 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3789 Jim_Free(val);
3792 static const Jim_HashTableType JimVariablesHashTableType = {
3793 JimStringCopyHTHashFunction, /* hash function */
3794 JimStringCopyHTDup, /* key dup */
3795 NULL, /* val dup */
3796 JimStringCopyHTKeyCompare, /* key compare */
3797 JimStringCopyHTKeyDestructor, /* key destructor */
3798 JimVariablesHTValDestructor /* val destructor */
3801 /* Commands HashTable Type.
3803 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3805 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3807 JimDecrCmdRefCount(interp, val);
3810 static const Jim_HashTableType JimCommandsHashTableType = {
3811 JimStringCopyHTHashFunction, /* hash function */
3812 JimStringCopyHTDup, /* key dup */
3813 NULL, /* val dup */
3814 JimStringCopyHTKeyCompare, /* key compare */
3815 JimStringCopyHTKeyDestructor, /* key destructor */
3816 JimCommandsHT_ValDestructor /* val destructor */
3819 /* ------------------------- Commands related functions --------------------- */
3821 #ifdef jim_ext_namespace
3823 * Returns the "unscoped" version of the given namespace.
3824 * That is, the fully qualified name without the leading ::
3825 * The returned value is either nsObj, or an object with a zero ref count.
3827 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3829 const char *name = Jim_String(nsObj);
3830 if (name[0] == ':' && name[1] == ':') {
3831 /* This command is being defined in the global namespace */
3832 while (*++name == ':') {
3834 nsObj = Jim_NewStringObj(interp, name, -1);
3836 else if (Jim_Length(interp->framePtr->nsObj)) {
3837 /* This command is being defined in a non-global namespace */
3838 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3839 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3841 return nsObj;
3844 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3846 Jim_Obj *resultObj;
3848 const char *name = Jim_String(nameObjPtr);
3849 if (name[0] == ':' && name[1] == ':') {
3850 return nameObjPtr;
3852 Jim_IncrRefCount(nameObjPtr);
3853 resultObj = Jim_NewStringObj(interp, "::", -1);
3854 Jim_AppendObj(interp, resultObj, nameObjPtr);
3855 Jim_DecrRefCount(interp, nameObjPtr);
3857 return resultObj;
3861 * An efficient version of JimQualifyNameObj() where the name is
3862 * available (and needed) as a 'const char *'.
3863 * Avoids creating an object if not necessary.
3864 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3866 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3868 Jim_Obj *objPtr = interp->emptyObj;
3870 if (name[0] == ':' && name[1] == ':') {
3871 /* This command is being defined in the global namespace */
3872 while (*++name == ':') {
3875 else if (Jim_Length(interp->framePtr->nsObj)) {
3876 /* This command is being defined in a non-global namespace */
3877 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3878 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3879 name = Jim_String(objPtr);
3881 Jim_IncrRefCount(objPtr);
3882 *objPtrPtr = objPtr;
3883 return name;
3886 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3888 #else
3889 /* We can be more efficient in the no-namespace case */
3890 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3891 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3893 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3895 return nameObjPtr;
3897 #endif
3899 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3901 /* It may already exist, so we try to delete the old one.
3902 * Note that reference count means that it won't be deleted yet if
3903 * it exists in the call stack.
3905 * BUT, if 'local' is in force, instead of deleting the existing
3906 * proc, we stash a reference to the old proc here.
3908 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3909 if (he) {
3910 /* There was an old cmd with the same name,
3911 * so this requires a 'proc epoch' update. */
3913 /* If a procedure with the same name didn't exist there is no need
3914 * to increment the 'proc epoch' because creation of a new procedure
3915 * can never affect existing cached commands. We don't do
3916 * negative caching. */
3917 Jim_InterpIncrProcEpoch(interp);
3920 if (he && interp->local) {
3921 /* Push this command over the top of the previous one */
3922 cmd->prevCmd = Jim_GetHashEntryVal(he);
3923 Jim_SetHashVal(&interp->commands, he, cmd);
3925 else {
3926 if (he) {
3927 /* Replace the existing command */
3928 Jim_DeleteHashEntry(&interp->commands, name);
3931 Jim_AddHashEntry(&interp->commands, name, cmd);
3933 return JIM_OK;
3937 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3938 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3940 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3942 /* Store the new details for this command */
3943 memset(cmdPtr, 0, sizeof(*cmdPtr));
3944 cmdPtr->inUse = 1;
3945 cmdPtr->u.native.delProc = delProc;
3946 cmdPtr->u.native.cmdProc = cmdProc;
3947 cmdPtr->u.native.privData = privData;
3949 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3951 return JIM_OK;
3954 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3956 int len, i;
3958 len = Jim_ListLength(interp, staticsListObjPtr);
3959 if (len == 0) {
3960 return JIM_OK;
3963 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3964 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3965 for (i = 0; i < len; i++) {
3966 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3967 Jim_Var *varPtr;
3968 int subLen;
3970 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3971 /* Check if it's composed of two elements. */
3972 subLen = Jim_ListLength(interp, objPtr);
3973 if (subLen == 1 || subLen == 2) {
3974 /* Try to get the variable value from the current
3975 * environment. */
3976 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3977 if (subLen == 1) {
3978 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3979 if (initObjPtr == NULL) {
3980 Jim_SetResultFormatted(interp,
3981 "variable for initialization of static \"%#s\" not found in the local context",
3982 nameObjPtr);
3983 return JIM_ERR;
3986 else {
3987 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3989 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3990 return JIM_ERR;
3993 varPtr = Jim_Alloc(sizeof(*varPtr));
3994 varPtr->objPtr = initObjPtr;
3995 Jim_IncrRefCount(initObjPtr);
3996 varPtr->linkFramePtr = NULL;
3997 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3998 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3999 Jim_SetResultFormatted(interp,
4000 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4001 Jim_DecrRefCount(interp, initObjPtr);
4002 Jim_Free(varPtr);
4003 return JIM_ERR;
4006 else {
4007 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4008 objPtr);
4009 return JIM_ERR;
4012 return JIM_OK;
4015 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4017 #ifdef jim_ext_namespace
4018 if (cmdPtr->isproc) {
4019 /* XXX: Really need JimNamespaceSplit() */
4020 const char *pt = strrchr(cmdname, ':');
4021 if (pt && pt != cmdname && pt[-1] == ':') {
4022 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4023 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4024 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4026 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4027 /* This commands shadows a global command, so a proc epoch update is required */
4028 Jim_InterpIncrProcEpoch(interp);
4032 #endif
4035 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4036 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4038 Jim_Cmd *cmdPtr;
4039 int argListLen;
4040 int i;
4042 argListLen = Jim_ListLength(interp, argListObjPtr);
4044 /* Allocate space for both the command pointer and the arg list */
4045 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4046 memset(cmdPtr, 0, sizeof(*cmdPtr));
4047 cmdPtr->inUse = 1;
4048 cmdPtr->isproc = 1;
4049 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4050 cmdPtr->u.proc.argListLen = argListLen;
4051 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4052 cmdPtr->u.proc.argsPos = -1;
4053 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4054 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4055 Jim_IncrRefCount(argListObjPtr);
4056 Jim_IncrRefCount(bodyObjPtr);
4057 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4059 /* Create the statics hash table. */
4060 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4061 goto err;
4064 /* Parse the args out into arglist, validating as we go */
4065 /* Examine the argument list for default parameters and 'args' */
4066 for (i = 0; i < argListLen; i++) {
4067 Jim_Obj *argPtr;
4068 Jim_Obj *nameObjPtr;
4069 Jim_Obj *defaultObjPtr;
4070 int len;
4072 /* Examine a parameter */
4073 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4074 len = Jim_ListLength(interp, argPtr);
4075 if (len == 0) {
4076 Jim_SetResultString(interp, "argument with no name", -1);
4077 err:
4078 JimDecrCmdRefCount(interp, cmdPtr);
4079 return NULL;
4081 if (len > 2) {
4082 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4083 goto err;
4086 if (len == 2) {
4087 /* Optional parameter */
4088 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4089 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4091 else {
4092 /* Required parameter */
4093 nameObjPtr = argPtr;
4094 defaultObjPtr = NULL;
4098 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4099 if (cmdPtr->u.proc.argsPos >= 0) {
4100 Jim_SetResultString(interp, "'args' specified more than once", -1);
4101 goto err;
4103 cmdPtr->u.proc.argsPos = i;
4105 else {
4106 if (len == 2) {
4107 cmdPtr->u.proc.optArity++;
4109 else {
4110 cmdPtr->u.proc.reqArity++;
4114 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4115 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4118 return cmdPtr;
4121 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4123 int ret = JIM_OK;
4124 Jim_Obj *qualifiedNameObj;
4125 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4127 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4128 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4129 ret = JIM_ERR;
4131 else {
4132 Jim_InterpIncrProcEpoch(interp);
4135 JimFreeQualifiedName(interp, qualifiedNameObj);
4137 return ret;
4140 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4142 int ret = JIM_ERR;
4143 Jim_HashEntry *he;
4144 Jim_Cmd *cmdPtr;
4145 Jim_Obj *qualifiedOldNameObj;
4146 Jim_Obj *qualifiedNewNameObj;
4147 const char *fqold;
4148 const char *fqnew;
4150 if (newName[0] == 0) {
4151 return Jim_DeleteCommand(interp, oldName);
4154 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4155 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4157 /* Does it exist? */
4158 he = Jim_FindHashEntry(&interp->commands, fqold);
4159 if (he == NULL) {
4160 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4162 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4163 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4165 else {
4166 /* Add the new name first */
4167 cmdPtr = Jim_GetHashEntryVal(he);
4168 JimIncrCmdRefCount(cmdPtr);
4169 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4170 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4172 /* Now remove the old name */
4173 Jim_DeleteHashEntry(&interp->commands, fqold);
4175 /* Increment the epoch */
4176 Jim_InterpIncrProcEpoch(interp);
4178 ret = JIM_OK;
4181 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4182 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4184 return ret;
4187 /* -----------------------------------------------------------------------------
4188 * Command object
4189 * ---------------------------------------------------------------------------*/
4191 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4193 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4196 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4198 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4199 dupPtr->typePtr = srcPtr->typePtr;
4200 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4203 static const Jim_ObjType commandObjType = {
4204 "command",
4205 FreeCommandInternalRep,
4206 DupCommandInternalRep,
4207 NULL,
4208 JIM_TYPE_REFERENCES,
4211 /* This function returns the command structure for the command name
4212 * stored in objPtr. It tries to specialize the objPtr to contain
4213 * a cached info instead to perform the lookup into the hash table
4214 * every time. The information cached may not be uptodate, in such
4215 * a case the lookup is performed and the cache updated.
4217 * Respects the 'upcall' setting
4219 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4221 Jim_Cmd *cmd;
4223 /* In order to be valid, the proc epoch must match and
4224 * the lookup must have occurred in the same namespace
4226 if (objPtr->typePtr != &commandObjType ||
4227 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4228 #ifdef jim_ext_namespace
4229 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4230 #endif
4232 /* Not cached or out of date, so lookup */
4234 /* Do we need to try the local namespace? */
4235 const char *name = Jim_String(objPtr);
4236 Jim_HashEntry *he;
4238 if (name[0] == ':' && name[1] == ':') {
4239 while (*++name == ':') {
4242 #ifdef jim_ext_namespace
4243 else if (Jim_Length(interp->framePtr->nsObj)) {
4244 /* This command is being defined in a non-global namespace */
4245 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4246 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4247 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4248 Jim_FreeNewObj(interp, nameObj);
4249 if (he) {
4250 goto found;
4253 #endif
4255 /* Lookup in the global namespace */
4256 he = Jim_FindHashEntry(&interp->commands, name);
4257 if (he == NULL) {
4258 if (flags & JIM_ERRMSG) {
4259 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4261 return NULL;
4263 #ifdef jim_ext_namespace
4264 found:
4265 #endif
4266 cmd = Jim_GetHashEntryVal(he);
4268 /* Free the old internal repr and set the new one. */
4269 Jim_FreeIntRep(interp, objPtr);
4270 objPtr->typePtr = &commandObjType;
4271 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4272 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4273 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4274 Jim_IncrRefCount(interp->framePtr->nsObj);
4276 else {
4277 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4279 while (cmd->u.proc.upcall) {
4280 cmd = cmd->prevCmd;
4282 return cmd;
4285 /* -----------------------------------------------------------------------------
4286 * Variables
4287 * ---------------------------------------------------------------------------*/
4289 /* -----------------------------------------------------------------------------
4290 * Variable object
4291 * ---------------------------------------------------------------------------*/
4293 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4295 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4297 static const Jim_ObjType variableObjType = {
4298 "variable",
4299 NULL,
4300 NULL,
4301 NULL,
4302 JIM_TYPE_REFERENCES,
4306 * Check that the name does not contain embedded nulls.
4308 * Variable and procedure names are manipulated as null terminated strings, so
4309 * don't allow names with embedded nulls.
4311 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4313 /* Variable names and proc names can't contain embedded nulls */
4314 if (nameObjPtr->typePtr != &variableObjType) {
4315 int len;
4316 const char *str = Jim_GetString(nameObjPtr, &len);
4317 if (memchr(str, '\0', len)) {
4318 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4319 return JIM_ERR;
4322 return JIM_OK;
4325 /* This method should be called only by the variable API.
4326 * It returns JIM_OK on success (variable already exists),
4327 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4328 * a variable name, but syntax glue for [dict] i.e. the last
4329 * character is ')' */
4330 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4332 const char *varName;
4333 Jim_CallFrame *framePtr;
4334 Jim_HashEntry *he;
4335 int global;
4336 int len;
4338 /* Check if the object is already an uptodate variable */
4339 if (objPtr->typePtr == &variableObjType) {
4340 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4341 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4342 /* nothing to do */
4343 return JIM_OK;
4345 /* Need to re-resolve the variable in the updated callframe */
4347 else if (objPtr->typePtr == &dictSubstObjType) {
4348 return JIM_DICT_SUGAR;
4350 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4351 return JIM_ERR;
4355 varName = Jim_GetString(objPtr, &len);
4357 /* Make sure it's not syntax glue to get/set dict. */
4358 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4359 return JIM_DICT_SUGAR;
4362 if (varName[0] == ':' && varName[1] == ':') {
4363 while (*++varName == ':') {
4365 global = 1;
4366 framePtr = interp->topFramePtr;
4368 else {
4369 global = 0;
4370 framePtr = interp->framePtr;
4373 /* Resolve this name in the variables hash table */
4374 he = Jim_FindHashEntry(&framePtr->vars, varName);
4375 if (he == NULL) {
4376 if (!global && framePtr->staticVars) {
4377 /* Try with static vars. */
4378 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4380 if (he == NULL) {
4381 return JIM_ERR;
4385 /* Free the old internal repr and set the new one. */
4386 Jim_FreeIntRep(interp, objPtr);
4387 objPtr->typePtr = &variableObjType;
4388 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4389 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4390 objPtr->internalRep.varValue.global = global;
4391 return JIM_OK;
4394 /* -------------------- Variables related functions ------------------------- */
4395 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4396 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4398 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4400 const char *name;
4401 Jim_CallFrame *framePtr;
4402 int global;
4404 /* New variable to create */
4405 Jim_Var *var = Jim_Alloc(sizeof(*var));
4407 var->objPtr = valObjPtr;
4408 Jim_IncrRefCount(valObjPtr);
4409 var->linkFramePtr = NULL;
4411 name = Jim_String(nameObjPtr);
4412 if (name[0] == ':' && name[1] == ':') {
4413 while (*++name == ':') {
4415 framePtr = interp->topFramePtr;
4416 global = 1;
4418 else {
4419 framePtr = interp->framePtr;
4420 global = 0;
4423 /* Insert the new variable */
4424 Jim_AddHashEntry(&framePtr->vars, name, var);
4426 /* Make the object int rep a variable */
4427 Jim_FreeIntRep(interp, nameObjPtr);
4428 nameObjPtr->typePtr = &variableObjType;
4429 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4430 nameObjPtr->internalRep.varValue.varPtr = var;
4431 nameObjPtr->internalRep.varValue.global = global;
4433 return var;
4436 /* For now that's dummy. Variables lookup should be optimized
4437 * in many ways, with caching of lookups, and possibly with
4438 * a table of pre-allocated vars in every CallFrame for local vars.
4439 * All the caching should also have an 'epoch' mechanism similar
4440 * to the one used by Tcl for procedures lookup caching. */
4442 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4444 int err;
4445 Jim_Var *var;
4447 switch (SetVariableFromAny(interp, nameObjPtr)) {
4448 case JIM_DICT_SUGAR:
4449 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4451 case JIM_ERR:
4452 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4453 return JIM_ERR;
4455 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4456 break;
4458 case JIM_OK:
4459 var = nameObjPtr->internalRep.varValue.varPtr;
4460 if (var->linkFramePtr == NULL) {
4461 Jim_IncrRefCount(valObjPtr);
4462 Jim_DecrRefCount(interp, var->objPtr);
4463 var->objPtr = valObjPtr;
4465 else { /* Else handle the link */
4466 Jim_CallFrame *savedCallFrame;
4468 savedCallFrame = interp->framePtr;
4469 interp->framePtr = var->linkFramePtr;
4470 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4471 interp->framePtr = savedCallFrame;
4472 if (err != JIM_OK)
4473 return err;
4476 return JIM_OK;
4479 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4481 Jim_Obj *nameObjPtr;
4482 int result;
4484 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4485 Jim_IncrRefCount(nameObjPtr);
4486 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4487 Jim_DecrRefCount(interp, nameObjPtr);
4488 return result;
4491 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4493 Jim_CallFrame *savedFramePtr;
4494 int result;
4496 savedFramePtr = interp->framePtr;
4497 interp->framePtr = interp->topFramePtr;
4498 result = Jim_SetVariableStr(interp, name, objPtr);
4499 interp->framePtr = savedFramePtr;
4500 return result;
4503 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4505 Jim_Obj *nameObjPtr, *valObjPtr;
4506 int result;
4508 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4509 valObjPtr = Jim_NewStringObj(interp, val, -1);
4510 Jim_IncrRefCount(nameObjPtr);
4511 Jim_IncrRefCount(valObjPtr);
4512 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4513 Jim_DecrRefCount(interp, nameObjPtr);
4514 Jim_DecrRefCount(interp, valObjPtr);
4515 return result;
4518 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4519 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4521 const char *varName;
4522 const char *targetName;
4523 Jim_CallFrame *framePtr;
4524 Jim_Var *varPtr;
4526 /* Check for an existing variable or link */
4527 switch (SetVariableFromAny(interp, nameObjPtr)) {
4528 case JIM_DICT_SUGAR:
4529 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4530 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4531 return JIM_ERR;
4533 case JIM_OK:
4534 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4536 if (varPtr->linkFramePtr == NULL) {
4537 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4538 return JIM_ERR;
4541 /* It exists, but is a link, so first delete the link */
4542 varPtr->linkFramePtr = NULL;
4543 break;
4546 /* Resolve the call frames for both variables */
4547 /* XXX: SetVariableFromAny() already did this! */
4548 varName = Jim_String(nameObjPtr);
4550 if (varName[0] == ':' && varName[1] == ':') {
4551 while (*++varName == ':') {
4553 /* Linking a global var does nothing */
4554 framePtr = interp->topFramePtr;
4556 else {
4557 framePtr = interp->framePtr;
4560 targetName = Jim_String(targetNameObjPtr);
4561 if (targetName[0] == ':' && targetName[1] == ':') {
4562 while (*++targetName == ':') {
4564 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4565 targetCallFrame = interp->topFramePtr;
4567 Jim_IncrRefCount(targetNameObjPtr);
4569 if (framePtr->level < targetCallFrame->level) {
4570 Jim_SetResultFormatted(interp,
4571 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4572 nameObjPtr);
4573 Jim_DecrRefCount(interp, targetNameObjPtr);
4574 return JIM_ERR;
4577 /* Check for cycles. */
4578 if (framePtr == targetCallFrame) {
4579 Jim_Obj *objPtr = targetNameObjPtr;
4581 /* Cycles are only possible with 'uplevel 0' */
4582 while (1) {
4583 if (strcmp(Jim_String(objPtr), varName) == 0) {
4584 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4585 Jim_DecrRefCount(interp, targetNameObjPtr);
4586 return JIM_ERR;
4588 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4589 break;
4590 varPtr = objPtr->internalRep.varValue.varPtr;
4591 if (varPtr->linkFramePtr != targetCallFrame)
4592 break;
4593 objPtr = varPtr->objPtr;
4597 /* Perform the binding */
4598 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4599 /* We are now sure 'nameObjPtr' type is variableObjType */
4600 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4601 Jim_DecrRefCount(interp, targetNameObjPtr);
4602 return JIM_OK;
4605 /* Return the Jim_Obj pointer associated with a variable name,
4606 * or NULL if the variable was not found in the current context.
4607 * The same optimization discussed in the comment to the
4608 * 'SetVariable' function should apply here.
4610 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4611 * in a dictionary which is shared, the array variable value is duplicated first.
4612 * This allows the array element to be updated (e.g. append, lappend) without
4613 * affecting other references to the dictionary.
4615 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4617 switch (SetVariableFromAny(interp, nameObjPtr)) {
4618 case JIM_OK:{
4619 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4621 if (varPtr->linkFramePtr == NULL) {
4622 return varPtr->objPtr;
4624 else {
4625 Jim_Obj *objPtr;
4627 /* The variable is a link? Resolve it. */
4628 Jim_CallFrame *savedCallFrame = interp->framePtr;
4630 interp->framePtr = varPtr->linkFramePtr;
4631 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4632 interp->framePtr = savedCallFrame;
4633 if (objPtr) {
4634 return objPtr;
4636 /* Error, so fall through to the error message */
4639 break;
4641 case JIM_DICT_SUGAR:
4642 /* [dict] syntax sugar. */
4643 return JimDictSugarGet(interp, nameObjPtr, flags);
4645 if (flags & JIM_ERRMSG) {
4646 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4648 return NULL;
4651 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4653 Jim_CallFrame *savedFramePtr;
4654 Jim_Obj *objPtr;
4656 savedFramePtr = interp->framePtr;
4657 interp->framePtr = interp->topFramePtr;
4658 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4659 interp->framePtr = savedFramePtr;
4661 return objPtr;
4664 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4666 Jim_Obj *nameObjPtr, *varObjPtr;
4668 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4669 Jim_IncrRefCount(nameObjPtr);
4670 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4671 Jim_DecrRefCount(interp, nameObjPtr);
4672 return varObjPtr;
4675 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4677 Jim_CallFrame *savedFramePtr;
4678 Jim_Obj *objPtr;
4680 savedFramePtr = interp->framePtr;
4681 interp->framePtr = interp->topFramePtr;
4682 objPtr = Jim_GetVariableStr(interp, name, flags);
4683 interp->framePtr = savedFramePtr;
4685 return objPtr;
4688 /* Unset a variable.
4689 * Note: On success unset invalidates all the variable objects created
4690 * in the current call frame incrementing. */
4691 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4693 Jim_Var *varPtr;
4694 int retval;
4695 Jim_CallFrame *framePtr;
4697 retval = SetVariableFromAny(interp, nameObjPtr);
4698 if (retval == JIM_DICT_SUGAR) {
4699 /* [dict] syntax sugar. */
4700 return JimDictSugarSet(interp, nameObjPtr, NULL);
4702 else if (retval == JIM_OK) {
4703 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4705 /* If it's a link call UnsetVariable recursively */
4706 if (varPtr->linkFramePtr) {
4707 framePtr = interp->framePtr;
4708 interp->framePtr = varPtr->linkFramePtr;
4709 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4710 interp->framePtr = framePtr;
4712 else {
4713 const char *name = Jim_String(nameObjPtr);
4714 if (nameObjPtr->internalRep.varValue.global) {
4715 name += 2;
4716 framePtr = interp->topFramePtr;
4718 else {
4719 framePtr = interp->framePtr;
4722 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4723 if (retval == JIM_OK) {
4724 /* Change the callframe id, invalidating var lookup caching */
4725 framePtr->id = interp->callFrameEpoch++;
4729 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4730 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4732 return retval;
4735 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4737 /* Given a variable name for [dict] operation syntax sugar,
4738 * this function returns two objects, the first with the name
4739 * of the variable to set, and the second with the respective key.
4740 * For example "foo(bar)" will return objects with string repr. of
4741 * "foo" and "bar".
4743 * The returned objects have refcount = 1. The function can't fail. */
4744 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4745 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4747 const char *str, *p;
4748 int len, keyLen;
4749 Jim_Obj *varObjPtr, *keyObjPtr;
4751 str = Jim_GetString(objPtr, &len);
4753 p = strchr(str, '(');
4754 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4756 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4758 p++;
4759 keyLen = (str + len) - p;
4760 if (str[len - 1] == ')') {
4761 keyLen--;
4764 /* Create the objects with the variable name and key. */
4765 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4767 Jim_IncrRefCount(varObjPtr);
4768 Jim_IncrRefCount(keyObjPtr);
4769 *varPtrPtr = varObjPtr;
4770 *keyPtrPtr = keyObjPtr;
4773 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4774 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4775 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4777 int err;
4779 SetDictSubstFromAny(interp, objPtr);
4781 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4782 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4784 if (err == JIM_OK) {
4785 /* Don't keep an extra ref to the result */
4786 Jim_SetEmptyResult(interp);
4788 else {
4789 if (!valObjPtr) {
4790 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4791 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4792 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4793 objPtr);
4794 return err;
4797 /* Make the error more informative and Tcl-compatible */
4798 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4799 (valObjPtr ? "set" : "unset"), objPtr);
4801 return err;
4805 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4807 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4808 * and stored back to the variable before expansion.
4810 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4811 Jim_Obj *keyObjPtr, int flags)
4813 Jim_Obj *dictObjPtr;
4814 Jim_Obj *resObjPtr = NULL;
4815 int ret;
4817 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4818 if (!dictObjPtr) {
4819 return NULL;
4822 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4823 if (ret != JIM_OK) {
4824 Jim_SetResultFormatted(interp,
4825 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4826 ret < 0 ? "variable isn't" : "no such element in");
4828 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4829 /* Update the variable to have an unshared copy */
4830 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4833 return resObjPtr;
4836 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4837 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4839 SetDictSubstFromAny(interp, objPtr);
4841 return JimDictExpandArrayVariable(interp,
4842 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4843 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4846 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4848 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4850 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4851 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4854 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4856 JIM_NOTUSED(interp);
4858 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4859 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4860 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4861 dupPtr->typePtr = &dictSubstObjType;
4864 /* Note: The object *must* be in dict-sugar format */
4865 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4867 if (objPtr->typePtr != &dictSubstObjType) {
4868 Jim_Obj *varObjPtr, *keyObjPtr;
4870 if (objPtr->typePtr == &interpolatedObjType) {
4871 /* An interpolated object in dict-sugar form */
4873 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4874 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4876 Jim_IncrRefCount(varObjPtr);
4877 Jim_IncrRefCount(keyObjPtr);
4879 else {
4880 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4883 Jim_FreeIntRep(interp, objPtr);
4884 objPtr->typePtr = &dictSubstObjType;
4885 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4886 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4890 /* This function is used to expand [dict get] sugar in the form
4891 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4892 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4893 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4894 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4895 * the [dict]ionary contained in variable VARNAME. */
4896 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4898 Jim_Obj *resObjPtr = NULL;
4899 Jim_Obj *substKeyObjPtr = NULL;
4901 SetDictSubstFromAny(interp, objPtr);
4903 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4904 &substKeyObjPtr, JIM_NONE)
4905 != JIM_OK) {
4906 return NULL;
4908 Jim_IncrRefCount(substKeyObjPtr);
4909 resObjPtr =
4910 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4911 substKeyObjPtr, 0);
4912 Jim_DecrRefCount(interp, substKeyObjPtr);
4914 return resObjPtr;
4917 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4919 Jim_Obj *resultObjPtr;
4921 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4922 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4923 resultObjPtr->refCount--;
4924 return resultObjPtr;
4926 return NULL;
4929 /* -----------------------------------------------------------------------------
4930 * CallFrame
4931 * ---------------------------------------------------------------------------*/
4933 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4935 Jim_CallFrame *cf;
4937 if (interp->freeFramesList) {
4938 cf = interp->freeFramesList;
4939 interp->freeFramesList = cf->next;
4941 cf->argv = NULL;
4942 cf->argc = 0;
4943 cf->procArgsObjPtr = NULL;
4944 cf->procBodyObjPtr = NULL;
4945 cf->next = NULL;
4946 cf->staticVars = NULL;
4947 cf->localCommands = NULL;
4948 cf->tailcallObj = NULL;
4949 cf->tailcallCmd = NULL;
4951 else {
4952 cf = Jim_Alloc(sizeof(*cf));
4953 memset(cf, 0, sizeof(*cf));
4955 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4958 cf->id = interp->callFrameEpoch++;
4959 cf->parent = parent;
4960 cf->level = parent ? parent->level + 1 : 0;
4961 cf->nsObj = nsObj;
4962 Jim_IncrRefCount(nsObj);
4964 return cf;
4967 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4969 /* Delete any local procs */
4970 if (localCommands) {
4971 Jim_Obj *cmdNameObj;
4973 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4974 Jim_HashEntry *he;
4975 Jim_Obj *fqObjName;
4976 Jim_HashTable *ht = &interp->commands;
4978 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4980 he = Jim_FindHashEntry(ht, fqname);
4982 if (he) {
4983 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4984 if (cmd->prevCmd) {
4985 Jim_Cmd *prevCmd = cmd->prevCmd;
4986 cmd->prevCmd = NULL;
4988 /* Delete the old command */
4989 JimDecrCmdRefCount(interp, cmd);
4991 /* And restore the original */
4992 Jim_SetHashVal(ht, he, prevCmd);
4994 else {
4995 Jim_DeleteHashEntry(ht, fqname);
4997 Jim_InterpIncrProcEpoch(interp);
4999 Jim_DecrRefCount(interp, cmdNameObj);
5000 JimFreeQualifiedName(interp, fqObjName);
5002 Jim_FreeStack(localCommands);
5003 Jim_Free(localCommands);
5005 return JIM_OK;
5009 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5010 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5011 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5013 JimDeleteLocalProcs(interp, cf->localCommands);
5015 if (cf->procArgsObjPtr)
5016 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5017 if (cf->procBodyObjPtr)
5018 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5019 Jim_DecrRefCount(interp, cf->nsObj);
5020 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5021 Jim_FreeHashTable(&cf->vars);
5022 else {
5023 int i;
5024 Jim_HashEntry **table = cf->vars.table, *he;
5026 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5027 he = table[i];
5028 while (he != NULL) {
5029 Jim_HashEntry *nextEntry = he->next;
5030 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5032 Jim_DecrRefCount(interp, varPtr->objPtr);
5033 Jim_Free(Jim_GetHashEntryKey(he));
5034 Jim_Free(varPtr);
5035 Jim_Free(he);
5036 table[i] = NULL;
5037 he = nextEntry;
5040 cf->vars.used = 0;
5042 cf->next = interp->freeFramesList;
5043 interp->freeFramesList = cf;
5047 /* -----------------------------------------------------------------------------
5048 * References
5049 * ---------------------------------------------------------------------------*/
5050 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5052 /* References HashTable Type.
5054 * Keys are unsigned long integers, dynamically allocated for now but in the
5055 * future it's worth to cache this 4 bytes objects. Values are pointers
5056 * to Jim_References. */
5057 static void JimReferencesHTValDestructor(void *interp, void *val)
5059 Jim_Reference *refPtr = (void *)val;
5061 Jim_DecrRefCount(interp, refPtr->objPtr);
5062 if (refPtr->finalizerCmdNamePtr != NULL) {
5063 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5065 Jim_Free(val);
5068 static unsigned int JimReferencesHTHashFunction(const void *key)
5070 /* Only the least significant bits are used. */
5071 const unsigned long *widePtr = key;
5072 unsigned int intValue = (unsigned int)*widePtr;
5074 return Jim_IntHashFunction(intValue);
5077 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5079 void *copy = Jim_Alloc(sizeof(unsigned long));
5081 JIM_NOTUSED(privdata);
5083 memcpy(copy, key, sizeof(unsigned long));
5084 return copy;
5087 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5089 JIM_NOTUSED(privdata);
5091 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5094 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5096 JIM_NOTUSED(privdata);
5098 Jim_Free(key);
5101 static const Jim_HashTableType JimReferencesHashTableType = {
5102 JimReferencesHTHashFunction, /* hash function */
5103 JimReferencesHTKeyDup, /* key dup */
5104 NULL, /* val dup */
5105 JimReferencesHTKeyCompare, /* key compare */
5106 JimReferencesHTKeyDestructor, /* key destructor */
5107 JimReferencesHTValDestructor /* val destructor */
5110 /* -----------------------------------------------------------------------------
5111 * Reference object type and References API
5112 * ---------------------------------------------------------------------------*/
5114 /* The string representation of references has two features in order
5115 * to make the GC faster. The first is that every reference starts
5116 * with a non common character '<', in order to make the string matching
5117 * faster. The second is that the reference string rep is 42 characters
5118 * in length, this means that it is not necessary to check any object with a string
5119 * repr < 42, and usually there aren't many of these objects. */
5121 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5123 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5125 const char *fmt = "<reference.<%s>.%020lu>";
5127 sprintf(buf, fmt, refPtr->tag, id);
5128 return JIM_REFERENCE_SPACE;
5131 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5133 static const Jim_ObjType referenceObjType = {
5134 "reference",
5135 NULL,
5136 NULL,
5137 UpdateStringOfReference,
5138 JIM_TYPE_REFERENCES,
5141 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5143 char buf[JIM_REFERENCE_SPACE + 1];
5145 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5146 JimSetStringBytes(objPtr, buf);
5149 /* returns true if 'c' is a valid reference tag character.
5150 * i.e. inside the range [_a-zA-Z0-9] */
5151 static int isrefchar(int c)
5153 return (c == '_' || isalnum(c));
5156 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5158 unsigned long value;
5159 int i, len;
5160 const char *str, *start, *end;
5161 char refId[21];
5162 Jim_Reference *refPtr;
5163 Jim_HashEntry *he;
5164 char *endptr;
5166 /* Get the string representation */
5167 str = Jim_GetString(objPtr, &len);
5168 /* Check if it looks like a reference */
5169 if (len < JIM_REFERENCE_SPACE)
5170 goto badformat;
5171 /* Trim spaces */
5172 start = str;
5173 end = str + len - 1;
5174 while (*start == ' ')
5175 start++;
5176 while (*end == ' ' && end > start)
5177 end--;
5178 if (end - start + 1 != JIM_REFERENCE_SPACE)
5179 goto badformat;
5180 /* <reference.<1234567>.%020> */
5181 if (memcmp(start, "<reference.<", 12) != 0)
5182 goto badformat;
5183 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5184 goto badformat;
5185 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5186 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5187 if (!isrefchar(start[12 + i]))
5188 goto badformat;
5190 /* Extract info from the reference. */
5191 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5192 refId[20] = '\0';
5193 /* Try to convert the ID into an unsigned long */
5194 value = strtoul(refId, &endptr, 10);
5195 if (JimCheckConversion(refId, endptr) != JIM_OK)
5196 goto badformat;
5197 /* Check if the reference really exists! */
5198 he = Jim_FindHashEntry(&interp->references, &value);
5199 if (he == NULL) {
5200 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5201 return JIM_ERR;
5203 refPtr = Jim_GetHashEntryVal(he);
5204 /* Free the old internal repr and set the new one. */
5205 Jim_FreeIntRep(interp, objPtr);
5206 objPtr->typePtr = &referenceObjType;
5207 objPtr->internalRep.refValue.id = value;
5208 objPtr->internalRep.refValue.refPtr = refPtr;
5209 return JIM_OK;
5211 badformat:
5212 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5213 return JIM_ERR;
5216 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5217 * as finalizer command (or NULL if there is no finalizer).
5218 * The returned reference object has refcount = 0. */
5219 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5221 struct Jim_Reference *refPtr;
5222 unsigned long id;
5223 Jim_Obj *refObjPtr;
5224 const char *tag;
5225 int tagLen, i;
5227 /* Perform the Garbage Collection if needed. */
5228 Jim_CollectIfNeeded(interp);
5230 refPtr = Jim_Alloc(sizeof(*refPtr));
5231 refPtr->objPtr = objPtr;
5232 Jim_IncrRefCount(objPtr);
5233 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5234 if (cmdNamePtr)
5235 Jim_IncrRefCount(cmdNamePtr);
5236 id = interp->referenceNextId++;
5237 Jim_AddHashEntry(&interp->references, &id, refPtr);
5238 refObjPtr = Jim_NewObj(interp);
5239 refObjPtr->typePtr = &referenceObjType;
5240 refObjPtr->bytes = NULL;
5241 refObjPtr->internalRep.refValue.id = id;
5242 refObjPtr->internalRep.refValue.refPtr = refPtr;
5243 interp->referenceNextId++;
5244 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5245 * that does not pass the 'isrefchar' test is replaced with '_' */
5246 tag = Jim_GetString(tagPtr, &tagLen);
5247 if (tagLen > JIM_REFERENCE_TAGLEN)
5248 tagLen = JIM_REFERENCE_TAGLEN;
5249 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5250 if (i < tagLen && isrefchar(tag[i]))
5251 refPtr->tag[i] = tag[i];
5252 else
5253 refPtr->tag[i] = '_';
5255 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5256 return refObjPtr;
5259 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5261 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5262 return NULL;
5263 return objPtr->internalRep.refValue.refPtr;
5266 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5268 Jim_Reference *refPtr;
5270 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5271 return JIM_ERR;
5272 Jim_IncrRefCount(cmdNamePtr);
5273 if (refPtr->finalizerCmdNamePtr)
5274 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5275 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5276 return JIM_OK;
5279 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5281 Jim_Reference *refPtr;
5283 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5284 return JIM_ERR;
5285 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5286 return JIM_OK;
5289 /* -----------------------------------------------------------------------------
5290 * References Garbage Collection
5291 * ---------------------------------------------------------------------------*/
5293 /* This the hash table type for the "MARK" phase of the GC */
5294 static const Jim_HashTableType JimRefMarkHashTableType = {
5295 JimReferencesHTHashFunction, /* hash function */
5296 JimReferencesHTKeyDup, /* key dup */
5297 NULL, /* val dup */
5298 JimReferencesHTKeyCompare, /* key compare */
5299 JimReferencesHTKeyDestructor, /* key destructor */
5300 NULL /* val destructor */
5303 /* Performs the garbage collection. */
5304 int Jim_Collect(Jim_Interp *interp)
5306 int collected = 0;
5307 Jim_HashTable marks;
5308 Jim_HashTableIterator htiter;
5309 Jim_HashEntry *he;
5310 Jim_Obj *objPtr;
5312 /* Avoid recursive calls */
5313 if (interp->lastCollectId == -1) {
5314 /* Jim_Collect() already running. Return just now. */
5315 return 0;
5317 interp->lastCollectId = -1;
5319 /* Mark all the references found into the 'mark' hash table.
5320 * The references are searched in every live object that
5321 * is of a type that can contain references. */
5322 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5323 objPtr = interp->liveList;
5324 while (objPtr) {
5325 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5326 const char *str, *p;
5327 int len;
5329 /* If the object is of type reference, to get the
5330 * Id is simple... */
5331 if (objPtr->typePtr == &referenceObjType) {
5332 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5333 #ifdef JIM_DEBUG_GC
5334 printf("MARK (reference): %d refcount: %d\n",
5335 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5336 #endif
5337 objPtr = objPtr->nextObjPtr;
5338 continue;
5340 /* Get the string repr of the object we want
5341 * to scan for references. */
5342 p = str = Jim_GetString(objPtr, &len);
5343 /* Skip objects too little to contain references. */
5344 if (len < JIM_REFERENCE_SPACE) {
5345 objPtr = objPtr->nextObjPtr;
5346 continue;
5348 /* Extract references from the object string repr. */
5349 while (1) {
5350 int i;
5351 unsigned long id;
5353 if ((p = strstr(p, "<reference.<")) == NULL)
5354 break;
5355 /* Check if it's a valid reference. */
5356 if (len - (p - str) < JIM_REFERENCE_SPACE)
5357 break;
5358 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5359 break;
5360 for (i = 21; i <= 40; i++)
5361 if (!isdigit(UCHAR(p[i])))
5362 break;
5363 /* Get the ID */
5364 id = strtoul(p + 21, NULL, 10);
5366 /* Ok, a reference for the given ID
5367 * was found. Mark it. */
5368 Jim_AddHashEntry(&marks, &id, NULL);
5369 #ifdef JIM_DEBUG_GC
5370 printf("MARK: %d\n", (int)id);
5371 #endif
5372 p += JIM_REFERENCE_SPACE;
5375 objPtr = objPtr->nextObjPtr;
5378 /* Run the references hash table to destroy every reference that
5379 * is not referenced outside (not present in the mark HT). */
5380 JimInitHashTableIterator(&interp->references, &htiter);
5381 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5382 const unsigned long *refId;
5383 Jim_Reference *refPtr;
5385 refId = he->key;
5386 /* Check if in the mark phase we encountered
5387 * this reference. */
5388 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5389 #ifdef JIM_DEBUG_GC
5390 printf("COLLECTING %d\n", (int)*refId);
5391 #endif
5392 collected++;
5393 /* Drop the reference, but call the
5394 * finalizer first if registered. */
5395 refPtr = Jim_GetHashEntryVal(he);
5396 if (refPtr->finalizerCmdNamePtr) {
5397 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5398 Jim_Obj *objv[3], *oldResult;
5400 JimFormatReference(refstr, refPtr, *refId);
5402 objv[0] = refPtr->finalizerCmdNamePtr;
5403 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5404 objv[2] = refPtr->objPtr;
5406 /* Drop the reference itself */
5407 /* Avoid the finaliser being freed here */
5408 Jim_IncrRefCount(objv[0]);
5409 /* Don't remove the reference from the hash table just yet
5410 * since that will free refPtr, and hence refPtr->objPtr
5413 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5414 oldResult = interp->result;
5415 Jim_IncrRefCount(oldResult);
5416 Jim_EvalObjVector(interp, 3, objv);
5417 Jim_SetResult(interp, oldResult);
5418 Jim_DecrRefCount(interp, oldResult);
5420 Jim_DecrRefCount(interp, objv[0]);
5422 Jim_DeleteHashEntry(&interp->references, refId);
5425 Jim_FreeHashTable(&marks);
5426 interp->lastCollectId = interp->referenceNextId;
5427 interp->lastCollectTime = time(NULL);
5428 return collected;
5431 #define JIM_COLLECT_ID_PERIOD 5000
5432 #define JIM_COLLECT_TIME_PERIOD 300
5434 void Jim_CollectIfNeeded(Jim_Interp *interp)
5436 unsigned long elapsedId;
5437 int elapsedTime;
5439 elapsedId = interp->referenceNextId - interp->lastCollectId;
5440 elapsedTime = time(NULL) - interp->lastCollectTime;
5443 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5444 Jim_Collect(interp);
5447 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5449 int Jim_IsBigEndian(void)
5451 union {
5452 unsigned short s;
5453 unsigned char c[2];
5454 } uval = {0x0102};
5456 return uval.c[0] == 1;
5459 /* -----------------------------------------------------------------------------
5460 * Interpreter related functions
5461 * ---------------------------------------------------------------------------*/
5463 Jim_Interp *Jim_CreateInterp(void)
5465 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5467 memset(i, 0, sizeof(*i));
5469 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5470 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5471 i->lastCollectTime = time(NULL);
5473 /* Note that we can create objects only after the
5474 * interpreter liveList and freeList pointers are
5475 * initialized to NULL. */
5476 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5477 #ifdef JIM_REFERENCES
5478 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5479 #endif
5480 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5481 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5482 i->emptyObj = Jim_NewEmptyStringObj(i);
5483 i->trueObj = Jim_NewIntObj(i, 1);
5484 i->falseObj = Jim_NewIntObj(i, 0);
5485 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5486 i->errorFileNameObj = i->emptyObj;
5487 i->result = i->emptyObj;
5488 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5489 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5490 i->errorProc = i->emptyObj;
5491 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5492 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5493 Jim_IncrRefCount(i->emptyObj);
5494 Jim_IncrRefCount(i->errorFileNameObj);
5495 Jim_IncrRefCount(i->result);
5496 Jim_IncrRefCount(i->stackTrace);
5497 Jim_IncrRefCount(i->unknown);
5498 Jim_IncrRefCount(i->currentScriptObj);
5499 Jim_IncrRefCount(i->nullScriptObj);
5500 Jim_IncrRefCount(i->errorProc);
5501 Jim_IncrRefCount(i->trueObj);
5502 Jim_IncrRefCount(i->falseObj);
5504 /* Initialize key variables every interpreter should contain */
5505 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5506 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5508 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5509 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5510 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5511 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5512 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5513 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5514 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5515 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5517 return i;
5520 void Jim_FreeInterp(Jim_Interp *i)
5522 Jim_CallFrame *cf, *cfx;
5524 Jim_Obj *objPtr, *nextObjPtr;
5526 /* Free the active call frames list - must be done before i->commands is destroyed */
5527 for (cf = i->framePtr; cf; cf = cfx) {
5528 cfx = cf->parent;
5529 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5532 Jim_DecrRefCount(i, i->emptyObj);
5533 Jim_DecrRefCount(i, i->trueObj);
5534 Jim_DecrRefCount(i, i->falseObj);
5535 Jim_DecrRefCount(i, i->result);
5536 Jim_DecrRefCount(i, i->stackTrace);
5537 Jim_DecrRefCount(i, i->errorProc);
5538 Jim_DecrRefCount(i, i->unknown);
5539 Jim_DecrRefCount(i, i->errorFileNameObj);
5540 Jim_DecrRefCount(i, i->currentScriptObj);
5541 Jim_DecrRefCount(i, i->nullScriptObj);
5542 Jim_FreeHashTable(&i->commands);
5543 #ifdef JIM_REFERENCES
5544 Jim_FreeHashTable(&i->references);
5545 #endif
5546 Jim_FreeHashTable(&i->packages);
5547 Jim_Free(i->prngState);
5548 Jim_FreeHashTable(&i->assocData);
5550 /* Check that the live object list is empty, otherwise
5551 * there is a memory leak. */
5552 #ifdef JIM_MAINTAINER
5553 if (i->liveList != NULL) {
5554 objPtr = i->liveList;
5556 printf("\n-------------------------------------\n");
5557 printf("Objects still in the free list:\n");
5558 while (objPtr) {
5559 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5561 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5562 printf("%p (%d) %-10s: '%.20s...'\n",
5563 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5565 else {
5566 printf("%p (%d) %-10s: '%s'\n",
5567 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5569 if (objPtr->typePtr == &sourceObjType) {
5570 printf("FILE %s LINE %d\n",
5571 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5572 objPtr->internalRep.sourceValue.lineNumber);
5574 objPtr = objPtr->nextObjPtr;
5576 printf("-------------------------------------\n\n");
5577 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5579 #endif
5581 /* Free all the freed objects. */
5582 objPtr = i->freeList;
5583 while (objPtr) {
5584 nextObjPtr = objPtr->nextObjPtr;
5585 Jim_Free(objPtr);
5586 objPtr = nextObjPtr;
5589 /* Free the free call frames list */
5590 for (cf = i->freeFramesList; cf; cf = cfx) {
5591 cfx = cf->next;
5592 if (cf->vars.table)
5593 Jim_FreeHashTable(&cf->vars);
5594 Jim_Free(cf);
5597 /* Free the interpreter structure. */
5598 Jim_Free(i);
5601 /* Returns the call frame relative to the level represented by
5602 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5604 * This function accepts the 'level' argument in the form
5605 * of the commands [uplevel] and [upvar].
5607 * Returns NULL on error.
5609 * Note: for a function accepting a relative integer as level suitable
5610 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5612 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5614 long level;
5615 const char *str;
5616 Jim_CallFrame *framePtr;
5618 if (levelObjPtr) {
5619 str = Jim_String(levelObjPtr);
5620 if (str[0] == '#') {
5621 char *endptr;
5623 level = jim_strtol(str + 1, &endptr);
5624 if (str[1] == '\0' || endptr[0] != '\0') {
5625 level = -1;
5628 else {
5629 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5630 level = -1;
5632 else {
5633 /* Convert from a relative to an absolute level */
5634 level = interp->framePtr->level - level;
5638 else {
5639 str = "1"; /* Needed to format the error message. */
5640 level = interp->framePtr->level - 1;
5643 if (level == 0) {
5644 return interp->topFramePtr;
5646 if (level > 0) {
5647 /* Lookup */
5648 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5649 if (framePtr->level == level) {
5650 return framePtr;
5655 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5656 return NULL;
5659 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5660 * as a relative integer like in the [info level ?level?] command.
5662 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5664 long level;
5665 Jim_CallFrame *framePtr;
5667 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5668 if (level <= 0) {
5669 /* Convert from a relative to an absolute level */
5670 level = interp->framePtr->level + level;
5673 if (level == 0) {
5674 return interp->topFramePtr;
5677 /* Lookup */
5678 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5679 if (framePtr->level == level) {
5680 return framePtr;
5685 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5686 return NULL;
5689 static void JimResetStackTrace(Jim_Interp *interp)
5691 Jim_DecrRefCount(interp, interp->stackTrace);
5692 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5693 Jim_IncrRefCount(interp->stackTrace);
5696 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5698 int len;
5700 /* Increment reference first in case these are the same object */
5701 Jim_IncrRefCount(stackTraceObj);
5702 Jim_DecrRefCount(interp, interp->stackTrace);
5703 interp->stackTrace = stackTraceObj;
5704 interp->errorFlag = 1;
5706 /* This is a bit ugly.
5707 * If the filename of the last entry of the stack trace is empty,
5708 * the next stack level should be added.
5710 len = Jim_ListLength(interp, interp->stackTrace);
5711 if (len >= 3) {
5712 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5713 interp->addStackTrace = 1;
5718 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5719 Jim_Obj *fileNameObj, int linenr)
5721 if (strcmp(procname, "unknown") == 0) {
5722 procname = "";
5724 if (!*procname && !Jim_Length(fileNameObj)) {
5725 /* No useful info here */
5726 return;
5729 if (Jim_IsShared(interp->stackTrace)) {
5730 Jim_DecrRefCount(interp, interp->stackTrace);
5731 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5732 Jim_IncrRefCount(interp->stackTrace);
5735 /* If we have no procname but the previous element did, merge with that frame */
5736 if (!*procname && Jim_Length(fileNameObj)) {
5737 /* Just a filename. Check the previous entry */
5738 int len = Jim_ListLength(interp, interp->stackTrace);
5740 if (len >= 3) {
5741 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5742 if (Jim_Length(objPtr)) {
5743 /* Yes, the previous level had procname */
5744 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5745 if (Jim_Length(objPtr) == 0) {
5746 /* But no filename, so merge the new info with that frame */
5747 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5748 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5749 return;
5755 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5756 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5757 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5760 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5761 void *data)
5763 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5765 assocEntryPtr->delProc = delProc;
5766 assocEntryPtr->data = data;
5767 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5770 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5772 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5774 if (entryPtr != NULL) {
5775 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5776 return assocEntryPtr->data;
5778 return NULL;
5781 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5783 return Jim_DeleteHashEntry(&interp->assocData, key);
5786 int Jim_GetExitCode(Jim_Interp *interp)
5788 return interp->exitCode;
5791 /* -----------------------------------------------------------------------------
5792 * Integer object
5793 * ---------------------------------------------------------------------------*/
5794 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5795 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5797 static const Jim_ObjType intObjType = {
5798 "int",
5799 NULL,
5800 NULL,
5801 UpdateStringOfInt,
5802 JIM_TYPE_NONE,
5805 /* A coerced double is closer to an int than a double.
5806 * It is an int value temporarily masquerading as a double value.
5807 * i.e. it has the same string value as an int and Jim_GetWide()
5808 * succeeds, but also Jim_GetDouble() returns the value directly.
5810 static const Jim_ObjType coercedDoubleObjType = {
5811 "coerced-double",
5812 NULL,
5813 NULL,
5814 UpdateStringOfInt,
5815 JIM_TYPE_NONE,
5819 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5821 char buf[JIM_INTEGER_SPACE + 1];
5822 jim_wide wideValue = JimWideValue(objPtr);
5823 int pos = 0;
5825 if (wideValue == 0) {
5826 buf[pos++] = '0';
5828 else {
5829 char tmp[JIM_INTEGER_SPACE];
5830 int num = 0;
5831 int i;
5833 if (wideValue < 0) {
5834 buf[pos++] = '-';
5835 i = wideValue % 10;
5836 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5837 * whereas C99 is always -6
5838 * coverity[dead_error_line]
5840 tmp[num++] = (i > 0) ? (10 - i) : -i;
5841 wideValue /= -10;
5844 while (wideValue) {
5845 tmp[num++] = wideValue % 10;
5846 wideValue /= 10;
5849 for (i = 0; i < num; i++) {
5850 buf[pos++] = '0' + tmp[num - i - 1];
5853 buf[pos] = 0;
5855 JimSetStringBytes(objPtr, buf);
5858 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5860 jim_wide wideValue;
5861 const char *str;
5863 if (objPtr->typePtr == &coercedDoubleObjType) {
5864 /* Simple switch */
5865 objPtr->typePtr = &intObjType;
5866 return JIM_OK;
5869 /* Get the string representation */
5870 str = Jim_String(objPtr);
5871 /* Try to convert into a jim_wide */
5872 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5873 if (flags & JIM_ERRMSG) {
5874 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5876 return JIM_ERR;
5878 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5879 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5880 return JIM_ERR;
5882 /* Free the old internal repr and set the new one. */
5883 Jim_FreeIntRep(interp, objPtr);
5884 objPtr->typePtr = &intObjType;
5885 objPtr->internalRep.wideValue = wideValue;
5886 return JIM_OK;
5889 #ifdef JIM_OPTIMIZATION
5890 static int JimIsWide(Jim_Obj *objPtr)
5892 return objPtr->typePtr == &intObjType;
5894 #endif
5896 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5898 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5899 return JIM_ERR;
5900 *widePtr = JimWideValue(objPtr);
5901 return JIM_OK;
5904 /* Get a wide but does not set an error if the format is bad. */
5905 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5907 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5908 return JIM_ERR;
5909 *widePtr = JimWideValue(objPtr);
5910 return JIM_OK;
5913 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5915 jim_wide wideValue;
5916 int retval;
5918 retval = Jim_GetWide(interp, objPtr, &wideValue);
5919 if (retval == JIM_OK) {
5920 *longPtr = (long)wideValue;
5921 return JIM_OK;
5923 return JIM_ERR;
5926 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5928 Jim_Obj *objPtr;
5930 objPtr = Jim_NewObj(interp);
5931 objPtr->typePtr = &intObjType;
5932 objPtr->bytes = NULL;
5933 objPtr->internalRep.wideValue = wideValue;
5934 return objPtr;
5937 /* -----------------------------------------------------------------------------
5938 * Double object
5939 * ---------------------------------------------------------------------------*/
5940 #define JIM_DOUBLE_SPACE 30
5942 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5943 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5945 static const Jim_ObjType doubleObjType = {
5946 "double",
5947 NULL,
5948 NULL,
5949 UpdateStringOfDouble,
5950 JIM_TYPE_NONE,
5953 #ifndef HAVE_ISNAN
5954 #undef isnan
5955 #define isnan(X) ((X) != (X))
5956 #endif
5957 #ifndef HAVE_ISINF
5958 #undef isinf
5959 #define isinf(X) (1.0 / (X) == 0.0)
5960 #endif
5962 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5964 double value = objPtr->internalRep.doubleValue;
5966 if (isnan(value)) {
5967 JimSetStringBytes(objPtr, "NaN");
5968 return;
5970 if (isinf(value)) {
5971 if (value < 0) {
5972 JimSetStringBytes(objPtr, "-Inf");
5974 else {
5975 JimSetStringBytes(objPtr, "Inf");
5977 return;
5980 char buf[JIM_DOUBLE_SPACE + 1];
5981 int i;
5982 int len = sprintf(buf, "%.12g", value);
5984 /* Add a final ".0" if necessary */
5985 for (i = 0; i < len; i++) {
5986 if (buf[i] == '.' || buf[i] == 'e') {
5987 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5988 /* If 'buf' ends in e-0nn or e+0nn, remove
5989 * the 0 after the + or - and reduce the length by 1
5991 char *e = strchr(buf, 'e');
5992 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5993 /* Move it up */
5994 e += 2;
5995 memmove(e, e + 1, len - (e - buf));
5997 #endif
5998 break;
6001 if (buf[i] == '\0') {
6002 buf[i++] = '.';
6003 buf[i++] = '0';
6004 buf[i] = '\0';
6006 JimSetStringBytes(objPtr, buf);
6010 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6012 double doubleValue;
6013 jim_wide wideValue;
6014 const char *str;
6016 /* Preserve the string representation.
6017 * Needed so we can convert back to int without loss
6019 str = Jim_String(objPtr);
6021 #ifdef HAVE_LONG_LONG
6022 /* Assume a 53 bit mantissa */
6023 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6024 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6026 if (objPtr->typePtr == &intObjType
6027 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6028 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6030 /* Direct conversion to coerced double */
6031 objPtr->typePtr = &coercedDoubleObjType;
6032 return JIM_OK;
6034 else
6035 #endif
6036 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6037 /* Managed to convert to an int, so we can use this as a cooerced double */
6038 Jim_FreeIntRep(interp, objPtr);
6039 objPtr->typePtr = &coercedDoubleObjType;
6040 objPtr->internalRep.wideValue = wideValue;
6041 return JIM_OK;
6043 else {
6044 /* Try to convert into a double */
6045 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6046 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6047 return JIM_ERR;
6049 /* Free the old internal repr and set the new one. */
6050 Jim_FreeIntRep(interp, objPtr);
6052 objPtr->typePtr = &doubleObjType;
6053 objPtr->internalRep.doubleValue = doubleValue;
6054 return JIM_OK;
6057 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6059 if (objPtr->typePtr == &coercedDoubleObjType) {
6060 *doublePtr = JimWideValue(objPtr);
6061 return JIM_OK;
6063 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6064 return JIM_ERR;
6066 if (objPtr->typePtr == &coercedDoubleObjType) {
6067 *doublePtr = JimWideValue(objPtr);
6069 else {
6070 *doublePtr = objPtr->internalRep.doubleValue;
6072 return JIM_OK;
6075 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6077 Jim_Obj *objPtr;
6079 objPtr = Jim_NewObj(interp);
6080 objPtr->typePtr = &doubleObjType;
6081 objPtr->bytes = NULL;
6082 objPtr->internalRep.doubleValue = doubleValue;
6083 return objPtr;
6086 /* -----------------------------------------------------------------------------
6087 * Boolean conversion
6088 * ---------------------------------------------------------------------------*/
6089 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6091 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6093 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6094 return JIM_ERR;
6095 *booleanPtr = (int) JimWideValue(objPtr);
6096 return JIM_OK;
6099 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6101 static const char * const falses[] = {
6102 "0", "false", "no", "off", NULL
6104 static const char * const trues[] = {
6105 "1", "true", "yes", "on", NULL
6108 int boolean;
6110 int index;
6111 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6112 boolean = 0;
6113 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6114 boolean = 1;
6115 } else {
6116 if (flags & JIM_ERRMSG) {
6117 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6119 return JIM_ERR;
6122 /* Free the old internal repr and set the new one. */
6123 Jim_FreeIntRep(interp, objPtr);
6124 objPtr->typePtr = &intObjType;
6125 objPtr->internalRep.wideValue = boolean;
6126 return JIM_OK;
6129 /* -----------------------------------------------------------------------------
6130 * List object
6131 * ---------------------------------------------------------------------------*/
6132 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6133 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6134 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6135 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6136 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6137 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6139 /* Note that while the elements of the list may contain references,
6140 * the list object itself can't. This basically means that the
6141 * list object string representation as a whole can't contain references
6142 * that are not presents in the single elements. */
6143 static const Jim_ObjType listObjType = {
6144 "list",
6145 FreeListInternalRep,
6146 DupListInternalRep,
6147 UpdateStringOfList,
6148 JIM_TYPE_NONE,
6151 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6153 int i;
6155 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6156 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6158 Jim_Free(objPtr->internalRep.listValue.ele);
6161 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6163 int i;
6165 JIM_NOTUSED(interp);
6167 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6168 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6169 dupPtr->internalRep.listValue.ele =
6170 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6171 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6172 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6173 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6174 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6176 dupPtr->typePtr = &listObjType;
6179 /* The following function checks if a given string can be encoded
6180 * into a list element without any kind of quoting, surrounded by braces,
6181 * or using escapes to quote. */
6182 #define JIM_ELESTR_SIMPLE 0
6183 #define JIM_ELESTR_BRACE 1
6184 #define JIM_ELESTR_QUOTE 2
6185 static unsigned char ListElementQuotingType(const char *s, int len)
6187 int i, level, blevel, trySimple = 1;
6189 /* Try with the SIMPLE case */
6190 if (len == 0)
6191 return JIM_ELESTR_BRACE;
6192 if (s[0] == '"' || s[0] == '{') {
6193 trySimple = 0;
6194 goto testbrace;
6196 for (i = 0; i < len; i++) {
6197 switch (s[i]) {
6198 case ' ':
6199 case '$':
6200 case '"':
6201 case '[':
6202 case ']':
6203 case ';':
6204 case '\\':
6205 case '\r':
6206 case '\n':
6207 case '\t':
6208 case '\f':
6209 case '\v':
6210 trySimple = 0;
6211 /* fall through */
6212 case '{':
6213 case '}':
6214 goto testbrace;
6217 return JIM_ELESTR_SIMPLE;
6219 testbrace:
6220 /* Test if it's possible to do with braces */
6221 if (s[len - 1] == '\\')
6222 return JIM_ELESTR_QUOTE;
6223 level = 0;
6224 blevel = 0;
6225 for (i = 0; i < len; i++) {
6226 switch (s[i]) {
6227 case '{':
6228 level++;
6229 break;
6230 case '}':
6231 level--;
6232 if (level < 0)
6233 return JIM_ELESTR_QUOTE;
6234 break;
6235 case '[':
6236 blevel++;
6237 break;
6238 case ']':
6239 blevel--;
6240 break;
6241 case '\\':
6242 if (s[i + 1] == '\n')
6243 return JIM_ELESTR_QUOTE;
6244 else if (s[i + 1] != '\0')
6245 i++;
6246 break;
6249 if (blevel < 0) {
6250 return JIM_ELESTR_QUOTE;
6253 if (level == 0) {
6254 if (!trySimple)
6255 return JIM_ELESTR_BRACE;
6256 for (i = 0; i < len; i++) {
6257 switch (s[i]) {
6258 case ' ':
6259 case '$':
6260 case '"':
6261 case '[':
6262 case ']':
6263 case ';':
6264 case '\\':
6265 case '\r':
6266 case '\n':
6267 case '\t':
6268 case '\f':
6269 case '\v':
6270 return JIM_ELESTR_BRACE;
6271 break;
6274 return JIM_ELESTR_SIMPLE;
6276 return JIM_ELESTR_QUOTE;
6279 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6280 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6281 * scenario.
6282 * Returns the length of the result.
6284 static int BackslashQuoteString(const char *s, int len, char *q)
6286 char *p = q;
6288 while (len--) {
6289 switch (*s) {
6290 case ' ':
6291 case '$':
6292 case '"':
6293 case '[':
6294 case ']':
6295 case '{':
6296 case '}':
6297 case ';':
6298 case '\\':
6299 *p++ = '\\';
6300 *p++ = *s++;
6301 break;
6302 case '\n':
6303 *p++ = '\\';
6304 *p++ = 'n';
6305 s++;
6306 break;
6307 case '\r':
6308 *p++ = '\\';
6309 *p++ = 'r';
6310 s++;
6311 break;
6312 case '\t':
6313 *p++ = '\\';
6314 *p++ = 't';
6315 s++;
6316 break;
6317 case '\f':
6318 *p++ = '\\';
6319 *p++ = 'f';
6320 s++;
6321 break;
6322 case '\v':
6323 *p++ = '\\';
6324 *p++ = 'v';
6325 s++;
6326 break;
6327 default:
6328 *p++ = *s++;
6329 break;
6332 *p = '\0';
6334 return p - q;
6337 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6339 #define STATIC_QUOTING_LEN 32
6340 int i, bufLen, realLength;
6341 const char *strRep;
6342 char *p;
6343 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6345 /* Estimate the space needed. */
6346 if (objc > STATIC_QUOTING_LEN) {
6347 quotingType = Jim_Alloc(objc);
6349 else {
6350 quotingType = staticQuoting;
6352 bufLen = 0;
6353 for (i = 0; i < objc; i++) {
6354 int len;
6356 strRep = Jim_GetString(objv[i], &len);
6357 quotingType[i] = ListElementQuotingType(strRep, len);
6358 switch (quotingType[i]) {
6359 case JIM_ELESTR_SIMPLE:
6360 if (i != 0 || strRep[0] != '#') {
6361 bufLen += len;
6362 break;
6364 /* Special case '#' on first element needs braces */
6365 quotingType[i] = JIM_ELESTR_BRACE;
6366 /* fall through */
6367 case JIM_ELESTR_BRACE:
6368 bufLen += len + 2;
6369 break;
6370 case JIM_ELESTR_QUOTE:
6371 bufLen += len * 2;
6372 break;
6374 bufLen++; /* elements separator. */
6376 bufLen++;
6378 /* Generate the string rep. */
6379 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6380 realLength = 0;
6381 for (i = 0; i < objc; i++) {
6382 int len, qlen;
6384 strRep = Jim_GetString(objv[i], &len);
6386 switch (quotingType[i]) {
6387 case JIM_ELESTR_SIMPLE:
6388 memcpy(p, strRep, len);
6389 p += len;
6390 realLength += len;
6391 break;
6392 case JIM_ELESTR_BRACE:
6393 *p++ = '{';
6394 memcpy(p, strRep, len);
6395 p += len;
6396 *p++ = '}';
6397 realLength += len + 2;
6398 break;
6399 case JIM_ELESTR_QUOTE:
6400 if (i == 0 && strRep[0] == '#') {
6401 *p++ = '\\';
6402 realLength++;
6404 qlen = BackslashQuoteString(strRep, len, p);
6405 p += qlen;
6406 realLength += qlen;
6407 break;
6409 /* Add a separating space */
6410 if (i + 1 != objc) {
6411 *p++ = ' ';
6412 realLength++;
6415 *p = '\0'; /* nul term. */
6416 objPtr->length = realLength;
6418 if (quotingType != staticQuoting) {
6419 Jim_Free(quotingType);
6423 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6425 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6428 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6430 struct JimParserCtx parser;
6431 const char *str;
6432 int strLen;
6433 Jim_Obj *fileNameObj;
6434 int linenr;
6436 if (objPtr->typePtr == &listObjType) {
6437 return JIM_OK;
6440 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6441 * it also preserves any source location of the dict elements
6442 * which can be very useful
6444 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6445 Jim_Obj **listObjPtrPtr;
6446 int len;
6447 int i;
6449 listObjPtrPtr = JimDictPairs(objPtr, &len);
6450 for (i = 0; i < len; i++) {
6451 Jim_IncrRefCount(listObjPtrPtr[i]);
6454 /* Now just switch the internal rep */
6455 Jim_FreeIntRep(interp, objPtr);
6456 objPtr->typePtr = &listObjType;
6457 objPtr->internalRep.listValue.len = len;
6458 objPtr->internalRep.listValue.maxLen = len;
6459 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6461 return JIM_OK;
6464 /* Try to preserve information about filename / line number */
6465 if (objPtr->typePtr == &sourceObjType) {
6466 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6467 linenr = objPtr->internalRep.sourceValue.lineNumber;
6469 else {
6470 fileNameObj = interp->emptyObj;
6471 linenr = 1;
6473 Jim_IncrRefCount(fileNameObj);
6475 /* Get the string representation */
6476 str = Jim_GetString(objPtr, &strLen);
6478 /* Free the old internal repr just now and initialize the
6479 * new one just now. The string->list conversion can't fail. */
6480 Jim_FreeIntRep(interp, objPtr);
6481 objPtr->typePtr = &listObjType;
6482 objPtr->internalRep.listValue.len = 0;
6483 objPtr->internalRep.listValue.maxLen = 0;
6484 objPtr->internalRep.listValue.ele = NULL;
6486 /* Convert into a list */
6487 if (strLen) {
6488 JimParserInit(&parser, str, strLen, linenr);
6489 while (!parser.eof) {
6490 Jim_Obj *elementPtr;
6492 JimParseList(&parser);
6493 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6494 continue;
6495 elementPtr = JimParserGetTokenObj(interp, &parser);
6496 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6497 ListAppendElement(objPtr, elementPtr);
6500 Jim_DecrRefCount(interp, fileNameObj);
6501 return JIM_OK;
6504 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6506 Jim_Obj *objPtr;
6508 objPtr = Jim_NewObj(interp);
6509 objPtr->typePtr = &listObjType;
6510 objPtr->bytes = NULL;
6511 objPtr->internalRep.listValue.ele = NULL;
6512 objPtr->internalRep.listValue.len = 0;
6513 objPtr->internalRep.listValue.maxLen = 0;
6515 if (len) {
6516 ListInsertElements(objPtr, 0, len, elements);
6519 return objPtr;
6522 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6523 * length of the vector. Note that the user of this function should make
6524 * sure that the list object can't shimmer while the vector returned
6525 * is in use, this vector is the one stored inside the internal representation
6526 * of the list object. This function is not exported, extensions should
6527 * always access to the List object elements using Jim_ListIndex(). */
6528 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6529 Jim_Obj ***listVec)
6531 *listLen = Jim_ListLength(interp, listObj);
6532 *listVec = listObj->internalRep.listValue.ele;
6535 /* Sorting uses ints, but commands may return wide */
6536 static int JimSign(jim_wide w)
6538 if (w == 0) {
6539 return 0;
6541 else if (w < 0) {
6542 return -1;
6544 return 1;
6547 /* ListSortElements type values */
6548 struct lsort_info {
6549 jmp_buf jmpbuf;
6550 Jim_Obj *command;
6551 Jim_Interp *interp;
6552 enum {
6553 JIM_LSORT_ASCII,
6554 JIM_LSORT_NOCASE,
6555 JIM_LSORT_INTEGER,
6556 JIM_LSORT_REAL,
6557 JIM_LSORT_COMMAND
6558 } type;
6559 int order;
6560 int index;
6561 int indexed;
6562 int unique;
6563 int (*subfn)(Jim_Obj **, Jim_Obj **);
6566 static struct lsort_info *sort_info;
6568 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6570 Jim_Obj *lObj, *rObj;
6572 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6573 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6574 longjmp(sort_info->jmpbuf, JIM_ERR);
6576 return sort_info->subfn(&lObj, &rObj);
6579 /* Sort the internal rep of a list. */
6580 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6582 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6585 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6587 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6590 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6592 jim_wide lhs = 0, rhs = 0;
6594 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6595 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6596 longjmp(sort_info->jmpbuf, JIM_ERR);
6599 return JimSign(lhs - rhs) * sort_info->order;
6602 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6604 double lhs = 0, rhs = 0;
6606 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6607 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6608 longjmp(sort_info->jmpbuf, JIM_ERR);
6610 if (lhs == rhs) {
6611 return 0;
6613 if (lhs > rhs) {
6614 return sort_info->order;
6616 return -sort_info->order;
6619 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6621 Jim_Obj *compare_script;
6622 int rc;
6624 jim_wide ret = 0;
6626 /* This must be a valid list */
6627 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6628 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6629 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6631 rc = Jim_EvalObj(sort_info->interp, compare_script);
6633 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6634 longjmp(sort_info->jmpbuf, rc);
6637 return JimSign(ret) * sort_info->order;
6640 /* Remove duplicate elements from the (sorted) list in-place, according to the
6641 * comparison function, comp.
6643 * Note that the last unique value is kept, not the first
6645 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6647 int src;
6648 int dst = 0;
6649 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6651 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6652 if (comp(&ele[dst], &ele[src]) == 0) {
6653 /* Match, so replace the dest with the current source */
6654 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6656 else {
6657 /* No match, so keep the current source and move to the next destination */
6658 dst++;
6660 ele[dst] = ele[src];
6662 /* At end of list, keep the final element */
6663 ele[++dst] = ele[src];
6665 /* Set the new length */
6666 listObjPtr->internalRep.listValue.len = dst;
6669 /* Sort a list *in place*. MUST be called with a non-shared list. */
6670 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6672 struct lsort_info *prev_info;
6674 typedef int (qsort_comparator) (const void *, const void *);
6675 int (*fn) (Jim_Obj **, Jim_Obj **);
6676 Jim_Obj **vector;
6677 int len;
6678 int rc;
6680 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6681 SetListFromAny(interp, listObjPtr);
6683 /* Allow lsort to be called reentrantly */
6684 prev_info = sort_info;
6685 sort_info = info;
6687 vector = listObjPtr->internalRep.listValue.ele;
6688 len = listObjPtr->internalRep.listValue.len;
6689 switch (info->type) {
6690 case JIM_LSORT_ASCII:
6691 fn = ListSortString;
6692 break;
6693 case JIM_LSORT_NOCASE:
6694 fn = ListSortStringNoCase;
6695 break;
6696 case JIM_LSORT_INTEGER:
6697 fn = ListSortInteger;
6698 break;
6699 case JIM_LSORT_REAL:
6700 fn = ListSortReal;
6701 break;
6702 case JIM_LSORT_COMMAND:
6703 fn = ListSortCommand;
6704 break;
6705 default:
6706 fn = NULL; /* avoid warning */
6707 JimPanic((1, "ListSort called with invalid sort type"));
6708 return -1; /* Should not be run but keeps static analysers happy */
6711 if (info->indexed) {
6712 /* Need to interpose a "list index" function */
6713 info->subfn = fn;
6714 fn = ListSortIndexHelper;
6717 if ((rc = setjmp(info->jmpbuf)) == 0) {
6718 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6720 if (info->unique && len > 1) {
6721 ListRemoveDuplicates(listObjPtr, fn);
6724 Jim_InvalidateStringRep(listObjPtr);
6726 sort_info = prev_info;
6728 return rc;
6731 /* This is the low-level function to insert elements into a list.
6732 * The higher-level Jim_ListInsertElements() performs shared object
6733 * check and invalidates the string repr. This version is used
6734 * in the internals of the List Object and is not exported.
6736 * NOTE: this function can be called only against objects
6737 * with internal type of List.
6739 * An insertion point (idx) of -1 means end-of-list.
6741 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6743 int currentLen = listPtr->internalRep.listValue.len;
6744 int requiredLen = currentLen + elemc;
6745 int i;
6746 Jim_Obj **point;
6748 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6749 if (requiredLen < 2) {
6750 /* Don't do allocations of under 4 pointers. */
6751 requiredLen = 4;
6753 else {
6754 requiredLen *= 2;
6757 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6758 sizeof(Jim_Obj *) * requiredLen);
6760 listPtr->internalRep.listValue.maxLen = requiredLen;
6762 if (idx < 0) {
6763 idx = currentLen;
6765 point = listPtr->internalRep.listValue.ele + idx;
6766 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6767 for (i = 0; i < elemc; ++i) {
6768 point[i] = elemVec[i];
6769 Jim_IncrRefCount(point[i]);
6771 listPtr->internalRep.listValue.len += elemc;
6774 /* Convenience call to ListInsertElements() to append a single element.
6776 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6778 ListInsertElements(listPtr, -1, 1, &objPtr);
6781 /* Appends every element of appendListPtr into listPtr.
6782 * Both have to be of the list type.
6783 * Convenience call to ListInsertElements()
6785 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6787 ListInsertElements(listPtr, -1,
6788 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6791 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6793 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6794 SetListFromAny(interp, listPtr);
6795 Jim_InvalidateStringRep(listPtr);
6796 ListAppendElement(listPtr, objPtr);
6799 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6801 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6802 SetListFromAny(interp, listPtr);
6803 SetListFromAny(interp, appendListPtr);
6804 Jim_InvalidateStringRep(listPtr);
6805 ListAppendList(listPtr, appendListPtr);
6808 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6810 SetListFromAny(interp, objPtr);
6811 return objPtr->internalRep.listValue.len;
6814 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6815 int objc, Jim_Obj *const *objVec)
6817 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6818 SetListFromAny(interp, listPtr);
6819 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6820 idx = listPtr->internalRep.listValue.len;
6821 else if (idx < 0)
6822 idx = 0;
6823 Jim_InvalidateStringRep(listPtr);
6824 ListInsertElements(listPtr, idx, objc, objVec);
6827 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6829 SetListFromAny(interp, listPtr);
6830 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6831 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6832 return NULL;
6834 if (idx < 0)
6835 idx = listPtr->internalRep.listValue.len + idx;
6836 return listPtr->internalRep.listValue.ele[idx];
6839 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6841 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6842 if (*objPtrPtr == NULL) {
6843 if (flags & JIM_ERRMSG) {
6844 Jim_SetResultString(interp, "list index out of range", -1);
6846 return JIM_ERR;
6848 return JIM_OK;
6851 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6852 Jim_Obj *newObjPtr, int flags)
6854 SetListFromAny(interp, listPtr);
6855 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6856 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6857 if (flags & JIM_ERRMSG) {
6858 Jim_SetResultString(interp, "list index out of range", -1);
6860 return JIM_ERR;
6862 if (idx < 0)
6863 idx = listPtr->internalRep.listValue.len + idx;
6864 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6865 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6866 Jim_IncrRefCount(newObjPtr);
6867 return JIM_OK;
6870 /* Modify the list stored in the variable named 'varNamePtr'
6871 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6872 * with the new element 'newObjptr'. (implements the [lset] command) */
6873 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6874 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6876 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6877 int shared, i, idx;
6879 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6880 if (objPtr == NULL)
6881 return JIM_ERR;
6882 if ((shared = Jim_IsShared(objPtr)))
6883 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6884 for (i = 0; i < indexc - 1; i++) {
6885 listObjPtr = objPtr;
6886 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6887 goto err;
6888 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6889 goto err;
6891 if (Jim_IsShared(objPtr)) {
6892 objPtr = Jim_DuplicateObj(interp, objPtr);
6893 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6895 Jim_InvalidateStringRep(listObjPtr);
6897 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6898 goto err;
6899 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6900 goto err;
6901 Jim_InvalidateStringRep(objPtr);
6902 Jim_InvalidateStringRep(varObjPtr);
6903 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6904 goto err;
6905 Jim_SetResult(interp, varObjPtr);
6906 return JIM_OK;
6907 err:
6908 if (shared) {
6909 Jim_FreeNewObj(interp, varObjPtr);
6911 return JIM_ERR;
6914 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6916 int i;
6917 int listLen = Jim_ListLength(interp, listObjPtr);
6918 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6920 for (i = 0; i < listLen; ) {
6921 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6922 if (++i != listLen) {
6923 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6926 return resObjPtr;
6929 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6931 int i;
6933 /* If all the objects in objv are lists,
6934 * it's possible to return a list as result, that's the
6935 * concatenation of all the lists. */
6936 for (i = 0; i < objc; i++) {
6937 if (!Jim_IsList(objv[i]))
6938 break;
6940 if (i == objc) {
6941 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6943 for (i = 0; i < objc; i++)
6944 ListAppendList(objPtr, objv[i]);
6945 return objPtr;
6947 else {
6948 /* Else... we have to glue strings together */
6949 int len = 0, objLen;
6950 char *bytes, *p;
6952 /* Compute the length */
6953 for (i = 0; i < objc; i++) {
6954 len += Jim_Length(objv[i]);
6956 if (objc)
6957 len += objc - 1;
6958 /* Create the string rep, and a string object holding it. */
6959 p = bytes = Jim_Alloc(len + 1);
6960 for (i = 0; i < objc; i++) {
6961 const char *s = Jim_GetString(objv[i], &objLen);
6963 /* Remove leading space */
6964 while (objLen && isspace(UCHAR(*s))) {
6965 s++;
6966 objLen--;
6967 len--;
6969 /* And trailing space */
6970 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6971 /* Handle trailing backslash-space case */
6972 if (objLen > 1 && s[objLen - 2] == '\\') {
6973 break;
6975 objLen--;
6976 len--;
6978 memcpy(p, s, objLen);
6979 p += objLen;
6980 if (i + 1 != objc) {
6981 if (objLen)
6982 *p++ = ' ';
6983 else {
6984 /* Drop the space calculated for this
6985 * element that is instead null. */
6986 len--;
6990 *p = '\0';
6991 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6995 /* Returns a list composed of the elements in the specified range.
6996 * first and start are directly accepted as Jim_Objects and
6997 * processed for the end?-index? case. */
6998 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6999 Jim_Obj *lastObjPtr)
7001 int first, last;
7002 int len, rangeLen;
7004 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7005 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7006 return NULL;
7007 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7008 first = JimRelToAbsIndex(len, first);
7009 last = JimRelToAbsIndex(len, last);
7010 JimRelToAbsRange(len, &first, &last, &rangeLen);
7011 if (first == 0 && last == len) {
7012 return listObjPtr;
7014 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7017 /* -----------------------------------------------------------------------------
7018 * Dict object
7019 * ---------------------------------------------------------------------------*/
7020 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7021 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7022 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7023 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7025 /* Dict HashTable Type.
7027 * Keys and Values are Jim objects. */
7029 static unsigned int JimObjectHTHashFunction(const void *key)
7031 int len;
7032 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7033 return Jim_GenHashFunction((const unsigned char *)str, len);
7036 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7038 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7041 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7043 Jim_IncrRefCount((Jim_Obj *)val);
7044 return (void *)val;
7047 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7049 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7052 static const Jim_HashTableType JimDictHashTableType = {
7053 JimObjectHTHashFunction, /* hash function */
7054 JimObjectHTKeyValDup, /* key dup */
7055 JimObjectHTKeyValDup, /* val dup */
7056 JimObjectHTKeyCompare, /* key compare */
7057 JimObjectHTKeyValDestructor, /* key destructor */
7058 JimObjectHTKeyValDestructor /* val destructor */
7061 /* Note that while the elements of the dict may contain references,
7062 * the list object itself can't. This basically means that the
7063 * dict object string representation as a whole can't contain references
7064 * that are not presents in the single elements. */
7065 static const Jim_ObjType dictObjType = {
7066 "dict",
7067 FreeDictInternalRep,
7068 DupDictInternalRep,
7069 UpdateStringOfDict,
7070 JIM_TYPE_NONE,
7073 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7075 JIM_NOTUSED(interp);
7077 Jim_FreeHashTable(objPtr->internalRep.ptr);
7078 Jim_Free(objPtr->internalRep.ptr);
7081 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7083 Jim_HashTable *ht, *dupHt;
7084 Jim_HashTableIterator htiter;
7085 Jim_HashEntry *he;
7087 /* Create a new hash table */
7088 ht = srcPtr->internalRep.ptr;
7089 dupHt = Jim_Alloc(sizeof(*dupHt));
7090 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7091 if (ht->size != 0)
7092 Jim_ExpandHashTable(dupHt, ht->size);
7093 /* Copy every element from the source to the dup hash table */
7094 JimInitHashTableIterator(ht, &htiter);
7095 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7096 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7099 dupPtr->internalRep.ptr = dupHt;
7100 dupPtr->typePtr = &dictObjType;
7103 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7105 Jim_HashTable *ht;
7106 Jim_HashTableIterator htiter;
7107 Jim_HashEntry *he;
7108 Jim_Obj **objv;
7109 int i;
7111 ht = dictPtr->internalRep.ptr;
7113 /* Turn the hash table into a flat vector of Jim_Objects. */
7114 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7115 JimInitHashTableIterator(ht, &htiter);
7116 i = 0;
7117 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7118 objv[i++] = Jim_GetHashEntryKey(he);
7119 objv[i++] = Jim_GetHashEntryVal(he);
7121 *len = i;
7122 return objv;
7125 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7127 /* Turn the hash table into a flat vector of Jim_Objects. */
7128 int len;
7129 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7131 /* And now generate the string rep as a list */
7132 JimMakeListStringRep(objPtr, objv, len);
7134 Jim_Free(objv);
7137 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7139 int listlen;
7141 if (objPtr->typePtr == &dictObjType) {
7142 return JIM_OK;
7145 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7146 /* A shared list, so get the string representation now to avoid
7147 * changing the order in case of fast conversion to dict.
7149 Jim_String(objPtr);
7152 /* For simplicity, convert a non-list object to a list and then to a dict */
7153 listlen = Jim_ListLength(interp, objPtr);
7154 if (listlen % 2) {
7155 Jim_SetResultString(interp, "missing value to go with key", -1);
7156 return JIM_ERR;
7158 else {
7159 /* Converting from a list to a dict can't fail */
7160 Jim_HashTable *ht;
7161 int i;
7163 ht = Jim_Alloc(sizeof(*ht));
7164 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7166 for (i = 0; i < listlen; i += 2) {
7167 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7168 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7170 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7173 Jim_FreeIntRep(interp, objPtr);
7174 objPtr->typePtr = &dictObjType;
7175 objPtr->internalRep.ptr = ht;
7177 return JIM_OK;
7181 /* Dict object API */
7183 /* Add an element to a dict. objPtr must be of the "dict" type.
7184 * The higher-level exported function is Jim_DictAddElement().
7185 * If an element with the specified key already exists, the value
7186 * associated is replaced with the new one.
7188 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7189 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7190 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7192 Jim_HashTable *ht = objPtr->internalRep.ptr;
7194 if (valueObjPtr == NULL) { /* unset */
7195 return Jim_DeleteHashEntry(ht, keyObjPtr);
7197 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7198 return JIM_OK;
7201 /* Add an element, higher-level interface for DictAddElement().
7202 * If valueObjPtr == NULL, the key is removed if it exists. */
7203 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7204 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7206 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7207 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7208 return JIM_ERR;
7210 Jim_InvalidateStringRep(objPtr);
7211 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7214 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7216 Jim_Obj *objPtr;
7217 int i;
7219 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7221 objPtr = Jim_NewObj(interp);
7222 objPtr->typePtr = &dictObjType;
7223 objPtr->bytes = NULL;
7224 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7225 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7226 for (i = 0; i < len; i += 2)
7227 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7228 return objPtr;
7231 /* Return the value associated to the specified dict key
7232 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7234 * Sets *objPtrPtr to non-NULL only upon success.
7236 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7237 Jim_Obj **objPtrPtr, int flags)
7239 Jim_HashEntry *he;
7240 Jim_HashTable *ht;
7242 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7243 return -1;
7245 ht = dictPtr->internalRep.ptr;
7246 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7247 if (flags & JIM_ERRMSG) {
7248 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7250 return JIM_ERR;
7252 else {
7253 *objPtrPtr = Jim_GetHashEntryVal(he);
7254 return JIM_OK;
7258 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7259 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7261 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7262 return JIM_ERR;
7264 *objPtrPtr = JimDictPairs(dictPtr, len);
7266 return JIM_OK;
7270 /* Return the value associated to the specified dict keys */
7271 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7272 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7274 int i;
7276 if (keyc == 0) {
7277 *objPtrPtr = dictPtr;
7278 return JIM_OK;
7281 for (i = 0; i < keyc; i++) {
7282 Jim_Obj *objPtr;
7284 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7285 if (rc != JIM_OK) {
7286 return rc;
7288 dictPtr = objPtr;
7290 *objPtrPtr = dictPtr;
7291 return JIM_OK;
7294 /* Modify the dict stored into the variable named 'varNamePtr'
7295 * setting the element specified by the 'keyc' keys objects in 'keyv',
7296 * with the new value of the element 'newObjPtr'.
7298 * If newObjPtr == NULL the operation is to remove the given key
7299 * from the dictionary.
7301 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7302 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7304 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7305 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7307 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7308 int shared, i;
7310 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7311 if (objPtr == NULL) {
7312 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7313 /* Cannot remove a key from non existing var */
7314 return JIM_ERR;
7316 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7317 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7318 Jim_FreeNewObj(interp, varObjPtr);
7319 return JIM_ERR;
7322 if ((shared = Jim_IsShared(objPtr)))
7323 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7324 for (i = 0; i < keyc; i++) {
7325 dictObjPtr = objPtr;
7327 /* Check if it's a valid dictionary */
7328 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7329 goto err;
7332 if (i == keyc - 1) {
7333 /* Last key: Note that error on unset with missing last key is OK */
7334 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7335 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7336 goto err;
7339 break;
7342 /* Check if the given key exists. */
7343 Jim_InvalidateStringRep(dictObjPtr);
7344 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7345 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7346 /* This key exists at the current level.
7347 * Make sure it's not shared!. */
7348 if (Jim_IsShared(objPtr)) {
7349 objPtr = Jim_DuplicateObj(interp, objPtr);
7350 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7353 else {
7354 /* Key not found. If it's an [unset] operation
7355 * this is an error. Only the last key may not
7356 * exist. */
7357 if (newObjPtr == NULL) {
7358 goto err;
7360 /* Otherwise set an empty dictionary
7361 * as key's value. */
7362 objPtr = Jim_NewDictObj(interp, NULL, 0);
7363 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7366 /* XXX: Is this necessary? */
7367 Jim_InvalidateStringRep(objPtr);
7368 Jim_InvalidateStringRep(varObjPtr);
7369 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7370 goto err;
7372 Jim_SetResult(interp, varObjPtr);
7373 return JIM_OK;
7374 err:
7375 if (shared) {
7376 Jim_FreeNewObj(interp, varObjPtr);
7378 return JIM_ERR;
7381 /* -----------------------------------------------------------------------------
7382 * Index object
7383 * ---------------------------------------------------------------------------*/
7384 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7385 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7387 static const Jim_ObjType indexObjType = {
7388 "index",
7389 NULL,
7390 NULL,
7391 UpdateStringOfIndex,
7392 JIM_TYPE_NONE,
7395 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7397 if (objPtr->internalRep.intValue == -1) {
7398 JimSetStringBytes(objPtr, "end");
7400 else {
7401 char buf[JIM_INTEGER_SPACE + 1];
7402 if (objPtr->internalRep.intValue >= 0) {
7403 sprintf(buf, "%d", objPtr->internalRep.intValue);
7405 else {
7406 /* Must be <= -2 */
7407 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7409 JimSetStringBytes(objPtr, buf);
7413 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7415 int idx, end = 0;
7416 const char *str;
7417 char *endptr;
7419 /* Get the string representation */
7420 str = Jim_String(objPtr);
7422 /* Try to convert into an index */
7423 if (strncmp(str, "end", 3) == 0) {
7424 end = 1;
7425 str += 3;
7426 idx = 0;
7428 else {
7429 idx = jim_strtol(str, &endptr);
7431 if (endptr == str) {
7432 goto badindex;
7434 str = endptr;
7437 /* Now str may include or +<num> or -<num> */
7438 if (*str == '+' || *str == '-') {
7439 int sign = (*str == '+' ? 1 : -1);
7441 idx += sign * jim_strtol(++str, &endptr);
7442 if (str == endptr || *endptr) {
7443 goto badindex;
7445 str = endptr;
7447 /* The only thing left should be spaces */
7448 while (isspace(UCHAR(*str))) {
7449 str++;
7451 if (*str) {
7452 goto badindex;
7454 if (end) {
7455 if (idx > 0) {
7456 idx = INT_MAX;
7458 else {
7459 /* end-1 is repesented as -2 */
7460 idx--;
7463 else if (idx < 0) {
7464 idx = -INT_MAX;
7467 /* Free the old internal repr and set the new one. */
7468 Jim_FreeIntRep(interp, objPtr);
7469 objPtr->typePtr = &indexObjType;
7470 objPtr->internalRep.intValue = idx;
7471 return JIM_OK;
7473 badindex:
7474 Jim_SetResultFormatted(interp,
7475 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7476 return JIM_ERR;
7479 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7481 /* Avoid shimmering if the object is an integer. */
7482 if (objPtr->typePtr == &intObjType) {
7483 jim_wide val = JimWideValue(objPtr);
7485 if (val < 0)
7486 *indexPtr = -INT_MAX;
7487 else if (val > INT_MAX)
7488 *indexPtr = INT_MAX;
7489 else
7490 *indexPtr = (int)val;
7491 return JIM_OK;
7493 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7494 return JIM_ERR;
7495 *indexPtr = objPtr->internalRep.intValue;
7496 return JIM_OK;
7499 /* -----------------------------------------------------------------------------
7500 * Return Code Object.
7501 * ---------------------------------------------------------------------------*/
7503 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7504 static const char * const jimReturnCodes[] = {
7505 "ok",
7506 "error",
7507 "return",
7508 "break",
7509 "continue",
7510 "signal",
7511 "exit",
7512 "eval",
7513 NULL
7516 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7518 static const Jim_ObjType returnCodeObjType = {
7519 "return-code",
7520 NULL,
7521 NULL,
7522 NULL,
7523 JIM_TYPE_NONE,
7526 /* Converts a (standard) return code to a string. Returns "?" for
7527 * non-standard return codes.
7529 const char *Jim_ReturnCode(int code)
7531 if (code < 0 || code >= (int)jimReturnCodesSize) {
7532 return "?";
7534 else {
7535 return jimReturnCodes[code];
7539 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7541 int returnCode;
7542 jim_wide wideValue;
7544 /* Try to convert into an integer */
7545 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7546 returnCode = (int)wideValue;
7547 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7548 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7549 return JIM_ERR;
7551 /* Free the old internal repr and set the new one. */
7552 Jim_FreeIntRep(interp, objPtr);
7553 objPtr->typePtr = &returnCodeObjType;
7554 objPtr->internalRep.intValue = returnCode;
7555 return JIM_OK;
7558 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7560 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7561 return JIM_ERR;
7562 *intPtr = objPtr->internalRep.intValue;
7563 return JIM_OK;
7566 /* -----------------------------------------------------------------------------
7567 * Expression Parsing
7568 * ---------------------------------------------------------------------------*/
7569 static int JimParseExprOperator(struct JimParserCtx *pc);
7570 static int JimParseExprNumber(struct JimParserCtx *pc);
7571 static int JimParseExprIrrational(struct JimParserCtx *pc);
7572 static int JimParseExprBoolean(struct JimParserCtx *pc);
7574 /* Exrp's Stack machine operators opcodes. */
7576 /* Binary operators (numbers) */
7577 enum
7579 /* Continues on from the JIM_TT_ space */
7580 /* Operations */
7581 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7582 JIM_EXPROP_DIV,
7583 JIM_EXPROP_MOD,
7584 JIM_EXPROP_SUB,
7585 JIM_EXPROP_ADD,
7586 JIM_EXPROP_LSHIFT,
7587 JIM_EXPROP_RSHIFT,
7588 JIM_EXPROP_ROTL,
7589 JIM_EXPROP_ROTR,
7590 JIM_EXPROP_LT,
7591 JIM_EXPROP_GT,
7592 JIM_EXPROP_LTE,
7593 JIM_EXPROP_GTE,
7594 JIM_EXPROP_NUMEQ,
7595 JIM_EXPROP_NUMNE,
7596 JIM_EXPROP_BITAND, /* 35 */
7597 JIM_EXPROP_BITXOR,
7598 JIM_EXPROP_BITOR,
7600 /* Note must keep these together */
7601 JIM_EXPROP_LOGICAND, /* 38 */
7602 JIM_EXPROP_LOGICAND_LEFT,
7603 JIM_EXPROP_LOGICAND_RIGHT,
7605 /* and these */
7606 JIM_EXPROP_LOGICOR, /* 41 */
7607 JIM_EXPROP_LOGICOR_LEFT,
7608 JIM_EXPROP_LOGICOR_RIGHT,
7610 /* and these */
7611 /* Ternary operators */
7612 JIM_EXPROP_TERNARY, /* 44 */
7613 JIM_EXPROP_TERNARY_LEFT,
7614 JIM_EXPROP_TERNARY_RIGHT,
7616 /* and these */
7617 JIM_EXPROP_COLON, /* 47 */
7618 JIM_EXPROP_COLON_LEFT,
7619 JIM_EXPROP_COLON_RIGHT,
7621 JIM_EXPROP_POW, /* 50 */
7623 /* Binary operators (strings) */
7624 JIM_EXPROP_STREQ, /* 51 */
7625 JIM_EXPROP_STRNE,
7626 JIM_EXPROP_STRIN,
7627 JIM_EXPROP_STRNI,
7629 /* Unary operators (numbers) */
7630 JIM_EXPROP_NOT, /* 55 */
7631 JIM_EXPROP_BITNOT,
7632 JIM_EXPROP_UNARYMINUS,
7633 JIM_EXPROP_UNARYPLUS,
7635 /* Functions */
7636 JIM_EXPROP_FUNC_FIRST, /* 59 */
7637 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7638 JIM_EXPROP_FUNC_WIDE,
7639 JIM_EXPROP_FUNC_ABS,
7640 JIM_EXPROP_FUNC_DOUBLE,
7641 JIM_EXPROP_FUNC_ROUND,
7642 JIM_EXPROP_FUNC_RAND,
7643 JIM_EXPROP_FUNC_SRAND,
7645 /* math functions from libm */
7646 JIM_EXPROP_FUNC_SIN, /* 65 */
7647 JIM_EXPROP_FUNC_COS,
7648 JIM_EXPROP_FUNC_TAN,
7649 JIM_EXPROP_FUNC_ASIN,
7650 JIM_EXPROP_FUNC_ACOS,
7651 JIM_EXPROP_FUNC_ATAN,
7652 JIM_EXPROP_FUNC_ATAN2,
7653 JIM_EXPROP_FUNC_SINH,
7654 JIM_EXPROP_FUNC_COSH,
7655 JIM_EXPROP_FUNC_TANH,
7656 JIM_EXPROP_FUNC_CEIL,
7657 JIM_EXPROP_FUNC_FLOOR,
7658 JIM_EXPROP_FUNC_EXP,
7659 JIM_EXPROP_FUNC_LOG,
7660 JIM_EXPROP_FUNC_LOG10,
7661 JIM_EXPROP_FUNC_SQRT,
7662 JIM_EXPROP_FUNC_POW,
7663 JIM_EXPROP_FUNC_HYPOT,
7664 JIM_EXPROP_FUNC_FMOD,
7667 struct JimExprState
7669 Jim_Obj **stack;
7670 int stacklen;
7671 int opcode;
7672 int skip;
7675 /* Operators table */
7676 typedef struct Jim_ExprOperator
7678 const char *name;
7679 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7680 unsigned char precedence;
7681 unsigned char arity;
7682 unsigned char lazy;
7683 unsigned char namelen;
7684 } Jim_ExprOperator;
7686 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7688 Jim_IncrRefCount(obj);
7689 e->stack[e->stacklen++] = obj;
7692 static Jim_Obj *ExprPop(struct JimExprState *e)
7694 return e->stack[--e->stacklen];
7697 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7699 int intresult = 1;
7700 int rc = JIM_OK;
7701 Jim_Obj *A = ExprPop(e);
7702 double dA, dC = 0;
7703 jim_wide wA, wC = 0;
7705 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7706 switch (e->opcode) {
7707 case JIM_EXPROP_FUNC_INT:
7708 case JIM_EXPROP_FUNC_WIDE:
7709 case JIM_EXPROP_FUNC_ROUND:
7710 case JIM_EXPROP_UNARYPLUS:
7711 wC = wA;
7712 break;
7713 case JIM_EXPROP_FUNC_DOUBLE:
7714 dC = wA;
7715 intresult = 0;
7716 break;
7717 case JIM_EXPROP_FUNC_ABS:
7718 wC = wA >= 0 ? wA : -wA;
7719 break;
7720 case JIM_EXPROP_UNARYMINUS:
7721 wC = -wA;
7722 break;
7723 case JIM_EXPROP_NOT:
7724 wC = !wA;
7725 break;
7726 default:
7727 abort();
7730 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7731 switch (e->opcode) {
7732 case JIM_EXPROP_FUNC_INT:
7733 case JIM_EXPROP_FUNC_WIDE:
7734 wC = dA;
7735 break;
7736 case JIM_EXPROP_FUNC_ROUND:
7737 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7738 break;
7739 case JIM_EXPROP_FUNC_DOUBLE:
7740 case JIM_EXPROP_UNARYPLUS:
7741 dC = dA;
7742 intresult = 0;
7743 break;
7744 case JIM_EXPROP_FUNC_ABS:
7745 #ifdef JIM_MATH_FUNCTIONS
7746 dC = fabs(dA);
7747 #else
7748 dC = dA >= 0 ? dA : -dA;
7749 #endif
7750 intresult = 0;
7751 break;
7752 case JIM_EXPROP_UNARYMINUS:
7753 dC = -dA;
7754 intresult = 0;
7755 break;
7756 case JIM_EXPROP_NOT:
7757 wC = !dA;
7758 break;
7759 default:
7760 abort();
7764 if (rc == JIM_OK) {
7765 if (intresult) {
7766 ExprPush(e, Jim_NewIntObj(interp, wC));
7768 else {
7769 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7773 Jim_DecrRefCount(interp, A);
7775 return rc;
7778 static double JimRandDouble(Jim_Interp *interp)
7780 unsigned long x;
7781 JimRandomBytes(interp, &x, sizeof(x));
7783 return (double)x / (unsigned long)~0;
7786 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7788 Jim_Obj *A = ExprPop(e);
7789 jim_wide wA;
7791 int rc = Jim_GetWide(interp, A, &wA);
7792 if (rc == JIM_OK) {
7793 switch (e->opcode) {
7794 case JIM_EXPROP_BITNOT:
7795 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7796 break;
7797 case JIM_EXPROP_FUNC_SRAND:
7798 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7799 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7800 break;
7801 default:
7802 abort();
7806 Jim_DecrRefCount(interp, A);
7808 return rc;
7811 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7813 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7815 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7817 return JIM_OK;
7820 #ifdef JIM_MATH_FUNCTIONS
7821 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7823 int rc;
7824 Jim_Obj *A = ExprPop(e);
7825 double dA, dC;
7827 rc = Jim_GetDouble(interp, A, &dA);
7828 if (rc == JIM_OK) {
7829 switch (e->opcode) {
7830 case JIM_EXPROP_FUNC_SIN:
7831 dC = sin(dA);
7832 break;
7833 case JIM_EXPROP_FUNC_COS:
7834 dC = cos(dA);
7835 break;
7836 case JIM_EXPROP_FUNC_TAN:
7837 dC = tan(dA);
7838 break;
7839 case JIM_EXPROP_FUNC_ASIN:
7840 dC = asin(dA);
7841 break;
7842 case JIM_EXPROP_FUNC_ACOS:
7843 dC = acos(dA);
7844 break;
7845 case JIM_EXPROP_FUNC_ATAN:
7846 dC = atan(dA);
7847 break;
7848 case JIM_EXPROP_FUNC_SINH:
7849 dC = sinh(dA);
7850 break;
7851 case JIM_EXPROP_FUNC_COSH:
7852 dC = cosh(dA);
7853 break;
7854 case JIM_EXPROP_FUNC_TANH:
7855 dC = tanh(dA);
7856 break;
7857 case JIM_EXPROP_FUNC_CEIL:
7858 dC = ceil(dA);
7859 break;
7860 case JIM_EXPROP_FUNC_FLOOR:
7861 dC = floor(dA);
7862 break;
7863 case JIM_EXPROP_FUNC_EXP:
7864 dC = exp(dA);
7865 break;
7866 case JIM_EXPROP_FUNC_LOG:
7867 dC = log(dA);
7868 break;
7869 case JIM_EXPROP_FUNC_LOG10:
7870 dC = log10(dA);
7871 break;
7872 case JIM_EXPROP_FUNC_SQRT:
7873 dC = sqrt(dA);
7874 break;
7875 default:
7876 abort();
7878 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7881 Jim_DecrRefCount(interp, A);
7883 return rc;
7885 #endif
7887 /* A binary operation on two ints */
7888 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7890 Jim_Obj *B = ExprPop(e);
7891 Jim_Obj *A = ExprPop(e);
7892 jim_wide wA, wB;
7893 int rc = JIM_ERR;
7895 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7896 jim_wide wC;
7898 rc = JIM_OK;
7900 switch (e->opcode) {
7901 case JIM_EXPROP_LSHIFT:
7902 wC = wA << wB;
7903 break;
7904 case JIM_EXPROP_RSHIFT:
7905 wC = wA >> wB;
7906 break;
7907 case JIM_EXPROP_BITAND:
7908 wC = wA & wB;
7909 break;
7910 case JIM_EXPROP_BITXOR:
7911 wC = wA ^ wB;
7912 break;
7913 case JIM_EXPROP_BITOR:
7914 wC = wA | wB;
7915 break;
7916 case JIM_EXPROP_MOD:
7917 if (wB == 0) {
7918 wC = 0;
7919 Jim_SetResultString(interp, "Division by zero", -1);
7920 rc = JIM_ERR;
7922 else {
7924 * From Tcl 8.x
7926 * This code is tricky: C doesn't guarantee much
7927 * about the quotient or remainder, but Tcl does.
7928 * The remainder always has the same sign as the
7929 * divisor and a smaller absolute value.
7931 int negative = 0;
7933 if (wB < 0) {
7934 wB = -wB;
7935 wA = -wA;
7936 negative = 1;
7938 wC = wA % wB;
7939 if (wC < 0) {
7940 wC += wB;
7942 if (negative) {
7943 wC = -wC;
7946 break;
7947 case JIM_EXPROP_ROTL:
7948 case JIM_EXPROP_ROTR:{
7949 /* uint32_t would be better. But not everyone has inttypes.h? */
7950 unsigned long uA = (unsigned long)wA;
7951 unsigned long uB = (unsigned long)wB;
7952 const unsigned int S = sizeof(unsigned long) * 8;
7954 /* Shift left by the word size or more is undefined. */
7955 uB %= S;
7957 if (e->opcode == JIM_EXPROP_ROTR) {
7958 uB = S - uB;
7960 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7961 break;
7963 default:
7964 abort();
7966 ExprPush(e, Jim_NewIntObj(interp, wC));
7970 Jim_DecrRefCount(interp, A);
7971 Jim_DecrRefCount(interp, B);
7973 return rc;
7977 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7978 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7980 int rc = JIM_OK;
7981 double dA, dB, dC = 0;
7982 jim_wide wA, wB, wC = 0;
7984 Jim_Obj *B = ExprPop(e);
7985 Jim_Obj *A = ExprPop(e);
7987 if ((A->typePtr != &doubleObjType || A->bytes) &&
7988 (B->typePtr != &doubleObjType || B->bytes) &&
7989 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7991 /* Both are ints */
7993 switch (e->opcode) {
7994 case JIM_EXPROP_POW:
7995 case JIM_EXPROP_FUNC_POW:
7996 if (wA == 0 && wB < 0) {
7997 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
7998 rc = JIM_ERR;
7999 goto done;
8001 wC = JimPowWide(wA, wB);
8002 goto intresult;
8003 case JIM_EXPROP_ADD:
8004 wC = wA + wB;
8005 goto intresult;
8006 case JIM_EXPROP_SUB:
8007 wC = wA - wB;
8008 goto intresult;
8009 case JIM_EXPROP_MUL:
8010 wC = wA * wB;
8011 goto intresult;
8012 case JIM_EXPROP_DIV:
8013 if (wB == 0) {
8014 Jim_SetResultString(interp, "Division by zero", -1);
8015 rc = JIM_ERR;
8016 goto done;
8018 else {
8020 * From Tcl 8.x
8022 * This code is tricky: C doesn't guarantee much
8023 * about the quotient or remainder, but Tcl does.
8024 * The remainder always has the same sign as the
8025 * divisor and a smaller absolute value.
8027 if (wB < 0) {
8028 wB = -wB;
8029 wA = -wA;
8031 wC = wA / wB;
8032 if (wA % wB < 0) {
8033 wC--;
8035 goto intresult;
8037 case JIM_EXPROP_LT:
8038 wC = wA < wB;
8039 goto intresult;
8040 case JIM_EXPROP_GT:
8041 wC = wA > wB;
8042 goto intresult;
8043 case JIM_EXPROP_LTE:
8044 wC = wA <= wB;
8045 goto intresult;
8046 case JIM_EXPROP_GTE:
8047 wC = wA >= wB;
8048 goto intresult;
8049 case JIM_EXPROP_NUMEQ:
8050 wC = wA == wB;
8051 goto intresult;
8052 case JIM_EXPROP_NUMNE:
8053 wC = wA != wB;
8054 goto intresult;
8057 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8058 switch (e->opcode) {
8059 #ifndef JIM_MATH_FUNCTIONS
8060 case JIM_EXPROP_POW:
8061 case JIM_EXPROP_FUNC_POW:
8062 case JIM_EXPROP_FUNC_ATAN2:
8063 case JIM_EXPROP_FUNC_HYPOT:
8064 case JIM_EXPROP_FUNC_FMOD:
8065 Jim_SetResultString(interp, "unsupported", -1);
8066 rc = JIM_ERR;
8067 goto done;
8068 #else
8069 case JIM_EXPROP_POW:
8070 case JIM_EXPROP_FUNC_POW:
8071 dC = pow(dA, dB);
8072 goto doubleresult;
8073 case JIM_EXPROP_FUNC_ATAN2:
8074 dC = atan2(dA, dB);
8075 goto doubleresult;
8076 case JIM_EXPROP_FUNC_HYPOT:
8077 dC = hypot(dA, dB);
8078 goto doubleresult;
8079 case JIM_EXPROP_FUNC_FMOD:
8080 dC = fmod(dA, dB);
8081 goto doubleresult;
8082 #endif
8083 case JIM_EXPROP_ADD:
8084 dC = dA + dB;
8085 goto doubleresult;
8086 case JIM_EXPROP_SUB:
8087 dC = dA - dB;
8088 goto doubleresult;
8089 case JIM_EXPROP_MUL:
8090 dC = dA * dB;
8091 goto doubleresult;
8092 case JIM_EXPROP_DIV:
8093 if (dB == 0) {
8094 #ifdef INFINITY
8095 dC = dA < 0 ? -INFINITY : INFINITY;
8096 #else
8097 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8098 #endif
8100 else {
8101 dC = dA / dB;
8103 goto doubleresult;
8104 case JIM_EXPROP_LT:
8105 wC = dA < dB;
8106 goto intresult;
8107 case JIM_EXPROP_GT:
8108 wC = dA > dB;
8109 goto intresult;
8110 case JIM_EXPROP_LTE:
8111 wC = dA <= dB;
8112 goto intresult;
8113 case JIM_EXPROP_GTE:
8114 wC = dA >= dB;
8115 goto intresult;
8116 case JIM_EXPROP_NUMEQ:
8117 wC = dA == dB;
8118 goto intresult;
8119 case JIM_EXPROP_NUMNE:
8120 wC = dA != dB;
8121 goto intresult;
8124 else {
8125 /* Handle the string case */
8127 /* XXX: Could optimise the eq/ne case by checking lengths */
8128 int i = Jim_StringCompareObj(interp, A, B, 0);
8130 switch (e->opcode) {
8131 case JIM_EXPROP_LT:
8132 wC = i < 0;
8133 goto intresult;
8134 case JIM_EXPROP_GT:
8135 wC = i > 0;
8136 goto intresult;
8137 case JIM_EXPROP_LTE:
8138 wC = i <= 0;
8139 goto intresult;
8140 case JIM_EXPROP_GTE:
8141 wC = i >= 0;
8142 goto intresult;
8143 case JIM_EXPROP_NUMEQ:
8144 wC = i == 0;
8145 goto intresult;
8146 case JIM_EXPROP_NUMNE:
8147 wC = i != 0;
8148 goto intresult;
8151 /* If we get here, it is an error */
8152 rc = JIM_ERR;
8153 done:
8154 Jim_DecrRefCount(interp, A);
8155 Jim_DecrRefCount(interp, B);
8156 return rc;
8157 intresult:
8158 ExprPush(e, Jim_NewIntObj(interp, wC));
8159 goto done;
8160 doubleresult:
8161 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8162 goto done;
8165 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8167 int listlen;
8168 int i;
8170 listlen = Jim_ListLength(interp, listObjPtr);
8171 for (i = 0; i < listlen; i++) {
8172 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8173 return 1;
8176 return 0;
8179 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8181 Jim_Obj *B = ExprPop(e);
8182 Jim_Obj *A = ExprPop(e);
8184 jim_wide wC;
8186 switch (e->opcode) {
8187 case JIM_EXPROP_STREQ:
8188 case JIM_EXPROP_STRNE:
8189 wC = Jim_StringEqObj(A, B);
8190 if (e->opcode == JIM_EXPROP_STRNE) {
8191 wC = !wC;
8193 break;
8194 case JIM_EXPROP_STRIN:
8195 wC = JimSearchList(interp, B, A);
8196 break;
8197 case JIM_EXPROP_STRNI:
8198 wC = !JimSearchList(interp, B, A);
8199 break;
8200 default:
8201 abort();
8203 ExprPush(e, Jim_NewIntObj(interp, wC));
8205 Jim_DecrRefCount(interp, A);
8206 Jim_DecrRefCount(interp, B);
8208 return JIM_OK;
8211 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8213 long l;
8214 double d;
8215 int b;
8217 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8218 return l != 0;
8220 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8221 return d != 0;
8223 if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8224 return b != 0;
8226 return -1;
8229 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8231 Jim_Obj *skip = ExprPop(e);
8232 Jim_Obj *A = ExprPop(e);
8233 int rc = JIM_OK;
8235 switch (ExprBool(interp, A)) {
8236 case 0:
8237 /* false, so skip RHS opcodes with a 0 result */
8238 e->skip = JimWideValue(skip);
8239 ExprPush(e, Jim_NewIntObj(interp, 0));
8240 break;
8242 case 1:
8243 /* true so continue */
8244 break;
8246 case -1:
8247 /* Invalid */
8248 rc = JIM_ERR;
8250 Jim_DecrRefCount(interp, A);
8251 Jim_DecrRefCount(interp, skip);
8253 return rc;
8256 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8258 Jim_Obj *skip = ExprPop(e);
8259 Jim_Obj *A = ExprPop(e);
8260 int rc = JIM_OK;
8262 switch (ExprBool(interp, A)) {
8263 case 0:
8264 /* false, so do nothing */
8265 break;
8267 case 1:
8268 /* true so skip RHS opcodes with a 1 result */
8269 e->skip = JimWideValue(skip);
8270 ExprPush(e, Jim_NewIntObj(interp, 1));
8271 break;
8273 case -1:
8274 /* Invalid */
8275 rc = JIM_ERR;
8276 break;
8278 Jim_DecrRefCount(interp, A);
8279 Jim_DecrRefCount(interp, skip);
8281 return rc;
8284 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8286 Jim_Obj *A = ExprPop(e);
8287 int rc = JIM_OK;
8289 switch (ExprBool(interp, A)) {
8290 case 0:
8291 ExprPush(e, Jim_NewIntObj(interp, 0));
8292 break;
8294 case 1:
8295 ExprPush(e, Jim_NewIntObj(interp, 1));
8296 break;
8298 case -1:
8299 /* Invalid */
8300 rc = JIM_ERR;
8301 break;
8303 Jim_DecrRefCount(interp, A);
8305 return rc;
8308 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8310 Jim_Obj *skip = ExprPop(e);
8311 Jim_Obj *A = ExprPop(e);
8312 int rc = JIM_OK;
8314 /* Repush A */
8315 ExprPush(e, A);
8317 switch (ExprBool(interp, A)) {
8318 case 0:
8319 /* false, skip RHS opcodes */
8320 e->skip = JimWideValue(skip);
8321 /* Push a dummy value */
8322 ExprPush(e, Jim_NewIntObj(interp, 0));
8323 break;
8325 case 1:
8326 /* true so do nothing */
8327 break;
8329 case -1:
8330 /* Invalid */
8331 rc = JIM_ERR;
8332 break;
8334 Jim_DecrRefCount(interp, A);
8335 Jim_DecrRefCount(interp, skip);
8337 return rc;
8340 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8342 Jim_Obj *skip = ExprPop(e);
8343 Jim_Obj *B = ExprPop(e);
8344 Jim_Obj *A = ExprPop(e);
8346 /* No need to check for A as non-boolean */
8347 if (ExprBool(interp, A)) {
8348 /* true, so skip RHS opcodes */
8349 e->skip = JimWideValue(skip);
8350 /* Repush B as the answer */
8351 ExprPush(e, B);
8354 Jim_DecrRefCount(interp, skip);
8355 Jim_DecrRefCount(interp, A);
8356 Jim_DecrRefCount(interp, B);
8357 return JIM_OK;
8360 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8362 return JIM_OK;
8365 enum
8367 LAZY_NONE,
8368 LAZY_OP,
8369 LAZY_LEFT,
8370 LAZY_RIGHT,
8371 RIGHT_ASSOC, /* reuse this field for right associativity too */
8374 /* name - precedence - arity - opcode
8376 * This array *must* be kept in sync with the JIM_EXPROP enum.
8378 * The following macros pre-compute the string length at compile time.
8380 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8381 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, LAZY_NONE)
8383 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8384 OPRINIT("*", 110, 2, JimExprOpBin),
8385 OPRINIT("/", 110, 2, JimExprOpBin),
8386 OPRINIT("%", 110, 2, JimExprOpIntBin),
8388 OPRINIT("-", 100, 2, JimExprOpBin),
8389 OPRINIT("+", 100, 2, JimExprOpBin),
8391 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8392 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8394 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8395 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8397 OPRINIT("<", 80, 2, JimExprOpBin),
8398 OPRINIT(">", 80, 2, JimExprOpBin),
8399 OPRINIT("<=", 80, 2, JimExprOpBin),
8400 OPRINIT(">=", 80, 2, JimExprOpBin),
8402 OPRINIT("==", 70, 2, JimExprOpBin),
8403 OPRINIT("!=", 70, 2, JimExprOpBin),
8405 OPRINIT("&", 50, 2, JimExprOpIntBin),
8406 OPRINIT("^", 49, 2, JimExprOpIntBin),
8407 OPRINIT("|", 48, 2, JimExprOpIntBin),
8409 OPRINIT_ATTR("&&", 10, 2, NULL, LAZY_OP),
8410 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8411 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8413 OPRINIT_ATTR("||", 9, 2, NULL, LAZY_OP),
8414 OPRINIT_ATTR(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8415 OPRINIT_ATTR(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8417 OPRINIT_ATTR("?", 5, 2, JimExprOpNull, LAZY_OP),
8418 OPRINIT_ATTR(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8419 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8421 OPRINIT_ATTR(":", 5, 2, JimExprOpNull, LAZY_OP),
8422 OPRINIT_ATTR(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8423 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8425 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8426 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, RIGHT_ASSOC),
8428 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8429 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8431 OPRINIT("in", 55, 2, JimExprOpStrBin),
8432 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8434 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8435 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8436 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8437 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8441 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8442 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8443 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8444 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8445 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8446 OPRINIT("rand", 200, 0, JimExprOpNone),
8447 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8449 #ifdef JIM_MATH_FUNCTIONS
8450 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8451 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8452 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8453 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8454 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8455 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8456 OPRINIT("atan2", 200, 2, JimExprOpBin),
8457 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8458 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8459 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8460 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8461 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8462 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8463 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8464 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8465 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8466 OPRINIT("pow", 200, 2, JimExprOpBin),
8467 OPRINIT("hypot", 200, 2, JimExprOpBin),
8468 OPRINIT("fmod", 200, 2, JimExprOpBin),
8469 #endif
8471 #undef OPRINIT
8472 #undef OPRINIT_LAZY
8474 #define JIM_EXPR_OPERATORS_NUM \
8475 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8477 static int JimParseExpression(struct JimParserCtx *pc)
8479 /* Discard spaces and quoted newline */
8480 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8481 if (*pc->p == '\n') {
8482 pc->linenr++;
8484 pc->p++;
8485 pc->len--;
8488 /* Common case */
8489 pc->tline = pc->linenr;
8490 pc->tstart = pc->p;
8492 if (pc->len == 0) {
8493 pc->tend = pc->p;
8494 pc->tt = JIM_TT_EOL;
8495 pc->eof = 1;
8496 return JIM_OK;
8498 switch (*(pc->p)) {
8499 case '(':
8500 pc->tt = JIM_TT_SUBEXPR_START;
8501 goto singlechar;
8502 case ')':
8503 pc->tt = JIM_TT_SUBEXPR_END;
8504 goto singlechar;
8505 case ',':
8506 pc->tt = JIM_TT_SUBEXPR_COMMA;
8507 singlechar:
8508 pc->tend = pc->p;
8509 pc->p++;
8510 pc->len--;
8511 break;
8512 case '[':
8513 return JimParseCmd(pc);
8514 case '$':
8515 if (JimParseVar(pc) == JIM_ERR)
8516 return JimParseExprOperator(pc);
8517 else {
8518 /* Don't allow expr sugar in expressions */
8519 if (pc->tt == JIM_TT_EXPRSUGAR) {
8520 return JIM_ERR;
8522 return JIM_OK;
8524 break;
8525 case '0':
8526 case '1':
8527 case '2':
8528 case '3':
8529 case '4':
8530 case '5':
8531 case '6':
8532 case '7':
8533 case '8':
8534 case '9':
8535 case '.':
8536 return JimParseExprNumber(pc);
8537 case '"':
8538 return JimParseQuote(pc);
8539 case '{':
8540 return JimParseBrace(pc);
8542 case 'N':
8543 case 'I':
8544 case 'n':
8545 case 'i':
8546 if (JimParseExprIrrational(pc) == JIM_ERR)
8547 if (JimParseExprBoolean(pc) == JIM_ERR)
8548 return JimParseExprOperator(pc);
8549 break;
8550 case 't':
8551 case 'f':
8552 case 'o':
8553 case 'y':
8554 if (JimParseExprBoolean(pc) == JIM_ERR)
8555 return JimParseExprOperator(pc);
8556 break;
8557 default:
8558 return JimParseExprOperator(pc);
8559 break;
8561 return JIM_OK;
8564 static int JimParseExprNumber(struct JimParserCtx *pc)
8566 char *end;
8568 /* Assume an integer for now */
8569 pc->tt = JIM_TT_EXPR_INT;
8571 jim_strtoull(pc->p, (char **)&pc->p);
8572 /* Tried as an integer, but perhaps it parses as a double */
8573 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8574 /* Some stupid compilers insist they are cleverer that
8575 * we are. Even a (void) cast doesn't prevent this warning!
8577 if (strtod(pc->tstart, &end)) { /* nothing */ }
8578 if (end == pc->tstart)
8579 return JIM_ERR;
8580 if (end > pc->p) {
8581 /* Yes, double captured more chars */
8582 pc->tt = JIM_TT_EXPR_DOUBLE;
8583 pc->p = end;
8586 pc->tend = pc->p - 1;
8587 pc->len -= (pc->p - pc->tstart);
8588 return JIM_OK;
8591 static int JimParseExprIrrational(struct JimParserCtx *pc)
8593 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8594 int i;
8596 for (i = 0; irrationals[i]; i++) {
8597 const char *irr = irrationals[i];
8599 if (strncmp(irr, pc->p, 3) == 0) {
8600 pc->p += 3;
8601 pc->len -= 3;
8602 pc->tend = pc->p - 1;
8603 pc->tt = JIM_TT_EXPR_DOUBLE;
8604 return JIM_OK;
8607 return JIM_ERR;
8610 static int JimParseExprBoolean(struct JimParserCtx *pc)
8612 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8613 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8614 int i;
8616 for (i = 0; booleans[i]; i++) {
8617 const char *boolean = booleans[i];
8618 int length = lengths[i];
8620 if (strncmp(boolean, pc->p, length) == 0) {
8621 pc->p += length;
8622 pc->len -= length;
8623 pc->tend = pc->p - 1;
8624 pc->tt = JIM_TT_EXPR_BOOLEAN;
8625 return JIM_OK;
8628 return JIM_ERR;
8631 static int JimParseExprOperator(struct JimParserCtx *pc)
8633 int i;
8634 int bestIdx = -1, bestLen = 0;
8636 /* Try to get the longest match. */
8637 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8638 const char * const opname = Jim_ExprOperators[i].name;
8639 const int oplen = Jim_ExprOperators[i].namelen;
8641 if (opname == NULL || opname[0] != pc->p[0]) {
8642 continue;
8645 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8646 bestIdx = i + JIM_TT_EXPR_OP;
8647 bestLen = oplen;
8650 if (bestIdx == -1) {
8651 return JIM_ERR;
8654 /* Validate paretheses around function arguments */
8655 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8656 const char *p = pc->p + bestLen;
8657 int len = pc->len - bestLen;
8659 while (len && isspace(UCHAR(*p))) {
8660 len--;
8661 p++;
8663 if (*p != '(') {
8664 return JIM_ERR;
8667 pc->tend = pc->p + bestLen - 1;
8668 pc->p += bestLen;
8669 pc->len -= bestLen;
8671 pc->tt = bestIdx;
8672 return JIM_OK;
8675 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8677 static Jim_ExprOperator dummy_op;
8678 if (opcode < JIM_TT_EXPR_OP) {
8679 return &dummy_op;
8681 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8684 const char *jim_tt_name(int type)
8686 static const char * const tt_names[JIM_TT_EXPR_OP] =
8687 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8688 "DBL", "BOO", "$()" };
8689 if (type < JIM_TT_EXPR_OP) {
8690 return tt_names[type];
8692 else if (type == JIM_EXPROP_UNARYMINUS) {
8693 return "-VE";
8695 else if (type == JIM_EXPROP_UNARYPLUS) {
8696 return "+VE";
8698 else {
8699 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8700 static char buf[20];
8702 if (op->name) {
8703 return op->name;
8705 sprintf(buf, "(%d)", type);
8706 return buf;
8710 /* -----------------------------------------------------------------------------
8711 * Expression Object
8712 * ---------------------------------------------------------------------------*/
8713 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8714 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8715 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8717 static const Jim_ObjType exprObjType = {
8718 "expression",
8719 FreeExprInternalRep,
8720 DupExprInternalRep,
8721 NULL,
8722 JIM_TYPE_REFERENCES,
8725 /* Expr bytecode structure */
8726 typedef struct ExprByteCode
8728 ScriptToken *token; /* Tokens array. */
8729 int len; /* Length as number of tokens. */
8730 int inUse; /* Used for sharing. */
8731 } ExprByteCode;
8733 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8735 int i;
8737 for (i = 0; i < expr->len; i++) {
8738 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8740 Jim_Free(expr->token);
8741 Jim_Free(expr);
8744 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8746 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8748 if (expr) {
8749 if (--expr->inUse != 0) {
8750 return;
8753 ExprFreeByteCode(interp, expr);
8757 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8759 JIM_NOTUSED(interp);
8760 JIM_NOTUSED(srcPtr);
8762 /* Just returns an simple string. */
8763 dupPtr->typePtr = NULL;
8766 /* Check if an expr program looks correct
8767 * Sets an error result on invalid
8769 static int ExprCheckCorrectness(Jim_Interp *interp, Jim_Obj *exprObjPtr, ExprByteCode * expr)
8771 int i;
8772 int stacklen = 0;
8773 int ternary = 0;
8774 int lasttt = JIM_TT_NONE;
8775 const char *errmsg;
8777 /* Try to check if there are stack underflows,
8778 * and make sure at the end of the program there is
8779 * a single result on the stack. */
8780 for (i = 0; i < expr->len; i++) {
8781 ScriptToken *t = &expr->token[i];
8782 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8783 lasttt = t->type;
8785 stacklen -= op->arity;
8787 if (stacklen < 0) {
8788 break;
8790 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8791 ternary++;
8793 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8794 if (--ternary < 0) {
8795 /* got : without preceding ? */
8796 stacklen = 1;
8797 break;
8801 /* All operations and operands add one to the stack */
8802 stacklen++;
8804 if (stacklen == 1 && ternary == 0) {
8805 return JIM_OK;
8808 if (stacklen <= 0) {
8809 /* Too few args */
8810 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8811 errmsg = "too few arguments for math function";
8812 Jim_SetResultString(interp, "too few arguments for math function", -1);
8813 } else {
8814 errmsg = "premature end of expression";
8817 else if (stacklen > 1) {
8818 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8819 errmsg = "too many arguments for math function";
8820 } else {
8821 errmsg = "extra tokens at end of expression";
8824 else {
8825 errmsg = "invalid ternary expression";
8827 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": %s", exprObjPtr, errmsg);
8828 return JIM_ERR;
8831 /* This procedure converts every occurrence of || and && opereators
8832 * in lazy unary versions.
8834 * a b || is converted into:
8836 * a <offset> |L b |R
8838 * a b && is converted into:
8840 * a <offset> &L b &R
8842 * "|L" checks if 'a' is true:
8843 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8844 * the opcode just after |R.
8845 * 2) if it is false does nothing.
8846 * "|R" checks if 'b' is true:
8847 * 1) if it is true pushes 1, otherwise pushes 0.
8849 * "&L" checks if 'a' is true:
8850 * 1) if it is true does nothing.
8851 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8852 * the opcode just after &R
8853 * "&R" checks if 'a' is true:
8854 * if it is true pushes 1, otherwise pushes 0.
8856 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8858 int i;
8860 int leftindex, arity, offset;
8862 /* Search for the end of the first operator */
8863 leftindex = expr->len - 1;
8865 arity = 1;
8866 while (arity) {
8867 ScriptToken *tt = &expr->token[leftindex];
8869 if (tt->type >= JIM_TT_EXPR_OP) {
8870 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8872 arity--;
8873 if (--leftindex < 0) {
8874 return JIM_ERR;
8877 leftindex++;
8879 /* Move them up */
8880 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8881 sizeof(*expr->token) * (expr->len - leftindex));
8882 expr->len += 2;
8883 offset = (expr->len - leftindex) - 1;
8885 /* Now we rely on the fact that the left and right version have opcodes
8886 * 1 and 2 after the main opcode respectively
8888 expr->token[leftindex + 1].type = t->type + 1;
8889 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8891 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8892 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8894 /* Now add the 'R' operator */
8895 expr->token[expr->len].objPtr = interp->emptyObj;
8896 expr->token[expr->len].type = t->type + 2;
8897 expr->len++;
8899 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8900 for (i = leftindex - 1; i > 0; i--) {
8901 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8902 if (op->lazy == LAZY_LEFT) {
8903 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8904 JimWideValue(expr->token[i - 1].objPtr) += 2;
8908 return JIM_OK;
8911 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8913 struct ScriptToken *token = &expr->token[expr->len];
8914 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8916 if (op->lazy == LAZY_OP) {
8917 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8918 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8919 return JIM_ERR;
8922 else {
8923 token->objPtr = interp->emptyObj;
8924 token->type = t->type;
8925 expr->len++;
8927 return JIM_OK;
8931 * Returns the index of the COLON_LEFT to the left of 'right_index'
8932 * taking into account nesting.
8934 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8936 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8938 int ternary_count = 1;
8940 right_index--;
8942 while (right_index > 1) {
8943 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8944 ternary_count--;
8946 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8947 ternary_count++;
8949 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8950 return right_index;
8952 right_index--;
8955 /*notreached*/
8956 return -1;
8960 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8962 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8963 * Otherwise returns 0.
8965 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8967 int i = right_index - 1;
8968 int ternary_count = 1;
8970 while (i > 1) {
8971 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8972 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8973 *prev_right_index = i - 2;
8974 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8975 return 1;
8978 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8979 if (ternary_count == 0) {
8980 return 0;
8982 ternary_count++;
8984 i--;
8986 return 0;
8990 * ExprTernaryReorderExpression description
8991 * ========================================
8993 * ?: is right-to-left associative which doesn't work with the stack-based
8994 * expression engine. The fix is to reorder the bytecode.
8996 * The expression:
8998 * expr 1?2:0?3:4
9000 * Has initial bytecode:
9002 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
9003 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
9005 * The fix involves simulating this expression instead:
9007 * expr 1?2:(0?3:4)
9009 * With the following bytecode:
9011 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
9012 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
9014 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
9015 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
9016 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
9017 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
9019 * ExprTernaryReorderExpression works thus as follows :
9020 * - start from the end of the stack
9021 * - while walking towards the beginning of the stack
9022 * if token=JIM_EXPROP_COLON_RIGHT then
9023 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
9024 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
9025 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
9026 * if all found then
9027 * perform the rotation
9028 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
9029 * end if
9030 * end if
9032 * Note: care has to be taken for nested ternary constructs!!!
9034 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
9036 int i;
9038 for (i = expr->len - 1; i > 1; i--) {
9039 int prev_right_index;
9040 int prev_left_index;
9041 int j;
9042 ScriptToken tmp;
9044 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
9045 continue;
9048 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
9049 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
9050 continue;
9054 ** rotate tokens down
9056 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
9057 ** | | |
9058 ** | V V
9059 ** | [...] : ...
9060 ** | | |
9061 ** | V V
9062 ** | [...] : ...
9063 ** | | |
9064 ** | V V
9065 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
9067 tmp = expr->token[prev_right_index];
9068 for (j = prev_right_index; j < i; j++) {
9069 expr->token[j] = expr->token[j + 1];
9071 expr->token[i] = tmp;
9073 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
9075 * This is 'colon left increment' = i - prev_right_index
9077 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
9078 * [prev_left_index-1] : skip_count
9081 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
9083 /* Adjust for i-- in the loop */
9084 i++;
9088 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9090 Jim_Stack stack;
9091 ExprByteCode *expr;
9092 int ok = 1;
9093 int i;
9094 int prevtt = JIM_TT_NONE;
9095 int have_ternary = 0;
9097 /* -1 for EOL */
9098 int count = tokenlist->count - 1;
9100 expr = Jim_Alloc(sizeof(*expr));
9101 expr->inUse = 1;
9102 expr->len = 0;
9104 Jim_InitStack(&stack);
9106 /* Need extra bytecodes for lazy operators.
9107 * Also check for the ternary operator
9109 for (i = 0; i < tokenlist->count; i++) {
9110 ParseToken *t = &tokenlist->list[i];
9111 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
9113 if (op->lazy == LAZY_OP) {
9114 count += 2;
9115 /* Ternary is a lazy op but also needs reordering */
9116 if (t->type == JIM_EXPROP_TERNARY) {
9117 have_ternary = 1;
9122 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
9124 for (i = 0; i < tokenlist->count && ok; i++) {
9125 ParseToken *t = &tokenlist->list[i];
9127 /* Next token will be stored here */
9128 struct ScriptToken *token = &expr->token[expr->len];
9130 if (t->type == JIM_TT_EOL) {
9131 break;
9134 if (TOKEN_IS_EXPR_OP(t->type)) {
9135 const struct Jim_ExprOperator *op;
9136 ParseToken *tt;
9138 /* Convert -/+ to unary minus or unary plus if necessary */
9139 if (prevtt == JIM_TT_NONE || prevtt == JIM_TT_SUBEXPR_START || prevtt == JIM_TT_SUBEXPR_COMMA || prevtt >= JIM_TT_EXPR_OP) {
9140 if (t->type == JIM_EXPROP_SUB) {
9141 t->type = JIM_EXPROP_UNARYMINUS;
9143 else if (t->type == JIM_EXPROP_ADD) {
9144 t->type = JIM_EXPROP_UNARYPLUS;
9148 op = JimExprOperatorInfoByOpcode(t->type);
9150 /* Handle precedence */
9151 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9152 const struct Jim_ExprOperator *tt_op =
9153 JimExprOperatorInfoByOpcode(tt->type);
9155 /* Note that right-to-left associativity of ?: operator is handled later.
9158 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9159 /* Don't reduce if right associative with equal precedence? */
9160 if (tt_op->precedence == op->precedence && tt_op->lazy == RIGHT_ASSOC) {
9161 break;
9163 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9164 ok = 0;
9165 goto err;
9167 Jim_StackPop(&stack);
9169 else {
9170 break;
9173 Jim_StackPush(&stack, t);
9175 else if (t->type == JIM_TT_SUBEXPR_START) {
9176 Jim_StackPush(&stack, t);
9178 else if (t->type == JIM_TT_SUBEXPR_END || t->type == JIM_TT_SUBEXPR_COMMA) {
9179 /* Reduce the expression back to the previous ( or , */
9180 ok = 0;
9181 while (Jim_StackLen(&stack)) {
9182 ParseToken *tt = Jim_StackPop(&stack);
9184 if (tt->type == JIM_TT_SUBEXPR_START || tt->type == JIM_TT_SUBEXPR_COMMA) {
9185 if (t->type == JIM_TT_SUBEXPR_COMMA) {
9186 /* Need to push back the previous START or COMMA in the case of comma */
9187 Jim_StackPush(&stack, tt);
9189 ok = 1;
9190 break;
9192 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9193 goto err;
9196 if (!ok) {
9197 Jim_SetResultFormatted(interp, "Unexpected close parenthesis in expression: \"%#s\"", exprObjPtr);
9198 goto err;
9201 else {
9202 Jim_Obj *objPtr = NULL;
9204 /* This is a simple non-operator term, so create and push the appropriate object */
9205 token->type = t->type;
9207 /* Two consecutive terms without an operator is invalid */
9208 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9209 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", exprObjPtr);
9210 ok = 0;
9211 goto err;
9214 /* Immediately create a double or int object? */
9215 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9216 char *endptr;
9217 if (t->type == JIM_TT_EXPR_INT) {
9218 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9220 else {
9221 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9223 if (endptr != t->token + t->len) {
9224 /* Conversion failed, so just store it as a string */
9225 Jim_FreeNewObj(interp, objPtr);
9226 objPtr = NULL;
9230 if (objPtr) {
9231 token->objPtr = objPtr;
9233 else {
9234 /* Everything else is stored a simple string term */
9235 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
9236 if (t->type == JIM_TT_CMD) {
9237 /* Only commands need source info */
9238 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
9241 expr->len++;
9243 prevtt = t->type;
9246 /* Reduce any remaining subexpr */
9247 while (Jim_StackLen(&stack)) {
9248 ParseToken *tt = Jim_StackPop(&stack);
9250 if (tt->type == JIM_TT_SUBEXPR_START) {
9251 ok = 0;
9252 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9253 goto err;
9255 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9256 ok = 0;
9257 goto err;
9261 if (have_ternary) {
9262 ExprTernaryReorderExpression(interp, expr);
9265 err:
9266 /* Free the stack used for the compilation. */
9267 Jim_FreeStack(&stack);
9269 for (i = 0; i < expr->len; i++) {
9270 Jim_IncrRefCount(expr->token[i].objPtr);
9273 if (!ok) {
9274 ExprFreeByteCode(interp, expr);
9275 return NULL;
9278 return expr;
9282 /* This method takes the string representation of an expression
9283 * and generates a program for the Expr's stack-based VM. */
9284 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9286 int exprTextLen;
9287 const char *exprText;
9288 struct JimParserCtx parser;
9289 struct ExprByteCode *expr;
9290 ParseTokenList tokenlist;
9291 int line;
9292 Jim_Obj *fileNameObj;
9293 int rc = JIM_ERR;
9295 /* Try to get information about filename / line number */
9296 if (objPtr->typePtr == &sourceObjType) {
9297 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9298 line = objPtr->internalRep.sourceValue.lineNumber;
9300 else {
9301 fileNameObj = interp->emptyObj;
9302 line = 1;
9304 Jim_IncrRefCount(fileNameObj);
9306 exprText = Jim_GetString(objPtr, &exprTextLen);
9308 /* Initially tokenise the expression into tokenlist */
9309 ScriptTokenListInit(&tokenlist);
9311 JimParserInit(&parser, exprText, exprTextLen, line);
9312 while (!parser.eof) {
9313 if (JimParseExpression(&parser) != JIM_OK) {
9314 ScriptTokenListFree(&tokenlist);
9315 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9316 expr = NULL;
9317 goto err;
9320 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9321 parser.tline);
9324 #ifdef DEBUG_SHOW_EXPR_TOKENS
9326 int i;
9327 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9328 for (i = 0; i < tokenlist.count; i++) {
9329 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9330 tokenlist.list[i].len, tokenlist.list[i].token);
9333 #endif
9335 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9336 ScriptTokenListFree(&tokenlist);
9337 Jim_DecrRefCount(interp, fileNameObj);
9338 return JIM_ERR;
9341 /* Now create the expression bytecode from the tokenlist */
9342 expr = ExprCreateByteCode(interp, &tokenlist, objPtr, fileNameObj);
9344 /* No longer need the token list */
9345 ScriptTokenListFree(&tokenlist);
9347 if (!expr) {
9348 goto err;
9351 #ifdef DEBUG_SHOW_EXPR
9353 int i;
9355 printf("==== Expr ====\n");
9356 for (i = 0; i < expr->len; i++) {
9357 ScriptToken *t = &expr->token[i];
9359 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9362 #endif
9364 /* Check program correctness. */
9365 if (ExprCheckCorrectness(interp, objPtr, expr) != JIM_OK) {
9366 /* ExprCheckCorrectness set an error in this case */
9367 ExprFreeByteCode(interp, expr);
9368 expr = NULL;
9369 goto err;
9372 rc = JIM_OK;
9374 err:
9375 /* Free the old internal rep and set the new one. */
9376 Jim_DecrRefCount(interp, fileNameObj);
9377 Jim_FreeIntRep(interp, objPtr);
9378 Jim_SetIntRepPtr(objPtr, expr);
9379 objPtr->typePtr = &exprObjType;
9380 return rc;
9383 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9385 if (objPtr->typePtr != &exprObjType) {
9386 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9387 return NULL;
9390 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9393 #ifdef JIM_OPTIMIZATION
9394 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9396 if (token->type == JIM_TT_EXPR_INT)
9397 return token->objPtr;
9398 else if (token->type == JIM_TT_VAR)
9399 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9400 else if (token->type == JIM_TT_DICTSUGAR)
9401 return JimExpandDictSugar(interp, token->objPtr);
9402 else
9403 return NULL;
9405 #endif
9407 /* -----------------------------------------------------------------------------
9408 * Expressions evaluation.
9409 * Jim uses a specialized stack-based virtual machine for expressions,
9410 * that takes advantage of the fact that expr's operators
9411 * can't be redefined.
9413 * Jim_EvalExpression() uses the bytecode compiled by
9414 * SetExprFromAny() method of the "expression" object.
9416 * On success a Tcl Object containing the result of the evaluation
9417 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9418 * returned.
9419 * On error the function returns a retcode != to JIM_OK and set a suitable
9420 * error on the interp.
9421 * ---------------------------------------------------------------------------*/
9422 #define JIM_EE_STATICSTACK_LEN 10
9424 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9426 ExprByteCode *expr;
9427 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9428 int i;
9429 int retcode = JIM_OK;
9430 struct JimExprState e;
9432 expr = JimGetExpression(interp, exprObjPtr);
9433 if (!expr) {
9434 return JIM_ERR; /* error in expression. */
9437 #ifdef JIM_OPTIMIZATION
9438 /* Check for one of the following common expressions used by while/for
9440 * CONST
9441 * $a
9442 * !$a
9443 * $a < CONST, $a < $b
9444 * $a <= CONST, $a <= $b
9445 * $a > CONST, $a > $b
9446 * $a >= CONST, $a >= $b
9447 * $a != CONST, $a != $b
9448 * $a == CONST, $a == $b
9451 Jim_Obj *objPtr;
9453 /* STEP 1 -- Check if there are the conditions to run the specialized
9454 * version of while */
9456 switch (expr->len) {
9457 case 1:
9458 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9459 if (objPtr) {
9460 Jim_IncrRefCount(objPtr);
9461 *exprResultPtrPtr = objPtr;
9462 return JIM_OK;
9464 break;
9466 case 2:
9467 if (expr->token[1].type == JIM_EXPROP_NOT) {
9468 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9470 if (objPtr && JimIsWide(objPtr)) {
9471 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9472 Jim_IncrRefCount(*exprResultPtrPtr);
9473 return JIM_OK;
9476 break;
9478 case 3:
9479 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9480 if (objPtr && JimIsWide(objPtr)) {
9481 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9482 if (objPtr2 && JimIsWide(objPtr2)) {
9483 jim_wide wideValueA = JimWideValue(objPtr);
9484 jim_wide wideValueB = JimWideValue(objPtr2);
9485 int cmpRes;
9486 switch (expr->token[2].type) {
9487 case JIM_EXPROP_LT:
9488 cmpRes = wideValueA < wideValueB;
9489 break;
9490 case JIM_EXPROP_LTE:
9491 cmpRes = wideValueA <= wideValueB;
9492 break;
9493 case JIM_EXPROP_GT:
9494 cmpRes = wideValueA > wideValueB;
9495 break;
9496 case JIM_EXPROP_GTE:
9497 cmpRes = wideValueA >= wideValueB;
9498 break;
9499 case JIM_EXPROP_NUMEQ:
9500 cmpRes = wideValueA == wideValueB;
9501 break;
9502 case JIM_EXPROP_NUMNE:
9503 cmpRes = wideValueA != wideValueB;
9504 break;
9505 default:
9506 goto noopt;
9508 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9509 Jim_IncrRefCount(*exprResultPtrPtr);
9510 return JIM_OK;
9513 break;
9516 noopt:
9517 #endif
9519 /* In order to avoid that the internal repr gets freed due to
9520 * shimmering of the exprObjPtr's object, we make the internal rep
9521 * shared. */
9522 expr->inUse++;
9524 /* The stack-based expr VM itself */
9526 /* Stack allocation. Expr programs have the feature that
9527 * a program of length N can't require a stack longer than
9528 * N. */
9529 if (expr->len > JIM_EE_STATICSTACK_LEN)
9530 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9531 else
9532 e.stack = staticStack;
9534 e.stacklen = 0;
9536 /* Execute every instruction */
9537 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9538 Jim_Obj *objPtr;
9540 switch (expr->token[i].type) {
9541 case JIM_TT_EXPR_INT:
9542 case JIM_TT_EXPR_DOUBLE:
9543 case JIM_TT_EXPR_BOOLEAN:
9544 case JIM_TT_STR:
9545 ExprPush(&e, expr->token[i].objPtr);
9546 break;
9548 case JIM_TT_VAR:
9549 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9550 if (objPtr) {
9551 ExprPush(&e, objPtr);
9553 else {
9554 retcode = JIM_ERR;
9556 break;
9558 case JIM_TT_DICTSUGAR:
9559 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9560 if (objPtr) {
9561 ExprPush(&e, objPtr);
9563 else {
9564 retcode = JIM_ERR;
9566 break;
9568 case JIM_TT_ESC:
9569 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9570 if (retcode == JIM_OK) {
9571 ExprPush(&e, objPtr);
9573 break;
9575 case JIM_TT_CMD:
9576 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9577 if (retcode == JIM_OK) {
9578 ExprPush(&e, Jim_GetResult(interp));
9580 break;
9582 default:{
9583 /* Find and execute the operation */
9584 e.skip = 0;
9585 e.opcode = expr->token[i].type;
9587 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9588 /* Skip some opcodes if necessary */
9589 i += e.skip;
9590 continue;
9595 expr->inUse--;
9597 if (retcode == JIM_OK) {
9598 *exprResultPtrPtr = ExprPop(&e);
9600 else {
9601 for (i = 0; i < e.stacklen; i++) {
9602 Jim_DecrRefCount(interp, e.stack[i]);
9605 if (e.stack != staticStack) {
9606 Jim_Free(e.stack);
9608 return retcode;
9611 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9613 int retcode;
9614 jim_wide wideValue;
9615 double doubleValue;
9616 int booleanValue;
9617 Jim_Obj *exprResultPtr;
9619 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9620 if (retcode != JIM_OK)
9621 return retcode;
9623 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9624 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9625 if (Jim_GetBoolean(interp, exprResultPtr, &booleanValue) != JIM_OK) {
9626 Jim_DecrRefCount(interp, exprResultPtr);
9627 return JIM_ERR;
9628 } else {
9629 Jim_DecrRefCount(interp, exprResultPtr);
9630 *boolPtr = booleanValue;
9631 return JIM_OK;
9634 else {
9635 Jim_DecrRefCount(interp, exprResultPtr);
9636 *boolPtr = doubleValue != 0;
9637 return JIM_OK;
9640 *boolPtr = wideValue != 0;
9642 Jim_DecrRefCount(interp, exprResultPtr);
9643 return JIM_OK;
9646 /* -----------------------------------------------------------------------------
9647 * ScanFormat String Object
9648 * ---------------------------------------------------------------------------*/
9650 /* This Jim_Obj will held a parsed representation of a format string passed to
9651 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9652 * to be parsed in its entirely first and then, if correct, can be used for
9653 * scanning. To avoid endless re-parsing, the parsed representation will be
9654 * stored in an internal representation and re-used for performance reason. */
9656 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9657 * scanformat string. This part will later be used to extract information
9658 * out from the string to be parsed by Jim_ScanString */
9660 typedef struct ScanFmtPartDescr
9662 char *arg; /* Specification of a CHARSET conversion */
9663 char *prefix; /* Prefix to be scanned literally before conversion */
9664 size_t width; /* Maximal width of input to be converted */
9665 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9666 char type; /* Type of conversion (e.g. c, d, f) */
9667 char modifier; /* Modify type (e.g. l - long, h - short */
9668 } ScanFmtPartDescr;
9670 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9671 * string parsed and separated in part descriptions. Furthermore it contains
9672 * the original string representation of the scanformat string to allow for
9673 * fast update of the Jim_Obj's string representation part.
9675 * As an add-on the internal object representation adds some scratch pad area
9676 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9677 * memory for purpose of string scanning.
9679 * The error member points to a static allocated string in case of a mal-
9680 * formed scanformat string or it contains '0' (NULL) in case of a valid
9681 * parse representation.
9683 * The whole memory of the internal representation is allocated as a single
9684 * area of memory that will be internally separated. So freeing and duplicating
9685 * of such an object is cheap */
9687 typedef struct ScanFmtStringObj
9689 jim_wide size; /* Size of internal repr in bytes */
9690 char *stringRep; /* Original string representation */
9691 size_t count; /* Number of ScanFmtPartDescr contained */
9692 size_t convCount; /* Number of conversions that will assign */
9693 size_t maxPos; /* Max position index if XPG3 is used */
9694 const char *error; /* Ptr to error text (NULL if no error */
9695 char *scratch; /* Some scratch pad used by Jim_ScanString */
9696 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9697 } ScanFmtStringObj;
9700 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9701 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9702 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9704 static const Jim_ObjType scanFmtStringObjType = {
9705 "scanformatstring",
9706 FreeScanFmtInternalRep,
9707 DupScanFmtInternalRep,
9708 UpdateStringOfScanFmt,
9709 JIM_TYPE_NONE,
9712 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9714 JIM_NOTUSED(interp);
9715 Jim_Free((char *)objPtr->internalRep.ptr);
9716 objPtr->internalRep.ptr = 0;
9719 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9721 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9722 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9724 JIM_NOTUSED(interp);
9725 memcpy(newVec, srcPtr->internalRep.ptr, size);
9726 dupPtr->internalRep.ptr = newVec;
9727 dupPtr->typePtr = &scanFmtStringObjType;
9730 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9732 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9735 /* SetScanFmtFromAny will parse a given string and create the internal
9736 * representation of the format specification. In case of an error
9737 * the error data member of the internal representation will be set
9738 * to an descriptive error text and the function will be left with
9739 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9740 * specification */
9742 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9744 ScanFmtStringObj *fmtObj;
9745 char *buffer;
9746 int maxCount, i, approxSize, lastPos = -1;
9747 const char *fmt = objPtr->bytes;
9748 int maxFmtLen = objPtr->length;
9749 const char *fmtEnd = fmt + maxFmtLen;
9750 int curr;
9752 Jim_FreeIntRep(interp, objPtr);
9753 /* Count how many conversions could take place maximally */
9754 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9755 if (fmt[i] == '%')
9756 ++maxCount;
9757 /* Calculate an approximation of the memory necessary */
9758 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9759 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9760 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9761 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9762 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9763 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9764 +1; /* safety byte */
9765 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9766 memset(fmtObj, 0, approxSize);
9767 fmtObj->size = approxSize;
9768 fmtObj->maxPos = 0;
9769 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9770 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9771 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9772 buffer = fmtObj->stringRep + maxFmtLen + 1;
9773 objPtr->internalRep.ptr = fmtObj;
9774 objPtr->typePtr = &scanFmtStringObjType;
9775 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9776 int width = 0, skip;
9777 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9779 fmtObj->count++;
9780 descr->width = 0; /* Assume width unspecified */
9781 /* Overread and store any "literal" prefix */
9782 if (*fmt != '%' || fmt[1] == '%') {
9783 descr->type = 0;
9784 descr->prefix = &buffer[i];
9785 for (; fmt < fmtEnd; ++fmt) {
9786 if (*fmt == '%') {
9787 if (fmt[1] != '%')
9788 break;
9789 ++fmt;
9791 buffer[i++] = *fmt;
9793 buffer[i++] = 0;
9795 /* Skip the conversion introducing '%' sign */
9796 ++fmt;
9797 /* End reached due to non-conversion literal only? */
9798 if (fmt >= fmtEnd)
9799 goto done;
9800 descr->pos = 0; /* Assume "natural" positioning */
9801 if (*fmt == '*') {
9802 descr->pos = -1; /* Okay, conversion will not be assigned */
9803 ++fmt;
9805 else
9806 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9807 /* Check if next token is a number (could be width or pos */
9808 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9809 fmt += skip;
9810 /* Was the number a XPG3 position specifier? */
9811 if (descr->pos != -1 && *fmt == '$') {
9812 int prev;
9814 ++fmt;
9815 descr->pos = width;
9816 width = 0;
9817 /* Look if "natural" postioning and XPG3 one was mixed */
9818 if ((lastPos == 0 && descr->pos > 0)
9819 || (lastPos > 0 && descr->pos == 0)) {
9820 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9821 return JIM_ERR;
9823 /* Look if this position was already used */
9824 for (prev = 0; prev < curr; ++prev) {
9825 if (fmtObj->descr[prev].pos == -1)
9826 continue;
9827 if (fmtObj->descr[prev].pos == descr->pos) {
9828 fmtObj->error =
9829 "variable is assigned by multiple \"%n$\" conversion specifiers";
9830 return JIM_ERR;
9833 /* Try to find a width after the XPG3 specifier */
9834 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9835 descr->width = width;
9836 fmt += skip;
9838 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9839 fmtObj->maxPos = descr->pos;
9841 else {
9842 /* Number was not a XPG3, so it has to be a width */
9843 descr->width = width;
9846 /* If positioning mode was undetermined yet, fix this */
9847 if (lastPos == -1)
9848 lastPos = descr->pos;
9849 /* Handle CHARSET conversion type ... */
9850 if (*fmt == '[') {
9851 int swapped = 1, beg = i, end, j;
9853 descr->type = '[';
9854 descr->arg = &buffer[i];
9855 ++fmt;
9856 if (*fmt == '^')
9857 buffer[i++] = *fmt++;
9858 if (*fmt == ']')
9859 buffer[i++] = *fmt++;
9860 while (*fmt && *fmt != ']')
9861 buffer[i++] = *fmt++;
9862 if (*fmt != ']') {
9863 fmtObj->error = "unmatched [ in format string";
9864 return JIM_ERR;
9866 end = i;
9867 buffer[i++] = 0;
9868 /* In case a range fence was given "backwards", swap it */
9869 while (swapped) {
9870 swapped = 0;
9871 for (j = beg + 1; j < end - 1; ++j) {
9872 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9873 char tmp = buffer[j - 1];
9875 buffer[j - 1] = buffer[j + 1];
9876 buffer[j + 1] = tmp;
9877 swapped = 1;
9882 else {
9883 /* Remember any valid modifier if given */
9884 if (strchr("hlL", *fmt) != 0)
9885 descr->modifier = tolower((int)*fmt++);
9887 descr->type = *fmt;
9888 if (strchr("efgcsndoxui", *fmt) == 0) {
9889 fmtObj->error = "bad scan conversion character";
9890 return JIM_ERR;
9892 else if (*fmt == 'c' && descr->width != 0) {
9893 fmtObj->error = "field width may not be specified in %c " "conversion";
9894 return JIM_ERR;
9896 else if (*fmt == 'u' && descr->modifier == 'l') {
9897 fmtObj->error = "unsigned wide not supported";
9898 return JIM_ERR;
9901 curr++;
9903 done:
9904 return JIM_OK;
9907 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9909 #define FormatGetCnvCount(_fo_) \
9910 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9911 #define FormatGetMaxPos(_fo_) \
9912 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9913 #define FormatGetError(_fo_) \
9914 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9916 /* JimScanAString is used to scan an unspecified string that ends with
9917 * next WS, or a string that is specified via a charset.
9920 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9922 char *buffer = Jim_StrDup(str);
9923 char *p = buffer;
9925 while (*str) {
9926 int c;
9927 int n;
9929 if (!sdescr && isspace(UCHAR(*str)))
9930 break; /* EOS via WS if unspecified */
9932 n = utf8_tounicode(str, &c);
9933 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9934 break;
9935 while (n--)
9936 *p++ = *str++;
9938 *p = 0;
9939 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9942 /* ScanOneEntry will scan one entry out of the string passed as argument.
9943 * It use the sscanf() function for this task. After extracting and
9944 * converting of the value, the count of scanned characters will be
9945 * returned of -1 in case of no conversion tool place and string was
9946 * already scanned thru */
9948 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9949 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9951 const char *tok;
9952 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9953 size_t scanned = 0;
9954 size_t anchor = pos;
9955 int i;
9956 Jim_Obj *tmpObj = NULL;
9958 /* First pessimistically assume, we will not scan anything :-) */
9959 *valObjPtr = 0;
9960 if (descr->prefix) {
9961 /* There was a prefix given before the conversion, skip it and adjust
9962 * the string-to-be-parsed accordingly */
9963 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9964 /* If prefix require, skip WS */
9965 if (isspace(UCHAR(descr->prefix[i])))
9966 while (pos < strLen && isspace(UCHAR(str[pos])))
9967 ++pos;
9968 else if (descr->prefix[i] != str[pos])
9969 break; /* Prefix do not match here, leave the loop */
9970 else
9971 ++pos; /* Prefix matched so far, next round */
9973 if (pos >= strLen) {
9974 return -1; /* All of str consumed: EOF condition */
9976 else if (descr->prefix[i] != 0)
9977 return 0; /* Not whole prefix consumed, no conversion possible */
9979 /* For all but following conversion, skip leading WS */
9980 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9981 while (isspace(UCHAR(str[pos])))
9982 ++pos;
9983 /* Determine how much skipped/scanned so far */
9984 scanned = pos - anchor;
9986 /* %c is a special, simple case. no width */
9987 if (descr->type == 'n') {
9988 /* Return pseudo conversion means: how much scanned so far? */
9989 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9991 else if (pos >= strLen) {
9992 /* Cannot scan anything, as str is totally consumed */
9993 return -1;
9995 else if (descr->type == 'c') {
9996 int c;
9997 scanned += utf8_tounicode(&str[pos], &c);
9998 *valObjPtr = Jim_NewIntObj(interp, c);
9999 return scanned;
10001 else {
10002 /* Processing of conversions follows ... */
10003 if (descr->width > 0) {
10004 /* Do not try to scan as fas as possible but only the given width.
10005 * To ensure this, we copy the part that should be scanned. */
10006 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
10007 size_t tLen = descr->width > sLen ? sLen : descr->width;
10009 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
10010 tok = tmpObj->bytes;
10012 else {
10013 /* As no width was given, simply refer to the original string */
10014 tok = &str[pos];
10016 switch (descr->type) {
10017 case 'd':
10018 case 'o':
10019 case 'x':
10020 case 'u':
10021 case 'i':{
10022 char *endp; /* Position where the number finished */
10023 jim_wide w;
10025 int base = descr->type == 'o' ? 8
10026 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
10028 /* Try to scan a number with the given base */
10029 if (base == 0) {
10030 w = jim_strtoull(tok, &endp);
10032 else {
10033 w = strtoull(tok, &endp, base);
10036 if (endp != tok) {
10037 /* There was some number sucessfully scanned! */
10038 *valObjPtr = Jim_NewIntObj(interp, w);
10040 /* Adjust the number-of-chars scanned so far */
10041 scanned += endp - tok;
10043 else {
10044 /* Nothing was scanned. We have to determine if this
10045 * happened due to e.g. prefix mismatch or input str
10046 * exhausted */
10047 scanned = *tok ? 0 : -1;
10049 break;
10051 case 's':
10052 case '[':{
10053 *valObjPtr = JimScanAString(interp, descr->arg, tok);
10054 scanned += Jim_Length(*valObjPtr);
10055 break;
10057 case 'e':
10058 case 'f':
10059 case 'g':{
10060 char *endp;
10061 double value = strtod(tok, &endp);
10063 if (endp != tok) {
10064 /* There was some number sucessfully scanned! */
10065 *valObjPtr = Jim_NewDoubleObj(interp, value);
10066 /* Adjust the number-of-chars scanned so far */
10067 scanned += endp - tok;
10069 else {
10070 /* Nothing was scanned. We have to determine if this
10071 * happened due to e.g. prefix mismatch or input str
10072 * exhausted */
10073 scanned = *tok ? 0 : -1;
10075 break;
10078 /* If a substring was allocated (due to pre-defined width) do not
10079 * forget to free it */
10080 if (tmpObj) {
10081 Jim_FreeNewObj(interp, tmpObj);
10084 return scanned;
10087 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
10088 * string and returns all converted (and not ignored) values in a list back
10089 * to the caller. If an error occured, a NULL pointer will be returned */
10091 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
10093 size_t i, pos;
10094 int scanned = 1;
10095 const char *str = Jim_String(strObjPtr);
10096 int strLen = Jim_Utf8Length(interp, strObjPtr);
10097 Jim_Obj *resultList = 0;
10098 Jim_Obj **resultVec = 0;
10099 int resultc;
10100 Jim_Obj *emptyStr = 0;
10101 ScanFmtStringObj *fmtObj;
10103 /* This should never happen. The format object should already be of the correct type */
10104 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
10106 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
10107 /* Check if format specification was valid */
10108 if (fmtObj->error != 0) {
10109 if (flags & JIM_ERRMSG)
10110 Jim_SetResultString(interp, fmtObj->error, -1);
10111 return 0;
10113 /* Allocate a new "shared" empty string for all unassigned conversions */
10114 emptyStr = Jim_NewEmptyStringObj(interp);
10115 Jim_IncrRefCount(emptyStr);
10116 /* Create a list and fill it with empty strings up to max specified XPG3 */
10117 resultList = Jim_NewListObj(interp, NULL, 0);
10118 if (fmtObj->maxPos > 0) {
10119 for (i = 0; i < fmtObj->maxPos; ++i)
10120 Jim_ListAppendElement(interp, resultList, emptyStr);
10121 JimListGetElements(interp, resultList, &resultc, &resultVec);
10123 /* Now handle every partial format description */
10124 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
10125 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
10126 Jim_Obj *value = 0;
10128 /* Only last type may be "literal" w/o conversion - skip it! */
10129 if (descr->type == 0)
10130 continue;
10131 /* As long as any conversion could be done, we will proceed */
10132 if (scanned > 0)
10133 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
10134 /* In case our first try results in EOF, we will leave */
10135 if (scanned == -1 && i == 0)
10136 goto eof;
10137 /* Advance next pos-to-be-scanned for the amount scanned already */
10138 pos += scanned;
10140 /* value == 0 means no conversion took place so take empty string */
10141 if (value == 0)
10142 value = Jim_NewEmptyStringObj(interp);
10143 /* If value is a non-assignable one, skip it */
10144 if (descr->pos == -1) {
10145 Jim_FreeNewObj(interp, value);
10147 else if (descr->pos == 0)
10148 /* Otherwise append it to the result list if no XPG3 was given */
10149 Jim_ListAppendElement(interp, resultList, value);
10150 else if (resultVec[descr->pos - 1] == emptyStr) {
10151 /* But due to given XPG3, put the value into the corr. slot */
10152 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
10153 Jim_IncrRefCount(value);
10154 resultVec[descr->pos - 1] = value;
10156 else {
10157 /* Otherwise, the slot was already used - free obj and ERROR */
10158 Jim_FreeNewObj(interp, value);
10159 goto err;
10162 Jim_DecrRefCount(interp, emptyStr);
10163 return resultList;
10164 eof:
10165 Jim_DecrRefCount(interp, emptyStr);
10166 Jim_FreeNewObj(interp, resultList);
10167 return (Jim_Obj *)EOF;
10168 err:
10169 Jim_DecrRefCount(interp, emptyStr);
10170 Jim_FreeNewObj(interp, resultList);
10171 return 0;
10174 /* -----------------------------------------------------------------------------
10175 * Pseudo Random Number Generation
10176 * ---------------------------------------------------------------------------*/
10177 /* Initialize the sbox with the numbers from 0 to 255 */
10178 static void JimPrngInit(Jim_Interp *interp)
10180 #define PRNG_SEED_SIZE 256
10181 int i;
10182 unsigned int *seed;
10183 time_t t = time(NULL);
10185 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10187 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10188 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10189 seed[i] = (rand() ^ t ^ clock());
10191 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10192 Jim_Free(seed);
10195 /* Generates N bytes of random data */
10196 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10198 Jim_PrngState *prng;
10199 unsigned char *destByte = (unsigned char *)dest;
10200 unsigned int si, sj, x;
10202 /* initialization, only needed the first time */
10203 if (interp->prngState == NULL)
10204 JimPrngInit(interp);
10205 prng = interp->prngState;
10206 /* generates 'len' bytes of pseudo-random numbers */
10207 for (x = 0; x < len; x++) {
10208 prng->i = (prng->i + 1) & 0xff;
10209 si = prng->sbox[prng->i];
10210 prng->j = (prng->j + si) & 0xff;
10211 sj = prng->sbox[prng->j];
10212 prng->sbox[prng->i] = sj;
10213 prng->sbox[prng->j] = si;
10214 *destByte++ = prng->sbox[(si + sj) & 0xff];
10218 /* Re-seed the generator with user-provided bytes */
10219 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10221 int i;
10222 Jim_PrngState *prng;
10224 /* initialization, only needed the first time */
10225 if (interp->prngState == NULL)
10226 JimPrngInit(interp);
10227 prng = interp->prngState;
10229 /* Set the sbox[i] with i */
10230 for (i = 0; i < 256; i++)
10231 prng->sbox[i] = i;
10232 /* Now use the seed to perform a random permutation of the sbox */
10233 for (i = 0; i < seedLen; i++) {
10234 unsigned char t;
10236 t = prng->sbox[i & 0xFF];
10237 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10238 prng->sbox[seed[i]] = t;
10240 prng->i = prng->j = 0;
10242 /* discard at least the first 256 bytes of stream.
10243 * borrow the seed buffer for this
10245 for (i = 0; i < 256; i += seedLen) {
10246 JimRandomBytes(interp, seed, seedLen);
10250 /* [incr] */
10251 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10253 jim_wide wideValue, increment = 1;
10254 Jim_Obj *intObjPtr;
10256 if (argc != 2 && argc != 3) {
10257 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10258 return JIM_ERR;
10260 if (argc == 3) {
10261 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10262 return JIM_ERR;
10264 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10265 if (!intObjPtr) {
10266 /* Set missing variable to 0 */
10267 wideValue = 0;
10269 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10270 return JIM_ERR;
10272 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10273 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10274 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10275 Jim_FreeNewObj(interp, intObjPtr);
10276 return JIM_ERR;
10279 else {
10280 /* Can do it the quick way */
10281 Jim_InvalidateStringRep(intObjPtr);
10282 JimWideValue(intObjPtr) = wideValue + increment;
10284 /* The following step is required in order to invalidate the
10285 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10286 if (argv[1]->typePtr != &variableObjType) {
10287 /* Note that this can't fail since GetVariable already succeeded */
10288 Jim_SetVariable(interp, argv[1], intObjPtr);
10291 Jim_SetResult(interp, intObjPtr);
10292 return JIM_OK;
10296 /* -----------------------------------------------------------------------------
10297 * Eval
10298 * ---------------------------------------------------------------------------*/
10299 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10300 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10302 /* Handle calls to the [unknown] command */
10303 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10305 int retcode;
10307 /* If JimUnknown() is recursively called too many times...
10308 * done here
10310 if (interp->unknown_called > 50) {
10311 return JIM_ERR;
10314 /* The object interp->unknown just contains
10315 * the "unknown" string, it is used in order to
10316 * avoid to lookup the unknown command every time
10317 * but instead to cache the result. */
10319 /* If the [unknown] command does not exist ... */
10320 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10321 return JIM_ERR;
10323 interp->unknown_called++;
10324 /* XXX: Are we losing fileNameObj and linenr? */
10325 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10326 interp->unknown_called--;
10328 return retcode;
10331 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10333 int retcode;
10334 Jim_Cmd *cmdPtr;
10336 #if 0
10337 printf("invoke");
10338 int j;
10339 for (j = 0; j < objc; j++) {
10340 printf(" '%s'", Jim_String(objv[j]));
10342 printf("\n");
10343 #endif
10345 if (interp->framePtr->tailcallCmd) {
10346 /* Special tailcall command was pre-resolved */
10347 cmdPtr = interp->framePtr->tailcallCmd;
10348 interp->framePtr->tailcallCmd = NULL;
10350 else {
10351 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10352 if (cmdPtr == NULL) {
10353 return JimUnknown(interp, objc, objv);
10355 JimIncrCmdRefCount(cmdPtr);
10358 if (interp->evalDepth == interp->maxEvalDepth) {
10359 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10360 retcode = JIM_ERR;
10361 goto out;
10363 interp->evalDepth++;
10365 /* Call it -- Make sure result is an empty object. */
10366 Jim_SetEmptyResult(interp);
10367 if (cmdPtr->isproc) {
10368 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10370 else {
10371 interp->cmdPrivData = cmdPtr->u.native.privData;
10372 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10374 interp->evalDepth--;
10376 out:
10377 JimDecrCmdRefCount(interp, cmdPtr);
10379 return retcode;
10382 /* Eval the object vector 'objv' composed of 'objc' elements.
10383 * Every element is used as single argument.
10384 * Jim_EvalObj() will call this function every time its object
10385 * argument is of "list" type, with no string representation.
10387 * This is possible because the string representation of a
10388 * list object generated by the UpdateStringOfList is made
10389 * in a way that ensures that every list element is a different
10390 * command argument. */
10391 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10393 int i, retcode;
10395 /* Incr refcount of arguments. */
10396 for (i = 0; i < objc; i++)
10397 Jim_IncrRefCount(objv[i]);
10399 retcode = JimInvokeCommand(interp, objc, objv);
10401 /* Decr refcount of arguments and return the retcode */
10402 for (i = 0; i < objc; i++)
10403 Jim_DecrRefCount(interp, objv[i]);
10405 return retcode;
10409 * Invokes 'prefix' as a command with the objv array as arguments.
10411 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10413 int ret;
10414 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10416 nargv[0] = prefix;
10417 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10418 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10419 Jim_Free(nargv);
10420 return ret;
10423 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10425 if (!interp->errorFlag) {
10426 /* This is the first error, so save the file/line information and reset the stack */
10427 interp->errorFlag = 1;
10428 Jim_IncrRefCount(script->fileNameObj);
10429 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10430 interp->errorFileNameObj = script->fileNameObj;
10431 interp->errorLine = script->linenr;
10433 JimResetStackTrace(interp);
10434 /* Always add a level where the error first occurs */
10435 interp->addStackTrace++;
10438 /* Now if this is an "interesting" level, add it to the stack trace */
10439 if (interp->addStackTrace > 0) {
10440 /* Add the stack info for the current level */
10442 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10444 /* Note: if we didn't have a filename for this level,
10445 * don't clear the addStackTrace flag
10446 * so we can pick it up at the next level
10448 if (Jim_Length(script->fileNameObj)) {
10449 interp->addStackTrace = 0;
10452 Jim_DecrRefCount(interp, interp->errorProc);
10453 interp->errorProc = interp->emptyObj;
10454 Jim_IncrRefCount(interp->errorProc);
10458 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10460 Jim_Obj *objPtr;
10462 switch (token->type) {
10463 case JIM_TT_STR:
10464 case JIM_TT_ESC:
10465 objPtr = token->objPtr;
10466 break;
10467 case JIM_TT_VAR:
10468 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10469 break;
10470 case JIM_TT_DICTSUGAR:
10471 objPtr = JimExpandDictSugar(interp, token->objPtr);
10472 break;
10473 case JIM_TT_EXPRSUGAR:
10474 objPtr = JimExpandExprSugar(interp, token->objPtr);
10475 break;
10476 case JIM_TT_CMD:
10477 switch (Jim_EvalObj(interp, token->objPtr)) {
10478 case JIM_OK:
10479 case JIM_RETURN:
10480 objPtr = interp->result;
10481 break;
10482 case JIM_BREAK:
10483 /* Stop substituting */
10484 return JIM_BREAK;
10485 case JIM_CONTINUE:
10486 /* just skip this one */
10487 return JIM_CONTINUE;
10488 default:
10489 return JIM_ERR;
10491 break;
10492 default:
10493 JimPanic((1,
10494 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10495 objPtr = NULL;
10496 break;
10498 if (objPtr) {
10499 *objPtrPtr = objPtr;
10500 return JIM_OK;
10502 return JIM_ERR;
10505 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10506 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10507 * The returned object has refcount = 0.
10509 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10511 int totlen = 0, i;
10512 Jim_Obj **intv;
10513 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10514 Jim_Obj *objPtr;
10515 char *s;
10517 if (tokens <= JIM_EVAL_SINTV_LEN)
10518 intv = sintv;
10519 else
10520 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10522 /* Compute every token forming the argument
10523 * in the intv objects vector. */
10524 for (i = 0; i < tokens; i++) {
10525 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10526 case JIM_OK:
10527 case JIM_RETURN:
10528 break;
10529 case JIM_BREAK:
10530 if (flags & JIM_SUBST_FLAG) {
10531 /* Stop here */
10532 tokens = i;
10533 continue;
10535 /* XXX: Should probably set an error about break outside loop */
10536 /* fall through to error */
10537 case JIM_CONTINUE:
10538 if (flags & JIM_SUBST_FLAG) {
10539 intv[i] = NULL;
10540 continue;
10542 /* XXX: Ditto continue outside loop */
10543 /* fall through to error */
10544 default:
10545 while (i--) {
10546 Jim_DecrRefCount(interp, intv[i]);
10548 if (intv != sintv) {
10549 Jim_Free(intv);
10551 return NULL;
10553 Jim_IncrRefCount(intv[i]);
10554 Jim_String(intv[i]);
10555 totlen += intv[i]->length;
10558 /* Fast path return for a single token */
10559 if (tokens == 1 && intv[0] && intv == sintv) {
10560 Jim_DecrRefCount(interp, intv[0]);
10561 return intv[0];
10564 /* Concatenate every token in an unique
10565 * object. */
10566 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10568 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10569 && token[2].type == JIM_TT_VAR) {
10570 /* May be able to do fast interpolated object -> dictSubst */
10571 objPtr->typePtr = &interpolatedObjType;
10572 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10573 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10574 Jim_IncrRefCount(intv[2]);
10576 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10577 /* The first interpolated token is source, so preserve the source info */
10578 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10582 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10583 objPtr->length = totlen;
10584 for (i = 0; i < tokens; i++) {
10585 if (intv[i]) {
10586 memcpy(s, intv[i]->bytes, intv[i]->length);
10587 s += intv[i]->length;
10588 Jim_DecrRefCount(interp, intv[i]);
10591 objPtr->bytes[totlen] = '\0';
10592 /* Free the intv vector if not static. */
10593 if (intv != sintv) {
10594 Jim_Free(intv);
10597 return objPtr;
10601 /* listPtr *must* be a list.
10602 * The contents of the list is evaluated with the first element as the command and
10603 * the remaining elements as the arguments.
10605 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10607 int retcode = JIM_OK;
10609 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10611 if (listPtr->internalRep.listValue.len) {
10612 Jim_IncrRefCount(listPtr);
10613 retcode = JimInvokeCommand(interp,
10614 listPtr->internalRep.listValue.len,
10615 listPtr->internalRep.listValue.ele);
10616 Jim_DecrRefCount(interp, listPtr);
10618 return retcode;
10621 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10623 SetListFromAny(interp, listPtr);
10624 return JimEvalObjList(interp, listPtr);
10627 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10629 int i;
10630 ScriptObj *script;
10631 ScriptToken *token;
10632 int retcode = JIM_OK;
10633 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10634 Jim_Obj *prevScriptObj;
10636 /* If the object is of type "list", with no string rep we can call
10637 * a specialized version of Jim_EvalObj() */
10638 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10639 return JimEvalObjList(interp, scriptObjPtr);
10642 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10643 script = JimGetScript(interp, scriptObjPtr);
10644 if (!JimScriptValid(interp, script)) {
10645 Jim_DecrRefCount(interp, scriptObjPtr);
10646 return JIM_ERR;
10649 /* Reset the interpreter result. This is useful to
10650 * return the empty result in the case of empty program. */
10651 Jim_SetEmptyResult(interp);
10653 token = script->token;
10655 #ifdef JIM_OPTIMIZATION
10656 /* Check for one of the following common scripts used by for, while
10658 * {}
10659 * incr a
10661 if (script->len == 0) {
10662 Jim_DecrRefCount(interp, scriptObjPtr);
10663 return JIM_OK;
10665 if (script->len == 3
10666 && token[1].objPtr->typePtr == &commandObjType
10667 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10668 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10669 && token[2].objPtr->typePtr == &variableObjType) {
10671 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10673 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10674 JimWideValue(objPtr)++;
10675 Jim_InvalidateStringRep(objPtr);
10676 Jim_DecrRefCount(interp, scriptObjPtr);
10677 Jim_SetResult(interp, objPtr);
10678 return JIM_OK;
10681 #endif
10683 /* Now we have to make sure the internal repr will not be
10684 * freed on shimmering.
10686 * Think for example to this:
10688 * set x {llength $x; ... some more code ...}; eval $x
10690 * In order to preserve the internal rep, we increment the
10691 * inUse field of the script internal rep structure. */
10692 script->inUse++;
10694 /* Stash the current script */
10695 prevScriptObj = interp->currentScriptObj;
10696 interp->currentScriptObj = scriptObjPtr;
10698 interp->errorFlag = 0;
10699 argv = sargv;
10701 /* Execute every command sequentially until the end of the script
10702 * or an error occurs.
10704 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10705 int argc;
10706 int j;
10708 /* First token of the line is always JIM_TT_LINE */
10709 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10710 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10712 /* Allocate the arguments vector if required */
10713 if (argc > JIM_EVAL_SARGV_LEN)
10714 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10716 /* Skip the JIM_TT_LINE token */
10717 i++;
10719 /* Populate the arguments objects.
10720 * If an error occurs, retcode will be set and
10721 * 'j' will be set to the number of args expanded
10723 for (j = 0; j < argc; j++) {
10724 long wordtokens = 1;
10725 int expand = 0;
10726 Jim_Obj *wordObjPtr = NULL;
10728 if (token[i].type == JIM_TT_WORD) {
10729 wordtokens = JimWideValue(token[i++].objPtr);
10730 if (wordtokens < 0) {
10731 expand = 1;
10732 wordtokens = -wordtokens;
10736 if (wordtokens == 1) {
10737 /* Fast path if the token does not
10738 * need interpolation */
10740 switch (token[i].type) {
10741 case JIM_TT_ESC:
10742 case JIM_TT_STR:
10743 wordObjPtr = token[i].objPtr;
10744 break;
10745 case JIM_TT_VAR:
10746 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10747 break;
10748 case JIM_TT_EXPRSUGAR:
10749 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10750 break;
10751 case JIM_TT_DICTSUGAR:
10752 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10753 break;
10754 case JIM_TT_CMD:
10755 retcode = Jim_EvalObj(interp, token[i].objPtr);
10756 if (retcode == JIM_OK) {
10757 wordObjPtr = Jim_GetResult(interp);
10759 break;
10760 default:
10761 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10764 else {
10765 /* For interpolation we call a helper
10766 * function to do the work for us. */
10767 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10770 if (!wordObjPtr) {
10771 if (retcode == JIM_OK) {
10772 retcode = JIM_ERR;
10774 break;
10777 Jim_IncrRefCount(wordObjPtr);
10778 i += wordtokens;
10780 if (!expand) {
10781 argv[j] = wordObjPtr;
10783 else {
10784 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10785 int len = Jim_ListLength(interp, wordObjPtr);
10786 int newargc = argc + len - 1;
10787 int k;
10789 if (len > 1) {
10790 if (argv == sargv) {
10791 if (newargc > JIM_EVAL_SARGV_LEN) {
10792 argv = Jim_Alloc(sizeof(*argv) * newargc);
10793 memcpy(argv, sargv, sizeof(*argv) * j);
10796 else {
10797 /* Need to realloc to make room for (len - 1) more entries */
10798 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10802 /* Now copy in the expanded version */
10803 for (k = 0; k < len; k++) {
10804 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10805 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10808 /* The original object reference is no longer needed,
10809 * after the expansion it is no longer present on
10810 * the argument vector, but the single elements are
10811 * in its place. */
10812 Jim_DecrRefCount(interp, wordObjPtr);
10814 /* And update the indexes */
10815 j--;
10816 argc += len - 1;
10820 if (retcode == JIM_OK && argc) {
10821 /* Invoke the command */
10822 retcode = JimInvokeCommand(interp, argc, argv);
10823 /* Check for a signal after each command */
10824 if (Jim_CheckSignal(interp)) {
10825 retcode = JIM_SIGNAL;
10829 /* Finished with the command, so decrement ref counts of each argument */
10830 while (j-- > 0) {
10831 Jim_DecrRefCount(interp, argv[j]);
10834 if (argv != sargv) {
10835 Jim_Free(argv);
10836 argv = sargv;
10840 /* Possibly add to the error stack trace */
10841 if (retcode == JIM_ERR) {
10842 JimAddErrorToStack(interp, script);
10844 /* Propagate the addStackTrace value through 'return -code error' */
10845 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10846 /* No need to add stack trace */
10847 interp->addStackTrace = 0;
10850 /* Restore the current script */
10851 interp->currentScriptObj = prevScriptObj;
10853 /* Note that we don't have to decrement inUse, because the
10854 * following code transfers our use of the reference again to
10855 * the script object. */
10856 Jim_FreeIntRep(interp, scriptObjPtr);
10857 scriptObjPtr->typePtr = &scriptObjType;
10858 Jim_SetIntRepPtr(scriptObjPtr, script);
10859 Jim_DecrRefCount(interp, scriptObjPtr);
10861 return retcode;
10864 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10866 int retcode;
10867 /* If argObjPtr begins with '&', do an automatic upvar */
10868 const char *varname = Jim_String(argNameObj);
10869 if (*varname == '&') {
10870 /* First check that the target variable exists */
10871 Jim_Obj *objPtr;
10872 Jim_CallFrame *savedCallFrame = interp->framePtr;
10874 interp->framePtr = interp->framePtr->parent;
10875 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10876 interp->framePtr = savedCallFrame;
10877 if (!objPtr) {
10878 return JIM_ERR;
10881 /* It exists, so perform the binding. */
10882 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10883 Jim_IncrRefCount(objPtr);
10884 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10885 Jim_DecrRefCount(interp, objPtr);
10887 else {
10888 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10890 return retcode;
10894 * Sets the interp result to be an error message indicating the required proc args.
10896 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10898 /* Create a nice error message, consistent with Tcl 8.5 */
10899 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10900 int i;
10902 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10903 Jim_AppendString(interp, argmsg, " ", 1);
10905 if (i == cmd->u.proc.argsPos) {
10906 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10907 /* Renamed args */
10908 Jim_AppendString(interp, argmsg, "?", 1);
10909 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10910 Jim_AppendString(interp, argmsg, " ...?", -1);
10912 else {
10913 /* We have plain args */
10914 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10917 else {
10918 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10919 Jim_AppendString(interp, argmsg, "?", 1);
10920 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10921 Jim_AppendString(interp, argmsg, "?", 1);
10923 else {
10924 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10925 if (*arg == '&') {
10926 arg++;
10928 Jim_AppendString(interp, argmsg, arg, -1);
10932 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10935 #ifdef jim_ext_namespace
10937 * [namespace eval]
10939 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10941 Jim_CallFrame *callFramePtr;
10942 int retcode;
10944 /* Create a new callframe */
10945 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10946 callFramePtr->argv = &interp->emptyObj;
10947 callFramePtr->argc = 0;
10948 callFramePtr->procArgsObjPtr = NULL;
10949 callFramePtr->procBodyObjPtr = scriptObj;
10950 callFramePtr->staticVars = NULL;
10951 callFramePtr->fileNameObj = interp->emptyObj;
10952 callFramePtr->line = 0;
10953 Jim_IncrRefCount(scriptObj);
10954 interp->framePtr = callFramePtr;
10956 /* Check if there are too nested calls */
10957 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10958 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10959 retcode = JIM_ERR;
10961 else {
10962 /* Eval the body */
10963 retcode = Jim_EvalObj(interp, scriptObj);
10966 /* Destroy the callframe */
10967 interp->framePtr = interp->framePtr->parent;
10968 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10970 return retcode;
10972 #endif
10974 /* Call a procedure implemented in Tcl.
10975 * It's possible to speed-up a lot this function, currently
10976 * the callframes are not cached, but allocated and
10977 * destroied every time. What is expecially costly is
10978 * to create/destroy the local vars hash table every time.
10980 * This can be fixed just implementing callframes caching
10981 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10982 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10984 Jim_CallFrame *callFramePtr;
10985 int i, d, retcode, optargs;
10986 ScriptObj *script;
10988 /* Check arity */
10989 if (argc - 1 < cmd->u.proc.reqArity ||
10990 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10991 JimSetProcWrongArgs(interp, argv[0], cmd);
10992 return JIM_ERR;
10995 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10996 /* Optimise for procedure with no body - useful for optional debugging */
10997 return JIM_OK;
11000 /* Check if there are too nested calls */
11001 if (interp->framePtr->level == interp->maxCallFrameDepth) {
11002 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
11003 return JIM_ERR;
11006 /* Create a new callframe */
11007 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
11008 callFramePtr->argv = argv;
11009 callFramePtr->argc = argc;
11010 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
11011 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
11012 callFramePtr->staticVars = cmd->u.proc.staticVars;
11014 /* Remember where we were called from. */
11015 script = JimGetScript(interp, interp->currentScriptObj);
11016 callFramePtr->fileNameObj = script->fileNameObj;
11017 callFramePtr->line = script->linenr;
11019 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
11020 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
11021 interp->framePtr = callFramePtr;
11023 /* How many optional args are available */
11024 optargs = (argc - 1 - cmd->u.proc.reqArity);
11026 /* Step 'i' along the actual args, and step 'd' along the formal args */
11027 i = 1;
11028 for (d = 0; d < cmd->u.proc.argListLen; d++) {
11029 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
11030 if (d == cmd->u.proc.argsPos) {
11031 /* assign $args */
11032 Jim_Obj *listObjPtr;
11033 int argsLen = 0;
11034 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
11035 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
11037 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
11039 /* It is possible to rename args. */
11040 if (cmd->u.proc.arglist[d].defaultObjPtr) {
11041 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
11043 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
11044 if (retcode != JIM_OK) {
11045 goto badargset;
11048 i += argsLen;
11049 continue;
11052 /* Optional or required? */
11053 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
11054 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
11056 else {
11057 /* Ran out, so use the default */
11058 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
11060 if (retcode != JIM_OK) {
11061 goto badargset;
11065 /* Eval the body */
11066 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
11068 badargset:
11070 /* Free the callframe */
11071 interp->framePtr = interp->framePtr->parent;
11072 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
11074 /* Now chain any tailcalls in the parent frame */
11075 if (interp->framePtr->tailcallObj) {
11076 do {
11077 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
11079 interp->framePtr->tailcallObj = NULL;
11081 if (retcode == JIM_EVAL) {
11082 retcode = Jim_EvalObjList(interp, tailcallObj);
11083 if (retcode == JIM_RETURN) {
11084 /* If the result of the tailcall is 'return', push
11085 * it up to the caller
11087 interp->returnLevel++;
11090 Jim_DecrRefCount(interp, tailcallObj);
11091 } while (interp->framePtr->tailcallObj);
11093 /* If the tailcall chain finished early, may need to manually discard the command */
11094 if (interp->framePtr->tailcallCmd) {
11095 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
11096 interp->framePtr->tailcallCmd = NULL;
11100 /* Handle the JIM_RETURN return code */
11101 if (retcode == JIM_RETURN) {
11102 if (--interp->returnLevel <= 0) {
11103 retcode = interp->returnCode;
11104 interp->returnCode = JIM_OK;
11105 interp->returnLevel = 0;
11108 else if (retcode == JIM_ERR) {
11109 interp->addStackTrace++;
11110 Jim_DecrRefCount(interp, interp->errorProc);
11111 interp->errorProc = argv[0];
11112 Jim_IncrRefCount(interp->errorProc);
11115 return retcode;
11118 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
11120 int retval;
11121 Jim_Obj *scriptObjPtr;
11123 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
11124 Jim_IncrRefCount(scriptObjPtr);
11126 if (filename) {
11127 Jim_Obj *prevScriptObj;
11129 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
11131 prevScriptObj = interp->currentScriptObj;
11132 interp->currentScriptObj = scriptObjPtr;
11134 retval = Jim_EvalObj(interp, scriptObjPtr);
11136 interp->currentScriptObj = prevScriptObj;
11138 else {
11139 retval = Jim_EvalObj(interp, scriptObjPtr);
11141 Jim_DecrRefCount(interp, scriptObjPtr);
11142 return retval;
11145 int Jim_Eval(Jim_Interp *interp, const char *script)
11147 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
11150 /* Execute script in the scope of the global level */
11151 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
11153 int retval;
11154 Jim_CallFrame *savedFramePtr = interp->framePtr;
11156 interp->framePtr = interp->topFramePtr;
11157 retval = Jim_Eval(interp, script);
11158 interp->framePtr = savedFramePtr;
11160 return retval;
11163 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
11165 int retval;
11166 Jim_CallFrame *savedFramePtr = interp->framePtr;
11168 interp->framePtr = interp->topFramePtr;
11169 retval = Jim_EvalFile(interp, filename);
11170 interp->framePtr = savedFramePtr;
11172 return retval;
11175 #include <sys/stat.h>
11177 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11179 FILE *fp;
11180 char *buf;
11181 Jim_Obj *scriptObjPtr;
11182 Jim_Obj *prevScriptObj;
11183 struct stat sb;
11184 int retcode;
11185 int readlen;
11187 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11188 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11189 return JIM_ERR;
11191 if (sb.st_size == 0) {
11192 fclose(fp);
11193 return JIM_OK;
11196 buf = Jim_Alloc(sb.st_size + 1);
11197 readlen = fread(buf, 1, sb.st_size, fp);
11198 if (ferror(fp)) {
11199 fclose(fp);
11200 Jim_Free(buf);
11201 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11202 return JIM_ERR;
11204 fclose(fp);
11205 buf[readlen] = 0;
11207 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11208 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11209 Jim_IncrRefCount(scriptObjPtr);
11211 prevScriptObj = interp->currentScriptObj;
11212 interp->currentScriptObj = scriptObjPtr;
11214 retcode = Jim_EvalObj(interp, scriptObjPtr);
11216 /* Handle the JIM_RETURN return code */
11217 if (retcode == JIM_RETURN) {
11218 if (--interp->returnLevel <= 0) {
11219 retcode = interp->returnCode;
11220 interp->returnCode = JIM_OK;
11221 interp->returnLevel = 0;
11224 if (retcode == JIM_ERR) {
11225 /* EvalFile changes context, so add a stack frame here */
11226 interp->addStackTrace++;
11229 interp->currentScriptObj = prevScriptObj;
11231 Jim_DecrRefCount(interp, scriptObjPtr);
11233 return retcode;
11236 /* -----------------------------------------------------------------------------
11237 * Subst
11238 * ---------------------------------------------------------------------------*/
11239 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11241 pc->tstart = pc->p;
11242 pc->tline = pc->linenr;
11244 if (pc->len == 0) {
11245 pc->tend = pc->p;
11246 pc->tt = JIM_TT_EOL;
11247 pc->eof = 1;
11248 return;
11250 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11251 JimParseCmd(pc);
11252 return;
11254 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11255 if (JimParseVar(pc) == JIM_OK) {
11256 return;
11258 /* Not a var, so treat as a string */
11259 pc->tstart = pc->p;
11260 flags |= JIM_SUBST_NOVAR;
11262 while (pc->len) {
11263 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11264 break;
11266 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11267 break;
11269 if (*pc->p == '\\' && pc->len > 1) {
11270 pc->p++;
11271 pc->len--;
11273 pc->p++;
11274 pc->len--;
11276 pc->tend = pc->p - 1;
11277 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11280 /* The subst object type reuses most of the data structures and functions
11281 * of the script object. Script's data structures are a bit more complex
11282 * for what is needed for [subst]itution tasks, but the reuse helps to
11283 * deal with a single data structure at the cost of some more memory
11284 * usage for substitutions. */
11286 /* This method takes the string representation of an object
11287 * as a Tcl string where to perform [subst]itution, and generates
11288 * the pre-parsed internal representation. */
11289 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11291 int scriptTextLen;
11292 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11293 struct JimParserCtx parser;
11294 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11295 ParseTokenList tokenlist;
11297 /* Initially parse the subst into tokens (in tokenlist) */
11298 ScriptTokenListInit(&tokenlist);
11300 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11301 while (1) {
11302 JimParseSubst(&parser, flags);
11303 if (parser.eof) {
11304 /* Note that subst doesn't need the EOL token */
11305 break;
11307 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11308 parser.tline);
11311 /* Create the "real" subst/script tokens from the initial token list */
11312 script->inUse = 1;
11313 script->substFlags = flags;
11314 script->fileNameObj = interp->emptyObj;
11315 Jim_IncrRefCount(script->fileNameObj);
11316 SubstObjAddTokens(interp, script, &tokenlist);
11318 /* No longer need the token list */
11319 ScriptTokenListFree(&tokenlist);
11321 #ifdef DEBUG_SHOW_SUBST
11323 int i;
11325 printf("==== Subst ====\n");
11326 for (i = 0; i < script->len; i++) {
11327 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11328 Jim_String(script->token[i].objPtr));
11331 #endif
11333 /* Free the old internal rep and set the new one. */
11334 Jim_FreeIntRep(interp, objPtr);
11335 Jim_SetIntRepPtr(objPtr, script);
11336 objPtr->typePtr = &scriptObjType;
11337 return JIM_OK;
11340 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11342 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11343 SetSubstFromAny(interp, objPtr, flags);
11344 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11347 /* Performs commands,variables,blackslashes substitution,
11348 * storing the result object (with refcount 0) into
11349 * resObjPtrPtr. */
11350 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11352 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11354 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11355 /* In order to preserve the internal rep, we increment the
11356 * inUse field of the script internal rep structure. */
11357 script->inUse++;
11359 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11361 script->inUse--;
11362 Jim_DecrRefCount(interp, substObjPtr);
11363 if (*resObjPtrPtr == NULL) {
11364 return JIM_ERR;
11366 return JIM_OK;
11369 /* -----------------------------------------------------------------------------
11370 * Core commands utility functions
11371 * ---------------------------------------------------------------------------*/
11372 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11374 Jim_Obj *objPtr;
11375 Jim_Obj *listObjPtr;
11377 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11379 listObjPtr = Jim_NewListObj(interp, argv, argc);
11381 if (*msg) {
11382 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11384 Jim_IncrRefCount(listObjPtr);
11385 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11386 Jim_DecrRefCount(interp, listObjPtr);
11388 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11392 * May add the key and/or value to the list.
11394 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11395 Jim_HashEntry *he, int type);
11397 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11400 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11401 * invoke the callback to add entries to a list.
11402 * Returns the list.
11404 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11405 JimHashtableIteratorCallbackType *callback, int type)
11407 Jim_HashEntry *he;
11408 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11410 /* Check for the non-pattern case. We can do this much more efficiently. */
11411 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11412 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11413 if (he) {
11414 callback(interp, listObjPtr, he, type);
11417 else {
11418 Jim_HashTableIterator htiter;
11419 JimInitHashTableIterator(ht, &htiter);
11420 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11421 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11422 callback(interp, listObjPtr, he, type);
11426 return listObjPtr;
11429 /* Keep these in order */
11430 #define JIM_CMDLIST_COMMANDS 0
11431 #define JIM_CMDLIST_PROCS 1
11432 #define JIM_CMDLIST_CHANNELS 2
11435 * Adds matching command names (procs, channels) to the list.
11437 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11438 Jim_HashEntry *he, int type)
11440 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11441 Jim_Obj *objPtr;
11443 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11444 /* not a proc */
11445 return;
11448 objPtr = Jim_NewStringObj(interp, he->key, -1);
11449 Jim_IncrRefCount(objPtr);
11451 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11452 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11454 Jim_DecrRefCount(interp, objPtr);
11457 /* type is JIM_CMDLIST_xxx */
11458 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11460 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11463 /* Keep these in order */
11464 #define JIM_VARLIST_GLOBALS 0
11465 #define JIM_VARLIST_LOCALS 1
11466 #define JIM_VARLIST_VARS 2
11468 #define JIM_VARLIST_VALUES 0x1000
11471 * Adds matching variable names to the list.
11473 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11474 Jim_HashEntry *he, int type)
11476 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11478 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11479 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11480 if (type & JIM_VARLIST_VALUES) {
11481 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11486 /* mode is JIM_VARLIST_xxx */
11487 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11489 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11490 /* For [info locals], if we are at top level an emtpy list
11491 * is returned. I don't agree, but we aim at compatibility (SS) */
11492 return interp->emptyObj;
11494 else {
11495 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11496 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11500 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11501 Jim_Obj **objPtrPtr, int info_level_cmd)
11503 Jim_CallFrame *targetCallFrame;
11505 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11506 if (targetCallFrame == NULL) {
11507 return JIM_ERR;
11509 /* No proc call at toplevel callframe */
11510 if (targetCallFrame == interp->topFramePtr) {
11511 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11512 return JIM_ERR;
11514 if (info_level_cmd) {
11515 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11517 else {
11518 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11520 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11521 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11522 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11523 *objPtrPtr = listObj;
11525 return JIM_OK;
11528 /* -----------------------------------------------------------------------------
11529 * Core commands
11530 * ---------------------------------------------------------------------------*/
11532 /* fake [puts] -- not the real puts, just for debugging. */
11533 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11535 if (argc != 2 && argc != 3) {
11536 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11537 return JIM_ERR;
11539 if (argc == 3) {
11540 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11541 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11542 return JIM_ERR;
11544 else {
11545 fputs(Jim_String(argv[2]), stdout);
11548 else {
11549 puts(Jim_String(argv[1]));
11551 return JIM_OK;
11554 /* Helper for [+] and [*] */
11555 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11557 jim_wide wideValue, res;
11558 double doubleValue, doubleRes;
11559 int i;
11561 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11563 for (i = 1; i < argc; i++) {
11564 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11565 goto trydouble;
11566 if (op == JIM_EXPROP_ADD)
11567 res += wideValue;
11568 else
11569 res *= wideValue;
11571 Jim_SetResultInt(interp, res);
11572 return JIM_OK;
11573 trydouble:
11574 doubleRes = (double)res;
11575 for (; i < argc; i++) {
11576 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11577 return JIM_ERR;
11578 if (op == JIM_EXPROP_ADD)
11579 doubleRes += doubleValue;
11580 else
11581 doubleRes *= doubleValue;
11583 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11584 return JIM_OK;
11587 /* Helper for [-] and [/] */
11588 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11590 jim_wide wideValue, res = 0;
11591 double doubleValue, doubleRes = 0;
11592 int i = 2;
11594 if (argc < 2) {
11595 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11596 return JIM_ERR;
11598 else if (argc == 2) {
11599 /* The arity = 2 case is different. For [- x] returns -x,
11600 * while [/ x] returns 1/x. */
11601 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11602 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11603 return JIM_ERR;
11605 else {
11606 if (op == JIM_EXPROP_SUB)
11607 doubleRes = -doubleValue;
11608 else
11609 doubleRes = 1.0 / doubleValue;
11610 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11611 return JIM_OK;
11614 if (op == JIM_EXPROP_SUB) {
11615 res = -wideValue;
11616 Jim_SetResultInt(interp, res);
11618 else {
11619 doubleRes = 1.0 / wideValue;
11620 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11622 return JIM_OK;
11624 else {
11625 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11626 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11627 != JIM_OK) {
11628 return JIM_ERR;
11630 else {
11631 goto trydouble;
11635 for (i = 2; i < argc; i++) {
11636 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11637 doubleRes = (double)res;
11638 goto trydouble;
11640 if (op == JIM_EXPROP_SUB)
11641 res -= wideValue;
11642 else {
11643 if (wideValue == 0) {
11644 Jim_SetResultString(interp, "Division by zero", -1);
11645 return JIM_ERR;
11647 res /= wideValue;
11650 Jim_SetResultInt(interp, res);
11651 return JIM_OK;
11652 trydouble:
11653 for (; i < argc; i++) {
11654 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11655 return JIM_ERR;
11656 if (op == JIM_EXPROP_SUB)
11657 doubleRes -= doubleValue;
11658 else
11659 doubleRes /= doubleValue;
11661 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11662 return JIM_OK;
11666 /* [+] */
11667 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11669 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11672 /* [*] */
11673 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11675 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11678 /* [-] */
11679 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11681 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11684 /* [/] */
11685 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11687 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11690 /* [set] */
11691 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11693 if (argc != 2 && argc != 3) {
11694 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11695 return JIM_ERR;
11697 if (argc == 2) {
11698 Jim_Obj *objPtr;
11700 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11701 if (!objPtr)
11702 return JIM_ERR;
11703 Jim_SetResult(interp, objPtr);
11704 return JIM_OK;
11706 /* argc == 3 case. */
11707 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11708 return JIM_ERR;
11709 Jim_SetResult(interp, argv[2]);
11710 return JIM_OK;
11713 /* [unset]
11715 * unset ?-nocomplain? ?--? ?varName ...?
11717 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11719 int i = 1;
11720 int complain = 1;
11722 while (i < argc) {
11723 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11724 i++;
11725 break;
11727 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11728 complain = 0;
11729 i++;
11730 continue;
11732 break;
11735 while (i < argc) {
11736 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11737 && complain) {
11738 return JIM_ERR;
11740 i++;
11742 return JIM_OK;
11745 /* [while] */
11746 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11748 if (argc != 3) {
11749 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11750 return JIM_ERR;
11753 /* The general purpose implementation of while starts here */
11754 while (1) {
11755 int boolean, retval;
11757 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11758 return retval;
11759 if (!boolean)
11760 break;
11762 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11763 switch (retval) {
11764 case JIM_BREAK:
11765 goto out;
11766 break;
11767 case JIM_CONTINUE:
11768 continue;
11769 break;
11770 default:
11771 return retval;
11775 out:
11776 Jim_SetEmptyResult(interp);
11777 return JIM_OK;
11780 /* [for] */
11781 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11783 int retval;
11784 int boolean = 1;
11785 Jim_Obj *varNamePtr = NULL;
11786 Jim_Obj *stopVarNamePtr = NULL;
11788 if (argc != 5) {
11789 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11790 return JIM_ERR;
11793 /* Do the initialisation */
11794 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11795 return retval;
11798 /* And do the first test now. Better for optimisation
11799 * if we can do next/test at the bottom of the loop
11801 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11803 /* Ready to do the body as follows:
11804 * while (1) {
11805 * body // check retcode
11806 * next // check retcode
11807 * test // check retcode/test bool
11811 #ifdef JIM_OPTIMIZATION
11812 /* Check if the for is on the form:
11813 * for ... {$i < CONST} {incr i}
11814 * for ... {$i < $j} {incr i}
11816 if (retval == JIM_OK && boolean) {
11817 ScriptObj *incrScript;
11818 ExprByteCode *expr;
11819 jim_wide stop, currentVal;
11820 Jim_Obj *objPtr;
11821 int cmpOffset;
11823 /* Do it only if there aren't shared arguments */
11824 expr = JimGetExpression(interp, argv[2]);
11825 incrScript = JimGetScript(interp, argv[3]);
11827 /* Ensure proper lengths to start */
11828 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11829 goto evalstart;
11831 /* Ensure proper token types. */
11832 if (incrScript->token[1].type != JIM_TT_ESC ||
11833 expr->token[0].type != JIM_TT_VAR ||
11834 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11835 goto evalstart;
11838 if (expr->token[2].type == JIM_EXPROP_LT) {
11839 cmpOffset = 0;
11841 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11842 cmpOffset = 1;
11844 else {
11845 goto evalstart;
11848 /* Update command must be incr */
11849 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11850 goto evalstart;
11853 /* incr, expression must be about the same variable */
11854 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11855 goto evalstart;
11858 /* Get the stop condition (must be a variable or integer) */
11859 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11860 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11861 goto evalstart;
11864 else {
11865 stopVarNamePtr = expr->token[1].objPtr;
11866 Jim_IncrRefCount(stopVarNamePtr);
11867 /* Keep the compiler happy */
11868 stop = 0;
11871 /* Initialization */
11872 varNamePtr = expr->token[0].objPtr;
11873 Jim_IncrRefCount(varNamePtr);
11875 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11876 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11877 goto testcond;
11880 /* --- OPTIMIZED FOR --- */
11881 while (retval == JIM_OK) {
11882 /* === Check condition === */
11883 /* Note that currentVal is already set here */
11885 /* Immediate or Variable? get the 'stop' value if the latter. */
11886 if (stopVarNamePtr) {
11887 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11888 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11889 goto testcond;
11893 if (currentVal >= stop + cmpOffset) {
11894 break;
11897 /* Eval body */
11898 retval = Jim_EvalObj(interp, argv[4]);
11899 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11900 retval = JIM_OK;
11902 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11904 /* Increment */
11905 if (objPtr == NULL) {
11906 retval = JIM_ERR;
11907 goto out;
11909 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11910 currentVal = ++JimWideValue(objPtr);
11911 Jim_InvalidateStringRep(objPtr);
11913 else {
11914 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11915 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11916 ++currentVal)) != JIM_OK) {
11917 goto evalnext;
11922 goto out;
11924 evalstart:
11925 #endif
11927 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11928 /* Body */
11929 retval = Jim_EvalObj(interp, argv[4]);
11931 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11932 /* increment */
11933 JIM_IF_OPTIM(evalnext:)
11934 retval = Jim_EvalObj(interp, argv[3]);
11935 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11936 /* test */
11937 JIM_IF_OPTIM(testcond:)
11938 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11942 JIM_IF_OPTIM(out:)
11943 if (stopVarNamePtr) {
11944 Jim_DecrRefCount(interp, stopVarNamePtr);
11946 if (varNamePtr) {
11947 Jim_DecrRefCount(interp, varNamePtr);
11950 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11951 Jim_SetEmptyResult(interp);
11952 return JIM_OK;
11955 return retval;
11958 /* [loop] */
11959 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11961 int retval;
11962 jim_wide i;
11963 jim_wide limit;
11964 jim_wide incr = 1;
11965 Jim_Obj *bodyObjPtr;
11967 if (argc != 5 && argc != 6) {
11968 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11969 return JIM_ERR;
11972 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11973 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11974 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11975 return JIM_ERR;
11977 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11979 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11981 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11982 retval = Jim_EvalObj(interp, bodyObjPtr);
11983 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11984 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11986 retval = JIM_OK;
11988 /* Increment */
11989 i += incr;
11991 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11992 if (argv[1]->typePtr != &variableObjType) {
11993 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11994 return JIM_ERR;
11997 JimWideValue(objPtr) = i;
11998 Jim_InvalidateStringRep(objPtr);
12000 /* The following step is required in order to invalidate the
12001 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
12002 if (argv[1]->typePtr != &variableObjType) {
12003 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
12004 retval = JIM_ERR;
12005 break;
12009 else {
12010 objPtr = Jim_NewIntObj(interp, i);
12011 retval = Jim_SetVariable(interp, argv[1], objPtr);
12012 if (retval != JIM_OK) {
12013 Jim_FreeNewObj(interp, objPtr);
12019 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
12020 Jim_SetEmptyResult(interp);
12021 return JIM_OK;
12023 return retval;
12026 /* List iterators make it easy to iterate over a list.
12027 * At some point iterators will be expanded to support generators.
12029 typedef struct {
12030 Jim_Obj *objPtr;
12031 int idx;
12032 } Jim_ListIter;
12035 * Initialise the iterator at the start of the list.
12037 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
12039 iter->objPtr = objPtr;
12040 iter->idx = 0;
12044 * Returns the next object from the list, or NULL on end-of-list.
12046 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
12048 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
12049 return NULL;
12051 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
12055 * Returns 1 if end-of-list has been reached.
12057 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
12059 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
12062 /* foreach + lmap implementation. */
12063 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
12065 int result = JIM_OK;
12066 int i, numargs;
12067 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
12068 Jim_ListIter *iters;
12069 Jim_Obj *script;
12070 Jim_Obj *resultObj;
12072 if (argc < 4 || argc % 2 != 0) {
12073 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
12074 return JIM_ERR;
12076 script = argv[argc - 1]; /* Last argument is a script */
12077 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
12079 if (numargs == 2) {
12080 iters = twoiters;
12082 else {
12083 iters = Jim_Alloc(numargs * sizeof(*iters));
12085 for (i = 0; i < numargs; i++) {
12086 JimListIterInit(&iters[i], argv[i + 1]);
12087 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
12088 result = JIM_ERR;
12091 if (result != JIM_OK) {
12092 Jim_SetResultString(interp, "foreach varlist is empty", -1);
12093 return result;
12096 if (doMap) {
12097 resultObj = Jim_NewListObj(interp, NULL, 0);
12099 else {
12100 resultObj = interp->emptyObj;
12102 Jim_IncrRefCount(resultObj);
12104 while (1) {
12105 /* Have we expired all lists? */
12106 for (i = 0; i < numargs; i += 2) {
12107 if (!JimListIterDone(interp, &iters[i + 1])) {
12108 break;
12111 if (i == numargs) {
12112 /* All done */
12113 break;
12116 /* For each list */
12117 for (i = 0; i < numargs; i += 2) {
12118 Jim_Obj *varName;
12120 /* foreach var */
12121 JimListIterInit(&iters[i], argv[i + 1]);
12122 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
12123 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
12124 if (!valObj) {
12125 /* Ran out, so store the empty string */
12126 valObj = interp->emptyObj;
12128 /* Avoid shimmering */
12129 Jim_IncrRefCount(valObj);
12130 result = Jim_SetVariable(interp, varName, valObj);
12131 Jim_DecrRefCount(interp, valObj);
12132 if (result != JIM_OK) {
12133 goto err;
12137 switch (result = Jim_EvalObj(interp, script)) {
12138 case JIM_OK:
12139 if (doMap) {
12140 Jim_ListAppendElement(interp, resultObj, interp->result);
12142 break;
12143 case JIM_CONTINUE:
12144 break;
12145 case JIM_BREAK:
12146 goto out;
12147 default:
12148 goto err;
12151 out:
12152 result = JIM_OK;
12153 Jim_SetResult(interp, resultObj);
12154 err:
12155 Jim_DecrRefCount(interp, resultObj);
12156 if (numargs > 2) {
12157 Jim_Free(iters);
12159 return result;
12162 /* [foreach] */
12163 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12165 return JimForeachMapHelper(interp, argc, argv, 0);
12168 /* [lmap] */
12169 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12171 return JimForeachMapHelper(interp, argc, argv, 1);
12174 /* [lassign] */
12175 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12177 int result = JIM_ERR;
12178 int i;
12179 Jim_ListIter iter;
12180 Jim_Obj *resultObj;
12182 if (argc < 2) {
12183 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12184 return JIM_ERR;
12187 JimListIterInit(&iter, argv[1]);
12189 for (i = 2; i < argc; i++) {
12190 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12191 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12192 if (result != JIM_OK) {
12193 return result;
12197 resultObj = Jim_NewListObj(interp, NULL, 0);
12198 while (!JimListIterDone(interp, &iter)) {
12199 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12202 Jim_SetResult(interp, resultObj);
12204 return JIM_OK;
12207 /* [if] */
12208 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12210 int boolean, retval, current = 1, falsebody = 0;
12212 if (argc >= 3) {
12213 while (1) {
12214 /* Far not enough arguments given! */
12215 if (current >= argc)
12216 goto err;
12217 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12218 != JIM_OK)
12219 return retval;
12220 /* There lacks something, isn't it? */
12221 if (current >= argc)
12222 goto err;
12223 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12224 current++;
12225 /* Tsk tsk, no then-clause? */
12226 if (current >= argc)
12227 goto err;
12228 if (boolean)
12229 return Jim_EvalObj(interp, argv[current]);
12230 /* Ok: no else-clause follows */
12231 if (++current >= argc) {
12232 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12233 return JIM_OK;
12235 falsebody = current++;
12236 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12237 /* IIICKS - else-clause isn't last cmd? */
12238 if (current != argc - 1)
12239 goto err;
12240 return Jim_EvalObj(interp, argv[current]);
12242 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12243 /* Ok: elseif follows meaning all the stuff
12244 * again (how boring...) */
12245 continue;
12246 /* OOPS - else-clause is not last cmd? */
12247 else if (falsebody != argc - 1)
12248 goto err;
12249 return Jim_EvalObj(interp, argv[falsebody]);
12251 return JIM_OK;
12253 err:
12254 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12255 return JIM_ERR;
12259 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12260 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12261 Jim_Obj *stringObj, int nocase)
12263 Jim_Obj *parms[4];
12264 int argc = 0;
12265 long eq;
12266 int rc;
12268 parms[argc++] = commandObj;
12269 if (nocase) {
12270 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12272 parms[argc++] = patternObj;
12273 parms[argc++] = stringObj;
12275 rc = Jim_EvalObjVector(interp, argc, parms);
12277 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12278 eq = -rc;
12281 return eq;
12284 enum
12285 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12287 /* [switch] */
12288 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12290 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12291 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12292 Jim_Obj *script = 0;
12294 if (argc < 3) {
12295 wrongnumargs:
12296 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12297 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12298 return JIM_ERR;
12300 for (opt = 1; opt < argc; ++opt) {
12301 const char *option = Jim_String(argv[opt]);
12303 if (*option != '-')
12304 break;
12305 else if (strncmp(option, "--", 2) == 0) {
12306 ++opt;
12307 break;
12309 else if (strncmp(option, "-exact", 2) == 0)
12310 matchOpt = SWITCH_EXACT;
12311 else if (strncmp(option, "-glob", 2) == 0)
12312 matchOpt = SWITCH_GLOB;
12313 else if (strncmp(option, "-regexp", 2) == 0)
12314 matchOpt = SWITCH_RE;
12315 else if (strncmp(option, "-command", 2) == 0) {
12316 matchOpt = SWITCH_CMD;
12317 if ((argc - opt) < 2)
12318 goto wrongnumargs;
12319 command = argv[++opt];
12321 else {
12322 Jim_SetResultFormatted(interp,
12323 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12324 argv[opt]);
12325 return JIM_ERR;
12327 if ((argc - opt) < 2)
12328 goto wrongnumargs;
12330 strObj = argv[opt++];
12331 patCount = argc - opt;
12332 if (patCount == 1) {
12333 Jim_Obj **vector;
12335 JimListGetElements(interp, argv[opt], &patCount, &vector);
12336 caseList = vector;
12338 else
12339 caseList = &argv[opt];
12340 if (patCount == 0 || patCount % 2 != 0)
12341 goto wrongnumargs;
12342 for (i = 0; script == 0 && i < patCount; i += 2) {
12343 Jim_Obj *patObj = caseList[i];
12345 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12346 || i < (patCount - 2)) {
12347 switch (matchOpt) {
12348 case SWITCH_EXACT:
12349 if (Jim_StringEqObj(strObj, patObj))
12350 script = caseList[i + 1];
12351 break;
12352 case SWITCH_GLOB:
12353 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12354 script = caseList[i + 1];
12355 break;
12356 case SWITCH_RE:
12357 command = Jim_NewStringObj(interp, "regexp", -1);
12358 /* Fall thru intentionally */
12359 case SWITCH_CMD:{
12360 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12362 /* After the execution of a command we need to
12363 * make sure to reconvert the object into a list
12364 * again. Only for the single-list style [switch]. */
12365 if (argc - opt == 1) {
12366 Jim_Obj **vector;
12368 JimListGetElements(interp, argv[opt], &patCount, &vector);
12369 caseList = vector;
12371 /* command is here already decref'd */
12372 if (rc < 0) {
12373 return -rc;
12375 if (rc)
12376 script = caseList[i + 1];
12377 break;
12381 else {
12382 script = caseList[i + 1];
12385 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12386 script = caseList[i + 1];
12387 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12388 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12389 return JIM_ERR;
12391 Jim_SetEmptyResult(interp);
12392 if (script) {
12393 return Jim_EvalObj(interp, script);
12395 return JIM_OK;
12398 /* [list] */
12399 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12401 Jim_Obj *listObjPtr;
12403 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12404 Jim_SetResult(interp, listObjPtr);
12405 return JIM_OK;
12408 /* [lindex] */
12409 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12411 Jim_Obj *objPtr, *listObjPtr;
12412 int i;
12413 int idx;
12415 if (argc < 2) {
12416 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12417 return JIM_ERR;
12419 objPtr = argv[1];
12420 Jim_IncrRefCount(objPtr);
12421 for (i = 2; i < argc; i++) {
12422 listObjPtr = objPtr;
12423 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12424 Jim_DecrRefCount(interp, listObjPtr);
12425 return JIM_ERR;
12427 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12428 /* Returns an empty object if the index
12429 * is out of range. */
12430 Jim_DecrRefCount(interp, listObjPtr);
12431 Jim_SetEmptyResult(interp);
12432 return JIM_OK;
12434 Jim_IncrRefCount(objPtr);
12435 Jim_DecrRefCount(interp, listObjPtr);
12437 Jim_SetResult(interp, objPtr);
12438 Jim_DecrRefCount(interp, objPtr);
12439 return JIM_OK;
12442 /* [llength] */
12443 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12445 if (argc != 2) {
12446 Jim_WrongNumArgs(interp, 1, argv, "list");
12447 return JIM_ERR;
12449 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12450 return JIM_OK;
12453 /* [lsearch] */
12454 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12456 static const char * const options[] = {
12457 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12458 NULL
12460 enum
12461 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12462 OPT_COMMAND };
12463 int i;
12464 int opt_bool = 0;
12465 int opt_not = 0;
12466 int opt_nocase = 0;
12467 int opt_all = 0;
12468 int opt_inline = 0;
12469 int opt_match = OPT_EXACT;
12470 int listlen;
12471 int rc = JIM_OK;
12472 Jim_Obj *listObjPtr = NULL;
12473 Jim_Obj *commandObj = NULL;
12475 if (argc < 3) {
12476 wrongargs:
12477 Jim_WrongNumArgs(interp, 1, argv,
12478 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12479 return JIM_ERR;
12482 for (i = 1; i < argc - 2; i++) {
12483 int option;
12485 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12486 return JIM_ERR;
12488 switch (option) {
12489 case OPT_BOOL:
12490 opt_bool = 1;
12491 opt_inline = 0;
12492 break;
12493 case OPT_NOT:
12494 opt_not = 1;
12495 break;
12496 case OPT_NOCASE:
12497 opt_nocase = 1;
12498 break;
12499 case OPT_INLINE:
12500 opt_inline = 1;
12501 opt_bool = 0;
12502 break;
12503 case OPT_ALL:
12504 opt_all = 1;
12505 break;
12506 case OPT_COMMAND:
12507 if (i >= argc - 2) {
12508 goto wrongargs;
12510 commandObj = argv[++i];
12511 /* fallthru */
12512 case OPT_EXACT:
12513 case OPT_GLOB:
12514 case OPT_REGEXP:
12515 opt_match = option;
12516 break;
12520 argv += i;
12522 if (opt_all) {
12523 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12525 if (opt_match == OPT_REGEXP) {
12526 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12528 if (commandObj) {
12529 Jim_IncrRefCount(commandObj);
12532 listlen = Jim_ListLength(interp, argv[0]);
12533 for (i = 0; i < listlen; i++) {
12534 int eq = 0;
12535 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12537 switch (opt_match) {
12538 case OPT_EXACT:
12539 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12540 break;
12542 case OPT_GLOB:
12543 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12544 break;
12546 case OPT_REGEXP:
12547 case OPT_COMMAND:
12548 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12549 if (eq < 0) {
12550 if (listObjPtr) {
12551 Jim_FreeNewObj(interp, listObjPtr);
12553 rc = JIM_ERR;
12554 goto done;
12556 break;
12559 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12560 if (!eq && opt_bool && opt_not && !opt_all) {
12561 continue;
12564 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12565 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12566 Jim_Obj *resultObj;
12568 if (opt_bool) {
12569 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12571 else if (!opt_inline) {
12572 resultObj = Jim_NewIntObj(interp, i);
12574 else {
12575 resultObj = objPtr;
12578 if (opt_all) {
12579 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12581 else {
12582 Jim_SetResult(interp, resultObj);
12583 goto done;
12588 if (opt_all) {
12589 Jim_SetResult(interp, listObjPtr);
12591 else {
12592 /* No match */
12593 if (opt_bool) {
12594 Jim_SetResultBool(interp, opt_not);
12596 else if (!opt_inline) {
12597 Jim_SetResultInt(interp, -1);
12601 done:
12602 if (commandObj) {
12603 Jim_DecrRefCount(interp, commandObj);
12605 return rc;
12608 /* [lappend] */
12609 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12611 Jim_Obj *listObjPtr;
12612 int new_obj = 0;
12613 int i;
12615 if (argc < 2) {
12616 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12617 return JIM_ERR;
12619 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12620 if (!listObjPtr) {
12621 /* Create the list if it does not exist */
12622 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12623 new_obj = 1;
12625 else if (Jim_IsShared(listObjPtr)) {
12626 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12627 new_obj = 1;
12629 for (i = 2; i < argc; i++)
12630 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12631 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12632 if (new_obj)
12633 Jim_FreeNewObj(interp, listObjPtr);
12634 return JIM_ERR;
12636 Jim_SetResult(interp, listObjPtr);
12637 return JIM_OK;
12640 /* [linsert] */
12641 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12643 int idx, len;
12644 Jim_Obj *listPtr;
12646 if (argc < 3) {
12647 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12648 return JIM_ERR;
12650 listPtr = argv[1];
12651 if (Jim_IsShared(listPtr))
12652 listPtr = Jim_DuplicateObj(interp, listPtr);
12653 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12654 goto err;
12655 len = Jim_ListLength(interp, listPtr);
12656 if (idx >= len)
12657 idx = len;
12658 else if (idx < 0)
12659 idx = len + idx + 1;
12660 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12661 Jim_SetResult(interp, listPtr);
12662 return JIM_OK;
12663 err:
12664 if (listPtr != argv[1]) {
12665 Jim_FreeNewObj(interp, listPtr);
12667 return JIM_ERR;
12670 /* [lreplace] */
12671 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12673 int first, last, len, rangeLen;
12674 Jim_Obj *listObj;
12675 Jim_Obj *newListObj;
12677 if (argc < 4) {
12678 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12679 return JIM_ERR;
12681 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12682 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12683 return JIM_ERR;
12686 listObj = argv[1];
12687 len = Jim_ListLength(interp, listObj);
12689 first = JimRelToAbsIndex(len, first);
12690 last = JimRelToAbsIndex(len, last);
12691 JimRelToAbsRange(len, &first, &last, &rangeLen);
12693 /* Now construct a new list which consists of:
12694 * <elements before first> <supplied elements> <elements after last>
12697 /* Check to see if trying to replace past the end of the list */
12698 if (first < len) {
12699 /* OK. Not past the end */
12701 else if (len == 0) {
12702 /* Special for empty list, adjust first to 0 */
12703 first = 0;
12705 else {
12706 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12707 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12708 return JIM_ERR;
12711 /* Add the first set of elements */
12712 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12714 /* Add supplied elements */
12715 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12717 /* Add the remaining elements */
12718 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12720 Jim_SetResult(interp, newListObj);
12721 return JIM_OK;
12724 /* [lset] */
12725 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12727 if (argc < 3) {
12728 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12729 return JIM_ERR;
12731 else if (argc == 3) {
12732 /* With no indexes, simply implements [set] */
12733 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12734 return JIM_ERR;
12735 Jim_SetResult(interp, argv[2]);
12736 return JIM_OK;
12738 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12741 /* [lsort] */
12742 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12744 static const char * const options[] = {
12745 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12747 enum
12748 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12749 Jim_Obj *resObj;
12750 int i;
12751 int retCode;
12753 struct lsort_info info;
12755 if (argc < 2) {
12756 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12757 return JIM_ERR;
12760 info.type = JIM_LSORT_ASCII;
12761 info.order = 1;
12762 info.indexed = 0;
12763 info.unique = 0;
12764 info.command = NULL;
12765 info.interp = interp;
12767 for (i = 1; i < (argc - 1); i++) {
12768 int option;
12770 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12771 != JIM_OK)
12772 return JIM_ERR;
12773 switch (option) {
12774 case OPT_ASCII:
12775 info.type = JIM_LSORT_ASCII;
12776 break;
12777 case OPT_NOCASE:
12778 info.type = JIM_LSORT_NOCASE;
12779 break;
12780 case OPT_INTEGER:
12781 info.type = JIM_LSORT_INTEGER;
12782 break;
12783 case OPT_REAL:
12784 info.type = JIM_LSORT_REAL;
12785 break;
12786 case OPT_INCREASING:
12787 info.order = 1;
12788 break;
12789 case OPT_DECREASING:
12790 info.order = -1;
12791 break;
12792 case OPT_UNIQUE:
12793 info.unique = 1;
12794 break;
12795 case OPT_COMMAND:
12796 if (i >= (argc - 2)) {
12797 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12798 return JIM_ERR;
12800 info.type = JIM_LSORT_COMMAND;
12801 info.command = argv[i + 1];
12802 i++;
12803 break;
12804 case OPT_INDEX:
12805 if (i >= (argc - 2)) {
12806 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12807 return JIM_ERR;
12809 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12810 return JIM_ERR;
12812 info.indexed = 1;
12813 i++;
12814 break;
12817 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12818 retCode = ListSortElements(interp, resObj, &info);
12819 if (retCode == JIM_OK) {
12820 Jim_SetResult(interp, resObj);
12822 else {
12823 Jim_FreeNewObj(interp, resObj);
12825 return retCode;
12828 /* [append] */
12829 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12831 Jim_Obj *stringObjPtr;
12832 int i;
12834 if (argc < 2) {
12835 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12836 return JIM_ERR;
12838 if (argc == 2) {
12839 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12840 if (!stringObjPtr)
12841 return JIM_ERR;
12843 else {
12844 int new_obj = 0;
12845 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12846 if (!stringObjPtr) {
12847 /* Create the string if it doesn't exist */
12848 stringObjPtr = Jim_NewEmptyStringObj(interp);
12849 new_obj = 1;
12851 else if (Jim_IsShared(stringObjPtr)) {
12852 new_obj = 1;
12853 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12855 for (i = 2; i < argc; i++) {
12856 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12858 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12859 if (new_obj) {
12860 Jim_FreeNewObj(interp, stringObjPtr);
12862 return JIM_ERR;
12865 Jim_SetResult(interp, stringObjPtr);
12866 return JIM_OK;
12869 /* [debug] */
12870 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12872 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12873 static const char * const options[] = {
12874 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12875 "exprbc", "show",
12876 NULL
12878 enum
12880 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12881 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12883 int option;
12885 if (argc < 2) {
12886 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12887 return JIM_ERR;
12889 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12890 return Jim_CheckShowCommands(interp, argv[1], options);
12891 if (option == OPT_REFCOUNT) {
12892 if (argc != 3) {
12893 Jim_WrongNumArgs(interp, 2, argv, "object");
12894 return JIM_ERR;
12896 Jim_SetResultInt(interp, argv[2]->refCount);
12897 return JIM_OK;
12899 else if (option == OPT_OBJCOUNT) {
12900 int freeobj = 0, liveobj = 0;
12901 char buf[256];
12902 Jim_Obj *objPtr;
12904 if (argc != 2) {
12905 Jim_WrongNumArgs(interp, 2, argv, "");
12906 return JIM_ERR;
12908 /* Count the number of free objects. */
12909 objPtr = interp->freeList;
12910 while (objPtr) {
12911 freeobj++;
12912 objPtr = objPtr->nextObjPtr;
12914 /* Count the number of live objects. */
12915 objPtr = interp->liveList;
12916 while (objPtr) {
12917 liveobj++;
12918 objPtr = objPtr->nextObjPtr;
12920 /* Set the result string and return. */
12921 sprintf(buf, "free %d used %d", freeobj, liveobj);
12922 Jim_SetResultString(interp, buf, -1);
12923 return JIM_OK;
12925 else if (option == OPT_OBJECTS) {
12926 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12928 /* Count the number of live objects. */
12929 objPtr = interp->liveList;
12930 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12931 while (objPtr) {
12932 char buf[128];
12933 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12935 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12936 sprintf(buf, "%p", objPtr);
12937 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12938 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12939 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12940 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12941 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12942 objPtr = objPtr->nextObjPtr;
12944 Jim_SetResult(interp, listObjPtr);
12945 return JIM_OK;
12947 else if (option == OPT_INVSTR) {
12948 Jim_Obj *objPtr;
12950 if (argc != 3) {
12951 Jim_WrongNumArgs(interp, 2, argv, "object");
12952 return JIM_ERR;
12954 objPtr = argv[2];
12955 if (objPtr->typePtr != NULL)
12956 Jim_InvalidateStringRep(objPtr);
12957 Jim_SetEmptyResult(interp);
12958 return JIM_OK;
12960 else if (option == OPT_SHOW) {
12961 const char *s;
12962 int len, charlen;
12964 if (argc != 3) {
12965 Jim_WrongNumArgs(interp, 2, argv, "object");
12966 return JIM_ERR;
12968 s = Jim_GetString(argv[2], &len);
12969 #ifdef JIM_UTF8
12970 charlen = utf8_strlen(s, len);
12971 #else
12972 charlen = len;
12973 #endif
12974 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12975 printf("chars (%d): <<%s>>\n", charlen, s);
12976 printf("bytes (%d):", len);
12977 while (len--) {
12978 printf(" %02x", (unsigned char)*s++);
12980 printf("\n");
12981 return JIM_OK;
12983 else if (option == OPT_SCRIPTLEN) {
12984 ScriptObj *script;
12986 if (argc != 3) {
12987 Jim_WrongNumArgs(interp, 2, argv, "script");
12988 return JIM_ERR;
12990 script = JimGetScript(interp, argv[2]);
12991 if (script == NULL)
12992 return JIM_ERR;
12993 Jim_SetResultInt(interp, script->len);
12994 return JIM_OK;
12996 else if (option == OPT_EXPRLEN) {
12997 ExprByteCode *expr;
12999 if (argc != 3) {
13000 Jim_WrongNumArgs(interp, 2, argv, "expression");
13001 return JIM_ERR;
13003 expr = JimGetExpression(interp, argv[2]);
13004 if (expr == NULL)
13005 return JIM_ERR;
13006 Jim_SetResultInt(interp, expr->len);
13007 return JIM_OK;
13009 else if (option == OPT_EXPRBC) {
13010 Jim_Obj *objPtr;
13011 ExprByteCode *expr;
13012 int i;
13014 if (argc != 3) {
13015 Jim_WrongNumArgs(interp, 2, argv, "expression");
13016 return JIM_ERR;
13018 expr = JimGetExpression(interp, argv[2]);
13019 if (expr == NULL)
13020 return JIM_ERR;
13021 objPtr = Jim_NewListObj(interp, NULL, 0);
13022 for (i = 0; i < expr->len; i++) {
13023 const char *type;
13024 const Jim_ExprOperator *op;
13025 Jim_Obj *obj = expr->token[i].objPtr;
13027 switch (expr->token[i].type) {
13028 case JIM_TT_EXPR_INT:
13029 type = "int";
13030 break;
13031 case JIM_TT_EXPR_DOUBLE:
13032 type = "double";
13033 break;
13034 case JIM_TT_EXPR_BOOLEAN:
13035 type = "boolean";
13036 break;
13037 case JIM_TT_CMD:
13038 type = "command";
13039 break;
13040 case JIM_TT_VAR:
13041 type = "variable";
13042 break;
13043 case JIM_TT_DICTSUGAR:
13044 type = "dictsugar";
13045 break;
13046 case JIM_TT_EXPRSUGAR:
13047 type = "exprsugar";
13048 break;
13049 case JIM_TT_ESC:
13050 type = "subst";
13051 break;
13052 case JIM_TT_STR:
13053 type = "string";
13054 break;
13055 default:
13056 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
13057 if (op == NULL) {
13058 type = "private";
13060 else {
13061 type = "operator";
13063 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
13064 break;
13066 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
13067 Jim_ListAppendElement(interp, objPtr, obj);
13069 Jim_SetResult(interp, objPtr);
13070 return JIM_OK;
13072 else {
13073 Jim_SetResultString(interp,
13074 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
13075 return JIM_ERR;
13077 /* unreached */
13078 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
13079 #if !defined(JIM_DEBUG_COMMAND)
13080 Jim_SetResultString(interp, "unsupported", -1);
13081 return JIM_ERR;
13082 #endif
13085 /* [eval] */
13086 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13088 int rc;
13090 if (argc < 2) {
13091 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
13092 return JIM_ERR;
13095 if (argc == 2) {
13096 rc = Jim_EvalObj(interp, argv[1]);
13098 else {
13099 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13102 if (rc == JIM_ERR) {
13103 /* eval is "interesting", so add a stack frame here */
13104 interp->addStackTrace++;
13106 return rc;
13109 /* [uplevel] */
13110 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13112 if (argc >= 2) {
13113 int retcode;
13114 Jim_CallFrame *savedCallFrame, *targetCallFrame;
13115 const char *str;
13117 /* Save the old callframe pointer */
13118 savedCallFrame = interp->framePtr;
13120 /* Lookup the target frame pointer */
13121 str = Jim_String(argv[1]);
13122 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
13123 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13124 argc--;
13125 argv++;
13127 else {
13128 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13130 if (targetCallFrame == NULL) {
13131 return JIM_ERR;
13133 if (argc < 2) {
13134 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
13135 return JIM_ERR;
13137 /* Eval the code in the target callframe. */
13138 interp->framePtr = targetCallFrame;
13139 if (argc == 2) {
13140 retcode = Jim_EvalObj(interp, argv[1]);
13142 else {
13143 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13145 interp->framePtr = savedCallFrame;
13146 return retcode;
13148 else {
13149 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
13150 return JIM_ERR;
13154 /* [expr] */
13155 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13157 Jim_Obj *exprResultPtr;
13158 int retcode;
13160 if (argc == 2) {
13161 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
13163 else if (argc > 2) {
13164 Jim_Obj *objPtr;
13166 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13167 Jim_IncrRefCount(objPtr);
13168 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
13169 Jim_DecrRefCount(interp, objPtr);
13171 else {
13172 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13173 return JIM_ERR;
13175 if (retcode != JIM_OK)
13176 return retcode;
13177 Jim_SetResult(interp, exprResultPtr);
13178 Jim_DecrRefCount(interp, exprResultPtr);
13179 return JIM_OK;
13182 /* [break] */
13183 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13185 if (argc != 1) {
13186 Jim_WrongNumArgs(interp, 1, argv, "");
13187 return JIM_ERR;
13189 return JIM_BREAK;
13192 /* [continue] */
13193 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13195 if (argc != 1) {
13196 Jim_WrongNumArgs(interp, 1, argv, "");
13197 return JIM_ERR;
13199 return JIM_CONTINUE;
13202 /* [return] */
13203 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13205 int i;
13206 Jim_Obj *stackTraceObj = NULL;
13207 Jim_Obj *errorCodeObj = NULL;
13208 int returnCode = JIM_OK;
13209 long level = 1;
13211 for (i = 1; i < argc - 1; i += 2) {
13212 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13213 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13214 return JIM_ERR;
13217 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13218 stackTraceObj = argv[i + 1];
13220 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13221 errorCodeObj = argv[i + 1];
13223 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13224 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13225 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13226 return JIM_ERR;
13229 else {
13230 break;
13234 if (i != argc - 1 && i != argc) {
13235 Jim_WrongNumArgs(interp, 1, argv,
13236 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13239 /* If a stack trace is supplied and code is error, set the stack trace */
13240 if (stackTraceObj && returnCode == JIM_ERR) {
13241 JimSetStackTrace(interp, stackTraceObj);
13243 /* If an error code list is supplied, set the global $errorCode */
13244 if (errorCodeObj && returnCode == JIM_ERR) {
13245 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13247 interp->returnCode = returnCode;
13248 interp->returnLevel = level;
13250 if (i == argc - 1) {
13251 Jim_SetResult(interp, argv[i]);
13253 return JIM_RETURN;
13256 /* [tailcall] */
13257 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13259 if (interp->framePtr->level == 0) {
13260 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13261 return JIM_ERR;
13263 else if (argc >= 2) {
13264 /* Need to resolve the tailcall command in the current context */
13265 Jim_CallFrame *cf = interp->framePtr->parent;
13267 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13268 if (cmdPtr == NULL) {
13269 return JIM_ERR;
13272 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13274 /* And stash this pre-resolved command */
13275 JimIncrCmdRefCount(cmdPtr);
13276 cf->tailcallCmd = cmdPtr;
13278 /* And stash the command list */
13279 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13281 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13282 Jim_IncrRefCount(cf->tailcallObj);
13284 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13285 return JIM_EVAL;
13287 return JIM_OK;
13290 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13292 Jim_Obj *cmdList;
13293 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13295 /* prefixListObj is a list to which the args need to be appended */
13296 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13297 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13299 return JimEvalObjList(interp, cmdList);
13302 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13304 Jim_Obj *prefixListObj = privData;
13305 Jim_DecrRefCount(interp, prefixListObj);
13308 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13310 Jim_Obj *prefixListObj;
13311 const char *newname;
13313 if (argc < 3) {
13314 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13315 return JIM_ERR;
13318 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13319 Jim_IncrRefCount(prefixListObj);
13320 newname = Jim_String(argv[1]);
13321 if (newname[0] == ':' && newname[1] == ':') {
13322 while (*++newname == ':') {
13326 Jim_SetResult(interp, argv[1]);
13328 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13331 /* [proc] */
13332 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13334 Jim_Cmd *cmd;
13336 if (argc != 4 && argc != 5) {
13337 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13338 return JIM_ERR;
13341 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13342 return JIM_ERR;
13345 if (argc == 4) {
13346 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13348 else {
13349 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13352 if (cmd) {
13353 /* Add the new command */
13354 Jim_Obj *qualifiedCmdNameObj;
13355 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13357 JimCreateCommand(interp, cmdname, cmd);
13359 /* Calculate and set the namespace for this proc */
13360 JimUpdateProcNamespace(interp, cmd, cmdname);
13362 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13364 /* Unlike Tcl, set the name of the proc as the result */
13365 Jim_SetResult(interp, argv[1]);
13366 return JIM_OK;
13368 return JIM_ERR;
13371 /* [local] */
13372 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13374 int retcode;
13376 if (argc < 2) {
13377 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13378 return JIM_ERR;
13381 /* Evaluate the arguments with 'local' in force */
13382 interp->local++;
13383 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13384 interp->local--;
13387 /* If OK, and the result is a proc, add it to the list of local procs */
13388 if (retcode == 0) {
13389 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13391 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13392 return JIM_ERR;
13394 if (interp->framePtr->localCommands == NULL) {
13395 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13396 Jim_InitStack(interp->framePtr->localCommands);
13398 Jim_IncrRefCount(cmdNameObj);
13399 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13402 return retcode;
13405 /* [upcall] */
13406 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13408 if (argc < 2) {
13409 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13410 return JIM_ERR;
13412 else {
13413 int retcode;
13415 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13416 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13417 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13418 return JIM_ERR;
13420 /* OK. Mark this command as being in an upcall */
13421 cmdPtr->u.proc.upcall++;
13422 JimIncrCmdRefCount(cmdPtr);
13424 /* Invoke the command as normal */
13425 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13427 /* No longer in an upcall */
13428 cmdPtr->u.proc.upcall--;
13429 JimDecrCmdRefCount(interp, cmdPtr);
13431 return retcode;
13435 /* [apply] */
13436 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13438 if (argc < 2) {
13439 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13440 return JIM_ERR;
13442 else {
13443 int ret;
13444 Jim_Cmd *cmd;
13445 Jim_Obj *argListObjPtr;
13446 Jim_Obj *bodyObjPtr;
13447 Jim_Obj *nsObj = NULL;
13448 Jim_Obj **nargv;
13450 int len = Jim_ListLength(interp, argv[1]);
13451 if (len != 2 && len != 3) {
13452 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13453 return JIM_ERR;
13456 if (len == 3) {
13457 #ifdef jim_ext_namespace
13458 /* Need to canonicalise the given namespace. */
13459 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13460 #else
13461 Jim_SetResultString(interp, "namespaces not enabled", -1);
13462 return JIM_ERR;
13463 #endif
13465 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13466 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13468 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13470 if (cmd) {
13471 /* Create a new argv array with a dummy argv[0], for error messages */
13472 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13473 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13474 Jim_IncrRefCount(nargv[0]);
13475 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13476 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13477 Jim_DecrRefCount(interp, nargv[0]);
13478 Jim_Free(nargv);
13480 JimDecrCmdRefCount(interp, cmd);
13481 return ret;
13483 return JIM_ERR;
13488 /* [concat] */
13489 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13491 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13492 return JIM_OK;
13495 /* [upvar] */
13496 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13498 int i;
13499 Jim_CallFrame *targetCallFrame;
13501 /* Lookup the target frame pointer */
13502 if (argc > 3 && (argc % 2 == 0)) {
13503 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13504 argc--;
13505 argv++;
13507 else {
13508 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13510 if (targetCallFrame == NULL) {
13511 return JIM_ERR;
13514 /* Check for arity */
13515 if (argc < 3) {
13516 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13517 return JIM_ERR;
13520 /* Now... for every other/local couple: */
13521 for (i = 1; i < argc; i += 2) {
13522 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13523 return JIM_ERR;
13525 return JIM_OK;
13528 /* [global] */
13529 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13531 int i;
13533 if (argc < 2) {
13534 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13535 return JIM_ERR;
13537 /* Link every var to the toplevel having the same name */
13538 if (interp->framePtr->level == 0)
13539 return JIM_OK; /* global at toplevel... */
13540 for (i = 1; i < argc; i++) {
13541 /* global ::blah does nothing */
13542 const char *name = Jim_String(argv[i]);
13543 if (name[0] != ':' || name[1] != ':') {
13544 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13545 return JIM_ERR;
13548 return JIM_OK;
13551 /* does the [string map] operation. On error NULL is returned,
13552 * otherwise a new string object with the result, having refcount = 0,
13553 * is returned. */
13554 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13555 Jim_Obj *objPtr, int nocase)
13557 int numMaps;
13558 const char *str, *noMatchStart = NULL;
13559 int strLen, i;
13560 Jim_Obj *resultObjPtr;
13562 numMaps = Jim_ListLength(interp, mapListObjPtr);
13563 if (numMaps % 2) {
13564 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13565 return NULL;
13568 str = Jim_String(objPtr);
13569 strLen = Jim_Utf8Length(interp, objPtr);
13571 /* Map it */
13572 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13573 while (strLen) {
13574 for (i = 0; i < numMaps; i += 2) {
13575 Jim_Obj *eachObjPtr;
13576 const char *k;
13577 int kl;
13579 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13580 k = Jim_String(eachObjPtr);
13581 kl = Jim_Utf8Length(interp, eachObjPtr);
13583 if (strLen >= kl && kl) {
13584 int rc;
13585 rc = JimStringCompareLen(str, k, kl, nocase);
13586 if (rc == 0) {
13587 if (noMatchStart) {
13588 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13589 noMatchStart = NULL;
13591 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13592 str += utf8_index(str, kl);
13593 strLen -= kl;
13594 break;
13598 if (i == numMaps) { /* no match */
13599 int c;
13600 if (noMatchStart == NULL)
13601 noMatchStart = str;
13602 str += utf8_tounicode(str, &c);
13603 strLen--;
13606 if (noMatchStart) {
13607 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13609 return resultObjPtr;
13612 /* [string] */
13613 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13615 int len;
13616 int opt_case = 1;
13617 int option;
13618 static const char * const options[] = {
13619 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13620 "map", "repeat", "reverse", "index", "first", "last", "cat",
13621 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13623 enum
13625 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13626 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13627 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13629 static const char * const nocase_options[] = {
13630 "-nocase", NULL
13632 static const char * const nocase_length_options[] = {
13633 "-nocase", "-length", NULL
13636 if (argc < 2) {
13637 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13638 return JIM_ERR;
13640 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13641 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13642 return Jim_CheckShowCommands(interp, argv[1], options);
13644 switch (option) {
13645 case OPT_LENGTH:
13646 case OPT_BYTELENGTH:
13647 if (argc != 3) {
13648 Jim_WrongNumArgs(interp, 2, argv, "string");
13649 return JIM_ERR;
13651 if (option == OPT_LENGTH) {
13652 len = Jim_Utf8Length(interp, argv[2]);
13654 else {
13655 len = Jim_Length(argv[2]);
13657 Jim_SetResultInt(interp, len);
13658 return JIM_OK;
13660 case OPT_CAT:{
13661 Jim_Obj *objPtr;
13662 if (argc == 3) {
13663 /* optimise the one-arg case */
13664 objPtr = argv[2];
13666 else {
13667 int i;
13669 objPtr = Jim_NewStringObj(interp, "", 0);
13671 for (i = 2; i < argc; i++) {
13672 Jim_AppendObj(interp, objPtr, argv[i]);
13675 Jim_SetResult(interp, objPtr);
13676 return JIM_OK;
13679 case OPT_COMPARE:
13680 case OPT_EQUAL:
13682 /* n is the number of remaining option args */
13683 long opt_length = -1;
13684 int n = argc - 4;
13685 int i = 2;
13686 while (n > 0) {
13687 int subopt;
13688 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13689 JIM_ENUM_ABBREV) != JIM_OK) {
13690 badcompareargs:
13691 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13692 return JIM_ERR;
13694 if (subopt == 0) {
13695 /* -nocase */
13696 opt_case = 0;
13697 n--;
13699 else {
13700 /* -length */
13701 if (n < 2) {
13702 goto badcompareargs;
13704 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13705 return JIM_ERR;
13707 n -= 2;
13710 if (n) {
13711 goto badcompareargs;
13713 argv += argc - 2;
13714 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13715 /* Fast version - [string equal], case sensitive, no length */
13716 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13718 else {
13719 if (opt_length >= 0) {
13720 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13722 else {
13723 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13725 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13727 return JIM_OK;
13730 case OPT_MATCH:
13731 if (argc != 4 &&
13732 (argc != 5 ||
13733 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13734 JIM_ENUM_ABBREV) != JIM_OK)) {
13735 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13736 return JIM_ERR;
13738 if (opt_case == 0) {
13739 argv++;
13741 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13742 return JIM_OK;
13744 case OPT_MAP:{
13745 Jim_Obj *objPtr;
13747 if (argc != 4 &&
13748 (argc != 5 ||
13749 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13750 JIM_ENUM_ABBREV) != JIM_OK)) {
13751 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13752 return JIM_ERR;
13755 if (opt_case == 0) {
13756 argv++;
13758 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13759 if (objPtr == NULL) {
13760 return JIM_ERR;
13762 Jim_SetResult(interp, objPtr);
13763 return JIM_OK;
13766 case OPT_RANGE:
13767 case OPT_BYTERANGE:{
13768 Jim_Obj *objPtr;
13770 if (argc != 5) {
13771 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13772 return JIM_ERR;
13774 if (option == OPT_RANGE) {
13775 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13777 else
13779 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13782 if (objPtr == NULL) {
13783 return JIM_ERR;
13785 Jim_SetResult(interp, objPtr);
13786 return JIM_OK;
13789 case OPT_REPLACE:{
13790 Jim_Obj *objPtr;
13792 if (argc != 5 && argc != 6) {
13793 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13794 return JIM_ERR;
13796 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13797 if (objPtr == NULL) {
13798 return JIM_ERR;
13800 Jim_SetResult(interp, objPtr);
13801 return JIM_OK;
13805 case OPT_REPEAT:{
13806 Jim_Obj *objPtr;
13807 jim_wide count;
13809 if (argc != 4) {
13810 Jim_WrongNumArgs(interp, 2, argv, "string count");
13811 return JIM_ERR;
13813 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13814 return JIM_ERR;
13816 objPtr = Jim_NewStringObj(interp, "", 0);
13817 if (count > 0) {
13818 while (count--) {
13819 Jim_AppendObj(interp, objPtr, argv[2]);
13822 Jim_SetResult(interp, objPtr);
13823 return JIM_OK;
13826 case OPT_REVERSE:{
13827 char *buf, *p;
13828 const char *str;
13829 int i;
13831 if (argc != 3) {
13832 Jim_WrongNumArgs(interp, 2, argv, "string");
13833 return JIM_ERR;
13836 str = Jim_GetString(argv[2], &len);
13837 buf = Jim_Alloc(len + 1);
13838 p = buf + len;
13839 *p = 0;
13840 for (i = 0; i < len; ) {
13841 int c;
13842 int l = utf8_tounicode(str, &c);
13843 memcpy(p - l, str, l);
13844 p -= l;
13845 i += l;
13846 str += l;
13848 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13849 return JIM_OK;
13852 case OPT_INDEX:{
13853 int idx;
13854 const char *str;
13856 if (argc != 4) {
13857 Jim_WrongNumArgs(interp, 2, argv, "string index");
13858 return JIM_ERR;
13860 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13861 return JIM_ERR;
13863 str = Jim_String(argv[2]);
13864 len = Jim_Utf8Length(interp, argv[2]);
13865 if (idx != INT_MIN && idx != INT_MAX) {
13866 idx = JimRelToAbsIndex(len, idx);
13868 if (idx < 0 || idx >= len || str == NULL) {
13869 Jim_SetResultString(interp, "", 0);
13871 else if (len == Jim_Length(argv[2])) {
13872 /* ASCII optimisation */
13873 Jim_SetResultString(interp, str + idx, 1);
13875 else {
13876 int c;
13877 int i = utf8_index(str, idx);
13878 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13880 return JIM_OK;
13883 case OPT_FIRST:
13884 case OPT_LAST:{
13885 int idx = 0, l1, l2;
13886 const char *s1, *s2;
13888 if (argc != 4 && argc != 5) {
13889 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13890 return JIM_ERR;
13892 s1 = Jim_String(argv[2]);
13893 s2 = Jim_String(argv[3]);
13894 l1 = Jim_Utf8Length(interp, argv[2]);
13895 l2 = Jim_Utf8Length(interp, argv[3]);
13896 if (argc == 5) {
13897 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13898 return JIM_ERR;
13900 idx = JimRelToAbsIndex(l2, idx);
13902 else if (option == OPT_LAST) {
13903 idx = l2;
13905 if (option == OPT_FIRST) {
13906 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13908 else {
13909 #ifdef JIM_UTF8
13910 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13911 #else
13912 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13913 #endif
13915 return JIM_OK;
13918 case OPT_TRIM:
13919 case OPT_TRIMLEFT:
13920 case OPT_TRIMRIGHT:{
13921 Jim_Obj *trimchars;
13923 if (argc != 3 && argc != 4) {
13924 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13925 return JIM_ERR;
13927 trimchars = (argc == 4 ? argv[3] : NULL);
13928 if (option == OPT_TRIM) {
13929 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13931 else if (option == OPT_TRIMLEFT) {
13932 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13934 else if (option == OPT_TRIMRIGHT) {
13935 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13937 return JIM_OK;
13940 case OPT_TOLOWER:
13941 case OPT_TOUPPER:
13942 case OPT_TOTITLE:
13943 if (argc != 3) {
13944 Jim_WrongNumArgs(interp, 2, argv, "string");
13945 return JIM_ERR;
13947 if (option == OPT_TOLOWER) {
13948 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13950 else if (option == OPT_TOUPPER) {
13951 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13953 else {
13954 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13956 return JIM_OK;
13958 case OPT_IS:
13959 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13960 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13962 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13963 return JIM_ERR;
13965 return JIM_OK;
13968 /* [time] */
13969 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13971 long i, count = 1;
13972 jim_wide start, elapsed;
13973 char buf[60];
13974 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13976 if (argc < 2) {
13977 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13978 return JIM_ERR;
13980 if (argc == 3) {
13981 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13982 return JIM_ERR;
13984 if (count < 0)
13985 return JIM_OK;
13986 i = count;
13987 start = JimClock();
13988 while (i-- > 0) {
13989 int retval;
13991 retval = Jim_EvalObj(interp, argv[1]);
13992 if (retval != JIM_OK) {
13993 return retval;
13996 elapsed = JimClock() - start;
13997 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13998 Jim_SetResultString(interp, buf, -1);
13999 return JIM_OK;
14002 /* [exit] */
14003 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14005 long exitCode = 0;
14007 if (argc > 2) {
14008 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
14009 return JIM_ERR;
14011 if (argc == 2) {
14012 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
14013 return JIM_ERR;
14015 interp->exitCode = exitCode;
14016 return JIM_EXIT;
14019 /* [catch] */
14020 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14022 int exitCode = 0;
14023 int i;
14024 int sig = 0;
14026 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
14027 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
14028 static const int max_ignore_code = sizeof(ignore_mask) * 8;
14030 /* Reset the error code before catch.
14031 * Note that this is not strictly correct.
14033 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
14035 for (i = 1; i < argc - 1; i++) {
14036 const char *arg = Jim_String(argv[i]);
14037 jim_wide option;
14038 int ignore;
14040 /* It's a pity we can't use Jim_GetEnum here :-( */
14041 if (strcmp(arg, "--") == 0) {
14042 i++;
14043 break;
14045 if (*arg != '-') {
14046 break;
14049 if (strncmp(arg, "-no", 3) == 0) {
14050 arg += 3;
14051 ignore = 1;
14053 else {
14054 arg++;
14055 ignore = 0;
14058 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
14059 option = -1;
14061 if (option < 0) {
14062 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
14064 if (option < 0) {
14065 goto wrongargs;
14068 if (ignore) {
14069 ignore_mask |= ((jim_wide)1 << option);
14071 else {
14072 ignore_mask &= (~((jim_wide)1 << option));
14076 argc -= i;
14077 if (argc < 1 || argc > 3) {
14078 wrongargs:
14079 Jim_WrongNumArgs(interp, 1, argv,
14080 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
14081 return JIM_ERR;
14083 argv += i;
14085 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
14086 sig++;
14089 interp->signal_level += sig;
14090 if (Jim_CheckSignal(interp)) {
14091 /* If a signal is set, don't even try to execute the body */
14092 exitCode = JIM_SIGNAL;
14094 else {
14095 exitCode = Jim_EvalObj(interp, argv[0]);
14096 /* Don't want any caught error included in a later stack trace */
14097 interp->errorFlag = 0;
14099 interp->signal_level -= sig;
14101 /* Catch or pass through? Only the first 32/64 codes can be passed through */
14102 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
14103 /* Not caught, pass it up */
14104 return exitCode;
14107 if (sig && exitCode == JIM_SIGNAL) {
14108 /* Catch the signal at this level */
14109 if (interp->signal_set_result) {
14110 interp->signal_set_result(interp, interp->sigmask);
14112 else {
14113 Jim_SetResultInt(interp, interp->sigmask);
14115 interp->sigmask = 0;
14118 if (argc >= 2) {
14119 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
14120 return JIM_ERR;
14122 if (argc == 3) {
14123 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
14125 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
14126 Jim_ListAppendElement(interp, optListObj,
14127 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
14128 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
14129 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
14130 if (exitCode == JIM_ERR) {
14131 Jim_Obj *errorCode;
14132 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
14133 -1));
14134 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
14136 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
14137 if (errorCode) {
14138 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
14139 Jim_ListAppendElement(interp, optListObj, errorCode);
14142 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
14143 return JIM_ERR;
14147 Jim_SetResultInt(interp, exitCode);
14148 return JIM_OK;
14151 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
14153 /* [ref] */
14154 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14156 if (argc != 3 && argc != 4) {
14157 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
14158 return JIM_ERR;
14160 if (argc == 3) {
14161 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
14163 else {
14164 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
14166 return JIM_OK;
14169 /* [getref] */
14170 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14172 Jim_Reference *refPtr;
14174 if (argc != 2) {
14175 Jim_WrongNumArgs(interp, 1, argv, "reference");
14176 return JIM_ERR;
14178 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14179 return JIM_ERR;
14180 Jim_SetResult(interp, refPtr->objPtr);
14181 return JIM_OK;
14184 /* [setref] */
14185 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14187 Jim_Reference *refPtr;
14189 if (argc != 3) {
14190 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14191 return JIM_ERR;
14193 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14194 return JIM_ERR;
14195 Jim_IncrRefCount(argv[2]);
14196 Jim_DecrRefCount(interp, refPtr->objPtr);
14197 refPtr->objPtr = argv[2];
14198 Jim_SetResult(interp, argv[2]);
14199 return JIM_OK;
14202 /* [collect] */
14203 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14205 if (argc != 1) {
14206 Jim_WrongNumArgs(interp, 1, argv, "");
14207 return JIM_ERR;
14209 Jim_SetResultInt(interp, Jim_Collect(interp));
14211 /* Free all the freed objects. */
14212 while (interp->freeList) {
14213 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14214 Jim_Free(interp->freeList);
14215 interp->freeList = nextObjPtr;
14218 return JIM_OK;
14221 /* [finalize] reference ?newValue? */
14222 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14224 if (argc != 2 && argc != 3) {
14225 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14226 return JIM_ERR;
14228 if (argc == 2) {
14229 Jim_Obj *cmdNamePtr;
14231 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14232 return JIM_ERR;
14233 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14234 Jim_SetResult(interp, cmdNamePtr);
14236 else {
14237 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14238 return JIM_ERR;
14239 Jim_SetResult(interp, argv[2]);
14241 return JIM_OK;
14244 /* [info references] */
14245 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14247 Jim_Obj *listObjPtr;
14248 Jim_HashTableIterator htiter;
14249 Jim_HashEntry *he;
14251 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14253 JimInitHashTableIterator(&interp->references, &htiter);
14254 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14255 char buf[JIM_REFERENCE_SPACE + 1];
14256 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14257 const unsigned long *refId = he->key;
14259 JimFormatReference(buf, refPtr, *refId);
14260 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14262 Jim_SetResult(interp, listObjPtr);
14263 return JIM_OK;
14265 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14267 /* [rename] */
14268 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14270 if (argc != 3) {
14271 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14272 return JIM_ERR;
14275 if (JimValidName(interp, "new procedure", argv[2])) {
14276 return JIM_ERR;
14279 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14282 #define JIM_DICTMATCH_KEYS 0x0001
14283 #define JIM_DICTMATCH_VALUES 0x002
14286 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14287 * return_types should be either or both
14289 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14291 Jim_HashEntry *he;
14292 Jim_Obj *listObjPtr;
14293 Jim_HashTableIterator htiter;
14295 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14296 return JIM_ERR;
14299 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14301 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14302 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14303 if (patternObj) {
14304 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14305 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14306 /* no match */
14307 continue;
14310 if (return_types & JIM_DICTMATCH_KEYS) {
14311 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14313 if (return_types & JIM_DICTMATCH_VALUES) {
14314 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14318 Jim_SetResult(interp, listObjPtr);
14319 return JIM_OK;
14322 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14324 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14325 return -1;
14327 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14331 * Must be called with at least one object.
14332 * Returns the new dictionary, or NULL on error.
14334 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14336 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14337 int i;
14339 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14341 /* Note that we don't optimise the trivial case of a single argument */
14343 for (i = 0; i < objc; i++) {
14344 Jim_HashTable *ht;
14345 Jim_HashTableIterator htiter;
14346 Jim_HashEntry *he;
14348 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14349 Jim_FreeNewObj(interp, objPtr);
14350 return NULL;
14352 ht = objv[i]->internalRep.ptr;
14353 JimInitHashTableIterator(ht, &htiter);
14354 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14355 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14358 return objPtr;
14361 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14363 Jim_HashTable *ht;
14364 unsigned int i;
14365 char buffer[100];
14366 int sum = 0;
14367 int nonzero_count = 0;
14368 Jim_Obj *output;
14369 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14371 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14372 return JIM_ERR;
14375 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14377 /* Note that this uses internal knowledge of the hash table */
14378 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14379 output = Jim_NewStringObj(interp, buffer, -1);
14381 for (i = 0; i < ht->size; i++) {
14382 Jim_HashEntry *he = ht->table[i];
14383 int entries = 0;
14384 while (he) {
14385 entries++;
14386 he = he->next;
14388 if (entries > 9) {
14389 bucket_counts[10]++;
14391 else {
14392 bucket_counts[entries]++;
14394 if (entries) {
14395 sum += entries;
14396 nonzero_count++;
14399 for (i = 0; i < 10; i++) {
14400 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14401 Jim_AppendString(interp, output, buffer, -1);
14403 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14404 Jim_AppendString(interp, output, buffer, -1);
14405 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14406 Jim_AppendString(interp, output, buffer, -1);
14407 Jim_SetResult(interp, output);
14408 return JIM_OK;
14411 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14413 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14415 Jim_AppendString(interp, prefixObj, " ", 1);
14416 Jim_AppendString(interp, prefixObj, subcmd, -1);
14418 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14422 * Implements the [dict with] command
14424 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14426 int i;
14427 Jim_Obj *objPtr;
14428 Jim_Obj *dictObj;
14429 Jim_Obj **dictValues;
14430 int len;
14431 int ret = JIM_OK;
14433 /* Open up the appropriate level of the dictionary */
14434 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14435 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14436 return JIM_ERR;
14438 /* Set the local variables */
14439 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14440 return JIM_ERR;
14442 for (i = 0; i < len; i += 2) {
14443 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14444 Jim_Free(dictValues);
14445 return JIM_ERR;
14449 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14450 if (Jim_Length(scriptObj)) {
14451 ret = Jim_EvalObj(interp, scriptObj);
14453 /* Now if the dictionary still exists, update it based on the local variables */
14454 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14455 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14456 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14457 for (i = 0; i < keyc; i++) {
14458 newkeyv[i] = keyv[i];
14461 for (i = 0; i < len; i += 2) {
14462 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14463 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14464 newkeyv[keyc] = dictValues[i];
14465 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14467 Jim_Free(newkeyv);
14471 Jim_Free(dictValues);
14473 return ret;
14476 /* [dict] */
14477 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14479 Jim_Obj *objPtr;
14480 int types = JIM_DICTMATCH_KEYS;
14481 int option;
14482 static const char * const options[] = {
14483 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14484 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14485 "replace", "update", NULL
14487 enum
14489 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14490 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14491 OPT_REPLACE, OPT_UPDATE,
14494 if (argc < 2) {
14495 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14496 return JIM_ERR;
14499 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14500 return Jim_CheckShowCommands(interp, argv[1], options);
14503 switch (option) {
14504 case OPT_GET:
14505 if (argc < 3) {
14506 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14507 return JIM_ERR;
14509 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14510 JIM_ERRMSG) != JIM_OK) {
14511 return JIM_ERR;
14513 Jim_SetResult(interp, objPtr);
14514 return JIM_OK;
14516 case OPT_SET:
14517 if (argc < 5) {
14518 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14519 return JIM_ERR;
14521 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14523 case OPT_EXISTS:
14524 if (argc < 4) {
14525 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14526 return JIM_ERR;
14528 else {
14529 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14530 if (rc < 0) {
14531 return JIM_ERR;
14533 Jim_SetResultBool(interp, rc == JIM_OK);
14534 return JIM_OK;
14537 case OPT_UNSET:
14538 if (argc < 4) {
14539 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14540 return JIM_ERR;
14542 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14543 return JIM_ERR;
14545 return JIM_OK;
14547 case OPT_VALUES:
14548 types = JIM_DICTMATCH_VALUES;
14549 /* fallthru */
14550 case OPT_KEYS:
14551 if (argc != 3 && argc != 4) {
14552 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14553 return JIM_ERR;
14555 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14557 case OPT_SIZE:
14558 if (argc != 3) {
14559 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14560 return JIM_ERR;
14562 else if (Jim_DictSize(interp, argv[2]) < 0) {
14563 return JIM_ERR;
14565 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14566 return JIM_OK;
14568 case OPT_MERGE:
14569 if (argc == 2) {
14570 return JIM_OK;
14572 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14573 if (objPtr == NULL) {
14574 return JIM_ERR;
14576 Jim_SetResult(interp, objPtr);
14577 return JIM_OK;
14579 case OPT_UPDATE:
14580 if (argc < 6 || argc % 2) {
14581 /* Better error message */
14582 argc = 2;
14584 break;
14586 case OPT_CREATE:
14587 if (argc % 2) {
14588 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14589 return JIM_ERR;
14591 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14592 Jim_SetResult(interp, objPtr);
14593 return JIM_OK;
14595 case OPT_INFO:
14596 if (argc != 3) {
14597 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14598 return JIM_ERR;
14600 return Jim_DictInfo(interp, argv[2]);
14602 case OPT_WITH:
14603 if (argc < 4) {
14604 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14605 return JIM_ERR;
14607 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14609 /* Handle command as an ensemble */
14610 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14613 /* [subst] */
14614 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14616 static const char * const options[] = {
14617 "-nobackslashes", "-nocommands", "-novariables", NULL
14619 enum
14620 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14621 int i;
14622 int flags = JIM_SUBST_FLAG;
14623 Jim_Obj *objPtr;
14625 if (argc < 2) {
14626 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14627 return JIM_ERR;
14629 for (i = 1; i < (argc - 1); i++) {
14630 int option;
14632 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14633 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14634 return JIM_ERR;
14636 switch (option) {
14637 case OPT_NOBACKSLASHES:
14638 flags |= JIM_SUBST_NOESC;
14639 break;
14640 case OPT_NOCOMMANDS:
14641 flags |= JIM_SUBST_NOCMD;
14642 break;
14643 case OPT_NOVARIABLES:
14644 flags |= JIM_SUBST_NOVAR;
14645 break;
14648 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14649 return JIM_ERR;
14651 Jim_SetResult(interp, objPtr);
14652 return JIM_OK;
14655 /* [info] */
14656 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14658 int cmd;
14659 Jim_Obj *objPtr;
14660 int mode = 0;
14662 static const char * const commands[] = {
14663 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14664 "vars", "version", "patchlevel", "complete", "args", "hostname",
14665 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14666 "references", "alias", NULL
14668 enum
14669 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14670 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14671 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14672 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14675 #ifdef jim_ext_namespace
14676 int nons = 0;
14678 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14679 /* This is for internal use only */
14680 argc--;
14681 argv++;
14682 nons = 1;
14684 #endif
14686 if (argc < 2) {
14687 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14688 return JIM_ERR;
14690 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14691 return Jim_CheckShowCommands(interp, argv[1], commands);
14694 /* Test for the most common commands first, just in case it makes a difference */
14695 switch (cmd) {
14696 case INFO_EXISTS:
14697 if (argc != 3) {
14698 Jim_WrongNumArgs(interp, 2, argv, "varName");
14699 return JIM_ERR;
14701 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14702 break;
14704 case INFO_ALIAS:{
14705 Jim_Cmd *cmdPtr;
14707 if (argc != 3) {
14708 Jim_WrongNumArgs(interp, 2, argv, "command");
14709 return JIM_ERR;
14711 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14712 return JIM_ERR;
14714 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14715 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14716 return JIM_ERR;
14718 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14719 return JIM_OK;
14722 case INFO_CHANNELS:
14723 mode++; /* JIM_CMDLIST_CHANNELS */
14724 #ifndef jim_ext_aio
14725 Jim_SetResultString(interp, "aio not enabled", -1);
14726 return JIM_ERR;
14727 #endif
14728 /* fall through */
14729 case INFO_PROCS:
14730 mode++; /* JIM_CMDLIST_PROCS */
14731 /* fall through */
14732 case INFO_COMMANDS:
14733 /* mode 0 => JIM_CMDLIST_COMMANDS */
14734 if (argc != 2 && argc != 3) {
14735 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14736 return JIM_ERR;
14738 #ifdef jim_ext_namespace
14739 if (!nons) {
14740 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14741 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14744 #endif
14745 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14746 break;
14748 case INFO_VARS:
14749 mode++; /* JIM_VARLIST_VARS */
14750 /* fall through */
14751 case INFO_LOCALS:
14752 mode++; /* JIM_VARLIST_LOCALS */
14753 /* fall through */
14754 case INFO_GLOBALS:
14755 /* mode 0 => JIM_VARLIST_GLOBALS */
14756 if (argc != 2 && argc != 3) {
14757 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14758 return JIM_ERR;
14760 #ifdef jim_ext_namespace
14761 if (!nons) {
14762 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14763 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14766 #endif
14767 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14768 break;
14770 case INFO_SCRIPT:
14771 if (argc != 2) {
14772 Jim_WrongNumArgs(interp, 2, argv, "");
14773 return JIM_ERR;
14775 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14776 break;
14778 case INFO_SOURCE:{
14779 jim_wide line;
14780 Jim_Obj *resObjPtr;
14781 Jim_Obj *fileNameObj;
14783 if (argc != 3 && argc != 5) {
14784 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14785 return JIM_ERR;
14787 if (argc == 5) {
14788 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14789 return JIM_ERR;
14791 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14792 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14794 else {
14795 if (argv[2]->typePtr == &sourceObjType) {
14796 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14797 line = argv[2]->internalRep.sourceValue.lineNumber;
14799 else if (argv[2]->typePtr == &scriptObjType) {
14800 ScriptObj *script = JimGetScript(interp, argv[2]);
14801 fileNameObj = script->fileNameObj;
14802 line = script->firstline;
14804 else {
14805 fileNameObj = interp->emptyObj;
14806 line = 1;
14808 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14809 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14810 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14812 Jim_SetResult(interp, resObjPtr);
14813 break;
14816 case INFO_STACKTRACE:
14817 Jim_SetResult(interp, interp->stackTrace);
14818 break;
14820 case INFO_LEVEL:
14821 case INFO_FRAME:
14822 switch (argc) {
14823 case 2:
14824 Jim_SetResultInt(interp, interp->framePtr->level);
14825 break;
14827 case 3:
14828 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14829 return JIM_ERR;
14831 Jim_SetResult(interp, objPtr);
14832 break;
14834 default:
14835 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14836 return JIM_ERR;
14838 break;
14840 case INFO_BODY:
14841 case INFO_STATICS:
14842 case INFO_ARGS:{
14843 Jim_Cmd *cmdPtr;
14845 if (argc != 3) {
14846 Jim_WrongNumArgs(interp, 2, argv, "procname");
14847 return JIM_ERR;
14849 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14850 return JIM_ERR;
14852 if (!cmdPtr->isproc) {
14853 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14854 return JIM_ERR;
14856 switch (cmd) {
14857 case INFO_BODY:
14858 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14859 break;
14860 case INFO_ARGS:
14861 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14862 break;
14863 case INFO_STATICS:
14864 if (cmdPtr->u.proc.staticVars) {
14865 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14866 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14868 break;
14870 break;
14873 case INFO_VERSION:
14874 case INFO_PATCHLEVEL:{
14875 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14877 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14878 Jim_SetResultString(interp, buf, -1);
14879 break;
14882 case INFO_COMPLETE:
14883 if (argc != 3 && argc != 4) {
14884 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14885 return JIM_ERR;
14887 else {
14888 char missing;
14890 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14891 if (missing != ' ' && argc == 4) {
14892 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14895 break;
14897 case INFO_HOSTNAME:
14898 /* Redirect to os.gethostname if it exists */
14899 return Jim_Eval(interp, "os.gethostname");
14901 case INFO_NAMEOFEXECUTABLE:
14902 /* Redirect to Tcl proc */
14903 return Jim_Eval(interp, "{info nameofexecutable}");
14905 case INFO_RETURNCODES:
14906 if (argc == 2) {
14907 int i;
14908 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14910 for (i = 0; jimReturnCodes[i]; i++) {
14911 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14912 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14913 jimReturnCodes[i], -1));
14916 Jim_SetResult(interp, listObjPtr);
14918 else if (argc == 3) {
14919 long code;
14920 const char *name;
14922 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14923 return JIM_ERR;
14925 name = Jim_ReturnCode(code);
14926 if (*name == '?') {
14927 Jim_SetResultInt(interp, code);
14929 else {
14930 Jim_SetResultString(interp, name, -1);
14933 else {
14934 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14935 return JIM_ERR;
14937 break;
14938 case INFO_REFERENCES:
14939 #ifdef JIM_REFERENCES
14940 return JimInfoReferences(interp, argc, argv);
14941 #else
14942 Jim_SetResultString(interp, "not supported", -1);
14943 return JIM_ERR;
14944 #endif
14946 return JIM_OK;
14949 /* [exists] */
14950 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14952 Jim_Obj *objPtr;
14953 int result = 0;
14955 static const char * const options[] = {
14956 "-command", "-proc", "-alias", "-var", NULL
14958 enum
14960 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14962 int option;
14964 if (argc == 2) {
14965 option = OPT_VAR;
14966 objPtr = argv[1];
14968 else if (argc == 3) {
14969 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14970 return JIM_ERR;
14972 objPtr = argv[2];
14974 else {
14975 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14976 return JIM_ERR;
14979 if (option == OPT_VAR) {
14980 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14982 else {
14983 /* Now different kinds of commands */
14984 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14986 if (cmd) {
14987 switch (option) {
14988 case OPT_COMMAND:
14989 result = 1;
14990 break;
14992 case OPT_ALIAS:
14993 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14994 break;
14996 case OPT_PROC:
14997 result = cmd->isproc;
14998 break;
15002 Jim_SetResultBool(interp, result);
15003 return JIM_OK;
15006 /* [split] */
15007 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15009 const char *str, *splitChars, *noMatchStart;
15010 int splitLen, strLen;
15011 Jim_Obj *resObjPtr;
15012 int c;
15013 int len;
15015 if (argc != 2 && argc != 3) {
15016 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
15017 return JIM_ERR;
15020 str = Jim_GetString(argv[1], &len);
15021 if (len == 0) {
15022 return JIM_OK;
15024 strLen = Jim_Utf8Length(interp, argv[1]);
15026 /* Init */
15027 if (argc == 2) {
15028 splitChars = " \n\t\r";
15029 splitLen = 4;
15031 else {
15032 splitChars = Jim_String(argv[2]);
15033 splitLen = Jim_Utf8Length(interp, argv[2]);
15036 noMatchStart = str;
15037 resObjPtr = Jim_NewListObj(interp, NULL, 0);
15039 /* Split */
15040 if (splitLen) {
15041 Jim_Obj *objPtr;
15042 while (strLen--) {
15043 const char *sc = splitChars;
15044 int scLen = splitLen;
15045 int sl = utf8_tounicode(str, &c);
15046 while (scLen--) {
15047 int pc;
15048 sc += utf8_tounicode(sc, &pc);
15049 if (c == pc) {
15050 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
15051 Jim_ListAppendElement(interp, resObjPtr, objPtr);
15052 noMatchStart = str + sl;
15053 break;
15056 str += sl;
15058 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
15059 Jim_ListAppendElement(interp, resObjPtr, objPtr);
15061 else {
15062 /* This handles the special case of splitchars eq {}
15063 * Optimise by sharing common (ASCII) characters
15065 Jim_Obj **commonObj = NULL;
15066 #define NUM_COMMON (128 - 9)
15067 while (strLen--) {
15068 int n = utf8_tounicode(str, &c);
15069 #ifdef JIM_OPTIMIZATION
15070 if (c >= 9 && c < 128) {
15071 /* Common ASCII char. Note that 9 is the tab character */
15072 c -= 9;
15073 if (!commonObj) {
15074 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
15075 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
15077 if (!commonObj[c]) {
15078 commonObj[c] = Jim_NewStringObj(interp, str, 1);
15080 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
15081 str++;
15082 continue;
15084 #endif
15085 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
15086 str += n;
15088 Jim_Free(commonObj);
15091 Jim_SetResult(interp, resObjPtr);
15092 return JIM_OK;
15095 /* [join] */
15096 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15098 const char *joinStr;
15099 int joinStrLen;
15101 if (argc != 2 && argc != 3) {
15102 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
15103 return JIM_ERR;
15105 /* Init */
15106 if (argc == 2) {
15107 joinStr = " ";
15108 joinStrLen = 1;
15110 else {
15111 joinStr = Jim_GetString(argv[2], &joinStrLen);
15113 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
15114 return JIM_OK;
15117 /* [format] */
15118 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15120 Jim_Obj *objPtr;
15122 if (argc < 2) {
15123 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
15124 return JIM_ERR;
15126 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
15127 if (objPtr == NULL)
15128 return JIM_ERR;
15129 Jim_SetResult(interp, objPtr);
15130 return JIM_OK;
15133 /* [scan] */
15134 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15136 Jim_Obj *listPtr, **outVec;
15137 int outc, i;
15139 if (argc < 3) {
15140 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
15141 return JIM_ERR;
15143 if (argv[2]->typePtr != &scanFmtStringObjType)
15144 SetScanFmtFromAny(interp, argv[2]);
15145 if (FormatGetError(argv[2]) != 0) {
15146 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
15147 return JIM_ERR;
15149 if (argc > 3) {
15150 int maxPos = FormatGetMaxPos(argv[2]);
15151 int count = FormatGetCnvCount(argv[2]);
15153 if (maxPos > argc - 3) {
15154 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
15155 return JIM_ERR;
15157 else if (count > argc - 3) {
15158 Jim_SetResultString(interp, "different numbers of variable names and "
15159 "field specifiers", -1);
15160 return JIM_ERR;
15162 else if (count < argc - 3) {
15163 Jim_SetResultString(interp, "variable is not assigned by any "
15164 "conversion specifiers", -1);
15165 return JIM_ERR;
15168 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
15169 if (listPtr == 0)
15170 return JIM_ERR;
15171 if (argc > 3) {
15172 int rc = JIM_OK;
15173 int count = 0;
15175 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
15176 int len = Jim_ListLength(interp, listPtr);
15178 if (len != 0) {
15179 JimListGetElements(interp, listPtr, &outc, &outVec);
15180 for (i = 0; i < outc; ++i) {
15181 if (Jim_Length(outVec[i]) > 0) {
15182 ++count;
15183 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
15184 rc = JIM_ERR;
15189 Jim_FreeNewObj(interp, listPtr);
15191 else {
15192 count = -1;
15194 if (rc == JIM_OK) {
15195 Jim_SetResultInt(interp, count);
15197 return rc;
15199 else {
15200 if (listPtr == (Jim_Obj *)EOF) {
15201 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
15202 return JIM_OK;
15204 Jim_SetResult(interp, listPtr);
15206 return JIM_OK;
15209 /* [error] */
15210 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15212 if (argc != 2 && argc != 3) {
15213 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
15214 return JIM_ERR;
15216 Jim_SetResult(interp, argv[1]);
15217 if (argc == 3) {
15218 JimSetStackTrace(interp, argv[2]);
15219 return JIM_ERR;
15221 interp->addStackTrace++;
15222 return JIM_ERR;
15225 /* [lrange] */
15226 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15228 Jim_Obj *objPtr;
15230 if (argc != 4) {
15231 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15232 return JIM_ERR;
15234 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15235 return JIM_ERR;
15236 Jim_SetResult(interp, objPtr);
15237 return JIM_OK;
15240 /* [lrepeat] */
15241 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15243 Jim_Obj *objPtr;
15244 long count;
15246 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15247 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15248 return JIM_ERR;
15251 if (count == 0 || argc == 2) {
15252 return JIM_OK;
15255 argc -= 2;
15256 argv += 2;
15258 objPtr = Jim_NewListObj(interp, argv, argc);
15259 while (--count) {
15260 ListInsertElements(objPtr, -1, argc, argv);
15263 Jim_SetResult(interp, objPtr);
15264 return JIM_OK;
15267 char **Jim_GetEnviron(void)
15269 #if defined(HAVE__NSGETENVIRON)
15270 return *_NSGetEnviron();
15271 #else
15272 #if !defined(NO_ENVIRON_EXTERN)
15273 extern char **environ;
15274 #endif
15276 return environ;
15277 #endif
15280 void Jim_SetEnviron(char **env)
15282 #if defined(HAVE__NSGETENVIRON)
15283 *_NSGetEnviron() = env;
15284 #else
15285 #if !defined(NO_ENVIRON_EXTERN)
15286 extern char **environ;
15287 #endif
15289 environ = env;
15290 #endif
15293 /* [env] */
15294 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15296 const char *key;
15297 const char *val;
15299 if (argc == 1) {
15300 char **e = Jim_GetEnviron();
15302 int i;
15303 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15305 for (i = 0; e[i]; i++) {
15306 const char *equals = strchr(e[i], '=');
15308 if (equals) {
15309 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15310 equals - e[i]));
15311 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15315 Jim_SetResult(interp, listObjPtr);
15316 return JIM_OK;
15319 if (argc < 2) {
15320 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15321 return JIM_ERR;
15323 key = Jim_String(argv[1]);
15324 val = getenv(key);
15325 if (val == NULL) {
15326 if (argc < 3) {
15327 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15328 return JIM_ERR;
15330 val = Jim_String(argv[2]);
15332 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15333 return JIM_OK;
15336 /* [source] */
15337 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15339 int retval;
15341 if (argc != 2) {
15342 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15343 return JIM_ERR;
15345 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15346 if (retval == JIM_RETURN)
15347 return JIM_OK;
15348 return retval;
15351 /* [lreverse] */
15352 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15354 Jim_Obj *revObjPtr, **ele;
15355 int len;
15357 if (argc != 2) {
15358 Jim_WrongNumArgs(interp, 1, argv, "list");
15359 return JIM_ERR;
15361 JimListGetElements(interp, argv[1], &len, &ele);
15362 len--;
15363 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15364 while (len >= 0)
15365 ListAppendElement(revObjPtr, ele[len--]);
15366 Jim_SetResult(interp, revObjPtr);
15367 return JIM_OK;
15370 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15372 jim_wide len;
15374 if (step == 0)
15375 return -1;
15376 if (start == end)
15377 return 0;
15378 else if (step > 0 && start > end)
15379 return -1;
15380 else if (step < 0 && end > start)
15381 return -1;
15382 len = end - start;
15383 if (len < 0)
15384 len = -len; /* abs(len) */
15385 if (step < 0)
15386 step = -step; /* abs(step) */
15387 len = 1 + ((len - 1) / step);
15388 /* We can truncate safely to INT_MAX, the range command
15389 * will always return an error for a such long range
15390 * because Tcl lists can't be so long. */
15391 if (len > INT_MAX)
15392 len = INT_MAX;
15393 return (int)((len < 0) ? -1 : len);
15396 /* [range] */
15397 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15399 jim_wide start = 0, end, step = 1;
15400 int len, i;
15401 Jim_Obj *objPtr;
15403 if (argc < 2 || argc > 4) {
15404 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15405 return JIM_ERR;
15407 if (argc == 2) {
15408 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15409 return JIM_ERR;
15411 else {
15412 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15413 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15414 return JIM_ERR;
15415 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15416 return JIM_ERR;
15418 if ((len = JimRangeLen(start, end, step)) == -1) {
15419 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15420 return JIM_ERR;
15422 objPtr = Jim_NewListObj(interp, NULL, 0);
15423 for (i = 0; i < len; i++)
15424 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15425 Jim_SetResult(interp, objPtr);
15426 return JIM_OK;
15429 /* [rand] */
15430 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15432 jim_wide min = 0, max = 0, len, maxMul;
15434 if (argc < 1 || argc > 3) {
15435 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15436 return JIM_ERR;
15438 if (argc == 1) {
15439 max = JIM_WIDE_MAX;
15440 } else if (argc == 2) {
15441 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15442 return JIM_ERR;
15443 } else if (argc == 3) {
15444 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15445 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15446 return JIM_ERR;
15448 len = max-min;
15449 if (len < 0) {
15450 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15451 return JIM_ERR;
15453 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15454 while (1) {
15455 jim_wide r;
15457 JimRandomBytes(interp, &r, sizeof(jim_wide));
15458 if (r < 0 || r >= maxMul) continue;
15459 r = (len == 0) ? 0 : r%len;
15460 Jim_SetResultInt(interp, min+r);
15461 return JIM_OK;
15465 static const struct {
15466 const char *name;
15467 Jim_CmdProc *cmdProc;
15468 } Jim_CoreCommandsTable[] = {
15469 {"alias", Jim_AliasCoreCommand},
15470 {"set", Jim_SetCoreCommand},
15471 {"unset", Jim_UnsetCoreCommand},
15472 {"puts", Jim_PutsCoreCommand},
15473 {"+", Jim_AddCoreCommand},
15474 {"*", Jim_MulCoreCommand},
15475 {"-", Jim_SubCoreCommand},
15476 {"/", Jim_DivCoreCommand},
15477 {"incr", Jim_IncrCoreCommand},
15478 {"while", Jim_WhileCoreCommand},
15479 {"loop", Jim_LoopCoreCommand},
15480 {"for", Jim_ForCoreCommand},
15481 {"foreach", Jim_ForeachCoreCommand},
15482 {"lmap", Jim_LmapCoreCommand},
15483 {"lassign", Jim_LassignCoreCommand},
15484 {"if", Jim_IfCoreCommand},
15485 {"switch", Jim_SwitchCoreCommand},
15486 {"list", Jim_ListCoreCommand},
15487 {"lindex", Jim_LindexCoreCommand},
15488 {"lset", Jim_LsetCoreCommand},
15489 {"lsearch", Jim_LsearchCoreCommand},
15490 {"llength", Jim_LlengthCoreCommand},
15491 {"lappend", Jim_LappendCoreCommand},
15492 {"linsert", Jim_LinsertCoreCommand},
15493 {"lreplace", Jim_LreplaceCoreCommand},
15494 {"lsort", Jim_LsortCoreCommand},
15495 {"append", Jim_AppendCoreCommand},
15496 {"debug", Jim_DebugCoreCommand},
15497 {"eval", Jim_EvalCoreCommand},
15498 {"uplevel", Jim_UplevelCoreCommand},
15499 {"expr", Jim_ExprCoreCommand},
15500 {"break", Jim_BreakCoreCommand},
15501 {"continue", Jim_ContinueCoreCommand},
15502 {"proc", Jim_ProcCoreCommand},
15503 {"concat", Jim_ConcatCoreCommand},
15504 {"return", Jim_ReturnCoreCommand},
15505 {"upvar", Jim_UpvarCoreCommand},
15506 {"global", Jim_GlobalCoreCommand},
15507 {"string", Jim_StringCoreCommand},
15508 {"time", Jim_TimeCoreCommand},
15509 {"exit", Jim_ExitCoreCommand},
15510 {"catch", Jim_CatchCoreCommand},
15511 #ifdef JIM_REFERENCES
15512 {"ref", Jim_RefCoreCommand},
15513 {"getref", Jim_GetrefCoreCommand},
15514 {"setref", Jim_SetrefCoreCommand},
15515 {"finalize", Jim_FinalizeCoreCommand},
15516 {"collect", Jim_CollectCoreCommand},
15517 #endif
15518 {"rename", Jim_RenameCoreCommand},
15519 {"dict", Jim_DictCoreCommand},
15520 {"subst", Jim_SubstCoreCommand},
15521 {"info", Jim_InfoCoreCommand},
15522 {"exists", Jim_ExistsCoreCommand},
15523 {"split", Jim_SplitCoreCommand},
15524 {"join", Jim_JoinCoreCommand},
15525 {"format", Jim_FormatCoreCommand},
15526 {"scan", Jim_ScanCoreCommand},
15527 {"error", Jim_ErrorCoreCommand},
15528 {"lrange", Jim_LrangeCoreCommand},
15529 {"lrepeat", Jim_LrepeatCoreCommand},
15530 {"env", Jim_EnvCoreCommand},
15531 {"source", Jim_SourceCoreCommand},
15532 {"lreverse", Jim_LreverseCoreCommand},
15533 {"range", Jim_RangeCoreCommand},
15534 {"rand", Jim_RandCoreCommand},
15535 {"tailcall", Jim_TailcallCoreCommand},
15536 {"local", Jim_LocalCoreCommand},
15537 {"upcall", Jim_UpcallCoreCommand},
15538 {"apply", Jim_ApplyCoreCommand},
15539 {NULL, NULL},
15542 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15544 int i = 0;
15546 while (Jim_CoreCommandsTable[i].name != NULL) {
15547 Jim_CreateCommand(interp,
15548 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15549 i++;
15553 /* -----------------------------------------------------------------------------
15554 * Interactive prompt
15555 * ---------------------------------------------------------------------------*/
15556 void Jim_MakeErrorMessage(Jim_Interp *interp)
15558 Jim_Obj *argv[2];
15560 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15561 argv[1] = interp->result;
15563 Jim_EvalObjVector(interp, 2, argv);
15567 * Given a null terminated array of strings, returns an allocated, sorted
15568 * copy of the array.
15570 static char **JimSortStringTable(const char *const *tablePtr)
15572 int count;
15573 char **tablePtrSorted;
15575 /* Find the size of the table */
15576 for (count = 0; tablePtr[count]; count++) {
15579 /* Allocate one extra for the terminating NULL pointer */
15580 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15581 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15582 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15583 tablePtrSorted[count] = NULL;
15585 return tablePtrSorted;
15588 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15589 const char *prefix, const char *const *tablePtr, const char *name)
15591 char **tablePtrSorted;
15592 int i;
15594 if (name == NULL) {
15595 name = "option";
15598 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15599 tablePtrSorted = JimSortStringTable(tablePtr);
15600 for (i = 0; tablePtrSorted[i]; i++) {
15601 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15602 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15604 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15605 if (tablePtrSorted[i + 1]) {
15606 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15609 Jim_Free(tablePtrSorted);
15614 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15615 * and returns JIM_OK.
15617 * Otherwise returns JIM_ERR.
15619 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15621 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15622 int i;
15623 char **tablePtrSorted = JimSortStringTable(tablePtr);
15624 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15625 for (i = 0; tablePtrSorted[i]; i++) {
15626 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15628 Jim_Free(tablePtrSorted);
15629 return JIM_OK;
15631 return JIM_ERR;
15634 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15635 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15637 const char *bad = "bad ";
15638 const char *const *entryPtr = NULL;
15639 int i;
15640 int match = -1;
15641 int arglen;
15642 const char *arg = Jim_GetString(objPtr, &arglen);
15644 *indexPtr = -1;
15646 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15647 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15648 /* Found an exact match */
15649 *indexPtr = i;
15650 return JIM_OK;
15652 if (flags & JIM_ENUM_ABBREV) {
15653 /* Accept an unambiguous abbreviation.
15654 * Note that '-' doesnt' consitute a valid abbreviation
15656 if (strncmp(arg, *entryPtr, arglen) == 0) {
15657 if (*arg == '-' && arglen == 1) {
15658 break;
15660 if (match >= 0) {
15661 bad = "ambiguous ";
15662 goto ambiguous;
15664 match = i;
15669 /* If we had an unambiguous partial match */
15670 if (match >= 0) {
15671 *indexPtr = match;
15672 return JIM_OK;
15675 ambiguous:
15676 if (flags & JIM_ERRMSG) {
15677 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15679 return JIM_ERR;
15682 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15684 int i;
15686 for (i = 0; i < (int)len; i++) {
15687 if (array[i] && strcmp(array[i], name) == 0) {
15688 return i;
15691 return -1;
15694 int Jim_IsDict(Jim_Obj *objPtr)
15696 return objPtr->typePtr == &dictObjType;
15699 int Jim_IsList(Jim_Obj *objPtr)
15701 return objPtr->typePtr == &listObjType;
15705 * Very simple printf-like formatting, designed for error messages.
15707 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15708 * The resulting string is created and set as the result.
15710 * Each '%s' should correspond to a regular string parameter.
15711 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15712 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15714 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15716 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15718 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15720 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15722 /* Initial space needed */
15723 int len = strlen(format);
15724 int extra = 0;
15725 int n = 0;
15726 const char *params[5];
15727 int nobjparam = 0;
15728 Jim_Obj *objparam[5];
15729 char *buf;
15730 va_list args;
15731 int i;
15733 va_start(args, format);
15735 for (i = 0; i < len && n < 5; i++) {
15736 int l;
15738 if (strncmp(format + i, "%s", 2) == 0) {
15739 params[n] = va_arg(args, char *);
15741 l = strlen(params[n]);
15743 else if (strncmp(format + i, "%#s", 3) == 0) {
15744 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15746 params[n] = Jim_GetString(objPtr, &l);
15747 objparam[nobjparam++] = objPtr;
15748 Jim_IncrRefCount(objPtr);
15750 else {
15751 if (format[i] == '%') {
15752 i++;
15754 continue;
15756 n++;
15757 extra += l;
15760 len += extra;
15761 buf = Jim_Alloc(len + 1);
15762 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15764 va_end(args);
15766 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15768 for (i = 0; i < nobjparam; i++) {
15769 Jim_DecrRefCount(interp, objparam[i]);
15773 /* stubs */
15774 #ifndef jim_ext_package
15775 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15777 return JIM_OK;
15779 #endif
15780 #ifndef jim_ext_aio
15781 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15783 Jim_SetResultString(interp, "aio not enabled", -1);
15784 return NULL;
15786 #endif
15790 * Local Variables: ***
15791 * c-basic-offset: 4 ***
15792 * tab-width: 4 ***
15793 * End: ***