auto.def: tclprefix should not be enabled by default
[jimtcl.git] / jim.c
blobfcbf9b02d8b13e0ee1074195cb59b8575bea85de
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);
2321 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2323 static const Jim_ObjType interpolatedObjType = {
2324 "interpolated",
2325 FreeInterpolatedInternalRep,
2326 DupInterpolatedInternalRep,
2327 NULL,
2328 JIM_TYPE_NONE,
2331 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2333 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2336 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2338 /* Copy the interal rep */
2339 dupPtr->internalRep = srcPtr->internalRep;
2340 /* Need to increment the key ref count */
2341 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2344 /* -----------------------------------------------------------------------------
2345 * String Object
2346 * ---------------------------------------------------------------------------*/
2347 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2348 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2350 static const Jim_ObjType stringObjType = {
2351 "string",
2352 NULL,
2353 DupStringInternalRep,
2354 NULL,
2355 JIM_TYPE_REFERENCES,
2358 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2360 JIM_NOTUSED(interp);
2362 /* This is a bit subtle: the only caller of this function
2363 * should be Jim_DuplicateObj(), that will copy the
2364 * string representaion. After the copy, the duplicated
2365 * object will not have more room in the buffer than
2366 * srcPtr->length bytes. So we just set it to length. */
2367 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2368 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2371 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2373 if (objPtr->typePtr != &stringObjType) {
2374 /* Get a fresh string representation. */
2375 if (objPtr->bytes == NULL) {
2376 /* Invalid string repr. Generate it. */
2377 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2378 objPtr->typePtr->updateStringProc(objPtr);
2380 /* Free any other internal representation. */
2381 Jim_FreeIntRep(interp, objPtr);
2382 /* Set it as string, i.e. just set the maxLength field. */
2383 objPtr->typePtr = &stringObjType;
2384 objPtr->internalRep.strValue.maxLength = objPtr->length;
2385 /* Don't know the utf-8 length yet */
2386 objPtr->internalRep.strValue.charLength = -1;
2388 return JIM_OK;
2392 * Returns the length of the object string in chars, not bytes.
2394 * These may be different for a utf-8 string.
2396 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2398 #ifdef JIM_UTF8
2399 SetStringFromAny(interp, objPtr);
2401 if (objPtr->internalRep.strValue.charLength < 0) {
2402 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2404 return objPtr->internalRep.strValue.charLength;
2405 #else
2406 return Jim_Length(objPtr);
2407 #endif
2410 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2411 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2413 Jim_Obj *objPtr = Jim_NewObj(interp);
2415 /* Need to find out how many bytes the string requires */
2416 if (len == -1)
2417 len = strlen(s);
2418 /* Alloc/Set the string rep. */
2419 if (len == 0) {
2420 objPtr->bytes = JimEmptyStringRep;
2422 else {
2423 objPtr->bytes = Jim_Alloc(len + 1);
2424 memcpy(objPtr->bytes, s, len);
2425 objPtr->bytes[len] = '\0';
2427 objPtr->length = len;
2429 /* No typePtr field for the vanilla string object. */
2430 objPtr->typePtr = NULL;
2431 return objPtr;
2434 /* charlen is in characters -- see also Jim_NewStringObj() */
2435 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2437 #ifdef JIM_UTF8
2438 /* Need to find out how many bytes the string requires */
2439 int bytelen = utf8_index(s, charlen);
2441 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2443 /* Remember the utf8 length, so set the type */
2444 objPtr->typePtr = &stringObjType;
2445 objPtr->internalRep.strValue.maxLength = bytelen;
2446 objPtr->internalRep.strValue.charLength = charlen;
2448 return objPtr;
2449 #else
2450 return Jim_NewStringObj(interp, s, charlen);
2451 #endif
2454 /* This version does not try to duplicate the 's' pointer, but
2455 * use it directly. */
2456 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2458 Jim_Obj *objPtr = Jim_NewObj(interp);
2460 objPtr->bytes = s;
2461 objPtr->length = (len == -1) ? strlen(s) : len;
2462 objPtr->typePtr = NULL;
2463 return objPtr;
2466 /* Low-level string append. Use it only against unshared objects
2467 * of type "string". */
2468 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2470 int needlen;
2472 if (len == -1)
2473 len = strlen(str);
2474 needlen = objPtr->length + len;
2475 if (objPtr->internalRep.strValue.maxLength < needlen ||
2476 objPtr->internalRep.strValue.maxLength == 0) {
2477 needlen *= 2;
2478 /* Inefficient to malloc() for less than 8 bytes */
2479 if (needlen < 7) {
2480 needlen = 7;
2482 if (objPtr->bytes == JimEmptyStringRep) {
2483 objPtr->bytes = Jim_Alloc(needlen + 1);
2485 else {
2486 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2488 objPtr->internalRep.strValue.maxLength = needlen;
2490 memcpy(objPtr->bytes + objPtr->length, str, len);
2491 objPtr->bytes[objPtr->length + len] = '\0';
2493 if (objPtr->internalRep.strValue.charLength >= 0) {
2494 /* Update the utf-8 char length */
2495 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2497 objPtr->length += len;
2500 /* Higher level API to append strings to objects.
2501 * Object must not be unshared for each of these.
2503 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2505 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2506 SetStringFromAny(interp, objPtr);
2507 StringAppendString(objPtr, str, len);
2510 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2512 int len;
2513 const char *str = Jim_GetString(appendObjPtr, &len);
2514 Jim_AppendString(interp, objPtr, str, len);
2517 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2519 va_list ap;
2521 SetStringFromAny(interp, objPtr);
2522 va_start(ap, objPtr);
2523 while (1) {
2524 const char *s = va_arg(ap, const char *);
2526 if (s == NULL)
2527 break;
2528 Jim_AppendString(interp, objPtr, s, -1);
2530 va_end(ap);
2533 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2535 if (aObjPtr == bObjPtr) {
2536 return 1;
2538 else {
2539 int Alen, Blen;
2540 const char *sA = Jim_GetString(aObjPtr, &Alen);
2541 const char *sB = Jim_GetString(bObjPtr, &Blen);
2543 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2548 * Note. Does not support embedded nulls in either the pattern or the object.
2550 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2552 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2556 * Note: does not support embedded nulls for the nocase option.
2558 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2560 int l1, l2;
2561 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2562 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2564 if (nocase) {
2565 /* Do a character compare for nocase */
2566 return JimStringCompareLen(s1, s2, -1, nocase);
2568 return JimStringCompare(s1, l1, s2, l2);
2572 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2574 * Note: does not support embedded nulls
2576 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2578 const char *s1 = Jim_String(firstObjPtr);
2579 const char *s2 = Jim_String(secondObjPtr);
2581 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2584 /* Convert a range, as returned by Jim_GetRange(), into
2585 * an absolute index into an object of the specified length.
2586 * This function may return negative values, or values
2587 * greater than or equal to the length of the list if the index
2588 * is out of range. */
2589 static int JimRelToAbsIndex(int len, int idx)
2591 if (idx < 0)
2592 return len + idx;
2593 return idx;
2596 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2597 * into a form suitable for implementation of commands like [string range] and [lrange].
2599 * The resulting range is guaranteed to address valid elements of
2600 * the structure.
2602 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2604 int rangeLen;
2606 if (*firstPtr > *lastPtr) {
2607 rangeLen = 0;
2609 else {
2610 rangeLen = *lastPtr - *firstPtr + 1;
2611 if (rangeLen) {
2612 if (*firstPtr < 0) {
2613 rangeLen += *firstPtr;
2614 *firstPtr = 0;
2616 if (*lastPtr >= len) {
2617 rangeLen -= (*lastPtr - (len - 1));
2618 *lastPtr = len - 1;
2622 if (rangeLen < 0)
2623 rangeLen = 0;
2625 *rangeLenPtr = rangeLen;
2628 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2629 int len, int *first, int *last, int *range)
2631 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2632 return JIM_ERR;
2634 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2635 return JIM_ERR;
2637 *first = JimRelToAbsIndex(len, *first);
2638 *last = JimRelToAbsIndex(len, *last);
2639 JimRelToAbsRange(len, first, last, range);
2640 return JIM_OK;
2643 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2644 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2646 int first, last;
2647 const char *str;
2648 int rangeLen;
2649 int bytelen;
2651 str = Jim_GetString(strObjPtr, &bytelen);
2653 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2654 return NULL;
2657 if (first == 0 && rangeLen == bytelen) {
2658 return strObjPtr;
2660 return Jim_NewStringObj(interp, str + first, rangeLen);
2663 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2664 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2666 #ifdef JIM_UTF8
2667 int first, last;
2668 const char *str;
2669 int len, rangeLen;
2670 int bytelen;
2672 str = Jim_GetString(strObjPtr, &bytelen);
2673 len = Jim_Utf8Length(interp, strObjPtr);
2675 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2676 return NULL;
2679 if (first == 0 && rangeLen == len) {
2680 return strObjPtr;
2682 if (len == bytelen) {
2683 /* ASCII optimisation */
2684 return Jim_NewStringObj(interp, str + first, rangeLen);
2686 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2687 #else
2688 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2689 #endif
2692 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2693 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2695 int first, last;
2696 const char *str;
2697 int len, rangeLen;
2698 Jim_Obj *objPtr;
2700 len = Jim_Utf8Length(interp, strObjPtr);
2702 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2703 return NULL;
2706 if (last < first) {
2707 return strObjPtr;
2710 str = Jim_String(strObjPtr);
2712 /* Before part */
2713 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2715 /* Replacement */
2716 if (newStrObj) {
2717 Jim_AppendObj(interp, objPtr, newStrObj);
2720 /* After part */
2721 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2723 return objPtr;
2727 * Note: does not support embedded nulls.
2729 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2731 while (*str) {
2732 int c;
2733 str += utf8_tounicode(str, &c);
2734 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2736 *dest = 0;
2740 * Note: does not support embedded nulls.
2742 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2744 char *buf;
2745 int len;
2746 const char *str;
2748 SetStringFromAny(interp, strObjPtr);
2750 str = Jim_GetString(strObjPtr, &len);
2752 #ifdef JIM_UTF8
2753 /* Case mapping can change the utf-8 length of the string.
2754 * But at worst it will be by one extra byte per char
2756 len *= 2;
2757 #endif
2758 buf = Jim_Alloc(len + 1);
2759 JimStrCopyUpperLower(buf, str, 0);
2760 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2764 * Note: does not support embedded nulls.
2766 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2768 char *buf;
2769 const char *str;
2770 int len;
2772 if (strObjPtr->typePtr != &stringObjType) {
2773 SetStringFromAny(interp, strObjPtr);
2776 str = Jim_GetString(strObjPtr, &len);
2778 #ifdef JIM_UTF8
2779 /* Case mapping can change the utf-8 length of the string.
2780 * But at worst it will be by one extra byte per char
2782 len *= 2;
2783 #endif
2784 buf = Jim_Alloc(len + 1);
2785 JimStrCopyUpperLower(buf, str, 1);
2786 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2790 * Note: does not support embedded nulls.
2792 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2794 char *buf, *p;
2795 int len;
2796 int c;
2797 const char *str;
2799 str = Jim_GetString(strObjPtr, &len);
2800 if (len == 0) {
2801 return strObjPtr;
2803 #ifdef JIM_UTF8
2804 /* Case mapping can change the utf-8 length of the string.
2805 * But at worst it will be by one extra byte per char
2807 len *= 2;
2808 #endif
2809 buf = p = Jim_Alloc(len + 1);
2811 str += utf8_tounicode(str, &c);
2812 p += utf8_getchars(p, utf8_title(c));
2814 JimStrCopyUpperLower(p, str, 0);
2816 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2819 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2820 * for unicode character 'c'.
2821 * Returns the position if found or NULL if not
2823 static const char *utf8_memchr(const char *str, int len, int c)
2825 #ifdef JIM_UTF8
2826 while (len) {
2827 int sc;
2828 int n = utf8_tounicode(str, &sc);
2829 if (sc == c) {
2830 return str;
2832 str += n;
2833 len -= n;
2835 return NULL;
2836 #else
2837 return memchr(str, c, len);
2838 #endif
2842 * Searches for the first non-trim char in string (str, len)
2844 * If none is found, returns just past the last char.
2846 * Lengths are in bytes.
2848 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2850 while (len) {
2851 int c;
2852 int n = utf8_tounicode(str, &c);
2854 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2855 /* Not a trim char, so stop */
2856 break;
2858 str += n;
2859 len -= n;
2861 return str;
2865 * Searches backwards for a non-trim char in string (str, len).
2867 * Returns a pointer to just after the non-trim char, or NULL if not found.
2869 * Lengths are in bytes.
2871 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2873 str += len;
2875 while (len) {
2876 int c;
2877 int n = utf8_prev_len(str, len);
2879 len -= n;
2880 str -= n;
2882 n = utf8_tounicode(str, &c);
2884 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2885 return str + n;
2889 return NULL;
2892 static const char default_trim_chars[] = " \t\n\r";
2893 /* sizeof() here includes the null byte */
2894 static int default_trim_chars_len = sizeof(default_trim_chars);
2896 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2898 int len;
2899 const char *str = Jim_GetString(strObjPtr, &len);
2900 const char *trimchars = default_trim_chars;
2901 int trimcharslen = default_trim_chars_len;
2902 const char *newstr;
2904 if (trimcharsObjPtr) {
2905 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2908 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2909 if (newstr == str) {
2910 return strObjPtr;
2913 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2916 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2918 int len;
2919 const char *trimchars = default_trim_chars;
2920 int trimcharslen = default_trim_chars_len;
2921 const char *nontrim;
2923 if (trimcharsObjPtr) {
2924 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2927 SetStringFromAny(interp, strObjPtr);
2929 len = Jim_Length(strObjPtr);
2930 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2932 if (nontrim == NULL) {
2933 /* All trim, so return a zero-length string */
2934 return Jim_NewEmptyStringObj(interp);
2936 if (nontrim == strObjPtr->bytes + len) {
2937 /* All non-trim, so return the original object */
2938 return strObjPtr;
2941 if (Jim_IsShared(strObjPtr)) {
2942 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2944 else {
2945 /* Can modify this string in place */
2946 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2947 strObjPtr->length = (nontrim - strObjPtr->bytes);
2950 return strObjPtr;
2953 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2955 /* First trim left. */
2956 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2958 /* Now trim right */
2959 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2961 /* Note: refCount check is needed since objPtr may be emptyObj */
2962 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2963 /* We don't want this object to be leaked */
2964 Jim_FreeNewObj(interp, objPtr);
2967 return strObjPtr;
2970 /* Some platforms don't have isascii - need a non-macro version */
2971 #ifdef HAVE_ISASCII
2972 #define jim_isascii isascii
2973 #else
2974 static int jim_isascii(int c)
2976 return !(c & ~0x7f);
2978 #endif
2980 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2982 static const char * const strclassnames[] = {
2983 "integer", "alpha", "alnum", "ascii", "digit",
2984 "double", "lower", "upper", "space", "xdigit",
2985 "control", "print", "graph", "punct", "boolean",
2986 NULL
2988 enum {
2989 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2990 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2991 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2993 int strclass;
2994 int len;
2995 int i;
2996 const char *str;
2997 int (*isclassfunc)(int c) = NULL;
2999 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
3000 return JIM_ERR;
3003 str = Jim_GetString(strObjPtr, &len);
3004 if (len == 0) {
3005 Jim_SetResultBool(interp, !strict);
3006 return JIM_OK;
3009 switch (strclass) {
3010 case STR_IS_INTEGER:
3012 jim_wide w;
3013 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3014 return JIM_OK;
3017 case STR_IS_DOUBLE:
3019 double d;
3020 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3021 return JIM_OK;
3024 case STR_IS_BOOLEAN:
3026 int b;
3027 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3028 return JIM_OK;
3031 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3032 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3033 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3034 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3035 case STR_IS_LOWER: isclassfunc = islower; break;
3036 case STR_IS_UPPER: isclassfunc = isupper; break;
3037 case STR_IS_SPACE: isclassfunc = isspace; break;
3038 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3039 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3040 case STR_IS_PRINT: isclassfunc = isprint; break;
3041 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3042 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3043 default:
3044 return JIM_ERR;
3047 for (i = 0; i < len; i++) {
3048 if (!isclassfunc(UCHAR(str[i]))) {
3049 Jim_SetResultBool(interp, 0);
3050 return JIM_OK;
3053 Jim_SetResultBool(interp, 1);
3054 return JIM_OK;
3057 /* -----------------------------------------------------------------------------
3058 * Compared String Object
3059 * ---------------------------------------------------------------------------*/
3061 /* This is strange object that allows comparison of a C literal string
3062 * with a Jim object in a very short time if the same comparison is done
3063 * multiple times. For example every time the [if] command is executed,
3064 * Jim has to check if a given argument is "else".
3065 * If the code has no errors, this comparison is true most of the time,
3066 * so we can cache the pointer of the string of the last matching
3067 * comparison inside the object. Because most C compilers perform literal sharing,
3068 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3069 * this works pretty well even if comparisons are at different places
3070 * inside the C code. */
3072 static const Jim_ObjType comparedStringObjType = {
3073 "compared-string",
3074 NULL,
3075 NULL,
3076 NULL,
3077 JIM_TYPE_REFERENCES,
3080 /* The only way this object is exposed to the API is via the following
3081 * function. Returns true if the string and the object string repr.
3082 * are the same, otherwise zero is returned.
3084 * Note: this isn't binary safe, but it hardly needs to be.*/
3085 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3087 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3088 return 1;
3090 else {
3091 const char *objStr = Jim_String(objPtr);
3093 if (strcmp(str, objStr) != 0)
3094 return 0;
3096 if (objPtr->typePtr != &comparedStringObjType) {
3097 Jim_FreeIntRep(interp, objPtr);
3098 objPtr->typePtr = &comparedStringObjType;
3100 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3101 return 1;
3105 static int qsortCompareStringPointers(const void *a, const void *b)
3107 char *const *sa = (char *const *)a;
3108 char *const *sb = (char *const *)b;
3110 return strcmp(*sa, *sb);
3114 /* -----------------------------------------------------------------------------
3115 * Source Object
3117 * This object is just a string from the language point of view, but
3118 * the internal representation contains the filename and line number
3119 * where this token was read. This information is used by
3120 * Jim_EvalObj() if the object passed happens to be of type "source".
3122 * This allows propagation of the information about line numbers and file
3123 * names and gives error messages with absolute line numbers.
3125 * Note that this object uses the internal representation of the Jim_Object,
3126 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3128 * Also the object will be converted to something else if the given
3129 * token it represents in the source file is not something to be
3130 * evaluated (not a script), and will be specialized in some other way,
3131 * so the time overhead is also almost zero.
3132 * ---------------------------------------------------------------------------*/
3134 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3135 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3137 static const Jim_ObjType sourceObjType = {
3138 "source",
3139 FreeSourceInternalRep,
3140 DupSourceInternalRep,
3141 NULL,
3142 JIM_TYPE_REFERENCES,
3145 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3147 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3150 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3152 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3153 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3156 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3157 Jim_Obj *fileNameObj, int lineNumber)
3159 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3160 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3161 Jim_IncrRefCount(fileNameObj);
3162 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3163 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3164 objPtr->typePtr = &sourceObjType;
3167 /* -----------------------------------------------------------------------------
3168 * ScriptLine Object
3170 * This object is used only in the Script internal represenation.
3171 * For each line of the script, it holds the number of tokens on the line
3172 * and the source line number.
3174 static const Jim_ObjType scriptLineObjType = {
3175 "scriptline",
3176 NULL,
3177 NULL,
3178 NULL,
3179 JIM_NONE,
3182 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3184 Jim_Obj *objPtr;
3186 #ifdef DEBUG_SHOW_SCRIPT
3187 char buf[100];
3188 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3189 objPtr = Jim_NewStringObj(interp, buf, -1);
3190 #else
3191 objPtr = Jim_NewEmptyStringObj(interp);
3192 #endif
3193 objPtr->typePtr = &scriptLineObjType;
3194 objPtr->internalRep.scriptLineValue.argc = argc;
3195 objPtr->internalRep.scriptLineValue.line = line;
3197 return objPtr;
3200 /* -----------------------------------------------------------------------------
3201 * Script Object
3203 * This object holds the parsed internal representation of a script.
3204 * This representation is help within an allocated ScriptObj (see below)
3206 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3207 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3209 static const Jim_ObjType scriptObjType = {
3210 "script",
3211 FreeScriptInternalRep,
3212 DupScriptInternalRep,
3213 NULL,
3214 JIM_TYPE_REFERENCES,
3217 /* Each token of a script is represented by a ScriptToken.
3218 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3219 * can be specialized by commands operating on it.
3221 typedef struct ScriptToken
3223 Jim_Obj *objPtr;
3224 int type;
3225 } ScriptToken;
3227 /* This is the script object internal representation. An array of
3228 * ScriptToken structures, including a pre-computed representation of the
3229 * command length and arguments.
3231 * For example the script:
3233 * puts hello
3234 * set $i $x$y [foo]BAR
3236 * will produce a ScriptObj with the following ScriptToken's:
3238 * LIN 2
3239 * ESC puts
3240 * ESC hello
3241 * LIN 4
3242 * ESC set
3243 * VAR i
3244 * WRD 2
3245 * VAR x
3246 * VAR y
3247 * WRD 2
3248 * CMD foo
3249 * ESC BAR
3251 * "puts hello" has two args (LIN 2), composed of single tokens.
3252 * (Note that the WRD token is omitted for the common case of a single token.)
3254 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3255 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3257 * The precomputation of the command structure makes Jim_Eval() faster,
3258 * and simpler because there aren't dynamic lengths / allocations.
3260 * -- {expand}/{*} handling --
3262 * Expand is handled in a special way.
3264 * If a "word" begins with {*}, the word token count is -ve.
3266 * For example the command:
3268 * list {*}{a b}
3270 * Will produce the following cmdstruct array:
3272 * LIN 2
3273 * ESC list
3274 * WRD -1
3275 * STR a b
3277 * Note that the 'LIN' token also contains the source information for the
3278 * first word of the line for error reporting purposes
3280 * -- the substFlags field of the structure --
3282 * The scriptObj structure is used to represent both "script" objects
3283 * and "subst" objects. In the second case, there are no LIN and WRD
3284 * tokens. Instead SEP and EOL tokens are added as-is.
3285 * In addition, the field 'substFlags' is used to represent the flags used to turn
3286 * the string into the internal representation.
3287 * If these flags do not match what the application requires,
3288 * the scriptObj is created again. For example the script:
3290 * subst -nocommands $string
3291 * subst -novariables $string
3293 * Will (re)create the internal representation of the $string object
3294 * two times.
3296 typedef struct ScriptObj
3298 ScriptToken *token; /* Tokens array. */
3299 Jim_Obj *fileNameObj; /* Filename */
3300 int len; /* Length of token[] */
3301 int substFlags; /* flags used for the compilation of "subst" objects */
3302 int inUse; /* Used to share a ScriptObj. Currently
3303 only used by Jim_EvalObj() as protection against
3304 shimmering of the currently evaluated object. */
3305 int firstline; /* Line number of the first line */
3306 int linenr; /* Error line number, if any */
3307 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3308 } ScriptObj;
3310 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3311 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3312 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3314 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3316 int i;
3317 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3319 if (--script->inUse != 0)
3320 return;
3321 for (i = 0; i < script->len; i++) {
3322 Jim_DecrRefCount(interp, script->token[i].objPtr);
3324 Jim_Free(script->token);
3325 Jim_DecrRefCount(interp, script->fileNameObj);
3326 Jim_Free(script);
3329 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3331 JIM_NOTUSED(interp);
3332 JIM_NOTUSED(srcPtr);
3334 /* Just return a simple string. We don't try to preserve the source info
3335 * since in practice scripts are never duplicated
3337 dupPtr->typePtr = NULL;
3340 /* A simple parse token.
3341 * As the script is parsed, the created tokens point into the script string rep.
3343 typedef struct
3345 const char *token; /* Pointer to the start of the token */
3346 int len; /* Length of this token */
3347 int type; /* Token type */
3348 int line; /* Line number */
3349 } ParseToken;
3351 /* A list of parsed tokens representing a script.
3352 * Tokens are added to this list as the script is parsed.
3353 * It grows as needed.
3355 typedef struct
3357 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3358 ParseToken *list; /* Array of tokens */
3359 int size; /* Current size of the list */
3360 int count; /* Number of entries used */
3361 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3362 } ParseTokenList;
3364 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3366 tokenlist->list = tokenlist->static_list;
3367 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3368 tokenlist->count = 0;
3371 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3373 if (tokenlist->list != tokenlist->static_list) {
3374 Jim_Free(tokenlist->list);
3379 * Adds the new token to the tokenlist.
3380 * The token has the given length, type and line number.
3381 * The token list is resized as necessary.
3383 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3384 int line)
3386 ParseToken *t;
3388 if (tokenlist->count == tokenlist->size) {
3389 /* Resize the list */
3390 tokenlist->size *= 2;
3391 if (tokenlist->list != tokenlist->static_list) {
3392 tokenlist->list =
3393 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3395 else {
3396 /* The list needs to become allocated */
3397 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3398 memcpy(tokenlist->list, tokenlist->static_list,
3399 tokenlist->count * sizeof(*tokenlist->list));
3402 t = &tokenlist->list[tokenlist->count++];
3403 t->token = token;
3404 t->len = len;
3405 t->type = type;
3406 t->line = line;
3409 /* Counts the number of adjoining non-separator tokens.
3411 * Returns -ve if the first token is the expansion
3412 * operator (in which case the count doesn't include
3413 * that token).
3415 static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t)
3417 int expand = 1;
3418 int count = 0;
3420 /* Is the first word {*} or {expand}? */
3421 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3422 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3423 /* Create an expand token */
3424 expand = -1;
3425 t++;
3427 else {
3428 if (script->missing == ' ') {
3429 /* This is a "extra characters after close-brace" error. Report the first error */
3430 script->missing = '}';
3431 script->linenr = t[1].line;
3436 /* Now count non-separator words */
3437 while (!TOKEN_IS_SEP(t->type)) {
3438 t++;
3439 count++;
3442 return count * expand;
3446 * Create a script/subst object from the given token.
3448 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3450 Jim_Obj *objPtr;
3452 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3453 /* Convert backlash escapes. The result will never be longer than the original */
3454 int len = t->len;
3455 char *str = Jim_Alloc(len + 1);
3456 len = JimEscape(str, t->token, len);
3457 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3459 else {
3460 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3461 * with a single space.
3463 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3465 return objPtr;
3469 * Takes a tokenlist and creates the allocated list of script tokens
3470 * in script->token, of length script->len.
3472 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3473 * as required.
3475 * Also sets script->line to the line number of the first token
3477 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3478 ParseTokenList *tokenlist)
3480 int i;
3481 struct ScriptToken *token;
3482 /* Number of tokens so far for the current command */
3483 int lineargs = 0;
3484 /* This is the first token for the current command */
3485 ScriptToken *linefirst;
3486 int count;
3487 int linenr;
3489 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3490 printf("==== Tokens ====\n");
3491 for (i = 0; i < tokenlist->count; i++) {
3492 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3493 tokenlist->list[i].len, tokenlist->list[i].token);
3495 #endif
3497 /* May need up to one extra script token for each EOL in the worst case */
3498 count = tokenlist->count;
3499 for (i = 0; i < tokenlist->count; i++) {
3500 if (tokenlist->list[i].type == JIM_TT_EOL) {
3501 count++;
3504 linenr = script->firstline = tokenlist->list[0].line;
3506 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3508 /* This is the first token for the current command */
3509 linefirst = token++;
3511 for (i = 0; i < tokenlist->count; ) {
3512 /* Look ahead to find out how many tokens make up the next word */
3513 int wordtokens;
3515 /* Skip any leading separators */
3516 while (tokenlist->list[i].type == JIM_TT_SEP) {
3517 i++;
3520 wordtokens = JimCountWordTokens(script, tokenlist->list + i);
3522 if (wordtokens == 0) {
3523 /* None, so at end of line */
3524 if (lineargs) {
3525 linefirst->type = JIM_TT_LINE;
3526 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3527 Jim_IncrRefCount(linefirst->objPtr);
3529 /* Reset for new line */
3530 lineargs = 0;
3531 linefirst = token++;
3533 i++;
3534 continue;
3536 else if (wordtokens != 1) {
3537 /* More than 1, or {*}, so insert a WORD token */
3538 token->type = JIM_TT_WORD;
3539 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3540 Jim_IncrRefCount(token->objPtr);
3541 token++;
3542 if (wordtokens < 0) {
3543 /* Skip the expand token */
3544 i++;
3545 wordtokens = -wordtokens - 1;
3546 lineargs--;
3550 if (lineargs == 0) {
3551 /* First real token on the line, so record the line number */
3552 linenr = tokenlist->list[i].line;
3554 lineargs++;
3556 /* Add each non-separator word token to the line */
3557 while (wordtokens--) {
3558 const ParseToken *t = &tokenlist->list[i++];
3560 token->type = t->type;
3561 token->objPtr = JimMakeScriptObj(interp, t);
3562 Jim_IncrRefCount(token->objPtr);
3564 /* Every object is initially a string of type 'source', but the
3565 * internal type may be specialized during execution of the
3566 * script. */
3567 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3568 token++;
3572 if (lineargs == 0) {
3573 token--;
3576 script->len = token - script->token;
3578 JimPanic((script->len >= count, "allocated script array is too short"));
3580 #ifdef DEBUG_SHOW_SCRIPT
3581 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3582 for (i = 0; i < script->len; i++) {
3583 const ScriptToken *t = &script->token[i];
3584 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3586 #endif
3590 /* Parses the given string object to determine if it represents a complete script.
3592 * This is useful for interactive shells implementation, for [info complete].
3594 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3595 * '{' on scripts incomplete missing one or more '}' to be balanced.
3596 * '[' on scripts incomplete missing one or more ']' to be balanced.
3597 * '"' on scripts incomplete missing a '"' char.
3598 * '\\' on scripts with a trailing backslash.
3600 * If the script is complete, 1 is returned, otherwise 0.
3602 * If the script has extra characters after a close brace, this still returns 1,
3603 * but sets *stateCharPtr to '}'
3604 * Evaluating the script will give the error "extra characters after close-brace".
3606 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3608 ScriptObj *script = JimGetScript(interp, scriptObj);
3609 if (stateCharPtr) {
3610 *stateCharPtr = script->missing;
3612 return script->missing == ' ' || script->missing == '}';
3616 * Sets an appropriate error message for a missing script/expression terminator.
3618 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3620 * Note that a trailing backslash is not considered to be an error.
3622 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3624 const char *msg;
3626 switch (ch) {
3627 case '\\':
3628 case ' ':
3629 return JIM_OK;
3631 case '[':
3632 msg = "unmatched \"[\"";
3633 break;
3634 case '{':
3635 msg = "missing close-brace";
3636 break;
3637 case '}':
3638 msg = "extra characters after close-brace";
3639 break;
3640 case '"':
3641 default:
3642 msg = "missing quote";
3643 break;
3646 Jim_SetResultString(interp, msg, -1);
3647 return JIM_ERR;
3651 * Similar to ScriptObjAddTokens(), but for subst objects.
3653 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3654 ParseTokenList *tokenlist)
3656 int i;
3657 struct ScriptToken *token;
3659 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3661 for (i = 0; i < tokenlist->count; i++) {
3662 const ParseToken *t = &tokenlist->list[i];
3664 /* Create a token for 't' */
3665 token->type = t->type;
3666 token->objPtr = JimMakeScriptObj(interp, t);
3667 Jim_IncrRefCount(token->objPtr);
3668 token++;
3671 script->len = i;
3674 /* This method takes the string representation of an object
3675 * as a Tcl script, and generates the pre-parsed internal representation
3676 * of the script.
3678 * On parse error, sets an error message and returns JIM_ERR
3679 * (Note: the object is still converted to a script, even if an error occurs)
3681 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3683 int scriptTextLen;
3684 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3685 struct JimParserCtx parser;
3686 struct ScriptObj *script;
3687 ParseTokenList tokenlist;
3688 int line = 1;
3690 /* Try to get information about filename / line number */
3691 if (objPtr->typePtr == &sourceObjType) {
3692 line = objPtr->internalRep.sourceValue.lineNumber;
3695 /* Initially parse the script into tokens (in tokenlist) */
3696 ScriptTokenListInit(&tokenlist);
3698 JimParserInit(&parser, scriptText, scriptTextLen, line);
3699 while (!parser.eof) {
3700 JimParseScript(&parser);
3701 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3702 parser.tline);
3705 /* Add a final EOF token */
3706 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3708 /* Create the "real" script tokens from the parsed tokens */
3709 script = Jim_Alloc(sizeof(*script));
3710 memset(script, 0, sizeof(*script));
3711 script->inUse = 1;
3712 if (objPtr->typePtr == &sourceObjType) {
3713 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3715 else {
3716 script->fileNameObj = interp->emptyObj;
3718 Jim_IncrRefCount(script->fileNameObj);
3719 script->missing = parser.missing.ch;
3720 script->linenr = parser.missing.line;
3722 ScriptObjAddTokens(interp, script, &tokenlist);
3724 /* No longer need the token list */
3725 ScriptTokenListFree(&tokenlist);
3727 /* Free the old internal rep and set the new one. */
3728 Jim_FreeIntRep(interp, objPtr);
3729 Jim_SetIntRepPtr(objPtr, script);
3730 objPtr->typePtr = &scriptObjType;
3733 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3736 * Returns the parsed script.
3737 * Note that if there is any possibility that the script is not valid,
3738 * call JimScriptValid() to check
3740 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3742 if (objPtr == interp->emptyObj) {
3743 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3744 objPtr = interp->nullScriptObj;
3747 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3748 JimSetScriptFromAny(interp, objPtr);
3751 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3755 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3756 * and leaves an error message in the interp result.
3759 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3761 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3762 JimAddErrorToStack(interp, script);
3763 return 0;
3765 return 1;
3769 /* -----------------------------------------------------------------------------
3770 * Commands
3771 * ---------------------------------------------------------------------------*/
3772 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3774 cmdPtr->inUse++;
3777 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3779 if (--cmdPtr->inUse == 0) {
3780 if (cmdPtr->isproc) {
3781 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3782 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3783 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3784 if (cmdPtr->u.proc.staticVars) {
3785 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3786 Jim_Free(cmdPtr->u.proc.staticVars);
3789 else {
3790 /* native (C) */
3791 if (cmdPtr->u.native.delProc) {
3792 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3795 if (cmdPtr->prevCmd) {
3796 /* Delete any pushed command too */
3797 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3799 Jim_Free(cmdPtr);
3803 /* Variables HashTable Type.
3805 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3808 /* Variables HashTable Type.
3810 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3811 static void JimVariablesHTValDestructor(void *interp, void *val)
3813 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3814 Jim_Free(val);
3817 static const Jim_HashTableType JimVariablesHashTableType = {
3818 JimStringCopyHTHashFunction, /* hash function */
3819 JimStringCopyHTDup, /* key dup */
3820 NULL, /* val dup */
3821 JimStringCopyHTKeyCompare, /* key compare */
3822 JimStringCopyHTKeyDestructor, /* key destructor */
3823 JimVariablesHTValDestructor /* val destructor */
3826 /* Commands HashTable Type.
3828 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3830 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3832 JimDecrCmdRefCount(interp, val);
3835 static const Jim_HashTableType JimCommandsHashTableType = {
3836 JimStringCopyHTHashFunction, /* hash function */
3837 JimStringCopyHTDup, /* key dup */
3838 NULL, /* val dup */
3839 JimStringCopyHTKeyCompare, /* key compare */
3840 JimStringCopyHTKeyDestructor, /* key destructor */
3841 JimCommandsHT_ValDestructor /* val destructor */
3844 /* ------------------------- Commands related functions --------------------- */
3846 #ifdef jim_ext_namespace
3848 * Returns the "unscoped" version of the given namespace.
3849 * That is, the fully qualified name without the leading ::
3850 * The returned value is either nsObj, or an object with a zero ref count.
3852 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3854 const char *name = Jim_String(nsObj);
3855 if (name[0] == ':' && name[1] == ':') {
3856 /* This command is being defined in the global namespace */
3857 while (*++name == ':') {
3859 nsObj = Jim_NewStringObj(interp, name, -1);
3861 else if (Jim_Length(interp->framePtr->nsObj)) {
3862 /* This command is being defined in a non-global namespace */
3863 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3864 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3866 return nsObj;
3869 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3871 Jim_Obj *resultObj;
3873 const char *name = Jim_String(nameObjPtr);
3874 if (name[0] == ':' && name[1] == ':') {
3875 return nameObjPtr;
3877 Jim_IncrRefCount(nameObjPtr);
3878 resultObj = Jim_NewStringObj(interp, "::", -1);
3879 Jim_AppendObj(interp, resultObj, nameObjPtr);
3880 Jim_DecrRefCount(interp, nameObjPtr);
3882 return resultObj;
3886 * An efficient version of JimQualifyNameObj() where the name is
3887 * available (and needed) as a 'const char *'.
3888 * Avoids creating an object if not necessary.
3889 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3891 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3893 Jim_Obj *objPtr = interp->emptyObj;
3895 if (name[0] == ':' && name[1] == ':') {
3896 /* This command is being defined in the global namespace */
3897 while (*++name == ':') {
3900 else if (Jim_Length(interp->framePtr->nsObj)) {
3901 /* This command is being defined in a non-global namespace */
3902 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3903 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3904 name = Jim_String(objPtr);
3906 Jim_IncrRefCount(objPtr);
3907 *objPtrPtr = objPtr;
3908 return name;
3911 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3913 #else
3914 /* We can be more efficient in the no-namespace case */
3915 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3916 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3918 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3920 return nameObjPtr;
3922 #endif
3924 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3926 /* It may already exist, so we try to delete the old one.
3927 * Note that reference count means that it won't be deleted yet if
3928 * it exists in the call stack.
3930 * BUT, if 'local' is in force, instead of deleting the existing
3931 * proc, we stash a reference to the old proc here.
3933 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3934 if (he) {
3935 /* There was an old cmd with the same name,
3936 * so this requires a 'proc epoch' update. */
3938 /* If a procedure with the same name didn't exist there is no need
3939 * to increment the 'proc epoch' because creation of a new procedure
3940 * can never affect existing cached commands. We don't do
3941 * negative caching. */
3942 Jim_InterpIncrProcEpoch(interp);
3945 if (he && interp->local) {
3946 /* Push this command over the top of the previous one */
3947 cmd->prevCmd = Jim_GetHashEntryVal(he);
3948 Jim_SetHashVal(&interp->commands, he, cmd);
3950 else {
3951 if (he) {
3952 /* Replace the existing command */
3953 Jim_DeleteHashEntry(&interp->commands, name);
3956 Jim_AddHashEntry(&interp->commands, name, cmd);
3958 return JIM_OK;
3962 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3963 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3965 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3967 /* Store the new details for this command */
3968 memset(cmdPtr, 0, sizeof(*cmdPtr));
3969 cmdPtr->inUse = 1;
3970 cmdPtr->u.native.delProc = delProc;
3971 cmdPtr->u.native.cmdProc = cmdProc;
3972 cmdPtr->u.native.privData = privData;
3974 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3976 return JIM_OK;
3979 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3981 int len, i;
3983 len = Jim_ListLength(interp, staticsListObjPtr);
3984 if (len == 0) {
3985 return JIM_OK;
3988 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3989 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3990 for (i = 0; i < len; i++) {
3991 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3992 Jim_Var *varPtr;
3993 int subLen;
3995 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3996 /* Check if it's composed of two elements. */
3997 subLen = Jim_ListLength(interp, objPtr);
3998 if (subLen == 1 || subLen == 2) {
3999 /* Try to get the variable value from the current
4000 * environment. */
4001 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
4002 if (subLen == 1) {
4003 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
4004 if (initObjPtr == NULL) {
4005 Jim_SetResultFormatted(interp,
4006 "variable for initialization of static \"%#s\" not found in the local context",
4007 nameObjPtr);
4008 return JIM_ERR;
4011 else {
4012 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
4014 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
4015 return JIM_ERR;
4018 varPtr = Jim_Alloc(sizeof(*varPtr));
4019 varPtr->objPtr = initObjPtr;
4020 Jim_IncrRefCount(initObjPtr);
4021 varPtr->linkFramePtr = NULL;
4022 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
4023 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
4024 Jim_SetResultFormatted(interp,
4025 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4026 Jim_DecrRefCount(interp, initObjPtr);
4027 Jim_Free(varPtr);
4028 return JIM_ERR;
4031 else {
4032 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4033 objPtr);
4034 return JIM_ERR;
4037 return JIM_OK;
4040 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4042 #ifdef jim_ext_namespace
4043 if (cmdPtr->isproc) {
4044 /* XXX: Really need JimNamespaceSplit() */
4045 const char *pt = strrchr(cmdname, ':');
4046 if (pt && pt != cmdname && pt[-1] == ':') {
4047 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4048 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4049 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4051 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4052 /* This commands shadows a global command, so a proc epoch update is required */
4053 Jim_InterpIncrProcEpoch(interp);
4057 #endif
4060 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4061 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4063 Jim_Cmd *cmdPtr;
4064 int argListLen;
4065 int i;
4067 argListLen = Jim_ListLength(interp, argListObjPtr);
4069 /* Allocate space for both the command pointer and the arg list */
4070 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4071 memset(cmdPtr, 0, sizeof(*cmdPtr));
4072 cmdPtr->inUse = 1;
4073 cmdPtr->isproc = 1;
4074 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4075 cmdPtr->u.proc.argListLen = argListLen;
4076 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4077 cmdPtr->u.proc.argsPos = -1;
4078 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4079 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4080 Jim_IncrRefCount(argListObjPtr);
4081 Jim_IncrRefCount(bodyObjPtr);
4082 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4084 /* Create the statics hash table. */
4085 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4086 goto err;
4089 /* Parse the args out into arglist, validating as we go */
4090 /* Examine the argument list for default parameters and 'args' */
4091 for (i = 0; i < argListLen; i++) {
4092 Jim_Obj *argPtr;
4093 Jim_Obj *nameObjPtr;
4094 Jim_Obj *defaultObjPtr;
4095 int len;
4097 /* Examine a parameter */
4098 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4099 len = Jim_ListLength(interp, argPtr);
4100 if (len == 0) {
4101 Jim_SetResultString(interp, "argument with no name", -1);
4102 err:
4103 JimDecrCmdRefCount(interp, cmdPtr);
4104 return NULL;
4106 if (len > 2) {
4107 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4108 goto err;
4111 if (len == 2) {
4112 /* Optional parameter */
4113 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4114 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4116 else {
4117 /* Required parameter */
4118 nameObjPtr = argPtr;
4119 defaultObjPtr = NULL;
4123 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4124 if (cmdPtr->u.proc.argsPos >= 0) {
4125 Jim_SetResultString(interp, "'args' specified more than once", -1);
4126 goto err;
4128 cmdPtr->u.proc.argsPos = i;
4130 else {
4131 if (len == 2) {
4132 cmdPtr->u.proc.optArity++;
4134 else {
4135 cmdPtr->u.proc.reqArity++;
4139 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4140 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4143 return cmdPtr;
4146 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4148 int ret = JIM_OK;
4149 Jim_Obj *qualifiedNameObj;
4150 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4152 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4153 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4154 ret = JIM_ERR;
4156 else {
4157 Jim_InterpIncrProcEpoch(interp);
4160 JimFreeQualifiedName(interp, qualifiedNameObj);
4162 return ret;
4165 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4167 int ret = JIM_ERR;
4168 Jim_HashEntry *he;
4169 Jim_Cmd *cmdPtr;
4170 Jim_Obj *qualifiedOldNameObj;
4171 Jim_Obj *qualifiedNewNameObj;
4172 const char *fqold;
4173 const char *fqnew;
4175 if (newName[0] == 0) {
4176 return Jim_DeleteCommand(interp, oldName);
4179 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4180 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4182 /* Does it exist? */
4183 he = Jim_FindHashEntry(&interp->commands, fqold);
4184 if (he == NULL) {
4185 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4187 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4188 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4190 else {
4191 /* Add the new name first */
4192 cmdPtr = Jim_GetHashEntryVal(he);
4193 JimIncrCmdRefCount(cmdPtr);
4194 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4195 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4197 /* Now remove the old name */
4198 Jim_DeleteHashEntry(&interp->commands, fqold);
4200 /* Increment the epoch */
4201 Jim_InterpIncrProcEpoch(interp);
4203 ret = JIM_OK;
4206 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4207 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4209 return ret;
4212 /* -----------------------------------------------------------------------------
4213 * Command object
4214 * ---------------------------------------------------------------------------*/
4216 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4218 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4221 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4223 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4224 dupPtr->typePtr = srcPtr->typePtr;
4225 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4228 static const Jim_ObjType commandObjType = {
4229 "command",
4230 FreeCommandInternalRep,
4231 DupCommandInternalRep,
4232 NULL,
4233 JIM_TYPE_REFERENCES,
4236 /* This function returns the command structure for the command name
4237 * stored in objPtr. It tries to specialize the objPtr to contain
4238 * a cached info instead to perform the lookup into the hash table
4239 * every time. The information cached may not be uptodate, in such
4240 * a case the lookup is performed and the cache updated.
4242 * Respects the 'upcall' setting
4244 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4246 Jim_Cmd *cmd;
4248 /* In order to be valid, the proc epoch must match and
4249 * the lookup must have occurred in the same namespace
4251 if (objPtr->typePtr != &commandObjType ||
4252 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4253 #ifdef jim_ext_namespace
4254 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4255 #endif
4257 /* Not cached or out of date, so lookup */
4259 /* Do we need to try the local namespace? */
4260 const char *name = Jim_String(objPtr);
4261 Jim_HashEntry *he;
4263 if (name[0] == ':' && name[1] == ':') {
4264 while (*++name == ':') {
4267 #ifdef jim_ext_namespace
4268 else if (Jim_Length(interp->framePtr->nsObj)) {
4269 /* This command is being defined in a non-global namespace */
4270 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4271 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4272 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4273 Jim_FreeNewObj(interp, nameObj);
4274 if (he) {
4275 goto found;
4278 #endif
4280 /* Lookup in the global namespace */
4281 he = Jim_FindHashEntry(&interp->commands, name);
4282 if (he == NULL) {
4283 if (flags & JIM_ERRMSG) {
4284 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4286 return NULL;
4288 #ifdef jim_ext_namespace
4289 found:
4290 #endif
4291 cmd = Jim_GetHashEntryVal(he);
4293 /* Free the old internal repr and set the new one. */
4294 Jim_FreeIntRep(interp, objPtr);
4295 objPtr->typePtr = &commandObjType;
4296 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4297 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4298 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4299 Jim_IncrRefCount(interp->framePtr->nsObj);
4301 else {
4302 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4304 while (cmd->u.proc.upcall) {
4305 cmd = cmd->prevCmd;
4307 return cmd;
4310 /* -----------------------------------------------------------------------------
4311 * Variables
4312 * ---------------------------------------------------------------------------*/
4314 /* -----------------------------------------------------------------------------
4315 * Variable object
4316 * ---------------------------------------------------------------------------*/
4318 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4320 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4322 static const Jim_ObjType variableObjType = {
4323 "variable",
4324 NULL,
4325 NULL,
4326 NULL,
4327 JIM_TYPE_REFERENCES,
4331 * Check that the name does not contain embedded nulls.
4333 * Variable and procedure names are manipulated as null terminated strings, so
4334 * don't allow names with embedded nulls.
4336 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4338 /* Variable names and proc names can't contain embedded nulls */
4339 if (nameObjPtr->typePtr != &variableObjType) {
4340 int len;
4341 const char *str = Jim_GetString(nameObjPtr, &len);
4342 if (memchr(str, '\0', len)) {
4343 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4344 return JIM_ERR;
4347 return JIM_OK;
4350 /* This method should be called only by the variable API.
4351 * It returns JIM_OK on success (variable already exists),
4352 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4353 * a variable name, but syntax glue for [dict] i.e. the last
4354 * character is ')' */
4355 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4357 const char *varName;
4358 Jim_CallFrame *framePtr;
4359 Jim_HashEntry *he;
4360 int global;
4361 int len;
4363 /* Check if the object is already an uptodate variable */
4364 if (objPtr->typePtr == &variableObjType) {
4365 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4366 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4367 /* nothing to do */
4368 return JIM_OK;
4370 /* Need to re-resolve the variable in the updated callframe */
4372 else if (objPtr->typePtr == &dictSubstObjType) {
4373 return JIM_DICT_SUGAR;
4375 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4376 return JIM_ERR;
4380 varName = Jim_GetString(objPtr, &len);
4382 /* Make sure it's not syntax glue to get/set dict. */
4383 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4384 return JIM_DICT_SUGAR;
4387 if (varName[0] == ':' && varName[1] == ':') {
4388 while (*++varName == ':') {
4390 global = 1;
4391 framePtr = interp->topFramePtr;
4393 else {
4394 global = 0;
4395 framePtr = interp->framePtr;
4398 /* Resolve this name in the variables hash table */
4399 he = Jim_FindHashEntry(&framePtr->vars, varName);
4400 if (he == NULL) {
4401 if (!global && framePtr->staticVars) {
4402 /* Try with static vars. */
4403 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4405 if (he == NULL) {
4406 return JIM_ERR;
4410 /* Free the old internal repr and set the new one. */
4411 Jim_FreeIntRep(interp, objPtr);
4412 objPtr->typePtr = &variableObjType;
4413 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4414 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4415 objPtr->internalRep.varValue.global = global;
4416 return JIM_OK;
4419 /* -------------------- Variables related functions ------------------------- */
4420 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4421 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4423 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4425 const char *name;
4426 Jim_CallFrame *framePtr;
4427 int global;
4429 /* New variable to create */
4430 Jim_Var *var = Jim_Alloc(sizeof(*var));
4432 var->objPtr = valObjPtr;
4433 Jim_IncrRefCount(valObjPtr);
4434 var->linkFramePtr = NULL;
4436 name = Jim_String(nameObjPtr);
4437 if (name[0] == ':' && name[1] == ':') {
4438 while (*++name == ':') {
4440 framePtr = interp->topFramePtr;
4441 global = 1;
4443 else {
4444 framePtr = interp->framePtr;
4445 global = 0;
4448 /* Insert the new variable */
4449 Jim_AddHashEntry(&framePtr->vars, name, var);
4451 /* Make the object int rep a variable */
4452 Jim_FreeIntRep(interp, nameObjPtr);
4453 nameObjPtr->typePtr = &variableObjType;
4454 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4455 nameObjPtr->internalRep.varValue.varPtr = var;
4456 nameObjPtr->internalRep.varValue.global = global;
4458 return var;
4461 /* For now that's dummy. Variables lookup should be optimized
4462 * in many ways, with caching of lookups, and possibly with
4463 * a table of pre-allocated vars in every CallFrame for local vars.
4464 * All the caching should also have an 'epoch' mechanism similar
4465 * to the one used by Tcl for procedures lookup caching. */
4467 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4469 int err;
4470 Jim_Var *var;
4472 switch (SetVariableFromAny(interp, nameObjPtr)) {
4473 case JIM_DICT_SUGAR:
4474 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4476 case JIM_ERR:
4477 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4478 return JIM_ERR;
4480 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4481 break;
4483 case JIM_OK:
4484 var = nameObjPtr->internalRep.varValue.varPtr;
4485 if (var->linkFramePtr == NULL) {
4486 Jim_IncrRefCount(valObjPtr);
4487 Jim_DecrRefCount(interp, var->objPtr);
4488 var->objPtr = valObjPtr;
4490 else { /* Else handle the link */
4491 Jim_CallFrame *savedCallFrame;
4493 savedCallFrame = interp->framePtr;
4494 interp->framePtr = var->linkFramePtr;
4495 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4496 interp->framePtr = savedCallFrame;
4497 if (err != JIM_OK)
4498 return err;
4501 return JIM_OK;
4504 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4506 Jim_Obj *nameObjPtr;
4507 int result;
4509 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4510 Jim_IncrRefCount(nameObjPtr);
4511 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4512 Jim_DecrRefCount(interp, nameObjPtr);
4513 return result;
4516 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4518 Jim_CallFrame *savedFramePtr;
4519 int result;
4521 savedFramePtr = interp->framePtr;
4522 interp->framePtr = interp->topFramePtr;
4523 result = Jim_SetVariableStr(interp, name, objPtr);
4524 interp->framePtr = savedFramePtr;
4525 return result;
4528 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4530 Jim_Obj *nameObjPtr, *valObjPtr;
4531 int result;
4533 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4534 valObjPtr = Jim_NewStringObj(interp, val, -1);
4535 Jim_IncrRefCount(nameObjPtr);
4536 Jim_IncrRefCount(valObjPtr);
4537 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4538 Jim_DecrRefCount(interp, nameObjPtr);
4539 Jim_DecrRefCount(interp, valObjPtr);
4540 return result;
4543 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4544 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4546 const char *varName;
4547 const char *targetName;
4548 Jim_CallFrame *framePtr;
4549 Jim_Var *varPtr;
4551 /* Check for an existing variable or link */
4552 switch (SetVariableFromAny(interp, nameObjPtr)) {
4553 case JIM_DICT_SUGAR:
4554 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4555 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4556 return JIM_ERR;
4558 case JIM_OK:
4559 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4561 if (varPtr->linkFramePtr == NULL) {
4562 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4563 return JIM_ERR;
4566 /* It exists, but is a link, so first delete the link */
4567 varPtr->linkFramePtr = NULL;
4568 break;
4571 /* Resolve the call frames for both variables */
4572 /* XXX: SetVariableFromAny() already did this! */
4573 varName = Jim_String(nameObjPtr);
4575 if (varName[0] == ':' && varName[1] == ':') {
4576 while (*++varName == ':') {
4578 /* Linking a global var does nothing */
4579 framePtr = interp->topFramePtr;
4581 else {
4582 framePtr = interp->framePtr;
4585 targetName = Jim_String(targetNameObjPtr);
4586 if (targetName[0] == ':' && targetName[1] == ':') {
4587 while (*++targetName == ':') {
4589 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4590 targetCallFrame = interp->topFramePtr;
4592 Jim_IncrRefCount(targetNameObjPtr);
4594 if (framePtr->level < targetCallFrame->level) {
4595 Jim_SetResultFormatted(interp,
4596 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4597 nameObjPtr);
4598 Jim_DecrRefCount(interp, targetNameObjPtr);
4599 return JIM_ERR;
4602 /* Check for cycles. */
4603 if (framePtr == targetCallFrame) {
4604 Jim_Obj *objPtr = targetNameObjPtr;
4606 /* Cycles are only possible with 'uplevel 0' */
4607 while (1) {
4608 if (strcmp(Jim_String(objPtr), varName) == 0) {
4609 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4610 Jim_DecrRefCount(interp, targetNameObjPtr);
4611 return JIM_ERR;
4613 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4614 break;
4615 varPtr = objPtr->internalRep.varValue.varPtr;
4616 if (varPtr->linkFramePtr != targetCallFrame)
4617 break;
4618 objPtr = varPtr->objPtr;
4622 /* Perform the binding */
4623 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4624 /* We are now sure 'nameObjPtr' type is variableObjType */
4625 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4626 Jim_DecrRefCount(interp, targetNameObjPtr);
4627 return JIM_OK;
4630 /* Return the Jim_Obj pointer associated with a variable name,
4631 * or NULL if the variable was not found in the current context.
4632 * The same optimization discussed in the comment to the
4633 * 'SetVariable' function should apply here.
4635 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4636 * in a dictionary which is shared, the array variable value is duplicated first.
4637 * This allows the array element to be updated (e.g. append, lappend) without
4638 * affecting other references to the dictionary.
4640 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4642 switch (SetVariableFromAny(interp, nameObjPtr)) {
4643 case JIM_OK:{
4644 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4646 if (varPtr->linkFramePtr == NULL) {
4647 return varPtr->objPtr;
4649 else {
4650 Jim_Obj *objPtr;
4652 /* The variable is a link? Resolve it. */
4653 Jim_CallFrame *savedCallFrame = interp->framePtr;
4655 interp->framePtr = varPtr->linkFramePtr;
4656 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4657 interp->framePtr = savedCallFrame;
4658 if (objPtr) {
4659 return objPtr;
4661 /* Error, so fall through to the error message */
4664 break;
4666 case JIM_DICT_SUGAR:
4667 /* [dict] syntax sugar. */
4668 return JimDictSugarGet(interp, nameObjPtr, flags);
4670 if (flags & JIM_ERRMSG) {
4671 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4673 return NULL;
4676 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4678 Jim_CallFrame *savedFramePtr;
4679 Jim_Obj *objPtr;
4681 savedFramePtr = interp->framePtr;
4682 interp->framePtr = interp->topFramePtr;
4683 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4684 interp->framePtr = savedFramePtr;
4686 return objPtr;
4689 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4691 Jim_Obj *nameObjPtr, *varObjPtr;
4693 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4694 Jim_IncrRefCount(nameObjPtr);
4695 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4696 Jim_DecrRefCount(interp, nameObjPtr);
4697 return varObjPtr;
4700 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4702 Jim_CallFrame *savedFramePtr;
4703 Jim_Obj *objPtr;
4705 savedFramePtr = interp->framePtr;
4706 interp->framePtr = interp->topFramePtr;
4707 objPtr = Jim_GetVariableStr(interp, name, flags);
4708 interp->framePtr = savedFramePtr;
4710 return objPtr;
4713 /* Unset a variable.
4714 * Note: On success unset invalidates all the variable objects created
4715 * in the current call frame incrementing. */
4716 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4718 Jim_Var *varPtr;
4719 int retval;
4720 Jim_CallFrame *framePtr;
4722 retval = SetVariableFromAny(interp, nameObjPtr);
4723 if (retval == JIM_DICT_SUGAR) {
4724 /* [dict] syntax sugar. */
4725 return JimDictSugarSet(interp, nameObjPtr, NULL);
4727 else if (retval == JIM_OK) {
4728 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4730 /* If it's a link call UnsetVariable recursively */
4731 if (varPtr->linkFramePtr) {
4732 framePtr = interp->framePtr;
4733 interp->framePtr = varPtr->linkFramePtr;
4734 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4735 interp->framePtr = framePtr;
4737 else {
4738 const char *name = Jim_String(nameObjPtr);
4739 if (nameObjPtr->internalRep.varValue.global) {
4740 name += 2;
4741 framePtr = interp->topFramePtr;
4743 else {
4744 framePtr = interp->framePtr;
4747 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4748 if (retval == JIM_OK) {
4749 /* Change the callframe id, invalidating var lookup caching */
4750 framePtr->id = interp->callFrameEpoch++;
4754 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4755 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4757 return retval;
4760 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4762 /* Given a variable name for [dict] operation syntax sugar,
4763 * this function returns two objects, the first with the name
4764 * of the variable to set, and the second with the respective key.
4765 * For example "foo(bar)" will return objects with string repr. of
4766 * "foo" and "bar".
4768 * The returned objects have refcount = 1. The function can't fail. */
4769 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4770 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4772 const char *str, *p;
4773 int len, keyLen;
4774 Jim_Obj *varObjPtr, *keyObjPtr;
4776 str = Jim_GetString(objPtr, &len);
4778 p = strchr(str, '(');
4779 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4781 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4783 p++;
4784 keyLen = (str + len) - p;
4785 if (str[len - 1] == ')') {
4786 keyLen--;
4789 /* Create the objects with the variable name and key. */
4790 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4792 Jim_IncrRefCount(varObjPtr);
4793 Jim_IncrRefCount(keyObjPtr);
4794 *varPtrPtr = varObjPtr;
4795 *keyPtrPtr = keyObjPtr;
4798 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4799 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4800 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4802 int err;
4804 SetDictSubstFromAny(interp, objPtr);
4806 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4807 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4809 if (err == JIM_OK) {
4810 /* Don't keep an extra ref to the result */
4811 Jim_SetEmptyResult(interp);
4813 else {
4814 if (!valObjPtr) {
4815 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4816 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4817 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4818 objPtr);
4819 return err;
4822 /* Make the error more informative and Tcl-compatible */
4823 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4824 (valObjPtr ? "set" : "unset"), objPtr);
4826 return err;
4830 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4832 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4833 * and stored back to the variable before expansion.
4835 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4836 Jim_Obj *keyObjPtr, int flags)
4838 Jim_Obj *dictObjPtr;
4839 Jim_Obj *resObjPtr = NULL;
4840 int ret;
4842 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4843 if (!dictObjPtr) {
4844 return NULL;
4847 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4848 if (ret != JIM_OK) {
4849 Jim_SetResultFormatted(interp,
4850 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4851 ret < 0 ? "variable isn't" : "no such element in");
4853 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4854 /* Update the variable to have an unshared copy */
4855 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4858 return resObjPtr;
4861 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4862 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4864 SetDictSubstFromAny(interp, objPtr);
4866 return JimDictExpandArrayVariable(interp,
4867 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4868 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4871 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4873 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4875 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4876 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4879 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4881 /* Copy the internal rep */
4882 dupPtr->internalRep = srcPtr->internalRep;
4883 /* Need to increment the ref counts */
4884 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr);
4885 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
4888 /* Note: The object *must* be in dict-sugar format */
4889 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4891 if (objPtr->typePtr != &dictSubstObjType) {
4892 Jim_Obj *varObjPtr, *keyObjPtr;
4894 if (objPtr->typePtr == &interpolatedObjType) {
4895 /* An interpolated object in dict-sugar form */
4897 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4898 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4900 Jim_IncrRefCount(varObjPtr);
4901 Jim_IncrRefCount(keyObjPtr);
4903 else {
4904 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4907 Jim_FreeIntRep(interp, objPtr);
4908 objPtr->typePtr = &dictSubstObjType;
4909 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4910 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4914 /* This function is used to expand [dict get] sugar in the form
4915 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4916 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4917 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4918 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4919 * the [dict]ionary contained in variable VARNAME. */
4920 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4922 Jim_Obj *resObjPtr = NULL;
4923 Jim_Obj *substKeyObjPtr = NULL;
4925 SetDictSubstFromAny(interp, objPtr);
4927 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4928 &substKeyObjPtr, JIM_NONE)
4929 != JIM_OK) {
4930 return NULL;
4932 Jim_IncrRefCount(substKeyObjPtr);
4933 resObjPtr =
4934 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4935 substKeyObjPtr, 0);
4936 Jim_DecrRefCount(interp, substKeyObjPtr);
4938 return resObjPtr;
4941 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4943 if (Jim_EvalExpression(interp, objPtr) == JIM_OK) {
4944 return Jim_GetResult(interp);
4946 return NULL;
4949 /* -----------------------------------------------------------------------------
4950 * CallFrame
4951 * ---------------------------------------------------------------------------*/
4953 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4955 Jim_CallFrame *cf;
4957 if (interp->freeFramesList) {
4958 cf = interp->freeFramesList;
4959 interp->freeFramesList = cf->next;
4961 cf->argv = NULL;
4962 cf->argc = 0;
4963 cf->procArgsObjPtr = NULL;
4964 cf->procBodyObjPtr = NULL;
4965 cf->next = NULL;
4966 cf->staticVars = NULL;
4967 cf->localCommands = NULL;
4968 cf->tailcallObj = NULL;
4969 cf->tailcallCmd = NULL;
4971 else {
4972 cf = Jim_Alloc(sizeof(*cf));
4973 memset(cf, 0, sizeof(*cf));
4975 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4978 cf->id = interp->callFrameEpoch++;
4979 cf->parent = parent;
4980 cf->level = parent ? parent->level + 1 : 0;
4981 cf->nsObj = nsObj;
4982 Jim_IncrRefCount(nsObj);
4984 return cf;
4987 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4989 /* Delete any local procs */
4990 if (localCommands) {
4991 Jim_Obj *cmdNameObj;
4993 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4994 Jim_HashEntry *he;
4995 Jim_Obj *fqObjName;
4996 Jim_HashTable *ht = &interp->commands;
4998 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
5000 he = Jim_FindHashEntry(ht, fqname);
5002 if (he) {
5003 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
5004 if (cmd->prevCmd) {
5005 Jim_Cmd *prevCmd = cmd->prevCmd;
5006 cmd->prevCmd = NULL;
5008 /* Delete the old command */
5009 JimDecrCmdRefCount(interp, cmd);
5011 /* And restore the original */
5012 Jim_SetHashVal(ht, he, prevCmd);
5014 else {
5015 Jim_DeleteHashEntry(ht, fqname);
5017 Jim_InterpIncrProcEpoch(interp);
5019 Jim_DecrRefCount(interp, cmdNameObj);
5020 JimFreeQualifiedName(interp, fqObjName);
5022 Jim_FreeStack(localCommands);
5023 Jim_Free(localCommands);
5025 return JIM_OK;
5029 * Run any $jim::defer scripts for the current call frame.
5031 * retcode is the return code from the current proc.
5033 * Returns the new return code.
5035 static int JimInvokeDefer(Jim_Interp *interp, int retcode)
5037 Jim_Obj *objPtr;
5039 /* Fast check for the likely case that the variable doesn't exist */
5040 if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
5041 return retcode;
5044 objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
5046 if (objPtr) {
5047 int ret = JIM_OK;
5048 int i;
5049 int listLen = Jim_ListLength(interp, objPtr);
5050 Jim_Obj *resultObjPtr;
5052 Jim_IncrRefCount(objPtr);
5054 /* Need to save away the current interp result and
5055 * restore it if appropriate
5057 resultObjPtr = Jim_GetResult(interp);
5058 Jim_IncrRefCount(resultObjPtr);
5059 Jim_SetEmptyResult(interp);
5061 /* Invoke in reverse order */
5062 for (i = listLen; i > 0; i--) {
5063 /* If a defer script returns an error, don't evaluate remaining scripts */
5064 Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
5065 ret = Jim_EvalObj(interp, scriptObjPtr);
5066 if (ret != JIM_OK) {
5067 break;
5071 if (ret == JIM_OK || retcode == JIM_ERR) {
5072 /* defer script had no error, or proc had an error so restore proc result */
5073 Jim_SetResult(interp, resultObjPtr);
5075 else {
5076 retcode = ret;
5079 Jim_DecrRefCount(interp, resultObjPtr);
5080 Jim_DecrRefCount(interp, objPtr);
5082 return retcode;
5085 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5086 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5087 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5089 JimDeleteLocalProcs(interp, cf->localCommands);
5091 if (cf->procArgsObjPtr)
5092 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5093 if (cf->procBodyObjPtr)
5094 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5095 Jim_DecrRefCount(interp, cf->nsObj);
5096 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5097 Jim_FreeHashTable(&cf->vars);
5098 else {
5099 int i;
5100 Jim_HashEntry **table = cf->vars.table, *he;
5102 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5103 he = table[i];
5104 while (he != NULL) {
5105 Jim_HashEntry *nextEntry = he->next;
5106 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5108 Jim_DecrRefCount(interp, varPtr->objPtr);
5109 Jim_Free(Jim_GetHashEntryKey(he));
5110 Jim_Free(varPtr);
5111 Jim_Free(he);
5112 table[i] = NULL;
5113 he = nextEntry;
5116 cf->vars.used = 0;
5118 cf->next = interp->freeFramesList;
5119 interp->freeFramesList = cf;
5123 /* -----------------------------------------------------------------------------
5124 * References
5125 * ---------------------------------------------------------------------------*/
5126 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5128 /* References HashTable Type.
5130 * Keys are unsigned long integers, dynamically allocated for now but in the
5131 * future it's worth to cache this 4 bytes objects. Values are pointers
5132 * to Jim_References. */
5133 static void JimReferencesHTValDestructor(void *interp, void *val)
5135 Jim_Reference *refPtr = (void *)val;
5137 Jim_DecrRefCount(interp, refPtr->objPtr);
5138 if (refPtr->finalizerCmdNamePtr != NULL) {
5139 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5141 Jim_Free(val);
5144 static unsigned int JimReferencesHTHashFunction(const void *key)
5146 /* Only the least significant bits are used. */
5147 const unsigned long *widePtr = key;
5148 unsigned int intValue = (unsigned int)*widePtr;
5150 return Jim_IntHashFunction(intValue);
5153 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5155 void *copy = Jim_Alloc(sizeof(unsigned long));
5157 JIM_NOTUSED(privdata);
5159 memcpy(copy, key, sizeof(unsigned long));
5160 return copy;
5163 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5165 JIM_NOTUSED(privdata);
5167 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5170 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5172 JIM_NOTUSED(privdata);
5174 Jim_Free(key);
5177 static const Jim_HashTableType JimReferencesHashTableType = {
5178 JimReferencesHTHashFunction, /* hash function */
5179 JimReferencesHTKeyDup, /* key dup */
5180 NULL, /* val dup */
5181 JimReferencesHTKeyCompare, /* key compare */
5182 JimReferencesHTKeyDestructor, /* key destructor */
5183 JimReferencesHTValDestructor /* val destructor */
5186 /* -----------------------------------------------------------------------------
5187 * Reference object type and References API
5188 * ---------------------------------------------------------------------------*/
5190 /* The string representation of references has two features in order
5191 * to make the GC faster. The first is that every reference starts
5192 * with a non common character '<', in order to make the string matching
5193 * faster. The second is that the reference string rep is 42 characters
5194 * in length, this means that it is not necessary to check any object with a string
5195 * repr < 42, and usually there aren't many of these objects. */
5197 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5199 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5201 const char *fmt = "<reference.<%s>.%020lu>";
5203 sprintf(buf, fmt, refPtr->tag, id);
5204 return JIM_REFERENCE_SPACE;
5207 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5209 static const Jim_ObjType referenceObjType = {
5210 "reference",
5211 NULL,
5212 NULL,
5213 UpdateStringOfReference,
5214 JIM_TYPE_REFERENCES,
5217 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5219 char buf[JIM_REFERENCE_SPACE + 1];
5221 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5222 JimSetStringBytes(objPtr, buf);
5225 /* returns true if 'c' is a valid reference tag character.
5226 * i.e. inside the range [_a-zA-Z0-9] */
5227 static int isrefchar(int c)
5229 return (c == '_' || isalnum(c));
5232 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5234 unsigned long value;
5235 int i, len;
5236 const char *str, *start, *end;
5237 char refId[21];
5238 Jim_Reference *refPtr;
5239 Jim_HashEntry *he;
5240 char *endptr;
5242 /* Get the string representation */
5243 str = Jim_GetString(objPtr, &len);
5244 /* Check if it looks like a reference */
5245 if (len < JIM_REFERENCE_SPACE)
5246 goto badformat;
5247 /* Trim spaces */
5248 start = str;
5249 end = str + len - 1;
5250 while (*start == ' ')
5251 start++;
5252 while (*end == ' ' && end > start)
5253 end--;
5254 if (end - start + 1 != JIM_REFERENCE_SPACE)
5255 goto badformat;
5256 /* <reference.<1234567>.%020> */
5257 if (memcmp(start, "<reference.<", 12) != 0)
5258 goto badformat;
5259 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5260 goto badformat;
5261 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5262 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5263 if (!isrefchar(start[12 + i]))
5264 goto badformat;
5266 /* Extract info from the reference. */
5267 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5268 refId[20] = '\0';
5269 /* Try to convert the ID into an unsigned long */
5270 value = strtoul(refId, &endptr, 10);
5271 if (JimCheckConversion(refId, endptr) != JIM_OK)
5272 goto badformat;
5273 /* Check if the reference really exists! */
5274 he = Jim_FindHashEntry(&interp->references, &value);
5275 if (he == NULL) {
5276 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5277 return JIM_ERR;
5279 refPtr = Jim_GetHashEntryVal(he);
5280 /* Free the old internal repr and set the new one. */
5281 Jim_FreeIntRep(interp, objPtr);
5282 objPtr->typePtr = &referenceObjType;
5283 objPtr->internalRep.refValue.id = value;
5284 objPtr->internalRep.refValue.refPtr = refPtr;
5285 return JIM_OK;
5287 badformat:
5288 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5289 return JIM_ERR;
5292 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5293 * as finalizer command (or NULL if there is no finalizer).
5294 * The returned reference object has refcount = 0. */
5295 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5297 struct Jim_Reference *refPtr;
5298 unsigned long id;
5299 Jim_Obj *refObjPtr;
5300 const char *tag;
5301 int tagLen, i;
5303 /* Perform the Garbage Collection if needed. */
5304 Jim_CollectIfNeeded(interp);
5306 refPtr = Jim_Alloc(sizeof(*refPtr));
5307 refPtr->objPtr = objPtr;
5308 Jim_IncrRefCount(objPtr);
5309 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5310 if (cmdNamePtr)
5311 Jim_IncrRefCount(cmdNamePtr);
5312 id = interp->referenceNextId++;
5313 Jim_AddHashEntry(&interp->references, &id, refPtr);
5314 refObjPtr = Jim_NewObj(interp);
5315 refObjPtr->typePtr = &referenceObjType;
5316 refObjPtr->bytes = NULL;
5317 refObjPtr->internalRep.refValue.id = id;
5318 refObjPtr->internalRep.refValue.refPtr = refPtr;
5319 interp->referenceNextId++;
5320 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5321 * that does not pass the 'isrefchar' test is replaced with '_' */
5322 tag = Jim_GetString(tagPtr, &tagLen);
5323 if (tagLen > JIM_REFERENCE_TAGLEN)
5324 tagLen = JIM_REFERENCE_TAGLEN;
5325 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5326 if (i < tagLen && isrefchar(tag[i]))
5327 refPtr->tag[i] = tag[i];
5328 else
5329 refPtr->tag[i] = '_';
5331 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5332 return refObjPtr;
5335 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5337 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5338 return NULL;
5339 return objPtr->internalRep.refValue.refPtr;
5342 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5344 Jim_Reference *refPtr;
5346 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5347 return JIM_ERR;
5348 Jim_IncrRefCount(cmdNamePtr);
5349 if (refPtr->finalizerCmdNamePtr)
5350 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5351 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5352 return JIM_OK;
5355 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5357 Jim_Reference *refPtr;
5359 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5360 return JIM_ERR;
5361 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5362 return JIM_OK;
5365 /* -----------------------------------------------------------------------------
5366 * References Garbage Collection
5367 * ---------------------------------------------------------------------------*/
5369 /* This the hash table type for the "MARK" phase of the GC */
5370 static const Jim_HashTableType JimRefMarkHashTableType = {
5371 JimReferencesHTHashFunction, /* hash function */
5372 JimReferencesHTKeyDup, /* key dup */
5373 NULL, /* val dup */
5374 JimReferencesHTKeyCompare, /* key compare */
5375 JimReferencesHTKeyDestructor, /* key destructor */
5376 NULL /* val destructor */
5379 /* Performs the garbage collection. */
5380 int Jim_Collect(Jim_Interp *interp)
5382 int collected = 0;
5383 Jim_HashTable marks;
5384 Jim_HashTableIterator htiter;
5385 Jim_HashEntry *he;
5386 Jim_Obj *objPtr;
5388 /* Avoid recursive calls */
5389 if (interp->lastCollectId == -1) {
5390 /* Jim_Collect() already running. Return just now. */
5391 return 0;
5393 interp->lastCollectId = -1;
5395 /* Mark all the references found into the 'mark' hash table.
5396 * The references are searched in every live object that
5397 * is of a type that can contain references. */
5398 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5399 objPtr = interp->liveList;
5400 while (objPtr) {
5401 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5402 const char *str, *p;
5403 int len;
5405 /* If the object is of type reference, to get the
5406 * Id is simple... */
5407 if (objPtr->typePtr == &referenceObjType) {
5408 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5409 #ifdef JIM_DEBUG_GC
5410 printf("MARK (reference): %d refcount: %d\n",
5411 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5412 #endif
5413 objPtr = objPtr->nextObjPtr;
5414 continue;
5416 /* Get the string repr of the object we want
5417 * to scan for references. */
5418 p = str = Jim_GetString(objPtr, &len);
5419 /* Skip objects too little to contain references. */
5420 if (len < JIM_REFERENCE_SPACE) {
5421 objPtr = objPtr->nextObjPtr;
5422 continue;
5424 /* Extract references from the object string repr. */
5425 while (1) {
5426 int i;
5427 unsigned long id;
5429 if ((p = strstr(p, "<reference.<")) == NULL)
5430 break;
5431 /* Check if it's a valid reference. */
5432 if (len - (p - str) < JIM_REFERENCE_SPACE)
5433 break;
5434 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5435 break;
5436 for (i = 21; i <= 40; i++)
5437 if (!isdigit(UCHAR(p[i])))
5438 break;
5439 /* Get the ID */
5440 id = strtoul(p + 21, NULL, 10);
5442 /* Ok, a reference for the given ID
5443 * was found. Mark it. */
5444 Jim_AddHashEntry(&marks, &id, NULL);
5445 #ifdef JIM_DEBUG_GC
5446 printf("MARK: %d\n", (int)id);
5447 #endif
5448 p += JIM_REFERENCE_SPACE;
5451 objPtr = objPtr->nextObjPtr;
5454 /* Run the references hash table to destroy every reference that
5455 * is not referenced outside (not present in the mark HT). */
5456 JimInitHashTableIterator(&interp->references, &htiter);
5457 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5458 const unsigned long *refId;
5459 Jim_Reference *refPtr;
5461 refId = he->key;
5462 /* Check if in the mark phase we encountered
5463 * this reference. */
5464 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5465 #ifdef JIM_DEBUG_GC
5466 printf("COLLECTING %d\n", (int)*refId);
5467 #endif
5468 collected++;
5469 /* Drop the reference, but call the
5470 * finalizer first if registered. */
5471 refPtr = Jim_GetHashEntryVal(he);
5472 if (refPtr->finalizerCmdNamePtr) {
5473 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5474 Jim_Obj *objv[3], *oldResult;
5476 JimFormatReference(refstr, refPtr, *refId);
5478 objv[0] = refPtr->finalizerCmdNamePtr;
5479 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5480 objv[2] = refPtr->objPtr;
5482 /* Drop the reference itself */
5483 /* Avoid the finaliser being freed here */
5484 Jim_IncrRefCount(objv[0]);
5485 /* Don't remove the reference from the hash table just yet
5486 * since that will free refPtr, and hence refPtr->objPtr
5489 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5490 oldResult = interp->result;
5491 Jim_IncrRefCount(oldResult);
5492 Jim_EvalObjVector(interp, 3, objv);
5493 Jim_SetResult(interp, oldResult);
5494 Jim_DecrRefCount(interp, oldResult);
5496 Jim_DecrRefCount(interp, objv[0]);
5498 Jim_DeleteHashEntry(&interp->references, refId);
5501 Jim_FreeHashTable(&marks);
5502 interp->lastCollectId = interp->referenceNextId;
5503 interp->lastCollectTime = time(NULL);
5504 return collected;
5507 #define JIM_COLLECT_ID_PERIOD 5000
5508 #define JIM_COLLECT_TIME_PERIOD 300
5510 void Jim_CollectIfNeeded(Jim_Interp *interp)
5512 unsigned long elapsedId;
5513 int elapsedTime;
5515 elapsedId = interp->referenceNextId - interp->lastCollectId;
5516 elapsedTime = time(NULL) - interp->lastCollectTime;
5519 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5520 Jim_Collect(interp);
5523 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5525 int Jim_IsBigEndian(void)
5527 union {
5528 unsigned short s;
5529 unsigned char c[2];
5530 } uval = {0x0102};
5532 return uval.c[0] == 1;
5535 /* -----------------------------------------------------------------------------
5536 * Interpreter related functions
5537 * ---------------------------------------------------------------------------*/
5539 Jim_Interp *Jim_CreateInterp(void)
5541 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5543 memset(i, 0, sizeof(*i));
5545 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5546 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5547 i->lastCollectTime = time(NULL);
5549 /* Note that we can create objects only after the
5550 * interpreter liveList and freeList pointers are
5551 * initialized to NULL. */
5552 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5553 #ifdef JIM_REFERENCES
5554 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5555 #endif
5556 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5557 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5558 i->emptyObj = Jim_NewEmptyStringObj(i);
5559 i->trueObj = Jim_NewIntObj(i, 1);
5560 i->falseObj = Jim_NewIntObj(i, 0);
5561 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5562 i->errorFileNameObj = i->emptyObj;
5563 i->result = i->emptyObj;
5564 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5565 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5566 i->errorProc = i->emptyObj;
5567 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5568 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5569 Jim_IncrRefCount(i->emptyObj);
5570 Jim_IncrRefCount(i->errorFileNameObj);
5571 Jim_IncrRefCount(i->result);
5572 Jim_IncrRefCount(i->stackTrace);
5573 Jim_IncrRefCount(i->unknown);
5574 Jim_IncrRefCount(i->currentScriptObj);
5575 Jim_IncrRefCount(i->nullScriptObj);
5576 Jim_IncrRefCount(i->errorProc);
5577 Jim_IncrRefCount(i->trueObj);
5578 Jim_IncrRefCount(i->falseObj);
5580 /* Initialize key variables every interpreter should contain */
5581 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5582 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5584 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5585 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5586 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5587 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5588 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5589 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5590 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5591 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5593 return i;
5596 void Jim_FreeInterp(Jim_Interp *i)
5598 Jim_CallFrame *cf, *cfx;
5600 Jim_Obj *objPtr, *nextObjPtr;
5602 /* Free the active call frames list - must be done before i->commands is destroyed */
5603 for (cf = i->framePtr; cf; cf = cfx) {
5604 /* Note that we ignore any errors */
5605 JimInvokeDefer(i, JIM_OK);
5606 cfx = cf->parent;
5607 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5610 Jim_DecrRefCount(i, i->emptyObj);
5611 Jim_DecrRefCount(i, i->trueObj);
5612 Jim_DecrRefCount(i, i->falseObj);
5613 Jim_DecrRefCount(i, i->result);
5614 Jim_DecrRefCount(i, i->stackTrace);
5615 Jim_DecrRefCount(i, i->errorProc);
5616 Jim_DecrRefCount(i, i->unknown);
5617 Jim_DecrRefCount(i, i->errorFileNameObj);
5618 Jim_DecrRefCount(i, i->currentScriptObj);
5619 Jim_DecrRefCount(i, i->nullScriptObj);
5620 Jim_FreeHashTable(&i->commands);
5621 #ifdef JIM_REFERENCES
5622 Jim_FreeHashTable(&i->references);
5623 #endif
5624 Jim_FreeHashTable(&i->packages);
5625 Jim_Free(i->prngState);
5626 Jim_FreeHashTable(&i->assocData);
5628 /* Check that the live object list is empty, otherwise
5629 * there is a memory leak. */
5630 #ifdef JIM_MAINTAINER
5631 if (i->liveList != NULL) {
5632 objPtr = i->liveList;
5634 printf("\n-------------------------------------\n");
5635 printf("Objects still in the free list:\n");
5636 while (objPtr) {
5637 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5638 Jim_String(objPtr);
5640 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5641 printf("%p (%d) %-10s: '%.20s...'\n",
5642 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5644 else {
5645 printf("%p (%d) %-10s: '%s'\n",
5646 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5648 if (objPtr->typePtr == &sourceObjType) {
5649 printf("FILE %s LINE %d\n",
5650 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5651 objPtr->internalRep.sourceValue.lineNumber);
5653 objPtr = objPtr->nextObjPtr;
5655 printf("-------------------------------------\n\n");
5656 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5658 #endif
5660 /* Free all the freed objects. */
5661 objPtr = i->freeList;
5662 while (objPtr) {
5663 nextObjPtr = objPtr->nextObjPtr;
5664 Jim_Free(objPtr);
5665 objPtr = nextObjPtr;
5668 /* Free the free call frames list */
5669 for (cf = i->freeFramesList; cf; cf = cfx) {
5670 cfx = cf->next;
5671 if (cf->vars.table)
5672 Jim_FreeHashTable(&cf->vars);
5673 Jim_Free(cf);
5676 /* Free the interpreter structure. */
5677 Jim_Free(i);
5680 /* Returns the call frame relative to the level represented by
5681 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5683 * This function accepts the 'level' argument in the form
5684 * of the commands [uplevel] and [upvar].
5686 * Returns NULL on error.
5688 * Note: for a function accepting a relative integer as level suitable
5689 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5691 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5693 long level;
5694 const char *str;
5695 Jim_CallFrame *framePtr;
5697 if (levelObjPtr) {
5698 str = Jim_String(levelObjPtr);
5699 if (str[0] == '#') {
5700 char *endptr;
5702 level = jim_strtol(str + 1, &endptr);
5703 if (str[1] == '\0' || endptr[0] != '\0') {
5704 level = -1;
5707 else {
5708 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5709 level = -1;
5711 else {
5712 /* Convert from a relative to an absolute level */
5713 level = interp->framePtr->level - level;
5717 else {
5718 str = "1"; /* Needed to format the error message. */
5719 level = interp->framePtr->level - 1;
5722 if (level == 0) {
5723 return interp->topFramePtr;
5725 if (level > 0) {
5726 /* Lookup */
5727 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5728 if (framePtr->level == level) {
5729 return framePtr;
5734 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5735 return NULL;
5738 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5739 * as a relative integer like in the [info level ?level?] command.
5741 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5743 long level;
5744 Jim_CallFrame *framePtr;
5746 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5747 if (level <= 0) {
5748 /* Convert from a relative to an absolute level */
5749 level = interp->framePtr->level + level;
5752 if (level == 0) {
5753 return interp->topFramePtr;
5756 /* Lookup */
5757 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5758 if (framePtr->level == level) {
5759 return framePtr;
5764 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5765 return NULL;
5768 static void JimResetStackTrace(Jim_Interp *interp)
5770 Jim_DecrRefCount(interp, interp->stackTrace);
5771 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5772 Jim_IncrRefCount(interp->stackTrace);
5775 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5777 int len;
5779 /* Increment reference first in case these are the same object */
5780 Jim_IncrRefCount(stackTraceObj);
5781 Jim_DecrRefCount(interp, interp->stackTrace);
5782 interp->stackTrace = stackTraceObj;
5783 interp->errorFlag = 1;
5785 /* This is a bit ugly.
5786 * If the filename of the last entry of the stack trace is empty,
5787 * the next stack level should be added.
5789 len = Jim_ListLength(interp, interp->stackTrace);
5790 if (len >= 3) {
5791 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5792 interp->addStackTrace = 1;
5797 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5798 Jim_Obj *fileNameObj, int linenr)
5800 if (strcmp(procname, "unknown") == 0) {
5801 procname = "";
5803 if (!*procname && !Jim_Length(fileNameObj)) {
5804 /* No useful info here */
5805 return;
5808 if (Jim_IsShared(interp->stackTrace)) {
5809 Jim_DecrRefCount(interp, interp->stackTrace);
5810 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5811 Jim_IncrRefCount(interp->stackTrace);
5814 /* If we have no procname but the previous element did, merge with that frame */
5815 if (!*procname && Jim_Length(fileNameObj)) {
5816 /* Just a filename. Check the previous entry */
5817 int len = Jim_ListLength(interp, interp->stackTrace);
5819 if (len >= 3) {
5820 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5821 if (Jim_Length(objPtr)) {
5822 /* Yes, the previous level had procname */
5823 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5824 if (Jim_Length(objPtr) == 0) {
5825 /* But no filename, so merge the new info with that frame */
5826 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5827 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5828 return;
5834 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5835 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5836 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5839 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5840 void *data)
5842 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5844 assocEntryPtr->delProc = delProc;
5845 assocEntryPtr->data = data;
5846 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5849 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5851 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5853 if (entryPtr != NULL) {
5854 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5855 return assocEntryPtr->data;
5857 return NULL;
5860 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5862 return Jim_DeleteHashEntry(&interp->assocData, key);
5865 int Jim_GetExitCode(Jim_Interp *interp)
5867 return interp->exitCode;
5870 /* -----------------------------------------------------------------------------
5871 * Integer object
5872 * ---------------------------------------------------------------------------*/
5873 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5874 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5876 static const Jim_ObjType intObjType = {
5877 "int",
5878 NULL,
5879 NULL,
5880 UpdateStringOfInt,
5881 JIM_TYPE_NONE,
5884 /* A coerced double is closer to an int than a double.
5885 * It is an int value temporarily masquerading as a double value.
5886 * i.e. it has the same string value as an int and Jim_GetWide()
5887 * succeeds, but also Jim_GetDouble() returns the value directly.
5889 static const Jim_ObjType coercedDoubleObjType = {
5890 "coerced-double",
5891 NULL,
5892 NULL,
5893 UpdateStringOfInt,
5894 JIM_TYPE_NONE,
5898 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5900 char buf[JIM_INTEGER_SPACE + 1];
5901 jim_wide wideValue = JimWideValue(objPtr);
5902 int pos = 0;
5904 if (wideValue == 0) {
5905 buf[pos++] = '0';
5907 else {
5908 char tmp[JIM_INTEGER_SPACE];
5909 int num = 0;
5910 int i;
5912 if (wideValue < 0) {
5913 buf[pos++] = '-';
5914 i = wideValue % 10;
5915 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5916 * whereas C99 is always -6
5917 * coverity[dead_error_line]
5919 tmp[num++] = (i > 0) ? (10 - i) : -i;
5920 wideValue /= -10;
5923 while (wideValue) {
5924 tmp[num++] = wideValue % 10;
5925 wideValue /= 10;
5928 for (i = 0; i < num; i++) {
5929 buf[pos++] = '0' + tmp[num - i - 1];
5932 buf[pos] = 0;
5934 JimSetStringBytes(objPtr, buf);
5937 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5939 jim_wide wideValue;
5940 const char *str;
5942 if (objPtr->typePtr == &coercedDoubleObjType) {
5943 /* Simple switch */
5944 objPtr->typePtr = &intObjType;
5945 return JIM_OK;
5948 /* Get the string representation */
5949 str = Jim_String(objPtr);
5950 /* Try to convert into a jim_wide */
5951 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5952 if (flags & JIM_ERRMSG) {
5953 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5955 return JIM_ERR;
5957 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5958 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5959 return JIM_ERR;
5961 /* Free the old internal repr and set the new one. */
5962 Jim_FreeIntRep(interp, objPtr);
5963 objPtr->typePtr = &intObjType;
5964 objPtr->internalRep.wideValue = wideValue;
5965 return JIM_OK;
5968 #ifdef JIM_OPTIMIZATION
5969 static int JimIsWide(Jim_Obj *objPtr)
5971 return objPtr->typePtr == &intObjType;
5973 #endif
5975 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5977 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5978 return JIM_ERR;
5979 *widePtr = JimWideValue(objPtr);
5980 return JIM_OK;
5983 /* Get a wide but does not set an error if the format is bad. */
5984 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5986 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5987 return JIM_ERR;
5988 *widePtr = JimWideValue(objPtr);
5989 return JIM_OK;
5992 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5994 jim_wide wideValue;
5995 int retval;
5997 retval = Jim_GetWide(interp, objPtr, &wideValue);
5998 if (retval == JIM_OK) {
5999 *longPtr = (long)wideValue;
6000 return JIM_OK;
6002 return JIM_ERR;
6005 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
6007 Jim_Obj *objPtr;
6009 objPtr = Jim_NewObj(interp);
6010 objPtr->typePtr = &intObjType;
6011 objPtr->bytes = NULL;
6012 objPtr->internalRep.wideValue = wideValue;
6013 return objPtr;
6016 /* -----------------------------------------------------------------------------
6017 * Double object
6018 * ---------------------------------------------------------------------------*/
6019 #define JIM_DOUBLE_SPACE 30
6021 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
6022 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
6024 static const Jim_ObjType doubleObjType = {
6025 "double",
6026 NULL,
6027 NULL,
6028 UpdateStringOfDouble,
6029 JIM_TYPE_NONE,
6032 #ifndef HAVE_ISNAN
6033 #undef isnan
6034 #define isnan(X) ((X) != (X))
6035 #endif
6036 #ifndef HAVE_ISINF
6037 #undef isinf
6038 #define isinf(X) (1.0 / (X) == 0.0)
6039 #endif
6041 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
6043 double value = objPtr->internalRep.doubleValue;
6045 if (isnan(value)) {
6046 JimSetStringBytes(objPtr, "NaN");
6047 return;
6049 if (isinf(value)) {
6050 if (value < 0) {
6051 JimSetStringBytes(objPtr, "-Inf");
6053 else {
6054 JimSetStringBytes(objPtr, "Inf");
6056 return;
6059 char buf[JIM_DOUBLE_SPACE + 1];
6060 int i;
6061 int len = sprintf(buf, "%.12g", value);
6063 /* Add a final ".0" if necessary */
6064 for (i = 0; i < len; i++) {
6065 if (buf[i] == '.' || buf[i] == 'e') {
6066 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6067 /* If 'buf' ends in e-0nn or e+0nn, remove
6068 * the 0 after the + or - and reduce the length by 1
6070 char *e = strchr(buf, 'e');
6071 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6072 /* Move it up */
6073 e += 2;
6074 memmove(e, e + 1, len - (e - buf));
6076 #endif
6077 break;
6080 if (buf[i] == '\0') {
6081 buf[i++] = '.';
6082 buf[i++] = '0';
6083 buf[i] = '\0';
6085 JimSetStringBytes(objPtr, buf);
6089 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6091 double doubleValue;
6092 jim_wide wideValue;
6093 const char *str;
6095 #ifdef HAVE_LONG_LONG
6096 /* Assume a 53 bit mantissa */
6097 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6098 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6100 if (objPtr->typePtr == &intObjType
6101 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6102 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6104 /* Direct conversion to coerced double */
6105 objPtr->typePtr = &coercedDoubleObjType;
6106 return JIM_OK;
6108 #endif
6109 /* Preserve the string representation.
6110 * Needed so we can convert back to int without loss
6112 str = Jim_String(objPtr);
6114 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6115 /* Managed to convert to an int, so we can use this as a cooerced double */
6116 Jim_FreeIntRep(interp, objPtr);
6117 objPtr->typePtr = &coercedDoubleObjType;
6118 objPtr->internalRep.wideValue = wideValue;
6119 return JIM_OK;
6121 else {
6122 /* Try to convert into a double */
6123 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6124 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6125 return JIM_ERR;
6127 /* Free the old internal repr and set the new one. */
6128 Jim_FreeIntRep(interp, objPtr);
6130 objPtr->typePtr = &doubleObjType;
6131 objPtr->internalRep.doubleValue = doubleValue;
6132 return JIM_OK;
6135 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6137 if (objPtr->typePtr == &coercedDoubleObjType) {
6138 *doublePtr = JimWideValue(objPtr);
6139 return JIM_OK;
6141 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6142 return JIM_ERR;
6144 if (objPtr->typePtr == &coercedDoubleObjType) {
6145 *doublePtr = JimWideValue(objPtr);
6147 else {
6148 *doublePtr = objPtr->internalRep.doubleValue;
6150 return JIM_OK;
6153 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6155 Jim_Obj *objPtr;
6157 objPtr = Jim_NewObj(interp);
6158 objPtr->typePtr = &doubleObjType;
6159 objPtr->bytes = NULL;
6160 objPtr->internalRep.doubleValue = doubleValue;
6161 return objPtr;
6164 /* -----------------------------------------------------------------------------
6165 * Boolean conversion
6166 * ---------------------------------------------------------------------------*/
6167 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6169 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6171 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6172 return JIM_ERR;
6173 *booleanPtr = (int) JimWideValue(objPtr);
6174 return JIM_OK;
6177 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6179 static const char * const falses[] = {
6180 "0", "false", "no", "off", NULL
6182 static const char * const trues[] = {
6183 "1", "true", "yes", "on", NULL
6186 int boolean;
6188 int index;
6189 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6190 boolean = 0;
6191 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6192 boolean = 1;
6193 } else {
6194 if (flags & JIM_ERRMSG) {
6195 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6197 return JIM_ERR;
6200 /* Free the old internal repr and set the new one. */
6201 Jim_FreeIntRep(interp, objPtr);
6202 objPtr->typePtr = &intObjType;
6203 objPtr->internalRep.wideValue = boolean;
6204 return JIM_OK;
6207 /* -----------------------------------------------------------------------------
6208 * List object
6209 * ---------------------------------------------------------------------------*/
6210 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6211 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6212 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6213 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6214 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6215 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6217 /* Note that while the elements of the list may contain references,
6218 * the list object itself can't. This basically means that the
6219 * list object string representation as a whole can't contain references
6220 * that are not presents in the single elements. */
6221 static const Jim_ObjType listObjType = {
6222 "list",
6223 FreeListInternalRep,
6224 DupListInternalRep,
6225 UpdateStringOfList,
6226 JIM_TYPE_NONE,
6229 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6231 int i;
6233 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6234 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6236 Jim_Free(objPtr->internalRep.listValue.ele);
6239 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6241 int i;
6243 JIM_NOTUSED(interp);
6245 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6246 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6247 dupPtr->internalRep.listValue.ele =
6248 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6249 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6250 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6251 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6252 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6254 dupPtr->typePtr = &listObjType;
6257 /* The following function checks if a given string can be encoded
6258 * into a list element without any kind of quoting, surrounded by braces,
6259 * or using escapes to quote. */
6260 #define JIM_ELESTR_SIMPLE 0
6261 #define JIM_ELESTR_BRACE 1
6262 #define JIM_ELESTR_QUOTE 2
6263 static unsigned char ListElementQuotingType(const char *s, int len)
6265 int i, level, blevel, trySimple = 1;
6267 /* Try with the SIMPLE case */
6268 if (len == 0)
6269 return JIM_ELESTR_BRACE;
6270 if (s[0] == '"' || s[0] == '{') {
6271 trySimple = 0;
6272 goto testbrace;
6274 for (i = 0; i < len; i++) {
6275 switch (s[i]) {
6276 case ' ':
6277 case '$':
6278 case '"':
6279 case '[':
6280 case ']':
6281 case ';':
6282 case '\\':
6283 case '\r':
6284 case '\n':
6285 case '\t':
6286 case '\f':
6287 case '\v':
6288 trySimple = 0;
6289 /* fall through */
6290 case '{':
6291 case '}':
6292 goto testbrace;
6295 return JIM_ELESTR_SIMPLE;
6297 testbrace:
6298 /* Test if it's possible to do with braces */
6299 if (s[len - 1] == '\\')
6300 return JIM_ELESTR_QUOTE;
6301 level = 0;
6302 blevel = 0;
6303 for (i = 0; i < len; i++) {
6304 switch (s[i]) {
6305 case '{':
6306 level++;
6307 break;
6308 case '}':
6309 level--;
6310 if (level < 0)
6311 return JIM_ELESTR_QUOTE;
6312 break;
6313 case '[':
6314 blevel++;
6315 break;
6316 case ']':
6317 blevel--;
6318 break;
6319 case '\\':
6320 if (s[i + 1] == '\n')
6321 return JIM_ELESTR_QUOTE;
6322 else if (s[i + 1] != '\0')
6323 i++;
6324 break;
6327 if (blevel < 0) {
6328 return JIM_ELESTR_QUOTE;
6331 if (level == 0) {
6332 if (!trySimple)
6333 return JIM_ELESTR_BRACE;
6334 for (i = 0; i < len; i++) {
6335 switch (s[i]) {
6336 case ' ':
6337 case '$':
6338 case '"':
6339 case '[':
6340 case ']':
6341 case ';':
6342 case '\\':
6343 case '\r':
6344 case '\n':
6345 case '\t':
6346 case '\f':
6347 case '\v':
6348 return JIM_ELESTR_BRACE;
6349 break;
6352 return JIM_ELESTR_SIMPLE;
6354 return JIM_ELESTR_QUOTE;
6357 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6358 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6359 * scenario.
6360 * Returns the length of the result.
6362 static int BackslashQuoteString(const char *s, int len, char *q)
6364 char *p = q;
6366 while (len--) {
6367 switch (*s) {
6368 case ' ':
6369 case '$':
6370 case '"':
6371 case '[':
6372 case ']':
6373 case '{':
6374 case '}':
6375 case ';':
6376 case '\\':
6377 *p++ = '\\';
6378 *p++ = *s++;
6379 break;
6380 case '\n':
6381 *p++ = '\\';
6382 *p++ = 'n';
6383 s++;
6384 break;
6385 case '\r':
6386 *p++ = '\\';
6387 *p++ = 'r';
6388 s++;
6389 break;
6390 case '\t':
6391 *p++ = '\\';
6392 *p++ = 't';
6393 s++;
6394 break;
6395 case '\f':
6396 *p++ = '\\';
6397 *p++ = 'f';
6398 s++;
6399 break;
6400 case '\v':
6401 *p++ = '\\';
6402 *p++ = 'v';
6403 s++;
6404 break;
6405 default:
6406 *p++ = *s++;
6407 break;
6410 *p = '\0';
6412 return p - q;
6415 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6417 #define STATIC_QUOTING_LEN 32
6418 int i, bufLen, realLength;
6419 const char *strRep;
6420 char *p;
6421 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6423 /* Estimate the space needed. */
6424 if (objc > STATIC_QUOTING_LEN) {
6425 quotingType = Jim_Alloc(objc);
6427 else {
6428 quotingType = staticQuoting;
6430 bufLen = 0;
6431 for (i = 0; i < objc; i++) {
6432 int len;
6434 strRep = Jim_GetString(objv[i], &len);
6435 quotingType[i] = ListElementQuotingType(strRep, len);
6436 switch (quotingType[i]) {
6437 case JIM_ELESTR_SIMPLE:
6438 if (i != 0 || strRep[0] != '#') {
6439 bufLen += len;
6440 break;
6442 /* Special case '#' on first element needs braces */
6443 quotingType[i] = JIM_ELESTR_BRACE;
6444 /* fall through */
6445 case JIM_ELESTR_BRACE:
6446 bufLen += len + 2;
6447 break;
6448 case JIM_ELESTR_QUOTE:
6449 bufLen += len * 2;
6450 break;
6452 bufLen++; /* elements separator. */
6454 bufLen++;
6456 /* Generate the string rep. */
6457 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6458 realLength = 0;
6459 for (i = 0; i < objc; i++) {
6460 int len, qlen;
6462 strRep = Jim_GetString(objv[i], &len);
6464 switch (quotingType[i]) {
6465 case JIM_ELESTR_SIMPLE:
6466 memcpy(p, strRep, len);
6467 p += len;
6468 realLength += len;
6469 break;
6470 case JIM_ELESTR_BRACE:
6471 *p++ = '{';
6472 memcpy(p, strRep, len);
6473 p += len;
6474 *p++ = '}';
6475 realLength += len + 2;
6476 break;
6477 case JIM_ELESTR_QUOTE:
6478 if (i == 0 && strRep[0] == '#') {
6479 *p++ = '\\';
6480 realLength++;
6482 qlen = BackslashQuoteString(strRep, len, p);
6483 p += qlen;
6484 realLength += qlen;
6485 break;
6487 /* Add a separating space */
6488 if (i + 1 != objc) {
6489 *p++ = ' ';
6490 realLength++;
6493 *p = '\0'; /* nul term. */
6494 objPtr->length = realLength;
6496 if (quotingType != staticQuoting) {
6497 Jim_Free(quotingType);
6501 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6503 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6506 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6508 struct JimParserCtx parser;
6509 const char *str;
6510 int strLen;
6511 Jim_Obj *fileNameObj;
6512 int linenr;
6514 if (objPtr->typePtr == &listObjType) {
6515 return JIM_OK;
6518 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6519 * it also preserves any source location of the dict elements
6520 * which can be very useful
6522 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6523 Jim_Obj **listObjPtrPtr;
6524 int len;
6525 int i;
6527 listObjPtrPtr = JimDictPairs(objPtr, &len);
6528 for (i = 0; i < len; i++) {
6529 Jim_IncrRefCount(listObjPtrPtr[i]);
6532 /* Now just switch the internal rep */
6533 Jim_FreeIntRep(interp, objPtr);
6534 objPtr->typePtr = &listObjType;
6535 objPtr->internalRep.listValue.len = len;
6536 objPtr->internalRep.listValue.maxLen = len;
6537 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6539 return JIM_OK;
6542 /* Try to preserve information about filename / line number */
6543 if (objPtr->typePtr == &sourceObjType) {
6544 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6545 linenr = objPtr->internalRep.sourceValue.lineNumber;
6547 else {
6548 fileNameObj = interp->emptyObj;
6549 linenr = 1;
6551 Jim_IncrRefCount(fileNameObj);
6553 /* Get the string representation */
6554 str = Jim_GetString(objPtr, &strLen);
6556 /* Free the old internal repr just now and initialize the
6557 * new one just now. The string->list conversion can't fail. */
6558 Jim_FreeIntRep(interp, objPtr);
6559 objPtr->typePtr = &listObjType;
6560 objPtr->internalRep.listValue.len = 0;
6561 objPtr->internalRep.listValue.maxLen = 0;
6562 objPtr->internalRep.listValue.ele = NULL;
6564 /* Convert into a list */
6565 if (strLen) {
6566 JimParserInit(&parser, str, strLen, linenr);
6567 while (!parser.eof) {
6568 Jim_Obj *elementPtr;
6570 JimParseList(&parser);
6571 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6572 continue;
6573 elementPtr = JimParserGetTokenObj(interp, &parser);
6574 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6575 ListAppendElement(objPtr, elementPtr);
6578 Jim_DecrRefCount(interp, fileNameObj);
6579 return JIM_OK;
6582 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6584 Jim_Obj *objPtr;
6586 objPtr = Jim_NewObj(interp);
6587 objPtr->typePtr = &listObjType;
6588 objPtr->bytes = NULL;
6589 objPtr->internalRep.listValue.ele = NULL;
6590 objPtr->internalRep.listValue.len = 0;
6591 objPtr->internalRep.listValue.maxLen = 0;
6593 if (len) {
6594 ListInsertElements(objPtr, 0, len, elements);
6597 return objPtr;
6600 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6601 * length of the vector. Note that the user of this function should make
6602 * sure that the list object can't shimmer while the vector returned
6603 * is in use, this vector is the one stored inside the internal representation
6604 * of the list object. This function is not exported, extensions should
6605 * always access to the List object elements using Jim_ListIndex(). */
6606 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6607 Jim_Obj ***listVec)
6609 *listLen = Jim_ListLength(interp, listObj);
6610 *listVec = listObj->internalRep.listValue.ele;
6613 /* Sorting uses ints, but commands may return wide */
6614 static int JimSign(jim_wide w)
6616 if (w == 0) {
6617 return 0;
6619 else if (w < 0) {
6620 return -1;
6622 return 1;
6625 /* ListSortElements type values */
6626 struct lsort_info {
6627 jmp_buf jmpbuf;
6628 Jim_Obj *command;
6629 Jim_Interp *interp;
6630 enum {
6631 JIM_LSORT_ASCII,
6632 JIM_LSORT_NOCASE,
6633 JIM_LSORT_INTEGER,
6634 JIM_LSORT_REAL,
6635 JIM_LSORT_COMMAND
6636 } type;
6637 int order;
6638 int index;
6639 int indexed;
6640 int unique;
6641 int (*subfn)(Jim_Obj **, Jim_Obj **);
6644 static struct lsort_info *sort_info;
6646 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6648 Jim_Obj *lObj, *rObj;
6650 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6651 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6652 longjmp(sort_info->jmpbuf, JIM_ERR);
6654 return sort_info->subfn(&lObj, &rObj);
6657 /* Sort the internal rep of a list. */
6658 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6660 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6663 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6665 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6668 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6670 jim_wide lhs = 0, rhs = 0;
6672 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6673 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6674 longjmp(sort_info->jmpbuf, JIM_ERR);
6677 return JimSign(lhs - rhs) * sort_info->order;
6680 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6682 double lhs = 0, rhs = 0;
6684 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6685 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6686 longjmp(sort_info->jmpbuf, JIM_ERR);
6688 if (lhs == rhs) {
6689 return 0;
6691 if (lhs > rhs) {
6692 return sort_info->order;
6694 return -sort_info->order;
6697 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6699 Jim_Obj *compare_script;
6700 int rc;
6702 jim_wide ret = 0;
6704 /* This must be a valid list */
6705 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6706 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6707 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6709 rc = Jim_EvalObj(sort_info->interp, compare_script);
6711 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6712 longjmp(sort_info->jmpbuf, rc);
6715 return JimSign(ret) * sort_info->order;
6718 /* Remove duplicate elements from the (sorted) list in-place, according to the
6719 * comparison function, comp.
6721 * Note that the last unique value is kept, not the first
6723 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6725 int src;
6726 int dst = 0;
6727 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6729 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6730 if (comp(&ele[dst], &ele[src]) == 0) {
6731 /* Match, so replace the dest with the current source */
6732 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6734 else {
6735 /* No match, so keep the current source and move to the next destination */
6736 dst++;
6738 ele[dst] = ele[src];
6741 /* At end of list, keep the final element unless all elements were kept */
6742 dst++;
6743 if (dst < listObjPtr->internalRep.listValue.len) {
6744 ele[dst] = ele[src];
6747 /* Set the new length */
6748 listObjPtr->internalRep.listValue.len = dst;
6751 /* Sort a list *in place*. MUST be called with a non-shared list. */
6752 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6754 struct lsort_info *prev_info;
6756 typedef int (qsort_comparator) (const void *, const void *);
6757 int (*fn) (Jim_Obj **, Jim_Obj **);
6758 Jim_Obj **vector;
6759 int len;
6760 int rc;
6762 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6763 SetListFromAny(interp, listObjPtr);
6765 /* Allow lsort to be called reentrantly */
6766 prev_info = sort_info;
6767 sort_info = info;
6769 vector = listObjPtr->internalRep.listValue.ele;
6770 len = listObjPtr->internalRep.listValue.len;
6771 switch (info->type) {
6772 case JIM_LSORT_ASCII:
6773 fn = ListSortString;
6774 break;
6775 case JIM_LSORT_NOCASE:
6776 fn = ListSortStringNoCase;
6777 break;
6778 case JIM_LSORT_INTEGER:
6779 fn = ListSortInteger;
6780 break;
6781 case JIM_LSORT_REAL:
6782 fn = ListSortReal;
6783 break;
6784 case JIM_LSORT_COMMAND:
6785 fn = ListSortCommand;
6786 break;
6787 default:
6788 fn = NULL; /* avoid warning */
6789 JimPanic((1, "ListSort called with invalid sort type"));
6790 return -1; /* Should not be run but keeps static analysers happy */
6793 if (info->indexed) {
6794 /* Need to interpose a "list index" function */
6795 info->subfn = fn;
6796 fn = ListSortIndexHelper;
6799 if ((rc = setjmp(info->jmpbuf)) == 0) {
6800 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6802 if (info->unique && len > 1) {
6803 ListRemoveDuplicates(listObjPtr, fn);
6806 Jim_InvalidateStringRep(listObjPtr);
6808 sort_info = prev_info;
6810 return rc;
6813 /* This is the low-level function to insert elements into a list.
6814 * The higher-level Jim_ListInsertElements() performs shared object
6815 * check and invalidates the string repr. This version is used
6816 * in the internals of the List Object and is not exported.
6818 * NOTE: this function can be called only against objects
6819 * with internal type of List.
6821 * An insertion point (idx) of -1 means end-of-list.
6823 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6825 int currentLen = listPtr->internalRep.listValue.len;
6826 int requiredLen = currentLen + elemc;
6827 int i;
6828 Jim_Obj **point;
6830 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6831 if (requiredLen < 2) {
6832 /* Don't do allocations of under 4 pointers. */
6833 requiredLen = 4;
6835 else {
6836 requiredLen *= 2;
6839 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6840 sizeof(Jim_Obj *) * requiredLen);
6842 listPtr->internalRep.listValue.maxLen = requiredLen;
6844 if (idx < 0) {
6845 idx = currentLen;
6847 point = listPtr->internalRep.listValue.ele + idx;
6848 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6849 for (i = 0; i < elemc; ++i) {
6850 point[i] = elemVec[i];
6851 Jim_IncrRefCount(point[i]);
6853 listPtr->internalRep.listValue.len += elemc;
6856 /* Convenience call to ListInsertElements() to append a single element.
6858 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6860 ListInsertElements(listPtr, -1, 1, &objPtr);
6863 /* Appends every element of appendListPtr into listPtr.
6864 * Both have to be of the list type.
6865 * Convenience call to ListInsertElements()
6867 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6869 ListInsertElements(listPtr, -1,
6870 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6873 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6875 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6876 SetListFromAny(interp, listPtr);
6877 Jim_InvalidateStringRep(listPtr);
6878 ListAppendElement(listPtr, objPtr);
6881 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6883 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6884 SetListFromAny(interp, listPtr);
6885 SetListFromAny(interp, appendListPtr);
6886 Jim_InvalidateStringRep(listPtr);
6887 ListAppendList(listPtr, appendListPtr);
6890 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6892 SetListFromAny(interp, objPtr);
6893 return objPtr->internalRep.listValue.len;
6896 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6897 int objc, Jim_Obj *const *objVec)
6899 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6900 SetListFromAny(interp, listPtr);
6901 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6902 idx = listPtr->internalRep.listValue.len;
6903 else if (idx < 0)
6904 idx = 0;
6905 Jim_InvalidateStringRep(listPtr);
6906 ListInsertElements(listPtr, idx, objc, objVec);
6909 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6911 SetListFromAny(interp, listPtr);
6912 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6913 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6914 return NULL;
6916 if (idx < 0)
6917 idx = listPtr->internalRep.listValue.len + idx;
6918 return listPtr->internalRep.listValue.ele[idx];
6921 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6923 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6924 if (*objPtrPtr == NULL) {
6925 if (flags & JIM_ERRMSG) {
6926 Jim_SetResultString(interp, "list index out of range", -1);
6928 return JIM_ERR;
6930 return JIM_OK;
6933 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6934 Jim_Obj *newObjPtr, int flags)
6936 SetListFromAny(interp, listPtr);
6937 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6938 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6939 if (flags & JIM_ERRMSG) {
6940 Jim_SetResultString(interp, "list index out of range", -1);
6942 return JIM_ERR;
6944 if (idx < 0)
6945 idx = listPtr->internalRep.listValue.len + idx;
6946 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6947 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6948 Jim_IncrRefCount(newObjPtr);
6949 return JIM_OK;
6952 /* Modify the list stored in the variable named 'varNamePtr'
6953 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6954 * with the new element 'newObjptr'. (implements the [lset] command) */
6955 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6956 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6958 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6959 int shared, i, idx;
6961 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6962 if (objPtr == NULL)
6963 return JIM_ERR;
6964 if ((shared = Jim_IsShared(objPtr)))
6965 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6966 for (i = 0; i < indexc - 1; i++) {
6967 listObjPtr = objPtr;
6968 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6969 goto err;
6970 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6971 goto err;
6973 if (Jim_IsShared(objPtr)) {
6974 objPtr = Jim_DuplicateObj(interp, objPtr);
6975 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6977 Jim_InvalidateStringRep(listObjPtr);
6979 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6980 goto err;
6981 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6982 goto err;
6983 Jim_InvalidateStringRep(objPtr);
6984 Jim_InvalidateStringRep(varObjPtr);
6985 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6986 goto err;
6987 Jim_SetResult(interp, varObjPtr);
6988 return JIM_OK;
6989 err:
6990 if (shared) {
6991 Jim_FreeNewObj(interp, varObjPtr);
6993 return JIM_ERR;
6996 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6998 int i;
6999 int listLen = Jim_ListLength(interp, listObjPtr);
7000 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
7002 for (i = 0; i < listLen; ) {
7003 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
7004 if (++i != listLen) {
7005 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
7008 return resObjPtr;
7011 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
7013 int i;
7015 /* If all the objects in objv are lists,
7016 * it's possible to return a list as result, that's the
7017 * concatenation of all the lists. */
7018 for (i = 0; i < objc; i++) {
7019 if (!Jim_IsList(objv[i]))
7020 break;
7022 if (i == objc) {
7023 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
7025 for (i = 0; i < objc; i++)
7026 ListAppendList(objPtr, objv[i]);
7027 return objPtr;
7029 else {
7030 /* Else... we have to glue strings together */
7031 int len = 0, objLen;
7032 char *bytes, *p;
7034 /* Compute the length */
7035 for (i = 0; i < objc; i++) {
7036 len += Jim_Length(objv[i]);
7038 if (objc)
7039 len += objc - 1;
7040 /* Create the string rep, and a string object holding it. */
7041 p = bytes = Jim_Alloc(len + 1);
7042 for (i = 0; i < objc; i++) {
7043 const char *s = Jim_GetString(objv[i], &objLen);
7045 /* Remove leading space */
7046 while (objLen && isspace(UCHAR(*s))) {
7047 s++;
7048 objLen--;
7049 len--;
7051 /* And trailing space */
7052 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
7053 /* Handle trailing backslash-space case */
7054 if (objLen > 1 && s[objLen - 2] == '\\') {
7055 break;
7057 objLen--;
7058 len--;
7060 memcpy(p, s, objLen);
7061 p += objLen;
7062 if (i + 1 != objc) {
7063 if (objLen)
7064 *p++ = ' ';
7065 else {
7066 /* Drop the space calculated for this
7067 * element that is instead null. */
7068 len--;
7072 *p = '\0';
7073 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7077 /* Returns a list composed of the elements in the specified range.
7078 * first and start are directly accepted as Jim_Objects and
7079 * processed for the end?-index? case. */
7080 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7081 Jim_Obj *lastObjPtr)
7083 int first, last;
7084 int len, rangeLen;
7086 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7087 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7088 return NULL;
7089 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7090 first = JimRelToAbsIndex(len, first);
7091 last = JimRelToAbsIndex(len, last);
7092 JimRelToAbsRange(len, &first, &last, &rangeLen);
7093 if (first == 0 && last == len) {
7094 return listObjPtr;
7096 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7099 /* -----------------------------------------------------------------------------
7100 * Dict object
7101 * ---------------------------------------------------------------------------*/
7102 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7103 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7104 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7105 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7107 /* Dict HashTable Type.
7109 * Keys and Values are Jim objects. */
7111 static unsigned int JimObjectHTHashFunction(const void *key)
7113 int len;
7114 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7115 return Jim_GenHashFunction((const unsigned char *)str, len);
7118 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7120 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7123 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7125 Jim_IncrRefCount((Jim_Obj *)val);
7126 return (void *)val;
7129 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7131 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7134 static const Jim_HashTableType JimDictHashTableType = {
7135 JimObjectHTHashFunction, /* hash function */
7136 JimObjectHTKeyValDup, /* key dup */
7137 JimObjectHTKeyValDup, /* val dup */
7138 JimObjectHTKeyCompare, /* key compare */
7139 JimObjectHTKeyValDestructor, /* key destructor */
7140 JimObjectHTKeyValDestructor /* val destructor */
7143 /* Note that while the elements of the dict may contain references,
7144 * the list object itself can't. This basically means that the
7145 * dict object string representation as a whole can't contain references
7146 * that are not presents in the single elements. */
7147 static const Jim_ObjType dictObjType = {
7148 "dict",
7149 FreeDictInternalRep,
7150 DupDictInternalRep,
7151 UpdateStringOfDict,
7152 JIM_TYPE_NONE,
7155 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7157 JIM_NOTUSED(interp);
7159 Jim_FreeHashTable(objPtr->internalRep.ptr);
7160 Jim_Free(objPtr->internalRep.ptr);
7163 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7165 Jim_HashTable *ht, *dupHt;
7166 Jim_HashTableIterator htiter;
7167 Jim_HashEntry *he;
7169 /* Create a new hash table */
7170 ht = srcPtr->internalRep.ptr;
7171 dupHt = Jim_Alloc(sizeof(*dupHt));
7172 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7173 if (ht->size != 0)
7174 Jim_ExpandHashTable(dupHt, ht->size);
7175 /* Copy every element from the source to the dup hash table */
7176 JimInitHashTableIterator(ht, &htiter);
7177 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7178 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7181 dupPtr->internalRep.ptr = dupHt;
7182 dupPtr->typePtr = &dictObjType;
7185 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7187 Jim_HashTable *ht;
7188 Jim_HashTableIterator htiter;
7189 Jim_HashEntry *he;
7190 Jim_Obj **objv;
7191 int i;
7193 ht = dictPtr->internalRep.ptr;
7195 /* Turn the hash table into a flat vector of Jim_Objects. */
7196 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7197 JimInitHashTableIterator(ht, &htiter);
7198 i = 0;
7199 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7200 objv[i++] = Jim_GetHashEntryKey(he);
7201 objv[i++] = Jim_GetHashEntryVal(he);
7203 *len = i;
7204 return objv;
7207 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7209 /* Turn the hash table into a flat vector of Jim_Objects. */
7210 int len;
7211 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7213 /* And now generate the string rep as a list */
7214 JimMakeListStringRep(objPtr, objv, len);
7216 Jim_Free(objv);
7219 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7221 int listlen;
7223 if (objPtr->typePtr == &dictObjType) {
7224 return JIM_OK;
7227 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7228 /* A shared list, so get the string representation now to avoid
7229 * changing the order in case of fast conversion to dict.
7231 Jim_String(objPtr);
7234 /* For simplicity, convert a non-list object to a list and then to a dict */
7235 listlen = Jim_ListLength(interp, objPtr);
7236 if (listlen % 2) {
7237 Jim_SetResultString(interp, "missing value to go with key", -1);
7238 return JIM_ERR;
7240 else {
7241 /* Converting from a list to a dict can't fail */
7242 Jim_HashTable *ht;
7243 int i;
7245 ht = Jim_Alloc(sizeof(*ht));
7246 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7248 for (i = 0; i < listlen; i += 2) {
7249 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7250 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7252 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7255 Jim_FreeIntRep(interp, objPtr);
7256 objPtr->typePtr = &dictObjType;
7257 objPtr->internalRep.ptr = ht;
7259 return JIM_OK;
7263 /* Dict object API */
7265 /* Add an element to a dict. objPtr must be of the "dict" type.
7266 * The higher-level exported function is Jim_DictAddElement().
7267 * If an element with the specified key already exists, the value
7268 * associated is replaced with the new one.
7270 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7271 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7272 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7274 Jim_HashTable *ht = objPtr->internalRep.ptr;
7276 if (valueObjPtr == NULL) { /* unset */
7277 return Jim_DeleteHashEntry(ht, keyObjPtr);
7279 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7280 return JIM_OK;
7283 /* Add an element, higher-level interface for DictAddElement().
7284 * If valueObjPtr == NULL, the key is removed if it exists. */
7285 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7286 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7288 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7289 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7290 return JIM_ERR;
7292 Jim_InvalidateStringRep(objPtr);
7293 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7296 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7298 Jim_Obj *objPtr;
7299 int i;
7301 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7303 objPtr = Jim_NewObj(interp);
7304 objPtr->typePtr = &dictObjType;
7305 objPtr->bytes = NULL;
7306 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7307 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7308 for (i = 0; i < len; i += 2)
7309 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7310 return objPtr;
7313 /* Return the value associated to the specified dict key
7314 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7316 * Sets *objPtrPtr to non-NULL only upon success.
7318 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7319 Jim_Obj **objPtrPtr, int flags)
7321 Jim_HashEntry *he;
7322 Jim_HashTable *ht;
7324 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7325 return -1;
7327 ht = dictPtr->internalRep.ptr;
7328 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7329 if (flags & JIM_ERRMSG) {
7330 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7332 return JIM_ERR;
7334 else {
7335 *objPtrPtr = Jim_GetHashEntryVal(he);
7336 return JIM_OK;
7340 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7341 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7343 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7344 return JIM_ERR;
7346 *objPtrPtr = JimDictPairs(dictPtr, len);
7348 return JIM_OK;
7352 /* Return the value associated to the specified dict keys */
7353 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7354 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7356 int i;
7358 if (keyc == 0) {
7359 *objPtrPtr = dictPtr;
7360 return JIM_OK;
7363 for (i = 0; i < keyc; i++) {
7364 Jim_Obj *objPtr;
7366 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7367 if (rc != JIM_OK) {
7368 return rc;
7370 dictPtr = objPtr;
7372 *objPtrPtr = dictPtr;
7373 return JIM_OK;
7376 /* Modify the dict stored into the variable named 'varNamePtr'
7377 * setting the element specified by the 'keyc' keys objects in 'keyv',
7378 * with the new value of the element 'newObjPtr'.
7380 * If newObjPtr == NULL the operation is to remove the given key
7381 * from the dictionary.
7383 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7384 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7386 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7387 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7389 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7390 int shared, i;
7392 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7393 if (objPtr == NULL) {
7394 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7395 /* Cannot remove a key from non existing var */
7396 return JIM_ERR;
7398 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7399 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7400 Jim_FreeNewObj(interp, varObjPtr);
7401 return JIM_ERR;
7404 if ((shared = Jim_IsShared(objPtr)))
7405 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7406 for (i = 0; i < keyc; i++) {
7407 dictObjPtr = objPtr;
7409 /* Check if it's a valid dictionary */
7410 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7411 goto err;
7414 if (i == keyc - 1) {
7415 /* Last key: Note that error on unset with missing last key is OK */
7416 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7417 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7418 goto err;
7421 break;
7424 /* Check if the given key exists. */
7425 Jim_InvalidateStringRep(dictObjPtr);
7426 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7427 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7428 /* This key exists at the current level.
7429 * Make sure it's not shared!. */
7430 if (Jim_IsShared(objPtr)) {
7431 objPtr = Jim_DuplicateObj(interp, objPtr);
7432 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7435 else {
7436 /* Key not found. If it's an [unset] operation
7437 * this is an error. Only the last key may not
7438 * exist. */
7439 if (newObjPtr == NULL) {
7440 goto err;
7442 /* Otherwise set an empty dictionary
7443 * as key's value. */
7444 objPtr = Jim_NewDictObj(interp, NULL, 0);
7445 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7448 /* XXX: Is this necessary? */
7449 Jim_InvalidateStringRep(objPtr);
7450 Jim_InvalidateStringRep(varObjPtr);
7451 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7452 goto err;
7454 Jim_SetResult(interp, varObjPtr);
7455 return JIM_OK;
7456 err:
7457 if (shared) {
7458 Jim_FreeNewObj(interp, varObjPtr);
7460 return JIM_ERR;
7463 /* -----------------------------------------------------------------------------
7464 * Index object
7465 * ---------------------------------------------------------------------------*/
7466 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7467 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7469 static const Jim_ObjType indexObjType = {
7470 "index",
7471 NULL,
7472 NULL,
7473 UpdateStringOfIndex,
7474 JIM_TYPE_NONE,
7477 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7479 if (objPtr->internalRep.intValue == -1) {
7480 JimSetStringBytes(objPtr, "end");
7482 else {
7483 char buf[JIM_INTEGER_SPACE + 1];
7484 if (objPtr->internalRep.intValue >= 0) {
7485 sprintf(buf, "%d", objPtr->internalRep.intValue);
7487 else {
7488 /* Must be <= -2 */
7489 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7491 JimSetStringBytes(objPtr, buf);
7495 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7497 int idx, end = 0;
7498 const char *str;
7499 char *endptr;
7501 /* Get the string representation */
7502 str = Jim_String(objPtr);
7504 /* Try to convert into an index */
7505 if (strncmp(str, "end", 3) == 0) {
7506 end = 1;
7507 str += 3;
7508 idx = 0;
7510 else {
7511 idx = jim_strtol(str, &endptr);
7513 if (endptr == str) {
7514 goto badindex;
7516 str = endptr;
7519 /* Now str may include or +<num> or -<num> */
7520 if (*str == '+' || *str == '-') {
7521 int sign = (*str == '+' ? 1 : -1);
7523 idx += sign * jim_strtol(++str, &endptr);
7524 if (str == endptr || *endptr) {
7525 goto badindex;
7527 str = endptr;
7529 /* The only thing left should be spaces */
7530 while (isspace(UCHAR(*str))) {
7531 str++;
7533 if (*str) {
7534 goto badindex;
7536 if (end) {
7537 if (idx > 0) {
7538 idx = INT_MAX;
7540 else {
7541 /* end-1 is repesented as -2 */
7542 idx--;
7545 else if (idx < 0) {
7546 idx = -INT_MAX;
7549 /* Free the old internal repr and set the new one. */
7550 Jim_FreeIntRep(interp, objPtr);
7551 objPtr->typePtr = &indexObjType;
7552 objPtr->internalRep.intValue = idx;
7553 return JIM_OK;
7555 badindex:
7556 Jim_SetResultFormatted(interp,
7557 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7558 return JIM_ERR;
7561 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7563 /* Avoid shimmering if the object is an integer. */
7564 if (objPtr->typePtr == &intObjType) {
7565 jim_wide val = JimWideValue(objPtr);
7567 if (val < 0)
7568 *indexPtr = -INT_MAX;
7569 else if (val > INT_MAX)
7570 *indexPtr = INT_MAX;
7571 else
7572 *indexPtr = (int)val;
7573 return JIM_OK;
7575 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7576 return JIM_ERR;
7577 *indexPtr = objPtr->internalRep.intValue;
7578 return JIM_OK;
7581 /* -----------------------------------------------------------------------------
7582 * Return Code Object.
7583 * ---------------------------------------------------------------------------*/
7585 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7586 static const char * const jimReturnCodes[] = {
7587 "ok",
7588 "error",
7589 "return",
7590 "break",
7591 "continue",
7592 "signal",
7593 "exit",
7594 "eval",
7595 NULL
7598 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7600 static const Jim_ObjType returnCodeObjType = {
7601 "return-code",
7602 NULL,
7603 NULL,
7604 NULL,
7605 JIM_TYPE_NONE,
7608 /* Converts a (standard) return code to a string. Returns "?" for
7609 * non-standard return codes.
7611 const char *Jim_ReturnCode(int code)
7613 if (code < 0 || code >= (int)jimReturnCodesSize) {
7614 return "?";
7616 else {
7617 return jimReturnCodes[code];
7621 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7623 int returnCode;
7624 jim_wide wideValue;
7626 /* Try to convert into an integer */
7627 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7628 returnCode = (int)wideValue;
7629 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7630 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7631 return JIM_ERR;
7633 /* Free the old internal repr and set the new one. */
7634 Jim_FreeIntRep(interp, objPtr);
7635 objPtr->typePtr = &returnCodeObjType;
7636 objPtr->internalRep.intValue = returnCode;
7637 return JIM_OK;
7640 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7642 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7643 return JIM_ERR;
7644 *intPtr = objPtr->internalRep.intValue;
7645 return JIM_OK;
7648 /* -----------------------------------------------------------------------------
7649 * Expression Parsing
7650 * ---------------------------------------------------------------------------*/
7651 static int JimParseExprOperator(struct JimParserCtx *pc);
7652 static int JimParseExprNumber(struct JimParserCtx *pc);
7653 static int JimParseExprIrrational(struct JimParserCtx *pc);
7654 static int JimParseExprBoolean(struct JimParserCtx *pc);
7656 /* expr operator opcodes. */
7657 enum
7659 /* Continues on from the JIM_TT_ space */
7661 /* Binary operators (numbers) */
7662 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7663 JIM_EXPROP_DIV,
7664 JIM_EXPROP_MOD,
7665 JIM_EXPROP_SUB,
7666 JIM_EXPROP_ADD,
7667 JIM_EXPROP_LSHIFT,
7668 JIM_EXPROP_RSHIFT,
7669 JIM_EXPROP_ROTL,
7670 JIM_EXPROP_ROTR,
7671 JIM_EXPROP_LT,
7672 JIM_EXPROP_GT,
7673 JIM_EXPROP_LTE,
7674 JIM_EXPROP_GTE,
7675 JIM_EXPROP_NUMEQ,
7676 JIM_EXPROP_NUMNE,
7677 JIM_EXPROP_BITAND, /* 35 */
7678 JIM_EXPROP_BITXOR,
7679 JIM_EXPROP_BITOR,
7680 JIM_EXPROP_LOGICAND, /* 38 */
7681 JIM_EXPROP_LOGICOR, /* 39 */
7682 JIM_EXPROP_TERNARY, /* 40 */
7683 JIM_EXPROP_COLON, /* 41 */
7684 JIM_EXPROP_POW, /* 42 */
7686 /* Binary operators (strings) */
7687 JIM_EXPROP_STREQ, /* 43 */
7688 JIM_EXPROP_STRNE,
7689 JIM_EXPROP_STRIN,
7690 JIM_EXPROP_STRNI,
7692 /* Unary operators (numbers) */
7693 JIM_EXPROP_NOT, /* 47 */
7694 JIM_EXPROP_BITNOT,
7695 JIM_EXPROP_UNARYMINUS,
7696 JIM_EXPROP_UNARYPLUS,
7698 /* Functions */
7699 JIM_EXPROP_FUNC_INT, /* 51 */
7700 JIM_EXPROP_FUNC_WIDE,
7701 JIM_EXPROP_FUNC_ABS,
7702 JIM_EXPROP_FUNC_DOUBLE,
7703 JIM_EXPROP_FUNC_ROUND,
7704 JIM_EXPROP_FUNC_RAND,
7705 JIM_EXPROP_FUNC_SRAND,
7707 /* math functions from libm */
7708 JIM_EXPROP_FUNC_SIN, /* 65 */
7709 JIM_EXPROP_FUNC_COS,
7710 JIM_EXPROP_FUNC_TAN,
7711 JIM_EXPROP_FUNC_ASIN,
7712 JIM_EXPROP_FUNC_ACOS,
7713 JIM_EXPROP_FUNC_ATAN,
7714 JIM_EXPROP_FUNC_ATAN2,
7715 JIM_EXPROP_FUNC_SINH,
7716 JIM_EXPROP_FUNC_COSH,
7717 JIM_EXPROP_FUNC_TANH,
7718 JIM_EXPROP_FUNC_CEIL,
7719 JIM_EXPROP_FUNC_FLOOR,
7720 JIM_EXPROP_FUNC_EXP,
7721 JIM_EXPROP_FUNC_LOG,
7722 JIM_EXPROP_FUNC_LOG10,
7723 JIM_EXPROP_FUNC_SQRT,
7724 JIM_EXPROP_FUNC_POW,
7725 JIM_EXPROP_FUNC_HYPOT,
7726 JIM_EXPROP_FUNC_FMOD,
7729 /* A expression node is either a term or an operator
7730 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7732 struct JimExprNode {
7733 int type; /* JIM_TT_xxx */
7734 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7736 struct JimExprNode *left; /* For all operators */
7737 struct JimExprNode *right; /* For binary operators */
7738 struct JimExprNode *ternary; /* For ternary operator only */
7741 /* Operators table */
7742 typedef struct Jim_ExprOperator
7744 const char *name;
7745 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7746 unsigned char precedence;
7747 unsigned char arity;
7748 unsigned char attr;
7749 unsigned char namelen;
7750 } Jim_ExprOperator;
7752 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7753 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7754 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7756 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7758 int intresult = 1;
7759 int rc;
7760 double dA, dC = 0;
7761 jim_wide wA, wC = 0;
7762 Jim_Obj *A;
7764 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7765 return rc;
7768 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7769 switch (node->type) {
7770 case JIM_EXPROP_FUNC_INT:
7771 case JIM_EXPROP_FUNC_WIDE:
7772 case JIM_EXPROP_FUNC_ROUND:
7773 case JIM_EXPROP_UNARYPLUS:
7774 wC = wA;
7775 break;
7776 case JIM_EXPROP_FUNC_DOUBLE:
7777 dC = wA;
7778 intresult = 0;
7779 break;
7780 case JIM_EXPROP_FUNC_ABS:
7781 wC = wA >= 0 ? wA : -wA;
7782 break;
7783 case JIM_EXPROP_UNARYMINUS:
7784 wC = -wA;
7785 break;
7786 case JIM_EXPROP_NOT:
7787 wC = !wA;
7788 break;
7789 default:
7790 abort();
7793 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7794 switch (node->type) {
7795 case JIM_EXPROP_FUNC_INT:
7796 case JIM_EXPROP_FUNC_WIDE:
7797 wC = dA;
7798 break;
7799 case JIM_EXPROP_FUNC_ROUND:
7800 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7801 break;
7802 case JIM_EXPROP_FUNC_DOUBLE:
7803 case JIM_EXPROP_UNARYPLUS:
7804 dC = dA;
7805 intresult = 0;
7806 break;
7807 case JIM_EXPROP_FUNC_ABS:
7808 #ifdef JIM_MATH_FUNCTIONS
7809 dC = fabs(dA);
7810 #else
7811 dC = dA >= 0 ? dA : -dA;
7812 #endif
7813 intresult = 0;
7814 break;
7815 case JIM_EXPROP_UNARYMINUS:
7816 dC = -dA;
7817 intresult = 0;
7818 break;
7819 case JIM_EXPROP_NOT:
7820 wC = !dA;
7821 break;
7822 default:
7823 abort();
7827 if (rc == JIM_OK) {
7828 if (intresult) {
7829 Jim_SetResultInt(interp, wC);
7831 else {
7832 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7836 Jim_DecrRefCount(interp, A);
7838 return rc;
7841 static double JimRandDouble(Jim_Interp *interp)
7843 unsigned long x;
7844 JimRandomBytes(interp, &x, sizeof(x));
7846 return (double)x / (unsigned long)~0;
7849 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7851 jim_wide wA;
7852 Jim_Obj *A;
7853 int rc;
7855 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7856 return rc;
7859 rc = Jim_GetWide(interp, A, &wA);
7860 if (rc == JIM_OK) {
7861 switch (node->type) {
7862 case JIM_EXPROP_BITNOT:
7863 Jim_SetResultInt(interp, ~wA);
7864 break;
7865 case JIM_EXPROP_FUNC_SRAND:
7866 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7867 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7868 break;
7869 default:
7870 abort();
7874 Jim_DecrRefCount(interp, A);
7876 return rc;
7879 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7881 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7883 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7885 return JIM_OK;
7888 #ifdef JIM_MATH_FUNCTIONS
7889 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7891 int rc;
7892 double dA, dC;
7893 Jim_Obj *A;
7895 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7896 return rc;
7899 rc = Jim_GetDouble(interp, A, &dA);
7900 if (rc == JIM_OK) {
7901 switch (node->type) {
7902 case JIM_EXPROP_FUNC_SIN:
7903 dC = sin(dA);
7904 break;
7905 case JIM_EXPROP_FUNC_COS:
7906 dC = cos(dA);
7907 break;
7908 case JIM_EXPROP_FUNC_TAN:
7909 dC = tan(dA);
7910 break;
7911 case JIM_EXPROP_FUNC_ASIN:
7912 dC = asin(dA);
7913 break;
7914 case JIM_EXPROP_FUNC_ACOS:
7915 dC = acos(dA);
7916 break;
7917 case JIM_EXPROP_FUNC_ATAN:
7918 dC = atan(dA);
7919 break;
7920 case JIM_EXPROP_FUNC_SINH:
7921 dC = sinh(dA);
7922 break;
7923 case JIM_EXPROP_FUNC_COSH:
7924 dC = cosh(dA);
7925 break;
7926 case JIM_EXPROP_FUNC_TANH:
7927 dC = tanh(dA);
7928 break;
7929 case JIM_EXPROP_FUNC_CEIL:
7930 dC = ceil(dA);
7931 break;
7932 case JIM_EXPROP_FUNC_FLOOR:
7933 dC = floor(dA);
7934 break;
7935 case JIM_EXPROP_FUNC_EXP:
7936 dC = exp(dA);
7937 break;
7938 case JIM_EXPROP_FUNC_LOG:
7939 dC = log(dA);
7940 break;
7941 case JIM_EXPROP_FUNC_LOG10:
7942 dC = log10(dA);
7943 break;
7944 case JIM_EXPROP_FUNC_SQRT:
7945 dC = sqrt(dA);
7946 break;
7947 default:
7948 abort();
7950 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7953 Jim_DecrRefCount(interp, A);
7955 return rc;
7957 #endif
7959 /* A binary operation on two ints */
7960 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7962 jim_wide wA, wB;
7963 int rc;
7964 Jim_Obj *A, *B;
7966 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7967 return rc;
7969 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7970 Jim_DecrRefCount(interp, A);
7971 return rc;
7974 rc = JIM_ERR;
7976 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7977 jim_wide wC;
7979 rc = JIM_OK;
7981 switch (node->type) {
7982 case JIM_EXPROP_LSHIFT:
7983 wC = wA << wB;
7984 break;
7985 case JIM_EXPROP_RSHIFT:
7986 wC = wA >> wB;
7987 break;
7988 case JIM_EXPROP_BITAND:
7989 wC = wA & wB;
7990 break;
7991 case JIM_EXPROP_BITXOR:
7992 wC = wA ^ wB;
7993 break;
7994 case JIM_EXPROP_BITOR:
7995 wC = wA | wB;
7996 break;
7997 case JIM_EXPROP_MOD:
7998 if (wB == 0) {
7999 wC = 0;
8000 Jim_SetResultString(interp, "Division by zero", -1);
8001 rc = JIM_ERR;
8003 else {
8005 * From Tcl 8.x
8007 * This code is tricky: C doesn't guarantee much
8008 * about the quotient or remainder, but Tcl does.
8009 * The remainder always has the same sign as the
8010 * divisor and a smaller absolute value.
8012 int negative = 0;
8014 if (wB < 0) {
8015 wB = -wB;
8016 wA = -wA;
8017 negative = 1;
8019 wC = wA % wB;
8020 if (wC < 0) {
8021 wC += wB;
8023 if (negative) {
8024 wC = -wC;
8027 break;
8028 case JIM_EXPROP_ROTL:
8029 case JIM_EXPROP_ROTR:{
8030 /* uint32_t would be better. But not everyone has inttypes.h? */
8031 unsigned long uA = (unsigned long)wA;
8032 unsigned long uB = (unsigned long)wB;
8033 const unsigned int S = sizeof(unsigned long) * 8;
8035 /* Shift left by the word size or more is undefined. */
8036 uB %= S;
8038 if (node->type == JIM_EXPROP_ROTR) {
8039 uB = S - uB;
8041 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
8042 break;
8044 default:
8045 abort();
8047 Jim_SetResultInt(interp, wC);
8050 Jim_DecrRefCount(interp, A);
8051 Jim_DecrRefCount(interp, B);
8053 return rc;
8057 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8058 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8060 int rc = JIM_OK;
8061 double dA, dB, dC = 0;
8062 jim_wide wA, wB, wC = 0;
8063 Jim_Obj *A, *B;
8065 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8066 return rc;
8068 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8069 Jim_DecrRefCount(interp, A);
8070 return rc;
8073 if ((A->typePtr != &doubleObjType || A->bytes) &&
8074 (B->typePtr != &doubleObjType || B->bytes) &&
8075 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8077 /* Both are ints */
8079 switch (node->type) {
8080 case JIM_EXPROP_POW:
8081 case JIM_EXPROP_FUNC_POW:
8082 if (wA == 0 && wB < 0) {
8083 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8084 rc = JIM_ERR;
8085 goto done;
8087 wC = JimPowWide(wA, wB);
8088 goto intresult;
8089 case JIM_EXPROP_ADD:
8090 wC = wA + wB;
8091 goto intresult;
8092 case JIM_EXPROP_SUB:
8093 wC = wA - wB;
8094 goto intresult;
8095 case JIM_EXPROP_MUL:
8096 wC = wA * wB;
8097 goto intresult;
8098 case JIM_EXPROP_DIV:
8099 if (wB == 0) {
8100 Jim_SetResultString(interp, "Division by zero", -1);
8101 rc = JIM_ERR;
8102 goto done;
8104 else {
8106 * From Tcl 8.x
8108 * This code is tricky: C doesn't guarantee much
8109 * about the quotient or remainder, but Tcl does.
8110 * The remainder always has the same sign as the
8111 * divisor and a smaller absolute value.
8113 if (wB < 0) {
8114 wB = -wB;
8115 wA = -wA;
8117 wC = wA / wB;
8118 if (wA % wB < 0) {
8119 wC--;
8121 goto intresult;
8123 case JIM_EXPROP_LT:
8124 wC = wA < wB;
8125 goto intresult;
8126 case JIM_EXPROP_GT:
8127 wC = wA > wB;
8128 goto intresult;
8129 case JIM_EXPROP_LTE:
8130 wC = wA <= wB;
8131 goto intresult;
8132 case JIM_EXPROP_GTE:
8133 wC = wA >= wB;
8134 goto intresult;
8135 case JIM_EXPROP_NUMEQ:
8136 wC = wA == wB;
8137 goto intresult;
8138 case JIM_EXPROP_NUMNE:
8139 wC = wA != wB;
8140 goto intresult;
8143 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8144 switch (node->type) {
8145 #ifndef JIM_MATH_FUNCTIONS
8146 case JIM_EXPROP_POW:
8147 case JIM_EXPROP_FUNC_POW:
8148 case JIM_EXPROP_FUNC_ATAN2:
8149 case JIM_EXPROP_FUNC_HYPOT:
8150 case JIM_EXPROP_FUNC_FMOD:
8151 Jim_SetResultString(interp, "unsupported", -1);
8152 rc = JIM_ERR;
8153 goto done;
8154 #else
8155 case JIM_EXPROP_POW:
8156 case JIM_EXPROP_FUNC_POW:
8157 dC = pow(dA, dB);
8158 goto doubleresult;
8159 case JIM_EXPROP_FUNC_ATAN2:
8160 dC = atan2(dA, dB);
8161 goto doubleresult;
8162 case JIM_EXPROP_FUNC_HYPOT:
8163 dC = hypot(dA, dB);
8164 goto doubleresult;
8165 case JIM_EXPROP_FUNC_FMOD:
8166 dC = fmod(dA, dB);
8167 goto doubleresult;
8168 #endif
8169 case JIM_EXPROP_ADD:
8170 dC = dA + dB;
8171 goto doubleresult;
8172 case JIM_EXPROP_SUB:
8173 dC = dA - dB;
8174 goto doubleresult;
8175 case JIM_EXPROP_MUL:
8176 dC = dA * dB;
8177 goto doubleresult;
8178 case JIM_EXPROP_DIV:
8179 if (dB == 0) {
8180 #ifdef INFINITY
8181 dC = dA < 0 ? -INFINITY : INFINITY;
8182 #else
8183 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8184 #endif
8186 else {
8187 dC = dA / dB;
8189 goto doubleresult;
8190 case JIM_EXPROP_LT:
8191 wC = dA < dB;
8192 goto intresult;
8193 case JIM_EXPROP_GT:
8194 wC = dA > dB;
8195 goto intresult;
8196 case JIM_EXPROP_LTE:
8197 wC = dA <= dB;
8198 goto intresult;
8199 case JIM_EXPROP_GTE:
8200 wC = dA >= dB;
8201 goto intresult;
8202 case JIM_EXPROP_NUMEQ:
8203 wC = dA == dB;
8204 goto intresult;
8205 case JIM_EXPROP_NUMNE:
8206 wC = dA != dB;
8207 goto intresult;
8210 else {
8211 /* Handle the string case */
8213 /* XXX: Could optimise the eq/ne case by checking lengths */
8214 int i = Jim_StringCompareObj(interp, A, B, 0);
8216 switch (node->type) {
8217 case JIM_EXPROP_LT:
8218 wC = i < 0;
8219 goto intresult;
8220 case JIM_EXPROP_GT:
8221 wC = i > 0;
8222 goto intresult;
8223 case JIM_EXPROP_LTE:
8224 wC = i <= 0;
8225 goto intresult;
8226 case JIM_EXPROP_GTE:
8227 wC = i >= 0;
8228 goto intresult;
8229 case JIM_EXPROP_NUMEQ:
8230 wC = i == 0;
8231 goto intresult;
8232 case JIM_EXPROP_NUMNE:
8233 wC = i != 0;
8234 goto intresult;
8237 /* If we get here, it is an error */
8238 rc = JIM_ERR;
8239 done:
8240 Jim_DecrRefCount(interp, A);
8241 Jim_DecrRefCount(interp, B);
8242 return rc;
8243 intresult:
8244 Jim_SetResultInt(interp, wC);
8245 goto done;
8246 doubleresult:
8247 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8248 goto done;
8251 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8253 int listlen;
8254 int i;
8256 listlen = Jim_ListLength(interp, listObjPtr);
8257 for (i = 0; i < listlen; i++) {
8258 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8259 return 1;
8262 return 0;
8267 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8269 Jim_Obj *A, *B;
8270 jim_wide wC;
8271 int rc;
8273 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8274 return rc;
8276 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8277 Jim_DecrRefCount(interp, A);
8278 return rc;
8281 switch (node->type) {
8282 case JIM_EXPROP_STREQ:
8283 case JIM_EXPROP_STRNE:
8284 wC = Jim_StringEqObj(A, B);
8285 if (node->type == JIM_EXPROP_STRNE) {
8286 wC = !wC;
8288 break;
8289 case JIM_EXPROP_STRIN:
8290 wC = JimSearchList(interp, B, A);
8291 break;
8292 case JIM_EXPROP_STRNI:
8293 wC = !JimSearchList(interp, B, A);
8294 break;
8295 default:
8296 abort();
8298 Jim_SetResultInt(interp, wC);
8300 Jim_DecrRefCount(interp, A);
8301 Jim_DecrRefCount(interp, B);
8303 return rc;
8306 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8308 long l;
8309 double d;
8310 int b;
8311 int ret = -1;
8313 /* In case the object is interp->result with refcount 1*/
8314 Jim_IncrRefCount(obj);
8316 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8317 ret = (l != 0);
8319 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8320 ret = (d != 0);
8322 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8323 ret = (b != 0);
8326 Jim_DecrRefCount(interp, obj);
8327 return ret;
8330 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8332 /* evaluate left */
8333 int result = JimExprGetTermBoolean(interp, node->left);
8335 if (result == 1) {
8336 /* true so evaluate right */
8337 result = JimExprGetTermBoolean(interp, node->right);
8339 if (result == -1) {
8340 return JIM_ERR;
8342 Jim_SetResultInt(interp, result);
8343 return JIM_OK;
8346 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8348 /* evaluate left */
8349 int result = JimExprGetTermBoolean(interp, node->left);
8351 if (result == 0) {
8352 /* false so evaluate right */
8353 result = JimExprGetTermBoolean(interp, node->right);
8355 if (result == -1) {
8356 return JIM_ERR;
8358 Jim_SetResultInt(interp, result);
8359 return JIM_OK;
8362 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8364 /* evaluate left */
8365 int result = JimExprGetTermBoolean(interp, node->left);
8367 if (result == 1) {
8368 /* true so select right */
8369 return JimExprEvalTermNode(interp, node->right);
8371 else if (result == 0) {
8372 /* false so select ternary */
8373 return JimExprEvalTermNode(interp, node->ternary);
8375 /* error */
8376 return JIM_ERR;
8379 enum
8381 OP_FUNC = 0x0001, /* function syntax */
8382 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8385 /* name - precedence - arity - opcode
8387 * This array *must* be kept in sync with the JIM_EXPROP enum.
8389 * The following macros pre-compute the string length at compile time.
8391 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8392 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8394 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8395 OPRINIT("*", 110, 2, JimExprOpBin),
8396 OPRINIT("/", 110, 2, JimExprOpBin),
8397 OPRINIT("%", 110, 2, JimExprOpIntBin),
8399 OPRINIT("-", 100, 2, JimExprOpBin),
8400 OPRINIT("+", 100, 2, JimExprOpBin),
8402 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8403 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8405 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8406 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8408 OPRINIT("<", 80, 2, JimExprOpBin),
8409 OPRINIT(">", 80, 2, JimExprOpBin),
8410 OPRINIT("<=", 80, 2, JimExprOpBin),
8411 OPRINIT(">=", 80, 2, JimExprOpBin),
8413 OPRINIT("==", 70, 2, JimExprOpBin),
8414 OPRINIT("!=", 70, 2, JimExprOpBin),
8416 OPRINIT("&", 50, 2, JimExprOpIntBin),
8417 OPRINIT("^", 49, 2, JimExprOpIntBin),
8418 OPRINIT("|", 48, 2, JimExprOpIntBin),
8420 OPRINIT("&&", 10, 2, JimExprOpAnd),
8421 OPRINIT("||", 9, 2, JimExprOpOr),
8422 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8423 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8425 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8426 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_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_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8435 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8436 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8437 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8441 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8442 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8443 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8444 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8445 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8446 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8447 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8449 #ifdef JIM_MATH_FUNCTIONS
8450 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8451 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8452 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8453 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8454 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8455 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8456 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8457 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8458 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8459 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8460 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8461 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8462 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8463 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8464 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8465 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8466 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8467 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8468 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8469 #endif
8471 #undef OPRINIT
8472 #undef OPRINIT_ATTR
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 const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8633 static Jim_ExprOperator dummy_op;
8634 if (opcode < JIM_TT_EXPR_OP) {
8635 return &dummy_op;
8637 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8640 static int JimParseExprOperator(struct JimParserCtx *pc)
8642 int i;
8643 const struct Jim_ExprOperator *bestOp = NULL;
8644 int bestLen = 0;
8646 /* Try to get the longest match. */
8647 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8648 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8650 if (op->name[0] != pc->p[0]) {
8651 continue;
8654 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8655 bestOp = op;
8656 bestLen = op->namelen;
8659 if (bestOp == NULL) {
8660 return JIM_ERR;
8663 /* Validate paretheses around function arguments */
8664 if (bestOp->attr & OP_FUNC) {
8665 const char *p = pc->p + bestLen;
8666 int len = pc->len - bestLen;
8668 while (len && isspace(UCHAR(*p))) {
8669 len--;
8670 p++;
8672 if (*p != '(') {
8673 return JIM_ERR;
8676 pc->tend = pc->p + bestLen - 1;
8677 pc->p += bestLen;
8678 pc->len -= bestLen;
8680 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8681 return JIM_OK;
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 tree structure */
8726 struct ExprTree
8728 struct JimExprNode *expr; /* The first operator or term */
8729 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8730 int len; /* Number of nodes in use */
8731 int inUse; /* Used for sharing. */
8734 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8736 int i;
8737 for (i = 0; i < num; i++) {
8738 if (nodes[i].objPtr) {
8739 Jim_DecrRefCount(interp, nodes[i].objPtr);
8742 Jim_Free(nodes);
8745 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8747 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8748 Jim_Free(expr);
8751 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8753 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8755 if (expr) {
8756 if (--expr->inUse != 0) {
8757 return;
8760 ExprTreeFree(interp, expr);
8764 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8766 JIM_NOTUSED(interp);
8767 JIM_NOTUSED(srcPtr);
8769 /* Just returns an simple string. */
8770 dupPtr->typePtr = NULL;
8773 struct ExprBuilder {
8774 int parencount; /* count of outstanding parentheses */
8775 int level; /* recursion depth */
8776 ParseToken *token; /* The current token */
8777 ParseToken *first_token; /* The first token */
8778 Jim_Stack stack; /* stack of pending terms */
8779 Jim_Obj *exprObjPtr; /* the original expression */
8780 Jim_Obj *fileNameObj; /* filename of the original expression */
8781 struct JimExprNode *nodes; /* storage for all nodes */
8782 struct JimExprNode *next; /* storage for the next node */
8785 #ifdef DEBUG_SHOW_EXPR
8786 static void JimShowExprNode(struct JimExprNode *node, int level)
8788 int i;
8789 for (i = 0; i < level; i++) {
8790 printf(" ");
8792 if (TOKEN_IS_EXPR_OP(node->type)) {
8793 printf("%s\n", jim_tt_name(node->type));
8794 if (node->left) {
8795 JimShowExprNode(node->left, level + 1);
8797 if (node->right) {
8798 JimShowExprNode(node->right, level + 1);
8800 if (node->ternary) {
8801 JimShowExprNode(node->ternary, level + 1);
8804 else {
8805 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8808 #endif
8810 #define EXPR_UNTIL_CLOSE 0x0001
8811 #define EXPR_FUNC_ARGS 0x0002
8812 #define EXPR_TERNARY 0x0004
8815 * Parse the subexpression at builder->token and return with the node on the stack.
8816 * builder->token is advanced to the next unconsumed token.
8817 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8819 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8820 * with an equal or lower precedence is reached (or strictly lower if right associative).
8822 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8823 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8824 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8826 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8828 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8830 int rc;
8831 struct JimExprNode *node;
8832 /* Calculate the stack length expected after pushing the number of expected terms */
8833 int exp_stacklen = builder->stack.len + exp_numterms;
8835 builder->level++;
8837 while (builder->token->type != JIM_TT_EOL) {
8838 ParseToken *t = builder->token++;
8839 int prevtt;
8841 if (t == builder->first_token) {
8842 prevtt = JIM_TT_NONE;
8844 else {
8845 prevtt = t[-1].type;
8848 if (t->type == JIM_TT_SUBEXPR_START) {
8849 if (builder->stack.len == exp_stacklen) {
8850 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8851 return JIM_ERR;
8853 builder->parencount++;
8854 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8855 if (rc != JIM_OK) {
8856 return rc;
8858 /* A complete subexpression is on the stack */
8860 else if (t->type == JIM_TT_SUBEXPR_END) {
8861 if (!(flags & EXPR_UNTIL_CLOSE)) {
8862 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8863 builder->token--;
8864 builder->level--;
8865 return JIM_OK;
8867 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8868 return JIM_ERR;
8870 builder->parencount--;
8871 if (builder->stack.len == exp_stacklen) {
8872 /* Return with the expected number of subexpressions on the stack */
8873 break;
8876 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8877 if (!(flags & EXPR_FUNC_ARGS)) {
8878 if (builder->stack.len == exp_stacklen) {
8879 /* handle the comma back at the parent level */
8880 builder->token--;
8881 builder->level--;
8882 return JIM_OK;
8884 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8885 return JIM_ERR;
8887 else {
8888 /* If we see more terms than expected, it is an error */
8889 if (builder->stack.len > exp_stacklen) {
8890 Jim_SetResultFormatted(interp, "too many arguments to math function");
8891 return JIM_ERR;
8894 /* just go onto the next arg */
8896 else if (t->type == JIM_EXPROP_COLON) {
8897 if (!(flags & EXPR_TERNARY)) {
8898 if (builder->level != 1) {
8899 /* handle the comma back at the parent level */
8900 builder->token--;
8901 builder->level--;
8902 return JIM_OK;
8904 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8905 return JIM_ERR;
8907 if (builder->stack.len == exp_stacklen) {
8908 /* handle the comma back at the parent level */
8909 builder->token--;
8910 builder->level--;
8911 return JIM_OK;
8913 /* just go onto the next term */
8915 else if (TOKEN_IS_EXPR_OP(t->type)) {
8916 const struct Jim_ExprOperator *op;
8918 /* Convert -/+ to unary minus or unary plus if necessary */
8919 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8920 if (t->type == JIM_EXPROP_SUB) {
8921 t->type = JIM_EXPROP_UNARYMINUS;
8923 else if (t->type == JIM_EXPROP_ADD) {
8924 t->type = JIM_EXPROP_UNARYPLUS;
8928 op = JimExprOperatorInfoByOpcode(t->type);
8930 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8931 /* next op is lower precedence, or equal and left associative, so done here */
8932 builder->token--;
8933 break;
8936 if (op->attr & OP_FUNC) {
8937 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8938 Jim_SetResultString(interp, "missing arguments for math function", -1);
8939 return JIM_ERR;
8941 builder->token++;
8942 if (op->arity == 0) {
8943 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8944 Jim_SetResultString(interp, "too many arguments for math function", -1);
8945 return JIM_ERR;
8947 builder->token++;
8948 goto noargs;
8950 builder->parencount++;
8952 /* This will push left and return right */
8953 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8955 else if (t->type == JIM_EXPROP_TERNARY) {
8956 /* Collect the two arguments to the ternary operator */
8957 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8959 else {
8960 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8961 * and push that on the term stack
8963 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8966 if (rc != JIM_OK) {
8967 return rc;
8970 noargs:
8971 node = builder->next++;
8972 node->type = t->type;
8974 if (op->arity >= 3) {
8975 node->ternary = Jim_StackPop(&builder->stack);
8976 if (node->ternary == NULL) {
8977 goto missingoperand;
8980 if (op->arity >= 2) {
8981 node->right = Jim_StackPop(&builder->stack);
8982 if (node->right == NULL) {
8983 goto missingoperand;
8986 if (op->arity >= 1) {
8987 node->left = Jim_StackPop(&builder->stack);
8988 if (node->left == NULL) {
8989 missingoperand:
8990 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8991 builder->next--;
8992 return JIM_ERR;
8997 /* Now push the node */
8998 Jim_StackPush(&builder->stack, node);
9000 else {
9001 Jim_Obj *objPtr = NULL;
9003 /* This is a simple non-operator term, so create and push the appropriate object */
9005 /* Two consecutive terms without an operator is invalid */
9006 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9007 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
9008 return JIM_ERR;
9011 /* Immediately create a double or int object? */
9012 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9013 char *endptr;
9014 if (t->type == JIM_TT_EXPR_INT) {
9015 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9017 else {
9018 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9020 if (endptr != t->token + t->len) {
9021 /* Conversion failed, so just store it as a string */
9022 Jim_FreeNewObj(interp, objPtr);
9023 objPtr = NULL;
9027 if (!objPtr) {
9028 /* Everything else is stored a simple string term */
9029 objPtr = Jim_NewStringObj(interp, t->token, t->len);
9030 if (t->type == JIM_TT_CMD) {
9031 /* Only commands need source info */
9032 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
9036 /* Now push a term node */
9037 node = builder->next++;
9038 node->objPtr = objPtr;
9039 Jim_IncrRefCount(node->objPtr);
9040 node->type = t->type;
9041 Jim_StackPush(&builder->stack, node);
9045 if (builder->stack.len == exp_stacklen) {
9046 builder->level--;
9047 return JIM_OK;
9050 if ((flags & EXPR_FUNC_ARGS)) {
9051 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
9053 else {
9054 if (builder->stack.len < exp_stacklen) {
9055 if (builder->level == 0) {
9056 Jim_SetResultFormatted(interp, "empty expression");
9058 else {
9059 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9062 else {
9063 Jim_SetResultFormatted(interp, "extra terms after expression");
9067 return JIM_ERR;
9070 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9072 struct ExprTree *expr;
9073 struct ExprBuilder builder;
9074 int rc;
9075 struct JimExprNode *top;
9077 builder.parencount = 0;
9078 builder.level = 0;
9079 builder.token = builder.first_token = tokenlist->list;
9080 builder.exprObjPtr = exprObjPtr;
9081 builder.fileNameObj = fileNameObj;
9082 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9083 builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9084 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9085 builder.next = builder.nodes;
9086 Jim_InitStack(&builder.stack);
9088 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9090 if (rc == JIM_OK) {
9091 top = Jim_StackPop(&builder.stack);
9093 if (builder.parencount) {
9094 Jim_SetResultString(interp, "missing close parenthesis", -1);
9095 rc = JIM_ERR;
9099 /* Free the stack used for the compilation. */
9100 Jim_FreeStack(&builder.stack);
9102 if (rc != JIM_OK) {
9103 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9104 return NULL;
9107 expr = Jim_Alloc(sizeof(*expr));
9108 expr->inUse = 1;
9109 expr->expr = top;
9110 expr->nodes = builder.nodes;
9111 expr->len = builder.next - builder.nodes;
9113 assert(expr->len <= tokenlist->count - 1);
9115 return expr;
9118 /* This method takes the string representation of an expression
9119 * and generates a program for the expr engine */
9120 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9122 int exprTextLen;
9123 const char *exprText;
9124 struct JimParserCtx parser;
9125 struct ExprTree *expr;
9126 ParseTokenList tokenlist;
9127 int line;
9128 Jim_Obj *fileNameObj;
9129 int rc = JIM_ERR;
9131 /* Try to get information about filename / line number */
9132 if (objPtr->typePtr == &sourceObjType) {
9133 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9134 line = objPtr->internalRep.sourceValue.lineNumber;
9136 else {
9137 fileNameObj = interp->emptyObj;
9138 line = 1;
9140 Jim_IncrRefCount(fileNameObj);
9142 exprText = Jim_GetString(objPtr, &exprTextLen);
9144 /* Initially tokenise the expression into tokenlist */
9145 ScriptTokenListInit(&tokenlist);
9147 JimParserInit(&parser, exprText, exprTextLen, line);
9148 while (!parser.eof) {
9149 if (JimParseExpression(&parser) != JIM_OK) {
9150 ScriptTokenListFree(&tokenlist);
9151 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9152 expr = NULL;
9153 goto err;
9156 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9157 parser.tline);
9160 #ifdef DEBUG_SHOW_EXPR_TOKENS
9162 int i;
9163 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9164 for (i = 0; i < tokenlist.count; i++) {
9165 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9166 tokenlist.list[i].len, tokenlist.list[i].token);
9169 #endif
9171 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9172 ScriptTokenListFree(&tokenlist);
9173 Jim_DecrRefCount(interp, fileNameObj);
9174 return JIM_ERR;
9177 /* Now create the expression bytecode from the tokenlist */
9178 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9180 /* No longer need the token list */
9181 ScriptTokenListFree(&tokenlist);
9183 if (!expr) {
9184 goto err;
9187 #ifdef DEBUG_SHOW_EXPR
9188 printf("==== Expr ====\n");
9189 JimShowExprNode(expr->expr, 0);
9190 #endif
9192 rc = JIM_OK;
9194 err:
9195 /* Free the old internal rep and set the new one. */
9196 Jim_DecrRefCount(interp, fileNameObj);
9197 Jim_FreeIntRep(interp, objPtr);
9198 Jim_SetIntRepPtr(objPtr, expr);
9199 objPtr->typePtr = &exprObjType;
9200 return rc;
9203 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9205 if (objPtr->typePtr != &exprObjType) {
9206 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9207 return NULL;
9210 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9213 #ifdef JIM_OPTIMIZATION
9214 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9216 if (node->type == JIM_TT_EXPR_INT)
9217 return node->objPtr;
9218 else if (node->type == JIM_TT_VAR)
9219 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9220 else if (node->type == JIM_TT_DICTSUGAR)
9221 return JimExpandDictSugar(interp, node->objPtr);
9222 else
9223 return NULL;
9225 #endif
9227 /* -----------------------------------------------------------------------------
9228 * Expressions evaluation.
9229 * Jim uses a recursive evaluation engine for expressions,
9230 * that takes advantage of the fact that expr's operators
9231 * can't be redefined.
9233 * Jim_EvalExpression() uses the expression tree compiled by
9234 * SetExprFromAny() method of the "expression" object.
9236 * On success a Tcl Object containing the result of the evaluation
9237 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9238 * returned.
9239 * On error the function returns a retcode != to JIM_OK and set a suitable
9240 * error on the interp.
9241 * ---------------------------------------------------------------------------*/
9243 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9245 if (TOKEN_IS_EXPR_OP(node->type)) {
9246 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9247 return op->funcop(interp, node);
9249 else {
9250 Jim_Obj *objPtr;
9252 /* A term */
9253 switch (node->type) {
9254 case JIM_TT_EXPR_INT:
9255 case JIM_TT_EXPR_DOUBLE:
9256 case JIM_TT_EXPR_BOOLEAN:
9257 case JIM_TT_STR:
9258 Jim_SetResult(interp, node->objPtr);
9259 return JIM_OK;
9261 case JIM_TT_VAR:
9262 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9263 if (objPtr) {
9264 Jim_SetResult(interp, objPtr);
9265 return JIM_OK;
9267 return JIM_ERR;
9269 case JIM_TT_DICTSUGAR:
9270 objPtr = JimExpandDictSugar(interp, node->objPtr);
9271 if (objPtr) {
9272 Jim_SetResult(interp, objPtr);
9273 return JIM_OK;
9275 return JIM_ERR;
9277 case JIM_TT_ESC:
9278 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9279 Jim_SetResult(interp, objPtr);
9280 return JIM_OK;
9282 return JIM_ERR;
9284 case JIM_TT_CMD:
9285 return Jim_EvalObj(interp, node->objPtr);
9287 default:
9288 /* Should never get here */
9289 return JIM_ERR;
9294 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9296 int rc = JimExprEvalTermNode(interp, node);
9297 if (rc == JIM_OK) {
9298 *objPtrPtr = Jim_GetResult(interp);
9299 Jim_IncrRefCount(*objPtrPtr);
9301 return rc;
9304 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9306 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9307 return ExprBool(interp, Jim_GetResult(interp));
9309 return -1;
9312 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9314 struct ExprTree *expr;
9315 int retcode = JIM_OK;
9317 expr = JimGetExpression(interp, exprObjPtr);
9318 if (!expr) {
9319 return JIM_ERR; /* error in expression. */
9322 #ifdef JIM_OPTIMIZATION
9323 /* Check for one of the following common expressions used by while/for
9325 * CONST
9326 * $a
9327 * !$a
9328 * $a < CONST, $a < $b
9329 * $a <= CONST, $a <= $b
9330 * $a > CONST, $a > $b
9331 * $a >= CONST, $a >= $b
9332 * $a != CONST, $a != $b
9333 * $a == CONST, $a == $b
9336 Jim_Obj *objPtr;
9338 /* STEP 1 -- Check if there are the conditions to run the specialized
9339 * version of while */
9341 switch (expr->len) {
9342 case 1:
9343 objPtr = JimExprIntValOrVar(interp, expr->expr);
9344 if (objPtr) {
9345 Jim_SetResult(interp, objPtr);
9346 return JIM_OK;
9348 break;
9350 case 2:
9351 if (expr->expr->type == JIM_EXPROP_NOT) {
9352 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9354 if (objPtr && JimIsWide(objPtr)) {
9355 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9356 return JIM_OK;
9359 break;
9361 case 3:
9362 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9363 if (objPtr && JimIsWide(objPtr)) {
9364 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9365 if (objPtr2 && JimIsWide(objPtr2)) {
9366 jim_wide wideValueA = JimWideValue(objPtr);
9367 jim_wide wideValueB = JimWideValue(objPtr2);
9368 int cmpRes;
9369 switch (expr->expr->type) {
9370 case JIM_EXPROP_LT:
9371 cmpRes = wideValueA < wideValueB;
9372 break;
9373 case JIM_EXPROP_LTE:
9374 cmpRes = wideValueA <= wideValueB;
9375 break;
9376 case JIM_EXPROP_GT:
9377 cmpRes = wideValueA > wideValueB;
9378 break;
9379 case JIM_EXPROP_GTE:
9380 cmpRes = wideValueA >= wideValueB;
9381 break;
9382 case JIM_EXPROP_NUMEQ:
9383 cmpRes = wideValueA == wideValueB;
9384 break;
9385 case JIM_EXPROP_NUMNE:
9386 cmpRes = wideValueA != wideValueB;
9387 break;
9388 default:
9389 goto noopt;
9391 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9392 return JIM_OK;
9395 break;
9398 noopt:
9399 #endif
9401 /* In order to avoid the internal repr being freed due to
9402 * shimmering of the exprObjPtr's object, we make the internal rep
9403 * shared. */
9404 expr->inUse++;
9406 /* Evaluate with the recursive expr engine */
9407 retcode = JimExprEvalTermNode(interp, expr->expr);
9409 expr->inUse--;
9411 return retcode;
9414 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9416 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9418 if (retcode == JIM_OK) {
9419 switch (ExprBool(interp, Jim_GetResult(interp))) {
9420 case 0:
9421 *boolPtr = 0;
9422 break;
9424 case 1:
9425 *boolPtr = 1;
9426 break;
9428 case -1:
9429 retcode = JIM_ERR;
9430 break;
9433 return retcode;
9436 /* -----------------------------------------------------------------------------
9437 * ScanFormat String Object
9438 * ---------------------------------------------------------------------------*/
9440 /* This Jim_Obj will held a parsed representation of a format string passed to
9441 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9442 * to be parsed in its entirely first and then, if correct, can be used for
9443 * scanning. To avoid endless re-parsing, the parsed representation will be
9444 * stored in an internal representation and re-used for performance reason. */
9446 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9447 * scanformat string. This part will later be used to extract information
9448 * out from the string to be parsed by Jim_ScanString */
9450 typedef struct ScanFmtPartDescr
9452 char *arg; /* Specification of a CHARSET conversion */
9453 char *prefix; /* Prefix to be scanned literally before conversion */
9454 size_t width; /* Maximal width of input to be converted */
9455 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9456 char type; /* Type of conversion (e.g. c, d, f) */
9457 char modifier; /* Modify type (e.g. l - long, h - short */
9458 } ScanFmtPartDescr;
9460 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9461 * string parsed and separated in part descriptions. Furthermore it contains
9462 * the original string representation of the scanformat string to allow for
9463 * fast update of the Jim_Obj's string representation part.
9465 * As an add-on the internal object representation adds some scratch pad area
9466 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9467 * memory for purpose of string scanning.
9469 * The error member points to a static allocated string in case of a mal-
9470 * formed scanformat string or it contains '0' (NULL) in case of a valid
9471 * parse representation.
9473 * The whole memory of the internal representation is allocated as a single
9474 * area of memory that will be internally separated. So freeing and duplicating
9475 * of such an object is cheap */
9477 typedef struct ScanFmtStringObj
9479 jim_wide size; /* Size of internal repr in bytes */
9480 char *stringRep; /* Original string representation */
9481 size_t count; /* Number of ScanFmtPartDescr contained */
9482 size_t convCount; /* Number of conversions that will assign */
9483 size_t maxPos; /* Max position index if XPG3 is used */
9484 const char *error; /* Ptr to error text (NULL if no error */
9485 char *scratch; /* Some scratch pad used by Jim_ScanString */
9486 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9487 } ScanFmtStringObj;
9490 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9491 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9492 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9494 static const Jim_ObjType scanFmtStringObjType = {
9495 "scanformatstring",
9496 FreeScanFmtInternalRep,
9497 DupScanFmtInternalRep,
9498 UpdateStringOfScanFmt,
9499 JIM_TYPE_NONE,
9502 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9504 JIM_NOTUSED(interp);
9505 Jim_Free((char *)objPtr->internalRep.ptr);
9506 objPtr->internalRep.ptr = 0;
9509 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9511 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9512 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9514 JIM_NOTUSED(interp);
9515 memcpy(newVec, srcPtr->internalRep.ptr, size);
9516 dupPtr->internalRep.ptr = newVec;
9517 dupPtr->typePtr = &scanFmtStringObjType;
9520 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9522 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9525 /* SetScanFmtFromAny will parse a given string and create the internal
9526 * representation of the format specification. In case of an error
9527 * the error data member of the internal representation will be set
9528 * to an descriptive error text and the function will be left with
9529 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9530 * specification */
9532 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9534 ScanFmtStringObj *fmtObj;
9535 char *buffer;
9536 int maxCount, i, approxSize, lastPos = -1;
9537 const char *fmt = Jim_String(objPtr);
9538 int maxFmtLen = Jim_Length(objPtr);
9539 const char *fmtEnd = fmt + maxFmtLen;
9540 int curr;
9542 Jim_FreeIntRep(interp, objPtr);
9543 /* Count how many conversions could take place maximally */
9544 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9545 if (fmt[i] == '%')
9546 ++maxCount;
9547 /* Calculate an approximation of the memory necessary */
9548 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9549 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9550 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9551 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9552 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9553 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9554 +1; /* safety byte */
9555 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9556 memset(fmtObj, 0, approxSize);
9557 fmtObj->size = approxSize;
9558 fmtObj->maxPos = 0;
9559 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9560 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9561 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9562 buffer = fmtObj->stringRep + maxFmtLen + 1;
9563 objPtr->internalRep.ptr = fmtObj;
9564 objPtr->typePtr = &scanFmtStringObjType;
9565 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9566 int width = 0, skip;
9567 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9569 fmtObj->count++;
9570 descr->width = 0; /* Assume width unspecified */
9571 /* Overread and store any "literal" prefix */
9572 if (*fmt != '%' || fmt[1] == '%') {
9573 descr->type = 0;
9574 descr->prefix = &buffer[i];
9575 for (; fmt < fmtEnd; ++fmt) {
9576 if (*fmt == '%') {
9577 if (fmt[1] != '%')
9578 break;
9579 ++fmt;
9581 buffer[i++] = *fmt;
9583 buffer[i++] = 0;
9585 /* Skip the conversion introducing '%' sign */
9586 ++fmt;
9587 /* End reached due to non-conversion literal only? */
9588 if (fmt >= fmtEnd)
9589 goto done;
9590 descr->pos = 0; /* Assume "natural" positioning */
9591 if (*fmt == '*') {
9592 descr->pos = -1; /* Okay, conversion will not be assigned */
9593 ++fmt;
9595 else
9596 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9597 /* Check if next token is a number (could be width or pos */
9598 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9599 fmt += skip;
9600 /* Was the number a XPG3 position specifier? */
9601 if (descr->pos != -1 && *fmt == '$') {
9602 int prev;
9604 ++fmt;
9605 descr->pos = width;
9606 width = 0;
9607 /* Look if "natural" postioning and XPG3 one was mixed */
9608 if ((lastPos == 0 && descr->pos > 0)
9609 || (lastPos > 0 && descr->pos == 0)) {
9610 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9611 return JIM_ERR;
9613 /* Look if this position was already used */
9614 for (prev = 0; prev < curr; ++prev) {
9615 if (fmtObj->descr[prev].pos == -1)
9616 continue;
9617 if (fmtObj->descr[prev].pos == descr->pos) {
9618 fmtObj->error =
9619 "variable is assigned by multiple \"%n$\" conversion specifiers";
9620 return JIM_ERR;
9623 if (descr->pos < 0) {
9624 fmtObj->error =
9625 "\"%n$\" conversion specifier is negative";
9626 return JIM_ERR;
9628 /* Try to find a width after the XPG3 specifier */
9629 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9630 descr->width = width;
9631 fmt += skip;
9633 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9634 fmtObj->maxPos = descr->pos;
9636 else {
9637 /* Number was not a XPG3, so it has to be a width */
9638 descr->width = width;
9641 /* If positioning mode was undetermined yet, fix this */
9642 if (lastPos == -1)
9643 lastPos = descr->pos;
9644 /* Handle CHARSET conversion type ... */
9645 if (*fmt == '[') {
9646 int swapped = 1, beg = i, end, j;
9648 descr->type = '[';
9649 descr->arg = &buffer[i];
9650 ++fmt;
9651 if (*fmt == '^')
9652 buffer[i++] = *fmt++;
9653 if (*fmt == ']')
9654 buffer[i++] = *fmt++;
9655 while (*fmt && *fmt != ']')
9656 buffer[i++] = *fmt++;
9657 if (*fmt != ']') {
9658 fmtObj->error = "unmatched [ in format string";
9659 return JIM_ERR;
9661 end = i;
9662 buffer[i++] = 0;
9663 /* In case a range fence was given "backwards", swap it */
9664 while (swapped) {
9665 swapped = 0;
9666 for (j = beg + 1; j < end - 1; ++j) {
9667 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9668 char tmp = buffer[j - 1];
9670 buffer[j - 1] = buffer[j + 1];
9671 buffer[j + 1] = tmp;
9672 swapped = 1;
9677 else {
9678 /* Remember any valid modifier if given */
9679 if (fmt < fmtEnd && strchr("hlL", *fmt))
9680 descr->modifier = tolower((int)*fmt++);
9682 if (fmt >= fmtEnd) {
9683 fmtObj->error = "missing scan conversion character";
9684 return JIM_ERR;
9687 descr->type = *fmt;
9688 if (strchr("efgcsndoxui", *fmt) == 0) {
9689 fmtObj->error = "bad scan conversion character";
9690 return JIM_ERR;
9692 else if (*fmt == 'c' && descr->width != 0) {
9693 fmtObj->error = "field width may not be specified in %c " "conversion";
9694 return JIM_ERR;
9696 else if (*fmt == 'u' && descr->modifier == 'l') {
9697 fmtObj->error = "unsigned wide not supported";
9698 return JIM_ERR;
9701 curr++;
9703 done:
9704 return JIM_OK;
9707 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9709 #define FormatGetCnvCount(_fo_) \
9710 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9711 #define FormatGetMaxPos(_fo_) \
9712 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9713 #define FormatGetError(_fo_) \
9714 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9716 /* JimScanAString is used to scan an unspecified string that ends with
9717 * next WS, or a string that is specified via a charset.
9720 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9722 char *buffer = Jim_StrDup(str);
9723 char *p = buffer;
9725 while (*str) {
9726 int c;
9727 int n;
9729 if (!sdescr && isspace(UCHAR(*str)))
9730 break; /* EOS via WS if unspecified */
9732 n = utf8_tounicode(str, &c);
9733 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9734 break;
9735 while (n--)
9736 *p++ = *str++;
9738 *p = 0;
9739 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9742 /* ScanOneEntry will scan one entry out of the string passed as argument.
9743 * It use the sscanf() function for this task. After extracting and
9744 * converting of the value, the count of scanned characters will be
9745 * returned of -1 in case of no conversion tool place and string was
9746 * already scanned thru */
9748 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9749 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9751 const char *tok;
9752 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9753 size_t scanned = 0;
9754 size_t anchor = pos;
9755 int i;
9756 Jim_Obj *tmpObj = NULL;
9758 /* First pessimistically assume, we will not scan anything :-) */
9759 *valObjPtr = 0;
9760 if (descr->prefix) {
9761 /* There was a prefix given before the conversion, skip it and adjust
9762 * the string-to-be-parsed accordingly */
9763 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9764 /* If prefix require, skip WS */
9765 if (isspace(UCHAR(descr->prefix[i])))
9766 while (pos < strLen && isspace(UCHAR(str[pos])))
9767 ++pos;
9768 else if (descr->prefix[i] != str[pos])
9769 break; /* Prefix do not match here, leave the loop */
9770 else
9771 ++pos; /* Prefix matched so far, next round */
9773 if (pos >= strLen) {
9774 return -1; /* All of str consumed: EOF condition */
9776 else if (descr->prefix[i] != 0)
9777 return 0; /* Not whole prefix consumed, no conversion possible */
9779 /* For all but following conversion, skip leading WS */
9780 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9781 while (isspace(UCHAR(str[pos])))
9782 ++pos;
9783 /* Determine how much skipped/scanned so far */
9784 scanned = pos - anchor;
9786 /* %c is a special, simple case. no width */
9787 if (descr->type == 'n') {
9788 /* Return pseudo conversion means: how much scanned so far? */
9789 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9791 else if (pos >= strLen) {
9792 /* Cannot scan anything, as str is totally consumed */
9793 return -1;
9795 else if (descr->type == 'c') {
9796 int c;
9797 scanned += utf8_tounicode(&str[pos], &c);
9798 *valObjPtr = Jim_NewIntObj(interp, c);
9799 return scanned;
9801 else {
9802 /* Processing of conversions follows ... */
9803 if (descr->width > 0) {
9804 /* Do not try to scan as fas as possible but only the given width.
9805 * To ensure this, we copy the part that should be scanned. */
9806 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9807 size_t tLen = descr->width > sLen ? sLen : descr->width;
9809 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9810 tok = tmpObj->bytes;
9812 else {
9813 /* As no width was given, simply refer to the original string */
9814 tok = &str[pos];
9816 switch (descr->type) {
9817 case 'd':
9818 case 'o':
9819 case 'x':
9820 case 'u':
9821 case 'i':{
9822 char *endp; /* Position where the number finished */
9823 jim_wide w;
9825 int base = descr->type == 'o' ? 8
9826 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9828 /* Try to scan a number with the given base */
9829 if (base == 0) {
9830 w = jim_strtoull(tok, &endp);
9832 else {
9833 w = strtoull(tok, &endp, base);
9836 if (endp != tok) {
9837 /* There was some number sucessfully scanned! */
9838 *valObjPtr = Jim_NewIntObj(interp, w);
9840 /* Adjust the number-of-chars scanned so far */
9841 scanned += endp - tok;
9843 else {
9844 /* Nothing was scanned. We have to determine if this
9845 * happened due to e.g. prefix mismatch or input str
9846 * exhausted */
9847 scanned = *tok ? 0 : -1;
9849 break;
9851 case 's':
9852 case '[':{
9853 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9854 scanned += Jim_Length(*valObjPtr);
9855 break;
9857 case 'e':
9858 case 'f':
9859 case 'g':{
9860 char *endp;
9861 double value = strtod(tok, &endp);
9863 if (endp != tok) {
9864 /* There was some number sucessfully scanned! */
9865 *valObjPtr = Jim_NewDoubleObj(interp, value);
9866 /* Adjust the number-of-chars scanned so far */
9867 scanned += endp - tok;
9869 else {
9870 /* Nothing was scanned. We have to determine if this
9871 * happened due to e.g. prefix mismatch or input str
9872 * exhausted */
9873 scanned = *tok ? 0 : -1;
9875 break;
9878 /* If a substring was allocated (due to pre-defined width) do not
9879 * forget to free it */
9880 if (tmpObj) {
9881 Jim_FreeNewObj(interp, tmpObj);
9884 return scanned;
9887 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9888 * string and returns all converted (and not ignored) values in a list back
9889 * to the caller. If an error occured, a NULL pointer will be returned */
9891 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9893 size_t i, pos;
9894 int scanned = 1;
9895 const char *str = Jim_String(strObjPtr);
9896 int strLen = Jim_Utf8Length(interp, strObjPtr);
9897 Jim_Obj *resultList = 0;
9898 Jim_Obj **resultVec = 0;
9899 int resultc;
9900 Jim_Obj *emptyStr = 0;
9901 ScanFmtStringObj *fmtObj;
9903 /* This should never happen. The format object should already be of the correct type */
9904 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9906 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9907 /* Check if format specification was valid */
9908 if (fmtObj->error != 0) {
9909 if (flags & JIM_ERRMSG)
9910 Jim_SetResultString(interp, fmtObj->error, -1);
9911 return 0;
9913 /* Allocate a new "shared" empty string for all unassigned conversions */
9914 emptyStr = Jim_NewEmptyStringObj(interp);
9915 Jim_IncrRefCount(emptyStr);
9916 /* Create a list and fill it with empty strings up to max specified XPG3 */
9917 resultList = Jim_NewListObj(interp, NULL, 0);
9918 if (fmtObj->maxPos > 0) {
9919 for (i = 0; i < fmtObj->maxPos; ++i)
9920 Jim_ListAppendElement(interp, resultList, emptyStr);
9921 JimListGetElements(interp, resultList, &resultc, &resultVec);
9923 /* Now handle every partial format description */
9924 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9925 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9926 Jim_Obj *value = 0;
9928 /* Only last type may be "literal" w/o conversion - skip it! */
9929 if (descr->type == 0)
9930 continue;
9931 /* As long as any conversion could be done, we will proceed */
9932 if (scanned > 0)
9933 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9934 /* In case our first try results in EOF, we will leave */
9935 if (scanned == -1 && i == 0)
9936 goto eof;
9937 /* Advance next pos-to-be-scanned for the amount scanned already */
9938 pos += scanned;
9940 /* value == 0 means no conversion took place so take empty string */
9941 if (value == 0)
9942 value = Jim_NewEmptyStringObj(interp);
9943 /* If value is a non-assignable one, skip it */
9944 if (descr->pos == -1) {
9945 Jim_FreeNewObj(interp, value);
9947 else if (descr->pos == 0)
9948 /* Otherwise append it to the result list if no XPG3 was given */
9949 Jim_ListAppendElement(interp, resultList, value);
9950 else if (resultVec[descr->pos - 1] == emptyStr) {
9951 /* But due to given XPG3, put the value into the corr. slot */
9952 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9953 Jim_IncrRefCount(value);
9954 resultVec[descr->pos - 1] = value;
9956 else {
9957 /* Otherwise, the slot was already used - free obj and ERROR */
9958 Jim_FreeNewObj(interp, value);
9959 goto err;
9962 Jim_DecrRefCount(interp, emptyStr);
9963 return resultList;
9964 eof:
9965 Jim_DecrRefCount(interp, emptyStr);
9966 Jim_FreeNewObj(interp, resultList);
9967 return (Jim_Obj *)EOF;
9968 err:
9969 Jim_DecrRefCount(interp, emptyStr);
9970 Jim_FreeNewObj(interp, resultList);
9971 return 0;
9974 /* -----------------------------------------------------------------------------
9975 * Pseudo Random Number Generation
9976 * ---------------------------------------------------------------------------*/
9977 /* Initialize the sbox with the numbers from 0 to 255 */
9978 static void JimPrngInit(Jim_Interp *interp)
9980 #define PRNG_SEED_SIZE 256
9981 int i;
9982 unsigned int *seed;
9983 time_t t = time(NULL);
9985 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9987 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9988 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9989 seed[i] = (rand() ^ t ^ clock());
9991 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9992 Jim_Free(seed);
9995 /* Generates N bytes of random data */
9996 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9998 Jim_PrngState *prng;
9999 unsigned char *destByte = (unsigned char *)dest;
10000 unsigned int si, sj, x;
10002 /* initialization, only needed the first time */
10003 if (interp->prngState == NULL)
10004 JimPrngInit(interp);
10005 prng = interp->prngState;
10006 /* generates 'len' bytes of pseudo-random numbers */
10007 for (x = 0; x < len; x++) {
10008 prng->i = (prng->i + 1) & 0xff;
10009 si = prng->sbox[prng->i];
10010 prng->j = (prng->j + si) & 0xff;
10011 sj = prng->sbox[prng->j];
10012 prng->sbox[prng->i] = sj;
10013 prng->sbox[prng->j] = si;
10014 *destByte++ = prng->sbox[(si + sj) & 0xff];
10018 /* Re-seed the generator with user-provided bytes */
10019 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10021 int i;
10022 Jim_PrngState *prng;
10024 /* initialization, only needed the first time */
10025 if (interp->prngState == NULL)
10026 JimPrngInit(interp);
10027 prng = interp->prngState;
10029 /* Set the sbox[i] with i */
10030 for (i = 0; i < 256; i++)
10031 prng->sbox[i] = i;
10032 /* Now use the seed to perform a random permutation of the sbox */
10033 for (i = 0; i < seedLen; i++) {
10034 unsigned char t;
10036 t = prng->sbox[i & 0xFF];
10037 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10038 prng->sbox[seed[i]] = t;
10040 prng->i = prng->j = 0;
10042 /* discard at least the first 256 bytes of stream.
10043 * borrow the seed buffer for this
10045 for (i = 0; i < 256; i += seedLen) {
10046 JimRandomBytes(interp, seed, seedLen);
10050 /* [incr] */
10051 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10053 jim_wide wideValue, increment = 1;
10054 Jim_Obj *intObjPtr;
10056 if (argc != 2 && argc != 3) {
10057 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10058 return JIM_ERR;
10060 if (argc == 3) {
10061 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10062 return JIM_ERR;
10064 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10065 if (!intObjPtr) {
10066 /* Set missing variable to 0 */
10067 wideValue = 0;
10069 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10070 return JIM_ERR;
10072 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10073 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10074 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10075 Jim_FreeNewObj(interp, intObjPtr);
10076 return JIM_ERR;
10079 else {
10080 /* Can do it the quick way */
10081 Jim_InvalidateStringRep(intObjPtr);
10082 JimWideValue(intObjPtr) = wideValue + increment;
10084 /* The following step is required in order to invalidate the
10085 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10086 if (argv[1]->typePtr != &variableObjType) {
10087 /* Note that this can't fail since GetVariable already succeeded */
10088 Jim_SetVariable(interp, argv[1], intObjPtr);
10091 Jim_SetResult(interp, intObjPtr);
10092 return JIM_OK;
10096 /* -----------------------------------------------------------------------------
10097 * Eval
10098 * ---------------------------------------------------------------------------*/
10099 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10100 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10102 /* Handle calls to the [unknown] command */
10103 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10105 int retcode;
10107 /* If JimUnknown() is recursively called too many times...
10108 * done here
10110 if (interp->unknown_called > 50) {
10111 return JIM_ERR;
10114 /* The object interp->unknown just contains
10115 * the "unknown" string, it is used in order to
10116 * avoid to lookup the unknown command every time
10117 * but instead to cache the result. */
10119 /* If the [unknown] command does not exist ... */
10120 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10121 return JIM_ERR;
10123 interp->unknown_called++;
10124 /* XXX: Are we losing fileNameObj and linenr? */
10125 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10126 interp->unknown_called--;
10128 return retcode;
10131 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10133 int retcode;
10134 Jim_Cmd *cmdPtr;
10136 #if 0
10137 printf("invoke");
10138 int j;
10139 for (j = 0; j < objc; j++) {
10140 printf(" '%s'", Jim_String(objv[j]));
10142 printf("\n");
10143 #endif
10145 if (interp->framePtr->tailcallCmd) {
10146 /* Special tailcall command was pre-resolved */
10147 cmdPtr = interp->framePtr->tailcallCmd;
10148 interp->framePtr->tailcallCmd = NULL;
10150 else {
10151 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10152 if (cmdPtr == NULL) {
10153 return JimUnknown(interp, objc, objv);
10155 JimIncrCmdRefCount(cmdPtr);
10158 if (interp->evalDepth == interp->maxEvalDepth) {
10159 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10160 retcode = JIM_ERR;
10161 goto out;
10163 interp->evalDepth++;
10165 /* Call it -- Make sure result is an empty object. */
10166 Jim_SetEmptyResult(interp);
10167 if (cmdPtr->isproc) {
10168 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10170 else {
10171 interp->cmdPrivData = cmdPtr->u.native.privData;
10172 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10174 interp->evalDepth--;
10176 out:
10177 JimDecrCmdRefCount(interp, cmdPtr);
10179 return retcode;
10182 /* Eval the object vector 'objv' composed of 'objc' elements.
10183 * Every element is used as single argument.
10184 * Jim_EvalObj() will call this function every time its object
10185 * argument is of "list" type, with no string representation.
10187 * This is possible because the string representation of a
10188 * list object generated by the UpdateStringOfList is made
10189 * in a way that ensures that every list element is a different
10190 * command argument. */
10191 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10193 int i, retcode;
10195 /* Incr refcount of arguments. */
10196 for (i = 0; i < objc; i++)
10197 Jim_IncrRefCount(objv[i]);
10199 retcode = JimInvokeCommand(interp, objc, objv);
10201 /* Decr refcount of arguments and return the retcode */
10202 for (i = 0; i < objc; i++)
10203 Jim_DecrRefCount(interp, objv[i]);
10205 return retcode;
10209 * Invokes 'prefix' as a command with the objv array as arguments.
10211 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10213 int ret;
10214 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10216 nargv[0] = prefix;
10217 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10218 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10219 Jim_Free(nargv);
10220 return ret;
10223 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10225 if (!interp->errorFlag) {
10226 /* This is the first error, so save the file/line information and reset the stack */
10227 interp->errorFlag = 1;
10228 Jim_IncrRefCount(script->fileNameObj);
10229 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10230 interp->errorFileNameObj = script->fileNameObj;
10231 interp->errorLine = script->linenr;
10233 JimResetStackTrace(interp);
10234 /* Always add a level where the error first occurs */
10235 interp->addStackTrace++;
10238 /* Now if this is an "interesting" level, add it to the stack trace */
10239 if (interp->addStackTrace > 0) {
10240 /* Add the stack info for the current level */
10242 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10244 /* Note: if we didn't have a filename for this level,
10245 * don't clear the addStackTrace flag
10246 * so we can pick it up at the next level
10248 if (Jim_Length(script->fileNameObj)) {
10249 interp->addStackTrace = 0;
10252 Jim_DecrRefCount(interp, interp->errorProc);
10253 interp->errorProc = interp->emptyObj;
10254 Jim_IncrRefCount(interp->errorProc);
10258 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10260 Jim_Obj *objPtr;
10262 switch (token->type) {
10263 case JIM_TT_STR:
10264 case JIM_TT_ESC:
10265 objPtr = token->objPtr;
10266 break;
10267 case JIM_TT_VAR:
10268 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10269 break;
10270 case JIM_TT_DICTSUGAR:
10271 objPtr = JimExpandDictSugar(interp, token->objPtr);
10272 break;
10273 case JIM_TT_EXPRSUGAR:
10274 objPtr = JimExpandExprSugar(interp, token->objPtr);
10275 break;
10276 case JIM_TT_CMD:
10277 switch (Jim_EvalObj(interp, token->objPtr)) {
10278 case JIM_OK:
10279 case JIM_RETURN:
10280 objPtr = interp->result;
10281 break;
10282 case JIM_BREAK:
10283 /* Stop substituting */
10284 return JIM_BREAK;
10285 case JIM_CONTINUE:
10286 /* just skip this one */
10287 return JIM_CONTINUE;
10288 default:
10289 return JIM_ERR;
10291 break;
10292 default:
10293 JimPanic((1,
10294 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10295 objPtr = NULL;
10296 break;
10298 if (objPtr) {
10299 *objPtrPtr = objPtr;
10300 return JIM_OK;
10302 return JIM_ERR;
10305 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10306 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10307 * The returned object has refcount = 0.
10309 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10311 int totlen = 0, i;
10312 Jim_Obj **intv;
10313 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10314 Jim_Obj *objPtr;
10315 char *s;
10317 if (tokens <= JIM_EVAL_SINTV_LEN)
10318 intv = sintv;
10319 else
10320 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10322 /* Compute every token forming the argument
10323 * in the intv objects vector. */
10324 for (i = 0; i < tokens; i++) {
10325 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10326 case JIM_OK:
10327 case JIM_RETURN:
10328 break;
10329 case JIM_BREAK:
10330 if (flags & JIM_SUBST_FLAG) {
10331 /* Stop here */
10332 tokens = i;
10333 continue;
10335 /* XXX: Should probably set an error about break outside loop */
10336 /* fall through to error */
10337 case JIM_CONTINUE:
10338 if (flags & JIM_SUBST_FLAG) {
10339 intv[i] = NULL;
10340 continue;
10342 /* XXX: Ditto continue outside loop */
10343 /* fall through to error */
10344 default:
10345 while (i--) {
10346 Jim_DecrRefCount(interp, intv[i]);
10348 if (intv != sintv) {
10349 Jim_Free(intv);
10351 return NULL;
10353 Jim_IncrRefCount(intv[i]);
10354 Jim_String(intv[i]);
10355 totlen += intv[i]->length;
10358 /* Fast path return for a single token */
10359 if (tokens == 1 && intv[0] && intv == sintv) {
10360 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10361 intv[0]->refCount--;
10362 return intv[0];
10365 /* Concatenate every token in an unique
10366 * object. */
10367 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10369 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10370 && token[2].type == JIM_TT_VAR) {
10371 /* May be able to do fast interpolated object -> dictSubst */
10372 objPtr->typePtr = &interpolatedObjType;
10373 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10374 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10375 Jim_IncrRefCount(intv[2]);
10377 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10378 /* The first interpolated token is source, so preserve the source info */
10379 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10383 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10384 objPtr->length = totlen;
10385 for (i = 0; i < tokens; i++) {
10386 if (intv[i]) {
10387 memcpy(s, intv[i]->bytes, intv[i]->length);
10388 s += intv[i]->length;
10389 Jim_DecrRefCount(interp, intv[i]);
10392 objPtr->bytes[totlen] = '\0';
10393 /* Free the intv vector if not static. */
10394 if (intv != sintv) {
10395 Jim_Free(intv);
10398 return objPtr;
10402 /* listPtr *must* be a list.
10403 * The contents of the list is evaluated with the first element as the command and
10404 * the remaining elements as the arguments.
10406 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10408 int retcode = JIM_OK;
10410 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10412 if (listPtr->internalRep.listValue.len) {
10413 Jim_IncrRefCount(listPtr);
10414 retcode = JimInvokeCommand(interp,
10415 listPtr->internalRep.listValue.len,
10416 listPtr->internalRep.listValue.ele);
10417 Jim_DecrRefCount(interp, listPtr);
10419 return retcode;
10422 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10424 SetListFromAny(interp, listPtr);
10425 return JimEvalObjList(interp, listPtr);
10428 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10430 int i;
10431 ScriptObj *script;
10432 ScriptToken *token;
10433 int retcode = JIM_OK;
10434 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10435 Jim_Obj *prevScriptObj;
10437 /* If the object is of type "list", with no string rep we can call
10438 * a specialized version of Jim_EvalObj() */
10439 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10440 return JimEvalObjList(interp, scriptObjPtr);
10443 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10444 script = JimGetScript(interp, scriptObjPtr);
10445 if (!JimScriptValid(interp, script)) {
10446 Jim_DecrRefCount(interp, scriptObjPtr);
10447 return JIM_ERR;
10450 /* Reset the interpreter result. This is useful to
10451 * return the empty result in the case of empty program. */
10452 Jim_SetEmptyResult(interp);
10454 token = script->token;
10456 #ifdef JIM_OPTIMIZATION
10457 /* Check for one of the following common scripts used by for, while
10459 * {}
10460 * incr a
10462 if (script->len == 0) {
10463 Jim_DecrRefCount(interp, scriptObjPtr);
10464 return JIM_OK;
10466 if (script->len == 3
10467 && token[1].objPtr->typePtr == &commandObjType
10468 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10469 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10470 && token[2].objPtr->typePtr == &variableObjType) {
10472 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10474 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10475 JimWideValue(objPtr)++;
10476 Jim_InvalidateStringRep(objPtr);
10477 Jim_DecrRefCount(interp, scriptObjPtr);
10478 Jim_SetResult(interp, objPtr);
10479 return JIM_OK;
10482 #endif
10484 /* Now we have to make sure the internal repr will not be
10485 * freed on shimmering.
10487 * Think for example to this:
10489 * set x {llength $x; ... some more code ...}; eval $x
10491 * In order to preserve the internal rep, we increment the
10492 * inUse field of the script internal rep structure. */
10493 script->inUse++;
10495 /* Stash the current script */
10496 prevScriptObj = interp->currentScriptObj;
10497 interp->currentScriptObj = scriptObjPtr;
10499 interp->errorFlag = 0;
10500 argv = sargv;
10502 /* Execute every command sequentially until the end of the script
10503 * or an error occurs.
10505 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10506 int argc;
10507 int j;
10509 /* First token of the line is always JIM_TT_LINE */
10510 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10511 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10513 /* Allocate the arguments vector if required */
10514 if (argc > JIM_EVAL_SARGV_LEN)
10515 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10517 /* Skip the JIM_TT_LINE token */
10518 i++;
10520 /* Populate the arguments objects.
10521 * If an error occurs, retcode will be set and
10522 * 'j' will be set to the number of args expanded
10524 for (j = 0; j < argc; j++) {
10525 long wordtokens = 1;
10526 int expand = 0;
10527 Jim_Obj *wordObjPtr = NULL;
10529 if (token[i].type == JIM_TT_WORD) {
10530 wordtokens = JimWideValue(token[i++].objPtr);
10531 if (wordtokens < 0) {
10532 expand = 1;
10533 wordtokens = -wordtokens;
10537 if (wordtokens == 1) {
10538 /* Fast path if the token does not
10539 * need interpolation */
10541 switch (token[i].type) {
10542 case JIM_TT_ESC:
10543 case JIM_TT_STR:
10544 wordObjPtr = token[i].objPtr;
10545 break;
10546 case JIM_TT_VAR:
10547 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10548 break;
10549 case JIM_TT_EXPRSUGAR:
10550 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10551 break;
10552 case JIM_TT_DICTSUGAR:
10553 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10554 break;
10555 case JIM_TT_CMD:
10556 retcode = Jim_EvalObj(interp, token[i].objPtr);
10557 if (retcode == JIM_OK) {
10558 wordObjPtr = Jim_GetResult(interp);
10560 break;
10561 default:
10562 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10565 else {
10566 /* For interpolation we call a helper
10567 * function to do the work for us. */
10568 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10571 if (!wordObjPtr) {
10572 if (retcode == JIM_OK) {
10573 retcode = JIM_ERR;
10575 break;
10578 Jim_IncrRefCount(wordObjPtr);
10579 i += wordtokens;
10581 if (!expand) {
10582 argv[j] = wordObjPtr;
10584 else {
10585 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10586 int len = Jim_ListLength(interp, wordObjPtr);
10587 int newargc = argc + len - 1;
10588 int k;
10590 if (len > 1) {
10591 if (argv == sargv) {
10592 if (newargc > JIM_EVAL_SARGV_LEN) {
10593 argv = Jim_Alloc(sizeof(*argv) * newargc);
10594 memcpy(argv, sargv, sizeof(*argv) * j);
10597 else {
10598 /* Need to realloc to make room for (len - 1) more entries */
10599 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10603 /* Now copy in the expanded version */
10604 for (k = 0; k < len; k++) {
10605 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10606 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10609 /* The original object reference is no longer needed,
10610 * after the expansion it is no longer present on
10611 * the argument vector, but the single elements are
10612 * in its place. */
10613 Jim_DecrRefCount(interp, wordObjPtr);
10615 /* And update the indexes */
10616 j--;
10617 argc += len - 1;
10621 if (retcode == JIM_OK && argc) {
10622 /* Invoke the command */
10623 retcode = JimInvokeCommand(interp, argc, argv);
10624 /* Check for a signal after each command */
10625 if (Jim_CheckSignal(interp)) {
10626 retcode = JIM_SIGNAL;
10630 /* Finished with the command, so decrement ref counts of each argument */
10631 while (j-- > 0) {
10632 Jim_DecrRefCount(interp, argv[j]);
10635 if (argv != sargv) {
10636 Jim_Free(argv);
10637 argv = sargv;
10641 /* Possibly add to the error stack trace */
10642 if (retcode == JIM_ERR) {
10643 JimAddErrorToStack(interp, script);
10645 /* Propagate the addStackTrace value through 'return -code error' */
10646 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10647 /* No need to add stack trace */
10648 interp->addStackTrace = 0;
10651 /* Restore the current script */
10652 interp->currentScriptObj = prevScriptObj;
10654 /* Note that we don't have to decrement inUse, because the
10655 * following code transfers our use of the reference again to
10656 * the script object. */
10657 Jim_FreeIntRep(interp, scriptObjPtr);
10658 scriptObjPtr->typePtr = &scriptObjType;
10659 Jim_SetIntRepPtr(scriptObjPtr, script);
10660 Jim_DecrRefCount(interp, scriptObjPtr);
10662 return retcode;
10665 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10667 int retcode;
10668 /* If argObjPtr begins with '&', do an automatic upvar */
10669 const char *varname = Jim_String(argNameObj);
10670 if (*varname == '&') {
10671 /* First check that the target variable exists */
10672 Jim_Obj *objPtr;
10673 Jim_CallFrame *savedCallFrame = interp->framePtr;
10675 interp->framePtr = interp->framePtr->parent;
10676 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10677 interp->framePtr = savedCallFrame;
10678 if (!objPtr) {
10679 return JIM_ERR;
10682 /* It exists, so perform the binding. */
10683 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10684 Jim_IncrRefCount(objPtr);
10685 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10686 Jim_DecrRefCount(interp, objPtr);
10688 else {
10689 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10691 return retcode;
10695 * Sets the interp result to be an error message indicating the required proc args.
10697 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10699 /* Create a nice error message, consistent with Tcl 8.5 */
10700 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10701 int i;
10703 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10704 Jim_AppendString(interp, argmsg, " ", 1);
10706 if (i == cmd->u.proc.argsPos) {
10707 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10708 /* Renamed args */
10709 Jim_AppendString(interp, argmsg, "?", 1);
10710 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10711 Jim_AppendString(interp, argmsg, " ...?", -1);
10713 else {
10714 /* We have plain args */
10715 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10718 else {
10719 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10720 Jim_AppendString(interp, argmsg, "?", 1);
10721 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10722 Jim_AppendString(interp, argmsg, "?", 1);
10724 else {
10725 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10726 if (*arg == '&') {
10727 arg++;
10729 Jim_AppendString(interp, argmsg, arg, -1);
10733 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10736 #ifdef jim_ext_namespace
10738 * [namespace eval]
10740 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10742 Jim_CallFrame *callFramePtr;
10743 int retcode;
10745 /* Create a new callframe */
10746 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10747 callFramePtr->argv = &interp->emptyObj;
10748 callFramePtr->argc = 0;
10749 callFramePtr->procArgsObjPtr = NULL;
10750 callFramePtr->procBodyObjPtr = scriptObj;
10751 callFramePtr->staticVars = NULL;
10752 callFramePtr->fileNameObj = interp->emptyObj;
10753 callFramePtr->line = 0;
10754 Jim_IncrRefCount(scriptObj);
10755 interp->framePtr = callFramePtr;
10757 /* Check if there are too nested calls */
10758 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10759 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10760 retcode = JIM_ERR;
10762 else {
10763 /* Eval the body */
10764 retcode = Jim_EvalObj(interp, scriptObj);
10767 /* Destroy the callframe */
10768 interp->framePtr = interp->framePtr->parent;
10769 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10771 return retcode;
10773 #endif
10775 /* Call a procedure implemented in Tcl.
10776 * It's possible to speed-up a lot this function, currently
10777 * the callframes are not cached, but allocated and
10778 * destroied every time. What is expecially costly is
10779 * to create/destroy the local vars hash table every time.
10781 * This can be fixed just implementing callframes caching
10782 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10783 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10785 Jim_CallFrame *callFramePtr;
10786 int i, d, retcode, optargs;
10787 ScriptObj *script;
10789 /* Check arity */
10790 if (argc - 1 < cmd->u.proc.reqArity ||
10791 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10792 JimSetProcWrongArgs(interp, argv[0], cmd);
10793 return JIM_ERR;
10796 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10797 /* Optimise for procedure with no body - useful for optional debugging */
10798 return JIM_OK;
10801 /* Check if there are too nested calls */
10802 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10803 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10804 return JIM_ERR;
10807 /* Create a new callframe */
10808 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10809 callFramePtr->argv = argv;
10810 callFramePtr->argc = argc;
10811 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10812 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10813 callFramePtr->staticVars = cmd->u.proc.staticVars;
10815 /* Remember where we were called from. */
10816 script = JimGetScript(interp, interp->currentScriptObj);
10817 callFramePtr->fileNameObj = script->fileNameObj;
10818 callFramePtr->line = script->linenr;
10820 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10821 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10822 interp->framePtr = callFramePtr;
10824 /* How many optional args are available */
10825 optargs = (argc - 1 - cmd->u.proc.reqArity);
10827 /* Step 'i' along the actual args, and step 'd' along the formal args */
10828 i = 1;
10829 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10830 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10831 if (d == cmd->u.proc.argsPos) {
10832 /* assign $args */
10833 Jim_Obj *listObjPtr;
10834 int argsLen = 0;
10835 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10836 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10838 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10840 /* It is possible to rename args. */
10841 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10842 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10844 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10845 if (retcode != JIM_OK) {
10846 goto badargset;
10849 i += argsLen;
10850 continue;
10853 /* Optional or required? */
10854 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10855 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10857 else {
10858 /* Ran out, so use the default */
10859 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10861 if (retcode != JIM_OK) {
10862 goto badargset;
10866 /* Eval the body */
10867 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10869 badargset:
10871 /* Invoke $jim::defer then destroy the callframe */
10872 retcode = JimInvokeDefer(interp, retcode);
10873 interp->framePtr = interp->framePtr->parent;
10874 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10876 /* Now chain any tailcalls in the parent frame */
10877 if (interp->framePtr->tailcallObj) {
10878 do {
10879 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10881 interp->framePtr->tailcallObj = NULL;
10883 if (retcode == JIM_EVAL) {
10884 retcode = Jim_EvalObjList(interp, tailcallObj);
10885 if (retcode == JIM_RETURN) {
10886 /* If the result of the tailcall is 'return', push
10887 * it up to the caller
10889 interp->returnLevel++;
10892 Jim_DecrRefCount(interp, tailcallObj);
10893 } while (interp->framePtr->tailcallObj);
10895 /* If the tailcall chain finished early, may need to manually discard the command */
10896 if (interp->framePtr->tailcallCmd) {
10897 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10898 interp->framePtr->tailcallCmd = NULL;
10902 /* Handle the JIM_RETURN return code */
10903 if (retcode == JIM_RETURN) {
10904 if (--interp->returnLevel <= 0) {
10905 retcode = interp->returnCode;
10906 interp->returnCode = JIM_OK;
10907 interp->returnLevel = 0;
10910 else if (retcode == JIM_ERR) {
10911 interp->addStackTrace++;
10912 Jim_DecrRefCount(interp, interp->errorProc);
10913 interp->errorProc = argv[0];
10914 Jim_IncrRefCount(interp->errorProc);
10917 return retcode;
10920 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10922 int retval;
10923 Jim_Obj *scriptObjPtr;
10925 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10926 Jim_IncrRefCount(scriptObjPtr);
10928 if (filename) {
10929 Jim_Obj *prevScriptObj;
10931 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10933 prevScriptObj = interp->currentScriptObj;
10934 interp->currentScriptObj = scriptObjPtr;
10936 retval = Jim_EvalObj(interp, scriptObjPtr);
10938 interp->currentScriptObj = prevScriptObj;
10940 else {
10941 retval = Jim_EvalObj(interp, scriptObjPtr);
10943 Jim_DecrRefCount(interp, scriptObjPtr);
10944 return retval;
10947 int Jim_Eval(Jim_Interp *interp, const char *script)
10949 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10952 /* Execute script in the scope of the global level */
10953 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10955 int retval;
10956 Jim_CallFrame *savedFramePtr = interp->framePtr;
10958 interp->framePtr = interp->topFramePtr;
10959 retval = Jim_Eval(interp, script);
10960 interp->framePtr = savedFramePtr;
10962 return retval;
10965 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10967 int retval;
10968 Jim_CallFrame *savedFramePtr = interp->framePtr;
10970 interp->framePtr = interp->topFramePtr;
10971 retval = Jim_EvalFile(interp, filename);
10972 interp->framePtr = savedFramePtr;
10974 return retval;
10977 #include <sys/stat.h>
10979 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10981 FILE *fp;
10982 char *buf;
10983 Jim_Obj *scriptObjPtr;
10984 Jim_Obj *prevScriptObj;
10985 struct stat sb;
10986 int retcode;
10987 int readlen;
10989 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10990 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10991 return JIM_ERR;
10993 if (sb.st_size == 0) {
10994 fclose(fp);
10995 return JIM_OK;
10998 buf = Jim_Alloc(sb.st_size + 1);
10999 readlen = fread(buf, 1, sb.st_size, fp);
11000 if (ferror(fp)) {
11001 fclose(fp);
11002 Jim_Free(buf);
11003 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11004 return JIM_ERR;
11006 fclose(fp);
11007 buf[readlen] = 0;
11009 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11010 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11011 Jim_IncrRefCount(scriptObjPtr);
11013 prevScriptObj = interp->currentScriptObj;
11014 interp->currentScriptObj = scriptObjPtr;
11016 retcode = Jim_EvalObj(interp, scriptObjPtr);
11018 /* Handle the JIM_RETURN return code */
11019 if (retcode == JIM_RETURN) {
11020 if (--interp->returnLevel <= 0) {
11021 retcode = interp->returnCode;
11022 interp->returnCode = JIM_OK;
11023 interp->returnLevel = 0;
11026 if (retcode == JIM_ERR) {
11027 /* EvalFile changes context, so add a stack frame here */
11028 interp->addStackTrace++;
11031 interp->currentScriptObj = prevScriptObj;
11033 Jim_DecrRefCount(interp, scriptObjPtr);
11035 return retcode;
11038 /* -----------------------------------------------------------------------------
11039 * Subst
11040 * ---------------------------------------------------------------------------*/
11041 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11043 pc->tstart = pc->p;
11044 pc->tline = pc->linenr;
11046 if (pc->len == 0) {
11047 pc->tend = pc->p;
11048 pc->tt = JIM_TT_EOL;
11049 pc->eof = 1;
11050 return;
11052 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11053 JimParseCmd(pc);
11054 return;
11056 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11057 if (JimParseVar(pc) == JIM_OK) {
11058 return;
11060 /* Not a var, so treat as a string */
11061 pc->tstart = pc->p;
11062 flags |= JIM_SUBST_NOVAR;
11064 while (pc->len) {
11065 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11066 break;
11068 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11069 break;
11071 if (*pc->p == '\\' && pc->len > 1) {
11072 pc->p++;
11073 pc->len--;
11075 pc->p++;
11076 pc->len--;
11078 pc->tend = pc->p - 1;
11079 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11082 /* The subst object type reuses most of the data structures and functions
11083 * of the script object. Script's data structures are a bit more complex
11084 * for what is needed for [subst]itution tasks, but the reuse helps to
11085 * deal with a single data structure at the cost of some more memory
11086 * usage for substitutions. */
11088 /* This method takes the string representation of an object
11089 * as a Tcl string where to perform [subst]itution, and generates
11090 * the pre-parsed internal representation. */
11091 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11093 int scriptTextLen;
11094 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11095 struct JimParserCtx parser;
11096 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11097 ParseTokenList tokenlist;
11099 /* Initially parse the subst into tokens (in tokenlist) */
11100 ScriptTokenListInit(&tokenlist);
11102 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11103 while (1) {
11104 JimParseSubst(&parser, flags);
11105 if (parser.eof) {
11106 /* Note that subst doesn't need the EOL token */
11107 break;
11109 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11110 parser.tline);
11113 /* Create the "real" subst/script tokens from the initial token list */
11114 script->inUse = 1;
11115 script->substFlags = flags;
11116 script->fileNameObj = interp->emptyObj;
11117 Jim_IncrRefCount(script->fileNameObj);
11118 SubstObjAddTokens(interp, script, &tokenlist);
11120 /* No longer need the token list */
11121 ScriptTokenListFree(&tokenlist);
11123 #ifdef DEBUG_SHOW_SUBST
11125 int i;
11127 printf("==== Subst ====\n");
11128 for (i = 0; i < script->len; i++) {
11129 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11130 Jim_String(script->token[i].objPtr));
11133 #endif
11135 /* Free the old internal rep and set the new one. */
11136 Jim_FreeIntRep(interp, objPtr);
11137 Jim_SetIntRepPtr(objPtr, script);
11138 objPtr->typePtr = &scriptObjType;
11139 return JIM_OK;
11142 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11144 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11145 SetSubstFromAny(interp, objPtr, flags);
11146 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11149 /* Performs commands,variables,blackslashes substitution,
11150 * storing the result object (with refcount 0) into
11151 * resObjPtrPtr. */
11152 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11154 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11156 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11157 /* In order to preserve the internal rep, we increment the
11158 * inUse field of the script internal rep structure. */
11159 script->inUse++;
11161 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11163 script->inUse--;
11164 Jim_DecrRefCount(interp, substObjPtr);
11165 if (*resObjPtrPtr == NULL) {
11166 return JIM_ERR;
11168 return JIM_OK;
11171 /* -----------------------------------------------------------------------------
11172 * Core commands utility functions
11173 * ---------------------------------------------------------------------------*/
11174 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11176 Jim_Obj *objPtr;
11177 Jim_Obj *listObjPtr;
11179 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11181 listObjPtr = Jim_NewListObj(interp, argv, argc);
11183 if (*msg) {
11184 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11186 Jim_IncrRefCount(listObjPtr);
11187 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11188 Jim_DecrRefCount(interp, listObjPtr);
11190 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11194 * May add the key and/or value to the list.
11196 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11197 Jim_HashEntry *he, int type);
11199 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11202 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11203 * invoke the callback to add entries to a list.
11204 * Returns the list.
11206 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11207 JimHashtableIteratorCallbackType *callback, int type)
11209 Jim_HashEntry *he;
11210 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11212 /* Check for the non-pattern case. We can do this much more efficiently. */
11213 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11214 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11215 if (he) {
11216 callback(interp, listObjPtr, he, type);
11219 else {
11220 Jim_HashTableIterator htiter;
11221 JimInitHashTableIterator(ht, &htiter);
11222 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11223 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11224 callback(interp, listObjPtr, he, type);
11228 return listObjPtr;
11231 /* Keep these in order */
11232 #define JIM_CMDLIST_COMMANDS 0
11233 #define JIM_CMDLIST_PROCS 1
11234 #define JIM_CMDLIST_CHANNELS 2
11237 * Adds matching command names (procs, channels) to the list.
11239 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11240 Jim_HashEntry *he, int type)
11242 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11243 Jim_Obj *objPtr;
11245 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11246 /* not a proc */
11247 return;
11250 objPtr = Jim_NewStringObj(interp, he->key, -1);
11251 Jim_IncrRefCount(objPtr);
11253 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11254 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11256 Jim_DecrRefCount(interp, objPtr);
11259 /* type is JIM_CMDLIST_xxx */
11260 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11262 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11265 /* Keep these in order */
11266 #define JIM_VARLIST_GLOBALS 0
11267 #define JIM_VARLIST_LOCALS 1
11268 #define JIM_VARLIST_VARS 2
11270 #define JIM_VARLIST_VALUES 0x1000
11273 * Adds matching variable names to the list.
11275 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11276 Jim_HashEntry *he, int type)
11278 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11280 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11281 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11282 if (type & JIM_VARLIST_VALUES) {
11283 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11288 /* mode is JIM_VARLIST_xxx */
11289 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11291 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11292 /* For [info locals], if we are at top level an emtpy list
11293 * is returned. I don't agree, but we aim at compatibility (SS) */
11294 return interp->emptyObj;
11296 else {
11297 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11298 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11302 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11303 Jim_Obj **objPtrPtr, int info_level_cmd)
11305 Jim_CallFrame *targetCallFrame;
11307 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11308 if (targetCallFrame == NULL) {
11309 return JIM_ERR;
11311 /* No proc call at toplevel callframe */
11312 if (targetCallFrame == interp->topFramePtr) {
11313 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11314 return JIM_ERR;
11316 if (info_level_cmd) {
11317 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11319 else {
11320 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11322 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11323 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11324 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11325 *objPtrPtr = listObj;
11327 return JIM_OK;
11330 /* -----------------------------------------------------------------------------
11331 * Core commands
11332 * ---------------------------------------------------------------------------*/
11334 /* fake [puts] -- not the real puts, just for debugging. */
11335 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11337 if (argc != 2 && argc != 3) {
11338 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11339 return JIM_ERR;
11341 if (argc == 3) {
11342 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11343 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11344 return JIM_ERR;
11346 else {
11347 fputs(Jim_String(argv[2]), stdout);
11350 else {
11351 puts(Jim_String(argv[1]));
11353 return JIM_OK;
11356 /* Helper for [+] and [*] */
11357 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11359 jim_wide wideValue, res;
11360 double doubleValue, doubleRes;
11361 int i;
11363 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11365 for (i = 1; i < argc; i++) {
11366 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11367 goto trydouble;
11368 if (op == JIM_EXPROP_ADD)
11369 res += wideValue;
11370 else
11371 res *= wideValue;
11373 Jim_SetResultInt(interp, res);
11374 return JIM_OK;
11375 trydouble:
11376 doubleRes = (double)res;
11377 for (; i < argc; i++) {
11378 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11379 return JIM_ERR;
11380 if (op == JIM_EXPROP_ADD)
11381 doubleRes += doubleValue;
11382 else
11383 doubleRes *= doubleValue;
11385 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11386 return JIM_OK;
11389 /* Helper for [-] and [/] */
11390 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11392 jim_wide wideValue, res = 0;
11393 double doubleValue, doubleRes = 0;
11394 int i = 2;
11396 if (argc < 2) {
11397 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11398 return JIM_ERR;
11400 else if (argc == 2) {
11401 /* The arity = 2 case is different. For [- x] returns -x,
11402 * while [/ x] returns 1/x. */
11403 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11404 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11405 return JIM_ERR;
11407 else {
11408 if (op == JIM_EXPROP_SUB)
11409 doubleRes = -doubleValue;
11410 else
11411 doubleRes = 1.0 / doubleValue;
11412 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11413 return JIM_OK;
11416 if (op == JIM_EXPROP_SUB) {
11417 res = -wideValue;
11418 Jim_SetResultInt(interp, res);
11420 else {
11421 doubleRes = 1.0 / wideValue;
11422 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11424 return JIM_OK;
11426 else {
11427 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11428 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11429 != JIM_OK) {
11430 return JIM_ERR;
11432 else {
11433 goto trydouble;
11437 for (i = 2; i < argc; i++) {
11438 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11439 doubleRes = (double)res;
11440 goto trydouble;
11442 if (op == JIM_EXPROP_SUB)
11443 res -= wideValue;
11444 else {
11445 if (wideValue == 0) {
11446 Jim_SetResultString(interp, "Division by zero", -1);
11447 return JIM_ERR;
11449 res /= wideValue;
11452 Jim_SetResultInt(interp, res);
11453 return JIM_OK;
11454 trydouble:
11455 for (; i < argc; i++) {
11456 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11457 return JIM_ERR;
11458 if (op == JIM_EXPROP_SUB)
11459 doubleRes -= doubleValue;
11460 else
11461 doubleRes /= doubleValue;
11463 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11464 return JIM_OK;
11468 /* [+] */
11469 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11471 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11474 /* [*] */
11475 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11477 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11480 /* [-] */
11481 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11483 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11486 /* [/] */
11487 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11489 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11492 /* [set] */
11493 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11495 if (argc != 2 && argc != 3) {
11496 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11497 return JIM_ERR;
11499 if (argc == 2) {
11500 Jim_Obj *objPtr;
11502 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11503 if (!objPtr)
11504 return JIM_ERR;
11505 Jim_SetResult(interp, objPtr);
11506 return JIM_OK;
11508 /* argc == 3 case. */
11509 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11510 return JIM_ERR;
11511 Jim_SetResult(interp, argv[2]);
11512 return JIM_OK;
11515 /* [unset]
11517 * unset ?-nocomplain? ?--? ?varName ...?
11519 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11521 int i = 1;
11522 int complain = 1;
11524 while (i < argc) {
11525 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11526 i++;
11527 break;
11529 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11530 complain = 0;
11531 i++;
11532 continue;
11534 break;
11537 while (i < argc) {
11538 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11539 && complain) {
11540 return JIM_ERR;
11542 i++;
11544 return JIM_OK;
11547 /* [while] */
11548 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11550 if (argc != 3) {
11551 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11552 return JIM_ERR;
11555 /* The general purpose implementation of while starts here */
11556 while (1) {
11557 int boolean, retval;
11559 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11560 return retval;
11561 if (!boolean)
11562 break;
11564 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11565 switch (retval) {
11566 case JIM_BREAK:
11567 goto out;
11568 break;
11569 case JIM_CONTINUE:
11570 continue;
11571 break;
11572 default:
11573 return retval;
11577 out:
11578 Jim_SetEmptyResult(interp);
11579 return JIM_OK;
11582 /* [for] */
11583 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11585 int retval;
11586 int boolean = 1;
11587 Jim_Obj *varNamePtr = NULL;
11588 Jim_Obj *stopVarNamePtr = NULL;
11590 if (argc != 5) {
11591 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11592 return JIM_ERR;
11595 /* Do the initialisation */
11596 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11597 return retval;
11600 /* And do the first test now. Better for optimisation
11601 * if we can do next/test at the bottom of the loop
11603 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11605 /* Ready to do the body as follows:
11606 * while (1) {
11607 * body // check retcode
11608 * next // check retcode
11609 * test // check retcode/test bool
11613 #ifdef JIM_OPTIMIZATION
11614 /* Check if the for is on the form:
11615 * for ... {$i < CONST} {incr i}
11616 * for ... {$i < $j} {incr i}
11618 if (retval == JIM_OK && boolean) {
11619 ScriptObj *incrScript;
11620 struct ExprTree *expr;
11621 jim_wide stop, currentVal;
11622 Jim_Obj *objPtr;
11623 int cmpOffset;
11625 /* Do it only if there aren't shared arguments */
11626 expr = JimGetExpression(interp, argv[2]);
11627 incrScript = JimGetScript(interp, argv[3]);
11629 /* Ensure proper lengths to start */
11630 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11631 goto evalstart;
11633 /* Ensure proper token types. */
11634 if (incrScript->token[1].type != JIM_TT_ESC) {
11635 goto evalstart;
11638 if (expr->expr->type == JIM_EXPROP_LT) {
11639 cmpOffset = 0;
11641 else if (expr->expr->type == JIM_EXPROP_LTE) {
11642 cmpOffset = 1;
11644 else {
11645 goto evalstart;
11648 if (expr->expr->left->type != JIM_TT_VAR) {
11649 goto evalstart;
11652 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11653 goto evalstart;
11656 /* Update command must be incr */
11657 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11658 goto evalstart;
11661 /* incr, expression must be about the same variable */
11662 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11663 goto evalstart;
11666 /* Get the stop condition (must be a variable or integer) */
11667 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11668 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11669 goto evalstart;
11672 else {
11673 stopVarNamePtr = expr->expr->right->objPtr;
11674 Jim_IncrRefCount(stopVarNamePtr);
11675 /* Keep the compiler happy */
11676 stop = 0;
11679 /* Initialization */
11680 varNamePtr = expr->expr->left->objPtr;
11681 Jim_IncrRefCount(varNamePtr);
11683 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11684 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11685 goto testcond;
11688 /* --- OPTIMIZED FOR --- */
11689 while (retval == JIM_OK) {
11690 /* === Check condition === */
11691 /* Note that currentVal is already set here */
11693 /* Immediate or Variable? get the 'stop' value if the latter. */
11694 if (stopVarNamePtr) {
11695 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11696 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11697 goto testcond;
11701 if (currentVal >= stop + cmpOffset) {
11702 break;
11705 /* Eval body */
11706 retval = Jim_EvalObj(interp, argv[4]);
11707 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11708 retval = JIM_OK;
11710 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11712 /* Increment */
11713 if (objPtr == NULL) {
11714 retval = JIM_ERR;
11715 goto out;
11717 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11718 currentVal = ++JimWideValue(objPtr);
11719 Jim_InvalidateStringRep(objPtr);
11721 else {
11722 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11723 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11724 ++currentVal)) != JIM_OK) {
11725 goto evalnext;
11730 goto out;
11732 evalstart:
11733 #endif
11735 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11736 /* Body */
11737 retval = Jim_EvalObj(interp, argv[4]);
11739 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11740 /* increment */
11741 JIM_IF_OPTIM(evalnext:)
11742 retval = Jim_EvalObj(interp, argv[3]);
11743 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11744 /* test */
11745 JIM_IF_OPTIM(testcond:)
11746 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11750 JIM_IF_OPTIM(out:)
11751 if (stopVarNamePtr) {
11752 Jim_DecrRefCount(interp, stopVarNamePtr);
11754 if (varNamePtr) {
11755 Jim_DecrRefCount(interp, varNamePtr);
11758 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11759 Jim_SetEmptyResult(interp);
11760 return JIM_OK;
11763 return retval;
11766 /* [loop] */
11767 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11769 int retval;
11770 jim_wide i;
11771 jim_wide limit;
11772 jim_wide incr = 1;
11773 Jim_Obj *bodyObjPtr;
11775 if (argc != 5 && argc != 6) {
11776 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11777 return JIM_ERR;
11780 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11781 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11782 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11783 return JIM_ERR;
11785 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11787 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11789 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11790 retval = Jim_EvalObj(interp, bodyObjPtr);
11791 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11792 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11794 retval = JIM_OK;
11796 /* Increment */
11797 i += incr;
11799 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11800 if (argv[1]->typePtr != &variableObjType) {
11801 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11802 return JIM_ERR;
11805 JimWideValue(objPtr) = i;
11806 Jim_InvalidateStringRep(objPtr);
11808 /* The following step is required in order to invalidate the
11809 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11810 if (argv[1]->typePtr != &variableObjType) {
11811 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11812 retval = JIM_ERR;
11813 break;
11817 else {
11818 objPtr = Jim_NewIntObj(interp, i);
11819 retval = Jim_SetVariable(interp, argv[1], objPtr);
11820 if (retval != JIM_OK) {
11821 Jim_FreeNewObj(interp, objPtr);
11827 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11828 Jim_SetEmptyResult(interp);
11829 return JIM_OK;
11831 return retval;
11834 /* List iterators make it easy to iterate over a list.
11835 * At some point iterators will be expanded to support generators.
11837 typedef struct {
11838 Jim_Obj *objPtr;
11839 int idx;
11840 } Jim_ListIter;
11843 * Initialise the iterator at the start of the list.
11845 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11847 iter->objPtr = objPtr;
11848 iter->idx = 0;
11852 * Returns the next object from the list, or NULL on end-of-list.
11854 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11856 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11857 return NULL;
11859 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11863 * Returns 1 if end-of-list has been reached.
11865 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11867 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11870 /* foreach + lmap implementation. */
11871 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11873 int result = JIM_OK;
11874 int i, numargs;
11875 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11876 Jim_ListIter *iters;
11877 Jim_Obj *script;
11878 Jim_Obj *resultObj;
11880 if (argc < 4 || argc % 2 != 0) {
11881 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11882 return JIM_ERR;
11884 script = argv[argc - 1]; /* Last argument is a script */
11885 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11887 if (numargs == 2) {
11888 iters = twoiters;
11890 else {
11891 iters = Jim_Alloc(numargs * sizeof(*iters));
11893 for (i = 0; i < numargs; i++) {
11894 JimListIterInit(&iters[i], argv[i + 1]);
11895 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11896 result = JIM_ERR;
11899 if (result != JIM_OK) {
11900 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11901 return result;
11904 if (doMap) {
11905 resultObj = Jim_NewListObj(interp, NULL, 0);
11907 else {
11908 resultObj = interp->emptyObj;
11910 Jim_IncrRefCount(resultObj);
11912 while (1) {
11913 /* Have we expired all lists? */
11914 for (i = 0; i < numargs; i += 2) {
11915 if (!JimListIterDone(interp, &iters[i + 1])) {
11916 break;
11919 if (i == numargs) {
11920 /* All done */
11921 break;
11924 /* For each list */
11925 for (i = 0; i < numargs; i += 2) {
11926 Jim_Obj *varName;
11928 /* foreach var */
11929 JimListIterInit(&iters[i], argv[i + 1]);
11930 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11931 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11932 if (!valObj) {
11933 /* Ran out, so store the empty string */
11934 valObj = interp->emptyObj;
11936 /* Avoid shimmering */
11937 Jim_IncrRefCount(valObj);
11938 result = Jim_SetVariable(interp, varName, valObj);
11939 Jim_DecrRefCount(interp, valObj);
11940 if (result != JIM_OK) {
11941 goto err;
11945 switch (result = Jim_EvalObj(interp, script)) {
11946 case JIM_OK:
11947 if (doMap) {
11948 Jim_ListAppendElement(interp, resultObj, interp->result);
11950 break;
11951 case JIM_CONTINUE:
11952 break;
11953 case JIM_BREAK:
11954 goto out;
11955 default:
11956 goto err;
11959 out:
11960 result = JIM_OK;
11961 Jim_SetResult(interp, resultObj);
11962 err:
11963 Jim_DecrRefCount(interp, resultObj);
11964 if (numargs > 2) {
11965 Jim_Free(iters);
11967 return result;
11970 /* [foreach] */
11971 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11973 return JimForeachMapHelper(interp, argc, argv, 0);
11976 /* [lmap] */
11977 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11979 return JimForeachMapHelper(interp, argc, argv, 1);
11982 /* [lassign] */
11983 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11985 int result = JIM_ERR;
11986 int i;
11987 Jim_ListIter iter;
11988 Jim_Obj *resultObj;
11990 if (argc < 2) {
11991 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11992 return JIM_ERR;
11995 JimListIterInit(&iter, argv[1]);
11997 for (i = 2; i < argc; i++) {
11998 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11999 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12000 if (result != JIM_OK) {
12001 return result;
12005 resultObj = Jim_NewListObj(interp, NULL, 0);
12006 while (!JimListIterDone(interp, &iter)) {
12007 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12010 Jim_SetResult(interp, resultObj);
12012 return JIM_OK;
12015 /* [if] */
12016 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12018 int boolean, retval, current = 1, falsebody = 0;
12020 if (argc >= 3) {
12021 while (1) {
12022 /* Far not enough arguments given! */
12023 if (current >= argc)
12024 goto err;
12025 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12026 != JIM_OK)
12027 return retval;
12028 /* There lacks something, isn't it? */
12029 if (current >= argc)
12030 goto err;
12031 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12032 current++;
12033 /* Tsk tsk, no then-clause? */
12034 if (current >= argc)
12035 goto err;
12036 if (boolean)
12037 return Jim_EvalObj(interp, argv[current]);
12038 /* Ok: no else-clause follows */
12039 if (++current >= argc) {
12040 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12041 return JIM_OK;
12043 falsebody = current++;
12044 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12045 /* IIICKS - else-clause isn't last cmd? */
12046 if (current != argc - 1)
12047 goto err;
12048 return Jim_EvalObj(interp, argv[current]);
12050 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12051 /* Ok: elseif follows meaning all the stuff
12052 * again (how boring...) */
12053 continue;
12054 /* OOPS - else-clause is not last cmd? */
12055 else if (falsebody != argc - 1)
12056 goto err;
12057 return Jim_EvalObj(interp, argv[falsebody]);
12059 return JIM_OK;
12061 err:
12062 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12063 return JIM_ERR;
12067 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12068 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12069 Jim_Obj *stringObj, int nocase)
12071 Jim_Obj *parms[4];
12072 int argc = 0;
12073 long eq;
12074 int rc;
12076 parms[argc++] = commandObj;
12077 if (nocase) {
12078 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12080 parms[argc++] = patternObj;
12081 parms[argc++] = stringObj;
12083 rc = Jim_EvalObjVector(interp, argc, parms);
12085 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12086 eq = -rc;
12089 return eq;
12092 /* [switch] */
12093 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12095 enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12096 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12097 Jim_Obj *command = NULL, *scriptObj = NULL, *strObj;
12098 Jim_Obj **caseList;
12100 if (argc < 3) {
12101 wrongnumargs:
12102 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12103 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12104 return JIM_ERR;
12106 for (opt = 1; opt < argc; ++opt) {
12107 const char *option = Jim_String(argv[opt]);
12109 if (*option != '-')
12110 break;
12111 else if (strncmp(option, "--", 2) == 0) {
12112 ++opt;
12113 break;
12115 else if (strncmp(option, "-exact", 2) == 0)
12116 matchOpt = SWITCH_EXACT;
12117 else if (strncmp(option, "-glob", 2) == 0)
12118 matchOpt = SWITCH_GLOB;
12119 else if (strncmp(option, "-regexp", 2) == 0)
12120 matchOpt = SWITCH_RE;
12121 else if (strncmp(option, "-command", 2) == 0) {
12122 matchOpt = SWITCH_CMD;
12123 if ((argc - opt) < 2)
12124 goto wrongnumargs;
12125 command = argv[++opt];
12127 else {
12128 Jim_SetResultFormatted(interp,
12129 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12130 argv[opt]);
12131 return JIM_ERR;
12133 if ((argc - opt) < 2)
12134 goto wrongnumargs;
12136 strObj = argv[opt++];
12137 patCount = argc - opt;
12138 if (patCount == 1) {
12139 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12141 else
12142 caseList = (Jim_Obj **)&argv[opt];
12143 if (patCount == 0 || patCount % 2 != 0)
12144 goto wrongnumargs;
12145 for (i = 0; scriptObj == NULL && i < patCount; i += 2) {
12146 Jim_Obj *patObj = caseList[i];
12148 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12149 || i < (patCount - 2)) {
12150 switch (matchOpt) {
12151 case SWITCH_EXACT:
12152 if (Jim_StringEqObj(strObj, patObj))
12153 scriptObj = caseList[i + 1];
12154 break;
12155 case SWITCH_GLOB:
12156 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12157 scriptObj = caseList[i + 1];
12158 break;
12159 case SWITCH_RE:
12160 command = Jim_NewStringObj(interp, "regexp", -1);
12161 /* Fall thru intentionally */
12162 case SWITCH_CMD:{
12163 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12165 /* After the execution of a command we need to
12166 * make sure to reconvert the object into a list
12167 * again. Only for the single-list style [switch]. */
12168 if (argc - opt == 1) {
12169 JimListGetElements(interp, argv[opt], &patCount, &caseList);
12171 /* command is here already decref'd */
12172 if (rc < 0) {
12173 return -rc;
12175 if (rc)
12176 scriptObj = caseList[i + 1];
12177 break;
12181 else {
12182 scriptObj = caseList[i + 1];
12185 for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2)
12186 scriptObj = caseList[i + 1];
12187 if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) {
12188 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12189 return JIM_ERR;
12191 Jim_SetEmptyResult(interp);
12192 if (scriptObj) {
12193 return Jim_EvalObj(interp, scriptObj);
12195 return JIM_OK;
12198 /* [list] */
12199 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12201 Jim_Obj *listObjPtr;
12203 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12204 Jim_SetResult(interp, listObjPtr);
12205 return JIM_OK;
12208 /* [lindex] */
12209 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12211 Jim_Obj *objPtr, *listObjPtr;
12212 int i;
12213 int idx;
12215 if (argc < 2) {
12216 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12217 return JIM_ERR;
12219 objPtr = argv[1];
12220 Jim_IncrRefCount(objPtr);
12221 for (i = 2; i < argc; i++) {
12222 listObjPtr = objPtr;
12223 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12224 Jim_DecrRefCount(interp, listObjPtr);
12225 return JIM_ERR;
12227 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12228 /* Returns an empty object if the index
12229 * is out of range. */
12230 Jim_DecrRefCount(interp, listObjPtr);
12231 Jim_SetEmptyResult(interp);
12232 return JIM_OK;
12234 Jim_IncrRefCount(objPtr);
12235 Jim_DecrRefCount(interp, listObjPtr);
12237 Jim_SetResult(interp, objPtr);
12238 Jim_DecrRefCount(interp, objPtr);
12239 return JIM_OK;
12242 /* [llength] */
12243 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12245 if (argc != 2) {
12246 Jim_WrongNumArgs(interp, 1, argv, "list");
12247 return JIM_ERR;
12249 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12250 return JIM_OK;
12253 /* [lsearch] */
12254 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12256 static const char * const options[] = {
12257 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12258 NULL
12260 enum
12261 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12262 OPT_COMMAND };
12263 int i;
12264 int opt_bool = 0;
12265 int opt_not = 0;
12266 int opt_nocase = 0;
12267 int opt_all = 0;
12268 int opt_inline = 0;
12269 int opt_match = OPT_EXACT;
12270 int listlen;
12271 int rc = JIM_OK;
12272 Jim_Obj *listObjPtr = NULL;
12273 Jim_Obj *commandObj = NULL;
12275 if (argc < 3) {
12276 wrongargs:
12277 Jim_WrongNumArgs(interp, 1, argv,
12278 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12279 return JIM_ERR;
12282 for (i = 1; i < argc - 2; i++) {
12283 int option;
12285 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12286 return JIM_ERR;
12288 switch (option) {
12289 case OPT_BOOL:
12290 opt_bool = 1;
12291 opt_inline = 0;
12292 break;
12293 case OPT_NOT:
12294 opt_not = 1;
12295 break;
12296 case OPT_NOCASE:
12297 opt_nocase = 1;
12298 break;
12299 case OPT_INLINE:
12300 opt_inline = 1;
12301 opt_bool = 0;
12302 break;
12303 case OPT_ALL:
12304 opt_all = 1;
12305 break;
12306 case OPT_COMMAND:
12307 if (i >= argc - 2) {
12308 goto wrongargs;
12310 commandObj = argv[++i];
12311 /* fallthru */
12312 case OPT_EXACT:
12313 case OPT_GLOB:
12314 case OPT_REGEXP:
12315 opt_match = option;
12316 break;
12320 argv += i;
12322 if (opt_all) {
12323 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12325 if (opt_match == OPT_REGEXP) {
12326 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12328 if (commandObj) {
12329 Jim_IncrRefCount(commandObj);
12332 listlen = Jim_ListLength(interp, argv[0]);
12333 for (i = 0; i < listlen; i++) {
12334 int eq = 0;
12335 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12337 switch (opt_match) {
12338 case OPT_EXACT:
12339 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12340 break;
12342 case OPT_GLOB:
12343 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12344 break;
12346 case OPT_REGEXP:
12347 case OPT_COMMAND:
12348 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12349 if (eq < 0) {
12350 if (listObjPtr) {
12351 Jim_FreeNewObj(interp, listObjPtr);
12353 rc = JIM_ERR;
12354 goto done;
12356 break;
12359 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12360 if (!eq && opt_bool && opt_not && !opt_all) {
12361 continue;
12364 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12365 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12366 Jim_Obj *resultObj;
12368 if (opt_bool) {
12369 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12371 else if (!opt_inline) {
12372 resultObj = Jim_NewIntObj(interp, i);
12374 else {
12375 resultObj = objPtr;
12378 if (opt_all) {
12379 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12381 else {
12382 Jim_SetResult(interp, resultObj);
12383 goto done;
12388 if (opt_all) {
12389 Jim_SetResult(interp, listObjPtr);
12391 else {
12392 /* No match */
12393 if (opt_bool) {
12394 Jim_SetResultBool(interp, opt_not);
12396 else if (!opt_inline) {
12397 Jim_SetResultInt(interp, -1);
12401 done:
12402 if (commandObj) {
12403 Jim_DecrRefCount(interp, commandObj);
12405 return rc;
12408 /* [lappend] */
12409 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12411 Jim_Obj *listObjPtr;
12412 int new_obj = 0;
12413 int i;
12415 if (argc < 2) {
12416 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12417 return JIM_ERR;
12419 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12420 if (!listObjPtr) {
12421 /* Create the list if it does not exist */
12422 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12423 new_obj = 1;
12425 else if (Jim_IsShared(listObjPtr)) {
12426 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12427 new_obj = 1;
12429 for (i = 2; i < argc; i++)
12430 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12431 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12432 if (new_obj)
12433 Jim_FreeNewObj(interp, listObjPtr);
12434 return JIM_ERR;
12436 Jim_SetResult(interp, listObjPtr);
12437 return JIM_OK;
12440 /* [linsert] */
12441 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12443 int idx, len;
12444 Jim_Obj *listPtr;
12446 if (argc < 3) {
12447 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12448 return JIM_ERR;
12450 listPtr = argv[1];
12451 if (Jim_IsShared(listPtr))
12452 listPtr = Jim_DuplicateObj(interp, listPtr);
12453 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12454 goto err;
12455 len = Jim_ListLength(interp, listPtr);
12456 if (idx >= len)
12457 idx = len;
12458 else if (idx < 0)
12459 idx = len + idx + 1;
12460 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12461 Jim_SetResult(interp, listPtr);
12462 return JIM_OK;
12463 err:
12464 if (listPtr != argv[1]) {
12465 Jim_FreeNewObj(interp, listPtr);
12467 return JIM_ERR;
12470 /* [lreplace] */
12471 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12473 int first, last, len, rangeLen;
12474 Jim_Obj *listObj;
12475 Jim_Obj *newListObj;
12477 if (argc < 4) {
12478 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12479 return JIM_ERR;
12481 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12482 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12483 return JIM_ERR;
12486 listObj = argv[1];
12487 len = Jim_ListLength(interp, listObj);
12489 first = JimRelToAbsIndex(len, first);
12490 last = JimRelToAbsIndex(len, last);
12491 JimRelToAbsRange(len, &first, &last, &rangeLen);
12493 /* Now construct a new list which consists of:
12494 * <elements before first> <supplied elements> <elements after last>
12497 /* Check to see if trying to replace past the end of the list */
12498 if (first < len) {
12499 /* OK. Not past the end */
12501 else if (len == 0) {
12502 /* Special for empty list, adjust first to 0 */
12503 first = 0;
12505 else {
12506 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12507 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12508 return JIM_ERR;
12511 /* Add the first set of elements */
12512 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12514 /* Add supplied elements */
12515 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12517 /* Add the remaining elements */
12518 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12520 Jim_SetResult(interp, newListObj);
12521 return JIM_OK;
12524 /* [lset] */
12525 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12527 if (argc < 3) {
12528 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12529 return JIM_ERR;
12531 else if (argc == 3) {
12532 /* With no indexes, simply implements [set] */
12533 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12534 return JIM_ERR;
12535 Jim_SetResult(interp, argv[2]);
12536 return JIM_OK;
12538 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12541 /* [lsort] */
12542 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12544 static const char * const options[] = {
12545 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12547 enum
12548 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12549 Jim_Obj *resObj;
12550 int i;
12551 int retCode;
12552 int shared;
12554 struct lsort_info info;
12556 if (argc < 2) {
12557 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12558 return JIM_ERR;
12561 info.type = JIM_LSORT_ASCII;
12562 info.order = 1;
12563 info.indexed = 0;
12564 info.unique = 0;
12565 info.command = NULL;
12566 info.interp = interp;
12568 for (i = 1; i < (argc - 1); i++) {
12569 int option;
12571 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12572 != JIM_OK)
12573 return JIM_ERR;
12574 switch (option) {
12575 case OPT_ASCII:
12576 info.type = JIM_LSORT_ASCII;
12577 break;
12578 case OPT_NOCASE:
12579 info.type = JIM_LSORT_NOCASE;
12580 break;
12581 case OPT_INTEGER:
12582 info.type = JIM_LSORT_INTEGER;
12583 break;
12584 case OPT_REAL:
12585 info.type = JIM_LSORT_REAL;
12586 break;
12587 case OPT_INCREASING:
12588 info.order = 1;
12589 break;
12590 case OPT_DECREASING:
12591 info.order = -1;
12592 break;
12593 case OPT_UNIQUE:
12594 info.unique = 1;
12595 break;
12596 case OPT_COMMAND:
12597 if (i >= (argc - 2)) {
12598 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12599 return JIM_ERR;
12601 info.type = JIM_LSORT_COMMAND;
12602 info.command = argv[i + 1];
12603 i++;
12604 break;
12605 case OPT_INDEX:
12606 if (i >= (argc - 2)) {
12607 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12608 return JIM_ERR;
12610 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12611 return JIM_ERR;
12613 info.indexed = 1;
12614 i++;
12615 break;
12618 resObj = argv[argc - 1];
12619 if ((shared = Jim_IsShared(resObj)))
12620 resObj = Jim_DuplicateObj(interp, resObj);
12621 retCode = ListSortElements(interp, resObj, &info);
12622 if (retCode == JIM_OK) {
12623 Jim_SetResult(interp, resObj);
12625 else if (shared) {
12626 Jim_FreeNewObj(interp, resObj);
12628 return retCode;
12631 /* [append] */
12632 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12634 Jim_Obj *stringObjPtr;
12635 int i;
12637 if (argc < 2) {
12638 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12639 return JIM_ERR;
12641 if (argc == 2) {
12642 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12643 if (!stringObjPtr)
12644 return JIM_ERR;
12646 else {
12647 int new_obj = 0;
12648 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12649 if (!stringObjPtr) {
12650 /* Create the string if it doesn't exist */
12651 stringObjPtr = Jim_NewEmptyStringObj(interp);
12652 new_obj = 1;
12654 else if (Jim_IsShared(stringObjPtr)) {
12655 new_obj = 1;
12656 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12658 for (i = 2; i < argc; i++) {
12659 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12661 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12662 if (new_obj) {
12663 Jim_FreeNewObj(interp, stringObjPtr);
12665 return JIM_ERR;
12668 Jim_SetResult(interp, stringObjPtr);
12669 return JIM_OK;
12672 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12674 * Returns a zero-refcount list describing the expression at 'node'
12676 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12678 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12680 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12681 if (TOKEN_IS_EXPR_OP(node->type)) {
12682 if (node->left) {
12683 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12685 if (node->right) {
12686 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12688 if (node->ternary) {
12689 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12692 else {
12693 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12695 return listObjPtr;
12697 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12699 /* [debug] */
12700 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12702 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12703 static const char * const options[] = {
12704 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12705 "exprbc", "show",
12706 NULL
12708 enum
12710 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12711 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12713 int option;
12715 if (argc < 2) {
12716 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12717 return JIM_ERR;
12719 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12720 return Jim_CheckShowCommands(interp, argv[1], options);
12721 if (option == OPT_REFCOUNT) {
12722 if (argc != 3) {
12723 Jim_WrongNumArgs(interp, 2, argv, "object");
12724 return JIM_ERR;
12726 Jim_SetResultInt(interp, argv[2]->refCount);
12727 return JIM_OK;
12729 else if (option == OPT_OBJCOUNT) {
12730 int freeobj = 0, liveobj = 0;
12731 char buf[256];
12732 Jim_Obj *objPtr;
12734 if (argc != 2) {
12735 Jim_WrongNumArgs(interp, 2, argv, "");
12736 return JIM_ERR;
12738 /* Count the number of free objects. */
12739 objPtr = interp->freeList;
12740 while (objPtr) {
12741 freeobj++;
12742 objPtr = objPtr->nextObjPtr;
12744 /* Count the number of live objects. */
12745 objPtr = interp->liveList;
12746 while (objPtr) {
12747 liveobj++;
12748 objPtr = objPtr->nextObjPtr;
12750 /* Set the result string and return. */
12751 sprintf(buf, "free %d used %d", freeobj, liveobj);
12752 Jim_SetResultString(interp, buf, -1);
12753 return JIM_OK;
12755 else if (option == OPT_OBJECTS) {
12756 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12758 /* Count the number of live objects. */
12759 objPtr = interp->liveList;
12760 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12761 while (objPtr) {
12762 char buf[128];
12763 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12765 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12766 sprintf(buf, "%p", objPtr);
12767 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12768 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12769 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12770 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12771 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12772 objPtr = objPtr->nextObjPtr;
12774 Jim_SetResult(interp, listObjPtr);
12775 return JIM_OK;
12777 else if (option == OPT_INVSTR) {
12778 Jim_Obj *objPtr;
12780 if (argc != 3) {
12781 Jim_WrongNumArgs(interp, 2, argv, "object");
12782 return JIM_ERR;
12784 objPtr = argv[2];
12785 if (objPtr->typePtr != NULL)
12786 Jim_InvalidateStringRep(objPtr);
12787 Jim_SetEmptyResult(interp);
12788 return JIM_OK;
12790 else if (option == OPT_SHOW) {
12791 const char *s;
12792 int len, charlen;
12794 if (argc != 3) {
12795 Jim_WrongNumArgs(interp, 2, argv, "object");
12796 return JIM_ERR;
12798 s = Jim_GetString(argv[2], &len);
12799 #ifdef JIM_UTF8
12800 charlen = utf8_strlen(s, len);
12801 #else
12802 charlen = len;
12803 #endif
12804 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12805 printf("chars (%d): <<%s>>\n", charlen, s);
12806 printf("bytes (%d):", len);
12807 while (len--) {
12808 printf(" %02x", (unsigned char)*s++);
12810 printf("\n");
12811 return JIM_OK;
12813 else if (option == OPT_SCRIPTLEN) {
12814 ScriptObj *script;
12816 if (argc != 3) {
12817 Jim_WrongNumArgs(interp, 2, argv, "script");
12818 return JIM_ERR;
12820 script = JimGetScript(interp, argv[2]);
12821 if (script == NULL)
12822 return JIM_ERR;
12823 Jim_SetResultInt(interp, script->len);
12824 return JIM_OK;
12826 else if (option == OPT_EXPRLEN) {
12827 struct ExprTree *expr;
12829 if (argc != 3) {
12830 Jim_WrongNumArgs(interp, 2, argv, "expression");
12831 return JIM_ERR;
12833 expr = JimGetExpression(interp, argv[2]);
12834 if (expr == NULL)
12835 return JIM_ERR;
12836 Jim_SetResultInt(interp, expr->len);
12837 return JIM_OK;
12839 else if (option == OPT_EXPRBC) {
12840 struct ExprTree *expr;
12842 if (argc != 3) {
12843 Jim_WrongNumArgs(interp, 2, argv, "expression");
12844 return JIM_ERR;
12846 expr = JimGetExpression(interp, argv[2]);
12847 if (expr == NULL)
12848 return JIM_ERR;
12849 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12850 return JIM_OK;
12852 else {
12853 Jim_SetResultString(interp,
12854 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12855 return JIM_ERR;
12857 /* unreached */
12858 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12859 #if !defined(JIM_DEBUG_COMMAND)
12860 Jim_SetResultString(interp, "unsupported", -1);
12861 return JIM_ERR;
12862 #endif
12865 /* [eval] */
12866 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12868 int rc;
12870 if (argc < 2) {
12871 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12872 return JIM_ERR;
12875 if (argc == 2) {
12876 rc = Jim_EvalObj(interp, argv[1]);
12878 else {
12879 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12882 if (rc == JIM_ERR) {
12883 /* eval is "interesting", so add a stack frame here */
12884 interp->addStackTrace++;
12886 return rc;
12889 /* [uplevel] */
12890 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12892 if (argc >= 2) {
12893 int retcode;
12894 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12895 const char *str;
12897 /* Save the old callframe pointer */
12898 savedCallFrame = interp->framePtr;
12900 /* Lookup the target frame pointer */
12901 str = Jim_String(argv[1]);
12902 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12903 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12904 argc--;
12905 argv++;
12907 else {
12908 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12910 if (targetCallFrame == NULL) {
12911 return JIM_ERR;
12913 if (argc < 2) {
12914 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12915 return JIM_ERR;
12917 /* Eval the code in the target callframe. */
12918 interp->framePtr = targetCallFrame;
12919 if (argc == 2) {
12920 retcode = Jim_EvalObj(interp, argv[1]);
12922 else {
12923 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12925 interp->framePtr = savedCallFrame;
12926 return retcode;
12928 else {
12929 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12930 return JIM_ERR;
12934 /* [expr] */
12935 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12937 int retcode;
12939 if (argc == 2) {
12940 retcode = Jim_EvalExpression(interp, argv[1]);
12942 else if (argc > 2) {
12943 Jim_Obj *objPtr;
12945 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12946 Jim_IncrRefCount(objPtr);
12947 retcode = Jim_EvalExpression(interp, objPtr);
12948 Jim_DecrRefCount(interp, objPtr);
12950 else {
12951 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12952 return JIM_ERR;
12954 if (retcode != JIM_OK)
12955 return retcode;
12956 return JIM_OK;
12959 /* [break] */
12960 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12962 if (argc != 1) {
12963 Jim_WrongNumArgs(interp, 1, argv, "");
12964 return JIM_ERR;
12966 return JIM_BREAK;
12969 /* [continue] */
12970 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12972 if (argc != 1) {
12973 Jim_WrongNumArgs(interp, 1, argv, "");
12974 return JIM_ERR;
12976 return JIM_CONTINUE;
12979 /* [return] */
12980 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12982 int i;
12983 Jim_Obj *stackTraceObj = NULL;
12984 Jim_Obj *errorCodeObj = NULL;
12985 int returnCode = JIM_OK;
12986 long level = 1;
12988 for (i = 1; i < argc - 1; i += 2) {
12989 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12990 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12991 return JIM_ERR;
12994 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12995 stackTraceObj = argv[i + 1];
12997 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12998 errorCodeObj = argv[i + 1];
13000 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13001 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13002 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13003 return JIM_ERR;
13006 else {
13007 break;
13011 if (i != argc - 1 && i != argc) {
13012 Jim_WrongNumArgs(interp, 1, argv,
13013 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13016 /* If a stack trace is supplied and code is error, set the stack trace */
13017 if (stackTraceObj && returnCode == JIM_ERR) {
13018 JimSetStackTrace(interp, stackTraceObj);
13020 /* If an error code list is supplied, set the global $errorCode */
13021 if (errorCodeObj && returnCode == JIM_ERR) {
13022 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13024 interp->returnCode = returnCode;
13025 interp->returnLevel = level;
13027 if (i == argc - 1) {
13028 Jim_SetResult(interp, argv[i]);
13030 return JIM_RETURN;
13033 /* [tailcall] */
13034 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13036 if (interp->framePtr->level == 0) {
13037 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13038 return JIM_ERR;
13040 else if (argc >= 2) {
13041 /* Need to resolve the tailcall command in the current context */
13042 Jim_CallFrame *cf = interp->framePtr->parent;
13044 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13045 if (cmdPtr == NULL) {
13046 return JIM_ERR;
13049 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13051 /* And stash this pre-resolved command */
13052 JimIncrCmdRefCount(cmdPtr);
13053 cf->tailcallCmd = cmdPtr;
13055 /* And stash the command list */
13056 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13058 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13059 Jim_IncrRefCount(cf->tailcallObj);
13061 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13062 return JIM_EVAL;
13064 return JIM_OK;
13067 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13069 Jim_Obj *cmdList;
13070 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13072 /* prefixListObj is a list to which the args need to be appended */
13073 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13074 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13076 return JimEvalObjList(interp, cmdList);
13079 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13081 Jim_Obj *prefixListObj = privData;
13082 Jim_DecrRefCount(interp, prefixListObj);
13085 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13087 Jim_Obj *prefixListObj;
13088 const char *newname;
13090 if (argc < 3) {
13091 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13092 return JIM_ERR;
13095 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13096 Jim_IncrRefCount(prefixListObj);
13097 newname = Jim_String(argv[1]);
13098 if (newname[0] == ':' && newname[1] == ':') {
13099 while (*++newname == ':') {
13103 Jim_SetResult(interp, argv[1]);
13105 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13108 /* [proc] */
13109 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13111 Jim_Cmd *cmd;
13113 if (argc != 4 && argc != 5) {
13114 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13115 return JIM_ERR;
13118 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13119 return JIM_ERR;
13122 if (argc == 4) {
13123 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13125 else {
13126 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13129 if (cmd) {
13130 /* Add the new command */
13131 Jim_Obj *qualifiedCmdNameObj;
13132 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13134 JimCreateCommand(interp, cmdname, cmd);
13136 /* Calculate and set the namespace for this proc */
13137 JimUpdateProcNamespace(interp, cmd, cmdname);
13139 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13141 /* Unlike Tcl, set the name of the proc as the result */
13142 Jim_SetResult(interp, argv[1]);
13143 return JIM_OK;
13145 return JIM_ERR;
13148 /* [local] */
13149 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13151 int retcode;
13153 if (argc < 2) {
13154 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13155 return JIM_ERR;
13158 /* Evaluate the arguments with 'local' in force */
13159 interp->local++;
13160 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13161 interp->local--;
13164 /* If OK, and the result is a proc, add it to the list of local procs */
13165 if (retcode == 0) {
13166 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13168 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13169 return JIM_ERR;
13171 if (interp->framePtr->localCommands == NULL) {
13172 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13173 Jim_InitStack(interp->framePtr->localCommands);
13175 Jim_IncrRefCount(cmdNameObj);
13176 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13179 return retcode;
13182 /* [upcall] */
13183 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13185 if (argc < 2) {
13186 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13187 return JIM_ERR;
13189 else {
13190 int retcode;
13192 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13193 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13194 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13195 return JIM_ERR;
13197 /* OK. Mark this command as being in an upcall */
13198 cmdPtr->u.proc.upcall++;
13199 JimIncrCmdRefCount(cmdPtr);
13201 /* Invoke the command as normal */
13202 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13204 /* No longer in an upcall */
13205 cmdPtr->u.proc.upcall--;
13206 JimDecrCmdRefCount(interp, cmdPtr);
13208 return retcode;
13212 /* [apply] */
13213 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13215 if (argc < 2) {
13216 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13217 return JIM_ERR;
13219 else {
13220 int ret;
13221 Jim_Cmd *cmd;
13222 Jim_Obj *argListObjPtr;
13223 Jim_Obj *bodyObjPtr;
13224 Jim_Obj *nsObj = NULL;
13225 Jim_Obj **nargv;
13227 int len = Jim_ListLength(interp, argv[1]);
13228 if (len != 2 && len != 3) {
13229 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13230 return JIM_ERR;
13233 if (len == 3) {
13234 #ifdef jim_ext_namespace
13235 /* Need to canonicalise the given namespace. */
13236 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13237 #else
13238 Jim_SetResultString(interp, "namespaces not enabled", -1);
13239 return JIM_ERR;
13240 #endif
13242 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13243 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13245 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13247 if (cmd) {
13248 /* Create a new argv array with a dummy argv[0], for error messages */
13249 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13250 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13251 Jim_IncrRefCount(nargv[0]);
13252 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13253 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13254 Jim_DecrRefCount(interp, nargv[0]);
13255 Jim_Free(nargv);
13257 JimDecrCmdRefCount(interp, cmd);
13258 return ret;
13260 return JIM_ERR;
13265 /* [concat] */
13266 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13268 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13269 return JIM_OK;
13272 /* [upvar] */
13273 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13275 int i;
13276 Jim_CallFrame *targetCallFrame;
13278 /* Lookup the target frame pointer */
13279 if (argc > 3 && (argc % 2 == 0)) {
13280 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13281 argc--;
13282 argv++;
13284 else {
13285 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13287 if (targetCallFrame == NULL) {
13288 return JIM_ERR;
13291 /* Check for arity */
13292 if (argc < 3) {
13293 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13294 return JIM_ERR;
13297 /* Now... for every other/local couple: */
13298 for (i = 1; i < argc; i += 2) {
13299 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13300 return JIM_ERR;
13302 return JIM_OK;
13305 /* [global] */
13306 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13308 int i;
13310 if (argc < 2) {
13311 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13312 return JIM_ERR;
13314 /* Link every var to the toplevel having the same name */
13315 if (interp->framePtr->level == 0)
13316 return JIM_OK; /* global at toplevel... */
13317 for (i = 1; i < argc; i++) {
13318 /* global ::blah does nothing */
13319 const char *name = Jim_String(argv[i]);
13320 if (name[0] != ':' || name[1] != ':') {
13321 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13322 return JIM_ERR;
13325 return JIM_OK;
13328 /* does the [string map] operation. On error NULL is returned,
13329 * otherwise a new string object with the result, having refcount = 0,
13330 * is returned. */
13331 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13332 Jim_Obj *objPtr, int nocase)
13334 int numMaps;
13335 const char *str, *noMatchStart = NULL;
13336 int strLen, i;
13337 Jim_Obj *resultObjPtr;
13339 numMaps = Jim_ListLength(interp, mapListObjPtr);
13340 if (numMaps % 2) {
13341 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13342 return NULL;
13345 str = Jim_String(objPtr);
13346 strLen = Jim_Utf8Length(interp, objPtr);
13348 /* Map it */
13349 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13350 while (strLen) {
13351 for (i = 0; i < numMaps; i += 2) {
13352 Jim_Obj *eachObjPtr;
13353 const char *k;
13354 int kl;
13356 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13357 k = Jim_String(eachObjPtr);
13358 kl = Jim_Utf8Length(interp, eachObjPtr);
13360 if (strLen >= kl && kl) {
13361 int rc;
13362 rc = JimStringCompareLen(str, k, kl, nocase);
13363 if (rc == 0) {
13364 if (noMatchStart) {
13365 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13366 noMatchStart = NULL;
13368 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13369 str += utf8_index(str, kl);
13370 strLen -= kl;
13371 break;
13375 if (i == numMaps) { /* no match */
13376 int c;
13377 if (noMatchStart == NULL)
13378 noMatchStart = str;
13379 str += utf8_tounicode(str, &c);
13380 strLen--;
13383 if (noMatchStart) {
13384 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13386 return resultObjPtr;
13389 /* [string] */
13390 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13392 int len;
13393 int opt_case = 1;
13394 int option;
13395 static const char * const options[] = {
13396 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13397 "map", "repeat", "reverse", "index", "first", "last", "cat",
13398 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13400 enum
13402 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13403 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13404 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13406 static const char * const nocase_options[] = {
13407 "-nocase", NULL
13409 static const char * const nocase_length_options[] = {
13410 "-nocase", "-length", NULL
13413 if (argc < 2) {
13414 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13415 return JIM_ERR;
13417 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13418 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13419 return Jim_CheckShowCommands(interp, argv[1], options);
13421 switch (option) {
13422 case OPT_LENGTH:
13423 case OPT_BYTELENGTH:
13424 if (argc != 3) {
13425 Jim_WrongNumArgs(interp, 2, argv, "string");
13426 return JIM_ERR;
13428 if (option == OPT_LENGTH) {
13429 len = Jim_Utf8Length(interp, argv[2]);
13431 else {
13432 len = Jim_Length(argv[2]);
13434 Jim_SetResultInt(interp, len);
13435 return JIM_OK;
13437 case OPT_CAT:{
13438 Jim_Obj *objPtr;
13439 if (argc == 3) {
13440 /* optimise the one-arg case */
13441 objPtr = argv[2];
13443 else {
13444 int i;
13446 objPtr = Jim_NewStringObj(interp, "", 0);
13448 for (i = 2; i < argc; i++) {
13449 Jim_AppendObj(interp, objPtr, argv[i]);
13452 Jim_SetResult(interp, objPtr);
13453 return JIM_OK;
13456 case OPT_COMPARE:
13457 case OPT_EQUAL:
13459 /* n is the number of remaining option args */
13460 long opt_length = -1;
13461 int n = argc - 4;
13462 int i = 2;
13463 while (n > 0) {
13464 int subopt;
13465 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13466 JIM_ENUM_ABBREV) != JIM_OK) {
13467 badcompareargs:
13468 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13469 return JIM_ERR;
13471 if (subopt == 0) {
13472 /* -nocase */
13473 opt_case = 0;
13474 n--;
13476 else {
13477 /* -length */
13478 if (n < 2) {
13479 goto badcompareargs;
13481 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13482 return JIM_ERR;
13484 n -= 2;
13487 if (n) {
13488 goto badcompareargs;
13490 argv += argc - 2;
13491 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13492 /* Fast version - [string equal], case sensitive, no length */
13493 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13495 else {
13496 if (opt_length >= 0) {
13497 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13499 else {
13500 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13502 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13504 return JIM_OK;
13507 case OPT_MATCH:
13508 if (argc != 4 &&
13509 (argc != 5 ||
13510 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13511 JIM_ENUM_ABBREV) != JIM_OK)) {
13512 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13513 return JIM_ERR;
13515 if (opt_case == 0) {
13516 argv++;
13518 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13519 return JIM_OK;
13521 case OPT_MAP:{
13522 Jim_Obj *objPtr;
13524 if (argc != 4 &&
13525 (argc != 5 ||
13526 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13527 JIM_ENUM_ABBREV) != JIM_OK)) {
13528 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13529 return JIM_ERR;
13532 if (opt_case == 0) {
13533 argv++;
13535 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13536 if (objPtr == NULL) {
13537 return JIM_ERR;
13539 Jim_SetResult(interp, objPtr);
13540 return JIM_OK;
13543 case OPT_RANGE:
13544 case OPT_BYTERANGE:{
13545 Jim_Obj *objPtr;
13547 if (argc != 5) {
13548 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13549 return JIM_ERR;
13551 if (option == OPT_RANGE) {
13552 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13554 else
13556 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13559 if (objPtr == NULL) {
13560 return JIM_ERR;
13562 Jim_SetResult(interp, objPtr);
13563 return JIM_OK;
13566 case OPT_REPLACE:{
13567 Jim_Obj *objPtr;
13569 if (argc != 5 && argc != 6) {
13570 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13571 return JIM_ERR;
13573 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13574 if (objPtr == NULL) {
13575 return JIM_ERR;
13577 Jim_SetResult(interp, objPtr);
13578 return JIM_OK;
13582 case OPT_REPEAT:{
13583 Jim_Obj *objPtr;
13584 jim_wide count;
13586 if (argc != 4) {
13587 Jim_WrongNumArgs(interp, 2, argv, "string count");
13588 return JIM_ERR;
13590 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13591 return JIM_ERR;
13593 objPtr = Jim_NewStringObj(interp, "", 0);
13594 if (count > 0) {
13595 while (count--) {
13596 Jim_AppendObj(interp, objPtr, argv[2]);
13599 Jim_SetResult(interp, objPtr);
13600 return JIM_OK;
13603 case OPT_REVERSE:{
13604 char *buf, *p;
13605 const char *str;
13606 int i;
13608 if (argc != 3) {
13609 Jim_WrongNumArgs(interp, 2, argv, "string");
13610 return JIM_ERR;
13613 str = Jim_GetString(argv[2], &len);
13614 buf = Jim_Alloc(len + 1);
13615 p = buf + len;
13616 *p = 0;
13617 for (i = 0; i < len; ) {
13618 int c;
13619 int l = utf8_tounicode(str, &c);
13620 memcpy(p - l, str, l);
13621 p -= l;
13622 i += l;
13623 str += l;
13625 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13626 return JIM_OK;
13629 case OPT_INDEX:{
13630 int idx;
13631 const char *str;
13633 if (argc != 4) {
13634 Jim_WrongNumArgs(interp, 2, argv, "string index");
13635 return JIM_ERR;
13637 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13638 return JIM_ERR;
13640 str = Jim_String(argv[2]);
13641 len = Jim_Utf8Length(interp, argv[2]);
13642 if (idx != INT_MIN && idx != INT_MAX) {
13643 idx = JimRelToAbsIndex(len, idx);
13645 if (idx < 0 || idx >= len || str == NULL) {
13646 Jim_SetResultString(interp, "", 0);
13648 else if (len == Jim_Length(argv[2])) {
13649 /* ASCII optimisation */
13650 Jim_SetResultString(interp, str + idx, 1);
13652 else {
13653 int c;
13654 int i = utf8_index(str, idx);
13655 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13657 return JIM_OK;
13660 case OPT_FIRST:
13661 case OPT_LAST:{
13662 int idx = 0, l1, l2;
13663 const char *s1, *s2;
13665 if (argc != 4 && argc != 5) {
13666 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13667 return JIM_ERR;
13669 s1 = Jim_String(argv[2]);
13670 s2 = Jim_String(argv[3]);
13671 l1 = Jim_Utf8Length(interp, argv[2]);
13672 l2 = Jim_Utf8Length(interp, argv[3]);
13673 if (argc == 5) {
13674 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13675 return JIM_ERR;
13677 idx = JimRelToAbsIndex(l2, idx);
13679 else if (option == OPT_LAST) {
13680 idx = l2;
13682 if (option == OPT_FIRST) {
13683 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13685 else {
13686 #ifdef JIM_UTF8
13687 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13688 #else
13689 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13690 #endif
13692 return JIM_OK;
13695 case OPT_TRIM:
13696 case OPT_TRIMLEFT:
13697 case OPT_TRIMRIGHT:{
13698 Jim_Obj *trimchars;
13700 if (argc != 3 && argc != 4) {
13701 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13702 return JIM_ERR;
13704 trimchars = (argc == 4 ? argv[3] : NULL);
13705 if (option == OPT_TRIM) {
13706 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13708 else if (option == OPT_TRIMLEFT) {
13709 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13711 else if (option == OPT_TRIMRIGHT) {
13712 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13714 return JIM_OK;
13717 case OPT_TOLOWER:
13718 case OPT_TOUPPER:
13719 case OPT_TOTITLE:
13720 if (argc != 3) {
13721 Jim_WrongNumArgs(interp, 2, argv, "string");
13722 return JIM_ERR;
13724 if (option == OPT_TOLOWER) {
13725 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13727 else if (option == OPT_TOUPPER) {
13728 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13730 else {
13731 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13733 return JIM_OK;
13735 case OPT_IS:
13736 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13737 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13739 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13740 return JIM_ERR;
13742 return JIM_OK;
13745 /* [time] */
13746 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13748 long i, count = 1;
13749 jim_wide start, elapsed;
13750 char buf[60];
13751 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13753 if (argc < 2) {
13754 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13755 return JIM_ERR;
13757 if (argc == 3) {
13758 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13759 return JIM_ERR;
13761 if (count < 0)
13762 return JIM_OK;
13763 i = count;
13764 start = JimClock();
13765 while (i-- > 0) {
13766 int retval;
13768 retval = Jim_EvalObj(interp, argv[1]);
13769 if (retval != JIM_OK) {
13770 return retval;
13773 elapsed = JimClock() - start;
13774 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13775 Jim_SetResultString(interp, buf, -1);
13776 return JIM_OK;
13779 /* [exit] */
13780 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13782 long exitCode = 0;
13784 if (argc > 2) {
13785 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13786 return JIM_ERR;
13788 if (argc == 2) {
13789 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13790 return JIM_ERR;
13792 interp->exitCode = exitCode;
13793 return JIM_EXIT;
13796 /* [catch] */
13797 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13799 int exitCode = 0;
13800 int i;
13801 int sig = 0;
13803 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13804 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13805 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13807 /* Reset the error code before catch.
13808 * Note that this is not strictly correct.
13810 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13812 for (i = 1; i < argc - 1; i++) {
13813 const char *arg = Jim_String(argv[i]);
13814 jim_wide option;
13815 int ignore;
13817 /* It's a pity we can't use Jim_GetEnum here :-( */
13818 if (strcmp(arg, "--") == 0) {
13819 i++;
13820 break;
13822 if (*arg != '-') {
13823 break;
13826 if (strncmp(arg, "-no", 3) == 0) {
13827 arg += 3;
13828 ignore = 1;
13830 else {
13831 arg++;
13832 ignore = 0;
13835 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13836 option = -1;
13838 if (option < 0) {
13839 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13841 if (option < 0) {
13842 goto wrongargs;
13845 if (ignore) {
13846 ignore_mask |= ((jim_wide)1 << option);
13848 else {
13849 ignore_mask &= (~((jim_wide)1 << option));
13853 argc -= i;
13854 if (argc < 1 || argc > 3) {
13855 wrongargs:
13856 Jim_WrongNumArgs(interp, 1, argv,
13857 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13858 return JIM_ERR;
13860 argv += i;
13862 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13863 sig++;
13866 interp->signal_level += sig;
13867 if (Jim_CheckSignal(interp)) {
13868 /* If a signal is set, don't even try to execute the body */
13869 exitCode = JIM_SIGNAL;
13871 else {
13872 exitCode = Jim_EvalObj(interp, argv[0]);
13873 /* Don't want any caught error included in a later stack trace */
13874 interp->errorFlag = 0;
13876 interp->signal_level -= sig;
13878 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13879 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13880 /* Not caught, pass it up */
13881 return exitCode;
13884 if (sig && exitCode == JIM_SIGNAL) {
13885 /* Catch the signal at this level */
13886 if (interp->signal_set_result) {
13887 interp->signal_set_result(interp, interp->sigmask);
13889 else {
13890 Jim_SetResultInt(interp, interp->sigmask);
13892 interp->sigmask = 0;
13895 if (argc >= 2) {
13896 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13897 return JIM_ERR;
13899 if (argc == 3) {
13900 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13902 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13903 Jim_ListAppendElement(interp, optListObj,
13904 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13905 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13906 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13907 if (exitCode == JIM_ERR) {
13908 Jim_Obj *errorCode;
13909 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13910 -1));
13911 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13913 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13914 if (errorCode) {
13915 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13916 Jim_ListAppendElement(interp, optListObj, errorCode);
13919 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13920 return JIM_ERR;
13924 Jim_SetResultInt(interp, exitCode);
13925 return JIM_OK;
13928 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13930 /* [ref] */
13931 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13933 if (argc != 3 && argc != 4) {
13934 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13935 return JIM_ERR;
13937 if (argc == 3) {
13938 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13940 else {
13941 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13943 return JIM_OK;
13946 /* [getref] */
13947 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13949 Jim_Reference *refPtr;
13951 if (argc != 2) {
13952 Jim_WrongNumArgs(interp, 1, argv, "reference");
13953 return JIM_ERR;
13955 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13956 return JIM_ERR;
13957 Jim_SetResult(interp, refPtr->objPtr);
13958 return JIM_OK;
13961 /* [setref] */
13962 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13964 Jim_Reference *refPtr;
13966 if (argc != 3) {
13967 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13968 return JIM_ERR;
13970 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13971 return JIM_ERR;
13972 Jim_IncrRefCount(argv[2]);
13973 Jim_DecrRefCount(interp, refPtr->objPtr);
13974 refPtr->objPtr = argv[2];
13975 Jim_SetResult(interp, argv[2]);
13976 return JIM_OK;
13979 /* [collect] */
13980 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13982 if (argc != 1) {
13983 Jim_WrongNumArgs(interp, 1, argv, "");
13984 return JIM_ERR;
13986 Jim_SetResultInt(interp, Jim_Collect(interp));
13988 /* Free all the freed objects. */
13989 while (interp->freeList) {
13990 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13991 Jim_Free(interp->freeList);
13992 interp->freeList = nextObjPtr;
13995 return JIM_OK;
13998 /* [finalize] reference ?newValue? */
13999 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14001 if (argc != 2 && argc != 3) {
14002 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14003 return JIM_ERR;
14005 if (argc == 2) {
14006 Jim_Obj *cmdNamePtr;
14008 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14009 return JIM_ERR;
14010 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14011 Jim_SetResult(interp, cmdNamePtr);
14013 else {
14014 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14015 return JIM_ERR;
14016 Jim_SetResult(interp, argv[2]);
14018 return JIM_OK;
14021 /* [info references] */
14022 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14024 Jim_Obj *listObjPtr;
14025 Jim_HashTableIterator htiter;
14026 Jim_HashEntry *he;
14028 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14030 JimInitHashTableIterator(&interp->references, &htiter);
14031 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14032 char buf[JIM_REFERENCE_SPACE + 1];
14033 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14034 const unsigned long *refId = he->key;
14036 JimFormatReference(buf, refPtr, *refId);
14037 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14039 Jim_SetResult(interp, listObjPtr);
14040 return JIM_OK;
14042 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14044 /* [rename] */
14045 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14047 if (argc != 3) {
14048 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14049 return JIM_ERR;
14052 if (JimValidName(interp, "new procedure", argv[2])) {
14053 return JIM_ERR;
14056 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14059 #define JIM_DICTMATCH_KEYS 0x0001
14060 #define JIM_DICTMATCH_VALUES 0x002
14063 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14064 * return_types should be either or both
14066 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14068 Jim_HashEntry *he;
14069 Jim_Obj *listObjPtr;
14070 Jim_HashTableIterator htiter;
14072 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14073 return JIM_ERR;
14076 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14078 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14079 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14080 if (patternObj) {
14081 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14082 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14083 /* no match */
14084 continue;
14087 if (return_types & JIM_DICTMATCH_KEYS) {
14088 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14090 if (return_types & JIM_DICTMATCH_VALUES) {
14091 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14095 Jim_SetResult(interp, listObjPtr);
14096 return JIM_OK;
14099 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14101 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14102 return -1;
14104 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14108 * Must be called with at least one object.
14109 * Returns the new dictionary, or NULL on error.
14111 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14113 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14114 int i;
14116 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14118 /* Note that we don't optimise the trivial case of a single argument */
14120 for (i = 0; i < objc; i++) {
14121 Jim_HashTable *ht;
14122 Jim_HashTableIterator htiter;
14123 Jim_HashEntry *he;
14125 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14126 Jim_FreeNewObj(interp, objPtr);
14127 return NULL;
14129 ht = objv[i]->internalRep.ptr;
14130 JimInitHashTableIterator(ht, &htiter);
14131 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14132 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14135 return objPtr;
14138 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14140 Jim_HashTable *ht;
14141 unsigned int i;
14142 char buffer[100];
14143 int sum = 0;
14144 int nonzero_count = 0;
14145 Jim_Obj *output;
14146 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14148 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14149 return JIM_ERR;
14152 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14154 /* Note that this uses internal knowledge of the hash table */
14155 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14156 output = Jim_NewStringObj(interp, buffer, -1);
14158 for (i = 0; i < ht->size; i++) {
14159 Jim_HashEntry *he = ht->table[i];
14160 int entries = 0;
14161 while (he) {
14162 entries++;
14163 he = he->next;
14165 if (entries > 9) {
14166 bucket_counts[10]++;
14168 else {
14169 bucket_counts[entries]++;
14171 if (entries) {
14172 sum += entries;
14173 nonzero_count++;
14176 for (i = 0; i < 10; i++) {
14177 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14178 Jim_AppendString(interp, output, buffer, -1);
14180 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14181 Jim_AppendString(interp, output, buffer, -1);
14182 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14183 Jim_AppendString(interp, output, buffer, -1);
14184 Jim_SetResult(interp, output);
14185 return JIM_OK;
14188 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14190 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14192 Jim_AppendString(interp, prefixObj, " ", 1);
14193 Jim_AppendString(interp, prefixObj, subcmd, -1);
14195 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14199 * Implements the [dict with] command
14201 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14203 int i;
14204 Jim_Obj *objPtr;
14205 Jim_Obj *dictObj;
14206 Jim_Obj **dictValues;
14207 int len;
14208 int ret = JIM_OK;
14210 /* Open up the appropriate level of the dictionary */
14211 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14212 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14213 return JIM_ERR;
14215 /* Set the local variables */
14216 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14217 return JIM_ERR;
14219 for (i = 0; i < len; i += 2) {
14220 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14221 Jim_Free(dictValues);
14222 return JIM_ERR;
14226 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14227 if (Jim_Length(scriptObj)) {
14228 ret = Jim_EvalObj(interp, scriptObj);
14230 /* Now if the dictionary still exists, update it based on the local variables */
14231 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14232 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14233 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14234 for (i = 0; i < keyc; i++) {
14235 newkeyv[i] = keyv[i];
14238 for (i = 0; i < len; i += 2) {
14239 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14240 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14241 newkeyv[keyc] = dictValues[i];
14242 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14244 Jim_Free(newkeyv);
14248 Jim_Free(dictValues);
14250 return ret;
14253 /* [dict] */
14254 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14256 Jim_Obj *objPtr;
14257 int types = JIM_DICTMATCH_KEYS;
14258 int option;
14259 static const char * const options[] = {
14260 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14261 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14262 "replace", "update", NULL
14264 enum
14266 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14267 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14268 OPT_REPLACE, OPT_UPDATE,
14271 if (argc < 2) {
14272 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14273 return JIM_ERR;
14276 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14277 return Jim_CheckShowCommands(interp, argv[1], options);
14280 switch (option) {
14281 case OPT_GET:
14282 if (argc < 3) {
14283 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14284 return JIM_ERR;
14286 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14287 JIM_ERRMSG) != JIM_OK) {
14288 return JIM_ERR;
14290 Jim_SetResult(interp, objPtr);
14291 return JIM_OK;
14293 case OPT_SET:
14294 if (argc < 5) {
14295 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14296 return JIM_ERR;
14298 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14300 case OPT_EXISTS:
14301 if (argc < 4) {
14302 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14303 return JIM_ERR;
14305 else {
14306 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14307 if (rc < 0) {
14308 return JIM_ERR;
14310 Jim_SetResultBool(interp, rc == JIM_OK);
14311 return JIM_OK;
14314 case OPT_UNSET:
14315 if (argc < 4) {
14316 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14317 return JIM_ERR;
14319 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14320 return JIM_ERR;
14322 return JIM_OK;
14324 case OPT_VALUES:
14325 types = JIM_DICTMATCH_VALUES;
14326 /* fallthru */
14327 case OPT_KEYS:
14328 if (argc != 3 && argc != 4) {
14329 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14330 return JIM_ERR;
14332 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14334 case OPT_SIZE:
14335 if (argc != 3) {
14336 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14337 return JIM_ERR;
14339 else if (Jim_DictSize(interp, argv[2]) < 0) {
14340 return JIM_ERR;
14342 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14343 return JIM_OK;
14345 case OPT_MERGE:
14346 if (argc == 2) {
14347 return JIM_OK;
14349 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14350 if (objPtr == NULL) {
14351 return JIM_ERR;
14353 Jim_SetResult(interp, objPtr);
14354 return JIM_OK;
14356 case OPT_UPDATE:
14357 if (argc < 6 || argc % 2) {
14358 /* Better error message */
14359 argc = 2;
14361 break;
14363 case OPT_CREATE:
14364 if (argc % 2) {
14365 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14366 return JIM_ERR;
14368 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14369 Jim_SetResult(interp, objPtr);
14370 return JIM_OK;
14372 case OPT_INFO:
14373 if (argc != 3) {
14374 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14375 return JIM_ERR;
14377 return Jim_DictInfo(interp, argv[2]);
14379 case OPT_WITH:
14380 if (argc < 4) {
14381 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14382 return JIM_ERR;
14384 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14386 /* Handle command as an ensemble */
14387 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14390 /* [subst] */
14391 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14393 static const char * const options[] = {
14394 "-nobackslashes", "-nocommands", "-novariables", NULL
14396 enum
14397 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14398 int i;
14399 int flags = JIM_SUBST_FLAG;
14400 Jim_Obj *objPtr;
14402 if (argc < 2) {
14403 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14404 return JIM_ERR;
14406 for (i = 1; i < (argc - 1); i++) {
14407 int option;
14409 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14410 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14411 return JIM_ERR;
14413 switch (option) {
14414 case OPT_NOBACKSLASHES:
14415 flags |= JIM_SUBST_NOESC;
14416 break;
14417 case OPT_NOCOMMANDS:
14418 flags |= JIM_SUBST_NOCMD;
14419 break;
14420 case OPT_NOVARIABLES:
14421 flags |= JIM_SUBST_NOVAR;
14422 break;
14425 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14426 return JIM_ERR;
14428 Jim_SetResult(interp, objPtr);
14429 return JIM_OK;
14432 /* [info] */
14433 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14435 int cmd;
14436 Jim_Obj *objPtr;
14437 int mode = 0;
14439 static const char * const commands[] = {
14440 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14441 "vars", "version", "patchlevel", "complete", "args", "hostname",
14442 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14443 "references", "alias", NULL
14445 enum
14446 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14447 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14448 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14449 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14452 #ifdef jim_ext_namespace
14453 int nons = 0;
14455 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14456 /* This is for internal use only */
14457 argc--;
14458 argv++;
14459 nons = 1;
14461 #endif
14463 if (argc < 2) {
14464 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14465 return JIM_ERR;
14467 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14468 return Jim_CheckShowCommands(interp, argv[1], commands);
14471 /* Test for the most common commands first, just in case it makes a difference */
14472 switch (cmd) {
14473 case INFO_EXISTS:
14474 if (argc != 3) {
14475 Jim_WrongNumArgs(interp, 2, argv, "varName");
14476 return JIM_ERR;
14478 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14479 break;
14481 case INFO_ALIAS:{
14482 Jim_Cmd *cmdPtr;
14484 if (argc != 3) {
14485 Jim_WrongNumArgs(interp, 2, argv, "command");
14486 return JIM_ERR;
14488 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14489 return JIM_ERR;
14491 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14492 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14493 return JIM_ERR;
14495 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14496 return JIM_OK;
14499 case INFO_CHANNELS:
14500 mode++; /* JIM_CMDLIST_CHANNELS */
14501 #ifndef jim_ext_aio
14502 Jim_SetResultString(interp, "aio not enabled", -1);
14503 return JIM_ERR;
14504 #endif
14505 /* fall through */
14506 case INFO_PROCS:
14507 mode++; /* JIM_CMDLIST_PROCS */
14508 /* fall through */
14509 case INFO_COMMANDS:
14510 /* mode 0 => JIM_CMDLIST_COMMANDS */
14511 if (argc != 2 && argc != 3) {
14512 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14513 return JIM_ERR;
14515 #ifdef jim_ext_namespace
14516 if (!nons) {
14517 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14518 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14521 #endif
14522 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14523 break;
14525 case INFO_VARS:
14526 mode++; /* JIM_VARLIST_VARS */
14527 /* fall through */
14528 case INFO_LOCALS:
14529 mode++; /* JIM_VARLIST_LOCALS */
14530 /* fall through */
14531 case INFO_GLOBALS:
14532 /* mode 0 => JIM_VARLIST_GLOBALS */
14533 if (argc != 2 && argc != 3) {
14534 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14535 return JIM_ERR;
14537 #ifdef jim_ext_namespace
14538 if (!nons) {
14539 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14540 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14543 #endif
14544 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14545 break;
14547 case INFO_SCRIPT:
14548 if (argc != 2) {
14549 Jim_WrongNumArgs(interp, 2, argv, "");
14550 return JIM_ERR;
14552 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14553 break;
14555 case INFO_SOURCE:{
14556 jim_wide line;
14557 Jim_Obj *resObjPtr;
14558 Jim_Obj *fileNameObj;
14560 if (argc != 3 && argc != 5) {
14561 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14562 return JIM_ERR;
14564 if (argc == 5) {
14565 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14566 return JIM_ERR;
14568 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14569 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14571 else {
14572 if (argv[2]->typePtr == &sourceObjType) {
14573 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14574 line = argv[2]->internalRep.sourceValue.lineNumber;
14576 else if (argv[2]->typePtr == &scriptObjType) {
14577 ScriptObj *script = JimGetScript(interp, argv[2]);
14578 fileNameObj = script->fileNameObj;
14579 line = script->firstline;
14581 else {
14582 fileNameObj = interp->emptyObj;
14583 line = 1;
14585 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14586 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14587 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14589 Jim_SetResult(interp, resObjPtr);
14590 break;
14593 case INFO_STACKTRACE:
14594 Jim_SetResult(interp, interp->stackTrace);
14595 break;
14597 case INFO_LEVEL:
14598 case INFO_FRAME:
14599 switch (argc) {
14600 case 2:
14601 Jim_SetResultInt(interp, interp->framePtr->level);
14602 break;
14604 case 3:
14605 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14606 return JIM_ERR;
14608 Jim_SetResult(interp, objPtr);
14609 break;
14611 default:
14612 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14613 return JIM_ERR;
14615 break;
14617 case INFO_BODY:
14618 case INFO_STATICS:
14619 case INFO_ARGS:{
14620 Jim_Cmd *cmdPtr;
14622 if (argc != 3) {
14623 Jim_WrongNumArgs(interp, 2, argv, "procname");
14624 return JIM_ERR;
14626 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14627 return JIM_ERR;
14629 if (!cmdPtr->isproc) {
14630 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14631 return JIM_ERR;
14633 switch (cmd) {
14634 case INFO_BODY:
14635 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14636 break;
14637 case INFO_ARGS:
14638 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14639 break;
14640 case INFO_STATICS:
14641 if (cmdPtr->u.proc.staticVars) {
14642 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14643 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14645 break;
14647 break;
14650 case INFO_VERSION:
14651 case INFO_PATCHLEVEL:{
14652 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14654 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14655 Jim_SetResultString(interp, buf, -1);
14656 break;
14659 case INFO_COMPLETE:
14660 if (argc != 3 && argc != 4) {
14661 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14662 return JIM_ERR;
14664 else {
14665 char missing;
14667 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14668 if (missing != ' ' && argc == 4) {
14669 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14672 break;
14674 case INFO_HOSTNAME:
14675 /* Redirect to os.gethostname if it exists */
14676 return Jim_Eval(interp, "os.gethostname");
14678 case INFO_NAMEOFEXECUTABLE:
14679 /* Redirect to Tcl proc */
14680 return Jim_Eval(interp, "{info nameofexecutable}");
14682 case INFO_RETURNCODES:
14683 if (argc == 2) {
14684 int i;
14685 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14687 for (i = 0; jimReturnCodes[i]; i++) {
14688 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14689 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14690 jimReturnCodes[i], -1));
14693 Jim_SetResult(interp, listObjPtr);
14695 else if (argc == 3) {
14696 long code;
14697 const char *name;
14699 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14700 return JIM_ERR;
14702 name = Jim_ReturnCode(code);
14703 if (*name == '?') {
14704 Jim_SetResultInt(interp, code);
14706 else {
14707 Jim_SetResultString(interp, name, -1);
14710 else {
14711 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14712 return JIM_ERR;
14714 break;
14715 case INFO_REFERENCES:
14716 #ifdef JIM_REFERENCES
14717 return JimInfoReferences(interp, argc, argv);
14718 #else
14719 Jim_SetResultString(interp, "not supported", -1);
14720 return JIM_ERR;
14721 #endif
14723 return JIM_OK;
14726 /* [exists] */
14727 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14729 Jim_Obj *objPtr;
14730 int result = 0;
14732 static const char * const options[] = {
14733 "-command", "-proc", "-alias", "-var", NULL
14735 enum
14737 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14739 int option;
14741 if (argc == 2) {
14742 option = OPT_VAR;
14743 objPtr = argv[1];
14745 else if (argc == 3) {
14746 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14747 return JIM_ERR;
14749 objPtr = argv[2];
14751 else {
14752 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14753 return JIM_ERR;
14756 if (option == OPT_VAR) {
14757 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14759 else {
14760 /* Now different kinds of commands */
14761 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14763 if (cmd) {
14764 switch (option) {
14765 case OPT_COMMAND:
14766 result = 1;
14767 break;
14769 case OPT_ALIAS:
14770 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14771 break;
14773 case OPT_PROC:
14774 result = cmd->isproc;
14775 break;
14779 Jim_SetResultBool(interp, result);
14780 return JIM_OK;
14783 /* [split] */
14784 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14786 const char *str, *splitChars, *noMatchStart;
14787 int splitLen, strLen;
14788 Jim_Obj *resObjPtr;
14789 int c;
14790 int len;
14792 if (argc != 2 && argc != 3) {
14793 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14794 return JIM_ERR;
14797 str = Jim_GetString(argv[1], &len);
14798 if (len == 0) {
14799 return JIM_OK;
14801 strLen = Jim_Utf8Length(interp, argv[1]);
14803 /* Init */
14804 if (argc == 2) {
14805 splitChars = " \n\t\r";
14806 splitLen = 4;
14808 else {
14809 splitChars = Jim_String(argv[2]);
14810 splitLen = Jim_Utf8Length(interp, argv[2]);
14813 noMatchStart = str;
14814 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14816 /* Split */
14817 if (splitLen) {
14818 Jim_Obj *objPtr;
14819 while (strLen--) {
14820 const char *sc = splitChars;
14821 int scLen = splitLen;
14822 int sl = utf8_tounicode(str, &c);
14823 while (scLen--) {
14824 int pc;
14825 sc += utf8_tounicode(sc, &pc);
14826 if (c == pc) {
14827 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14828 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14829 noMatchStart = str + sl;
14830 break;
14833 str += sl;
14835 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14836 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14838 else {
14839 /* This handles the special case of splitchars eq {}
14840 * Optimise by sharing common (ASCII) characters
14842 Jim_Obj **commonObj = NULL;
14843 #define NUM_COMMON (128 - 9)
14844 while (strLen--) {
14845 int n = utf8_tounicode(str, &c);
14846 #ifdef JIM_OPTIMIZATION
14847 if (c >= 9 && c < 128) {
14848 /* Common ASCII char. Note that 9 is the tab character */
14849 c -= 9;
14850 if (!commonObj) {
14851 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14852 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14854 if (!commonObj[c]) {
14855 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14857 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14858 str++;
14859 continue;
14861 #endif
14862 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14863 str += n;
14865 Jim_Free(commonObj);
14868 Jim_SetResult(interp, resObjPtr);
14869 return JIM_OK;
14872 /* [join] */
14873 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14875 const char *joinStr;
14876 int joinStrLen;
14878 if (argc != 2 && argc != 3) {
14879 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14880 return JIM_ERR;
14882 /* Init */
14883 if (argc == 2) {
14884 joinStr = " ";
14885 joinStrLen = 1;
14887 else {
14888 joinStr = Jim_GetString(argv[2], &joinStrLen);
14890 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14891 return JIM_OK;
14894 /* [format] */
14895 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14897 Jim_Obj *objPtr;
14899 if (argc < 2) {
14900 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14901 return JIM_ERR;
14903 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14904 if (objPtr == NULL)
14905 return JIM_ERR;
14906 Jim_SetResult(interp, objPtr);
14907 return JIM_OK;
14910 /* [scan] */
14911 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14913 Jim_Obj *listPtr, **outVec;
14914 int outc, i;
14916 if (argc < 3) {
14917 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14918 return JIM_ERR;
14920 if (argv[2]->typePtr != &scanFmtStringObjType)
14921 SetScanFmtFromAny(interp, argv[2]);
14922 if (FormatGetError(argv[2]) != 0) {
14923 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14924 return JIM_ERR;
14926 if (argc > 3) {
14927 int maxPos = FormatGetMaxPos(argv[2]);
14928 int count = FormatGetCnvCount(argv[2]);
14930 if (maxPos > argc - 3) {
14931 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14932 return JIM_ERR;
14934 else if (count > argc - 3) {
14935 Jim_SetResultString(interp, "different numbers of variable names and "
14936 "field specifiers", -1);
14937 return JIM_ERR;
14939 else if (count < argc - 3) {
14940 Jim_SetResultString(interp, "variable is not assigned by any "
14941 "conversion specifiers", -1);
14942 return JIM_ERR;
14945 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14946 if (listPtr == 0)
14947 return JIM_ERR;
14948 if (argc > 3) {
14949 int rc = JIM_OK;
14950 int count = 0;
14952 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14953 int len = Jim_ListLength(interp, listPtr);
14955 if (len != 0) {
14956 JimListGetElements(interp, listPtr, &outc, &outVec);
14957 for (i = 0; i < outc; ++i) {
14958 if (Jim_Length(outVec[i]) > 0) {
14959 ++count;
14960 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14961 rc = JIM_ERR;
14966 Jim_FreeNewObj(interp, listPtr);
14968 else {
14969 count = -1;
14971 if (rc == JIM_OK) {
14972 Jim_SetResultInt(interp, count);
14974 return rc;
14976 else {
14977 if (listPtr == (Jim_Obj *)EOF) {
14978 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14979 return JIM_OK;
14981 Jim_SetResult(interp, listPtr);
14983 return JIM_OK;
14986 /* [error] */
14987 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14989 if (argc != 2 && argc != 3) {
14990 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14991 return JIM_ERR;
14993 Jim_SetResult(interp, argv[1]);
14994 if (argc == 3) {
14995 JimSetStackTrace(interp, argv[2]);
14996 return JIM_ERR;
14998 interp->addStackTrace++;
14999 return JIM_ERR;
15002 /* [lrange] */
15003 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15005 Jim_Obj *objPtr;
15007 if (argc != 4) {
15008 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15009 return JIM_ERR;
15011 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15012 return JIM_ERR;
15013 Jim_SetResult(interp, objPtr);
15014 return JIM_OK;
15017 /* [lrepeat] */
15018 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15020 Jim_Obj *objPtr;
15021 long count;
15023 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15024 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15025 return JIM_ERR;
15028 if (count == 0 || argc == 2) {
15029 return JIM_OK;
15032 argc -= 2;
15033 argv += 2;
15035 objPtr = Jim_NewListObj(interp, argv, argc);
15036 while (--count) {
15037 ListInsertElements(objPtr, -1, argc, argv);
15040 Jim_SetResult(interp, objPtr);
15041 return JIM_OK;
15044 char **Jim_GetEnviron(void)
15046 #if defined(HAVE__NSGETENVIRON)
15047 return *_NSGetEnviron();
15048 #else
15049 #if !defined(NO_ENVIRON_EXTERN)
15050 extern char **environ;
15051 #endif
15053 return environ;
15054 #endif
15057 void Jim_SetEnviron(char **env)
15059 #if defined(HAVE__NSGETENVIRON)
15060 *_NSGetEnviron() = env;
15061 #else
15062 #if !defined(NO_ENVIRON_EXTERN)
15063 extern char **environ;
15064 #endif
15066 environ = env;
15067 #endif
15070 /* [env] */
15071 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15073 const char *key;
15074 const char *val;
15076 if (argc == 1) {
15077 char **e = Jim_GetEnviron();
15079 int i;
15080 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15082 for (i = 0; e[i]; i++) {
15083 const char *equals = strchr(e[i], '=');
15085 if (equals) {
15086 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15087 equals - e[i]));
15088 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15092 Jim_SetResult(interp, listObjPtr);
15093 return JIM_OK;
15096 if (argc < 2) {
15097 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15098 return JIM_ERR;
15100 key = Jim_String(argv[1]);
15101 val = getenv(key);
15102 if (val == NULL) {
15103 if (argc < 3) {
15104 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15105 return JIM_ERR;
15107 val = Jim_String(argv[2]);
15109 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15110 return JIM_OK;
15113 /* [source] */
15114 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15116 int retval;
15118 if (argc != 2) {
15119 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15120 return JIM_ERR;
15122 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15123 if (retval == JIM_RETURN)
15124 return JIM_OK;
15125 return retval;
15128 /* [lreverse] */
15129 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15131 Jim_Obj *revObjPtr, **ele;
15132 int len;
15134 if (argc != 2) {
15135 Jim_WrongNumArgs(interp, 1, argv, "list");
15136 return JIM_ERR;
15138 JimListGetElements(interp, argv[1], &len, &ele);
15139 len--;
15140 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15141 while (len >= 0)
15142 ListAppendElement(revObjPtr, ele[len--]);
15143 Jim_SetResult(interp, revObjPtr);
15144 return JIM_OK;
15147 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15149 jim_wide len;
15151 if (step == 0)
15152 return -1;
15153 if (start == end)
15154 return 0;
15155 else if (step > 0 && start > end)
15156 return -1;
15157 else if (step < 0 && end > start)
15158 return -1;
15159 len = end - start;
15160 if (len < 0)
15161 len = -len; /* abs(len) */
15162 if (step < 0)
15163 step = -step; /* abs(step) */
15164 len = 1 + ((len - 1) / step);
15165 /* We can truncate safely to INT_MAX, the range command
15166 * will always return an error for a such long range
15167 * because Tcl lists can't be so long. */
15168 if (len > INT_MAX)
15169 len = INT_MAX;
15170 return (int)((len < 0) ? -1 : len);
15173 /* [range] */
15174 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15176 jim_wide start = 0, end, step = 1;
15177 int len, i;
15178 Jim_Obj *objPtr;
15180 if (argc < 2 || argc > 4) {
15181 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15182 return JIM_ERR;
15184 if (argc == 2) {
15185 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15186 return JIM_ERR;
15188 else {
15189 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15190 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15191 return JIM_ERR;
15192 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15193 return JIM_ERR;
15195 if ((len = JimRangeLen(start, end, step)) == -1) {
15196 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15197 return JIM_ERR;
15199 objPtr = Jim_NewListObj(interp, NULL, 0);
15200 for (i = 0; i < len; i++)
15201 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15202 Jim_SetResult(interp, objPtr);
15203 return JIM_OK;
15206 /* [rand] */
15207 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15209 jim_wide min = 0, max = 0, len, maxMul;
15211 if (argc < 1 || argc > 3) {
15212 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15213 return JIM_ERR;
15215 if (argc == 1) {
15216 max = JIM_WIDE_MAX;
15217 } else if (argc == 2) {
15218 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15219 return JIM_ERR;
15220 } else if (argc == 3) {
15221 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15222 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15223 return JIM_ERR;
15225 len = max-min;
15226 if (len < 0) {
15227 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15228 return JIM_ERR;
15230 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15231 while (1) {
15232 jim_wide r;
15234 JimRandomBytes(interp, &r, sizeof(jim_wide));
15235 if (r < 0 || r >= maxMul) continue;
15236 r = (len == 0) ? 0 : r%len;
15237 Jim_SetResultInt(interp, min+r);
15238 return JIM_OK;
15242 static const struct {
15243 const char *name;
15244 Jim_CmdProc *cmdProc;
15245 } Jim_CoreCommandsTable[] = {
15246 {"alias", Jim_AliasCoreCommand},
15247 {"set", Jim_SetCoreCommand},
15248 {"unset", Jim_UnsetCoreCommand},
15249 {"puts", Jim_PutsCoreCommand},
15250 {"+", Jim_AddCoreCommand},
15251 {"*", Jim_MulCoreCommand},
15252 {"-", Jim_SubCoreCommand},
15253 {"/", Jim_DivCoreCommand},
15254 {"incr", Jim_IncrCoreCommand},
15255 {"while", Jim_WhileCoreCommand},
15256 {"loop", Jim_LoopCoreCommand},
15257 {"for", Jim_ForCoreCommand},
15258 {"foreach", Jim_ForeachCoreCommand},
15259 {"lmap", Jim_LmapCoreCommand},
15260 {"lassign", Jim_LassignCoreCommand},
15261 {"if", Jim_IfCoreCommand},
15262 {"switch", Jim_SwitchCoreCommand},
15263 {"list", Jim_ListCoreCommand},
15264 {"lindex", Jim_LindexCoreCommand},
15265 {"lset", Jim_LsetCoreCommand},
15266 {"lsearch", Jim_LsearchCoreCommand},
15267 {"llength", Jim_LlengthCoreCommand},
15268 {"lappend", Jim_LappendCoreCommand},
15269 {"linsert", Jim_LinsertCoreCommand},
15270 {"lreplace", Jim_LreplaceCoreCommand},
15271 {"lsort", Jim_LsortCoreCommand},
15272 {"append", Jim_AppendCoreCommand},
15273 {"debug", Jim_DebugCoreCommand},
15274 {"eval", Jim_EvalCoreCommand},
15275 {"uplevel", Jim_UplevelCoreCommand},
15276 {"expr", Jim_ExprCoreCommand},
15277 {"break", Jim_BreakCoreCommand},
15278 {"continue", Jim_ContinueCoreCommand},
15279 {"proc", Jim_ProcCoreCommand},
15280 {"concat", Jim_ConcatCoreCommand},
15281 {"return", Jim_ReturnCoreCommand},
15282 {"upvar", Jim_UpvarCoreCommand},
15283 {"global", Jim_GlobalCoreCommand},
15284 {"string", Jim_StringCoreCommand},
15285 {"time", Jim_TimeCoreCommand},
15286 {"exit", Jim_ExitCoreCommand},
15287 {"catch", Jim_CatchCoreCommand},
15288 #ifdef JIM_REFERENCES
15289 {"ref", Jim_RefCoreCommand},
15290 {"getref", Jim_GetrefCoreCommand},
15291 {"setref", Jim_SetrefCoreCommand},
15292 {"finalize", Jim_FinalizeCoreCommand},
15293 {"collect", Jim_CollectCoreCommand},
15294 #endif
15295 {"rename", Jim_RenameCoreCommand},
15296 {"dict", Jim_DictCoreCommand},
15297 {"subst", Jim_SubstCoreCommand},
15298 {"info", Jim_InfoCoreCommand},
15299 {"exists", Jim_ExistsCoreCommand},
15300 {"split", Jim_SplitCoreCommand},
15301 {"join", Jim_JoinCoreCommand},
15302 {"format", Jim_FormatCoreCommand},
15303 {"scan", Jim_ScanCoreCommand},
15304 {"error", Jim_ErrorCoreCommand},
15305 {"lrange", Jim_LrangeCoreCommand},
15306 {"lrepeat", Jim_LrepeatCoreCommand},
15307 {"env", Jim_EnvCoreCommand},
15308 {"source", Jim_SourceCoreCommand},
15309 {"lreverse", Jim_LreverseCoreCommand},
15310 {"range", Jim_RangeCoreCommand},
15311 {"rand", Jim_RandCoreCommand},
15312 {"tailcall", Jim_TailcallCoreCommand},
15313 {"local", Jim_LocalCoreCommand},
15314 {"upcall", Jim_UpcallCoreCommand},
15315 {"apply", Jim_ApplyCoreCommand},
15316 {NULL, NULL},
15319 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15321 int i = 0;
15323 while (Jim_CoreCommandsTable[i].name != NULL) {
15324 Jim_CreateCommand(interp,
15325 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15326 i++;
15330 /* -----------------------------------------------------------------------------
15331 * Interactive prompt
15332 * ---------------------------------------------------------------------------*/
15333 void Jim_MakeErrorMessage(Jim_Interp *interp)
15335 Jim_Obj *argv[2];
15337 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15338 argv[1] = interp->result;
15340 Jim_EvalObjVector(interp, 2, argv);
15344 * Given a null terminated array of strings, returns an allocated, sorted
15345 * copy of the array.
15347 static char **JimSortStringTable(const char *const *tablePtr)
15349 int count;
15350 char **tablePtrSorted;
15352 /* Find the size of the table */
15353 for (count = 0; tablePtr[count]; count++) {
15356 /* Allocate one extra for the terminating NULL pointer */
15357 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15358 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15359 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15360 tablePtrSorted[count] = NULL;
15362 return tablePtrSorted;
15365 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15366 const char *prefix, const char *const *tablePtr, const char *name)
15368 char **tablePtrSorted;
15369 int i;
15371 if (name == NULL) {
15372 name = "option";
15375 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15376 tablePtrSorted = JimSortStringTable(tablePtr);
15377 for (i = 0; tablePtrSorted[i]; i++) {
15378 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15379 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15381 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15382 if (tablePtrSorted[i + 1]) {
15383 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15386 Jim_Free(tablePtrSorted);
15391 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15392 * and returns JIM_OK.
15394 * Otherwise returns JIM_ERR.
15396 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15398 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15399 int i;
15400 char **tablePtrSorted = JimSortStringTable(tablePtr);
15401 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15402 for (i = 0; tablePtrSorted[i]; i++) {
15403 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15405 Jim_Free(tablePtrSorted);
15406 return JIM_OK;
15408 return JIM_ERR;
15411 /* internal rep is stored in ptrIntvalue
15412 * ptr = tablePtr
15413 * int1 = flags
15414 * int2 = index
15416 static const Jim_ObjType getEnumObjType = {
15417 "get-enum",
15418 NULL,
15419 NULL,
15420 NULL,
15421 JIM_TYPE_REFERENCES
15424 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15425 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15427 const char *bad = "bad ";
15428 const char *const *entryPtr = NULL;
15429 int i;
15430 int match = -1;
15431 int arglen;
15432 const char *arg;
15434 if (objPtr->typePtr == &getEnumObjType) {
15435 if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) {
15436 *indexPtr = objPtr->internalRep.ptrIntValue.int2;
15437 return JIM_OK;
15441 arg = Jim_GetString(objPtr, &arglen);
15443 *indexPtr = -1;
15445 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15446 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15447 /* Found an exact match */
15448 match = i;
15449 goto found;
15451 if (flags & JIM_ENUM_ABBREV) {
15452 /* Accept an unambiguous abbreviation.
15453 * Note that '-' doesnt' consitute a valid abbreviation
15455 if (strncmp(arg, *entryPtr, arglen) == 0) {
15456 if (*arg == '-' && arglen == 1) {
15457 break;
15459 if (match >= 0) {
15460 bad = "ambiguous ";
15461 goto ambiguous;
15463 match = i;
15468 /* If we had an unambiguous partial match */
15469 if (match >= 0) {
15470 found:
15471 /* Record the match in the object */
15472 Jim_FreeIntRep(interp, objPtr);
15473 objPtr->typePtr = &getEnumObjType;
15474 objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr;
15475 objPtr->internalRep.ptrIntValue.int1 = flags;
15476 objPtr->internalRep.ptrIntValue.int2 = match;
15477 /* Return the result */
15478 *indexPtr = match;
15479 return JIM_OK;
15482 ambiguous:
15483 if (flags & JIM_ERRMSG) {
15484 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15486 return JIM_ERR;
15489 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15491 int i;
15493 for (i = 0; i < (int)len; i++) {
15494 if (array[i] && strcmp(array[i], name) == 0) {
15495 return i;
15498 return -1;
15501 int Jim_IsDict(Jim_Obj *objPtr)
15503 return objPtr->typePtr == &dictObjType;
15506 int Jim_IsList(Jim_Obj *objPtr)
15508 return objPtr->typePtr == &listObjType;
15512 * Very simple printf-like formatting, designed for error messages.
15514 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15515 * The resulting string is created and set as the result.
15517 * Each '%s' should correspond to a regular string parameter.
15518 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15519 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15521 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15523 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15525 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15527 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15529 /* Initial space needed */
15530 int len = strlen(format);
15531 int extra = 0;
15532 int n = 0;
15533 const char *params[5];
15534 int nobjparam = 0;
15535 Jim_Obj *objparam[5];
15536 char *buf;
15537 va_list args;
15538 int i;
15540 va_start(args, format);
15542 for (i = 0; i < len && n < 5; i++) {
15543 int l;
15545 if (strncmp(format + i, "%s", 2) == 0) {
15546 params[n] = va_arg(args, char *);
15548 l = strlen(params[n]);
15550 else if (strncmp(format + i, "%#s", 3) == 0) {
15551 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15553 params[n] = Jim_GetString(objPtr, &l);
15554 objparam[nobjparam++] = objPtr;
15555 Jim_IncrRefCount(objPtr);
15557 else {
15558 if (format[i] == '%') {
15559 i++;
15561 continue;
15563 n++;
15564 extra += l;
15567 len += extra;
15568 buf = Jim_Alloc(len + 1);
15569 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15571 va_end(args);
15573 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15575 for (i = 0; i < nobjparam; i++) {
15576 Jim_DecrRefCount(interp, objparam[i]);
15580 /* stubs */
15581 #ifndef jim_ext_package
15582 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15584 return JIM_OK;
15586 #endif
15587 #ifndef jim_ext_aio
15588 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15590 Jim_SetResultString(interp, "aio not enabled", -1);
15591 return NULL;
15593 #endif
15597 * Local Variables: ***
15598 * c-basic-offset: 4 ***
15599 * tab-width: 4 ***
15600 * End: ***