tests/exec.test: Minor fix for exec-12.1 on hurd
[jimtcl.git] / jim.c
blob83a42a2b5ef27cfd856b1d79dcc54180c2e4871e
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 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5030 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5031 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5033 JimDeleteLocalProcs(interp, cf->localCommands);
5035 if (cf->procArgsObjPtr)
5036 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5037 if (cf->procBodyObjPtr)
5038 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5039 Jim_DecrRefCount(interp, cf->nsObj);
5040 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5041 Jim_FreeHashTable(&cf->vars);
5042 else {
5043 int i;
5044 Jim_HashEntry **table = cf->vars.table, *he;
5046 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5047 he = table[i];
5048 while (he != NULL) {
5049 Jim_HashEntry *nextEntry = he->next;
5050 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5052 Jim_DecrRefCount(interp, varPtr->objPtr);
5053 Jim_Free(Jim_GetHashEntryKey(he));
5054 Jim_Free(varPtr);
5055 Jim_Free(he);
5056 table[i] = NULL;
5057 he = nextEntry;
5060 cf->vars.used = 0;
5062 cf->next = interp->freeFramesList;
5063 interp->freeFramesList = cf;
5067 /* -----------------------------------------------------------------------------
5068 * References
5069 * ---------------------------------------------------------------------------*/
5070 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5072 /* References HashTable Type.
5074 * Keys are unsigned long integers, dynamically allocated for now but in the
5075 * future it's worth to cache this 4 bytes objects. Values are pointers
5076 * to Jim_References. */
5077 static void JimReferencesHTValDestructor(void *interp, void *val)
5079 Jim_Reference *refPtr = (void *)val;
5081 Jim_DecrRefCount(interp, refPtr->objPtr);
5082 if (refPtr->finalizerCmdNamePtr != NULL) {
5083 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5085 Jim_Free(val);
5088 static unsigned int JimReferencesHTHashFunction(const void *key)
5090 /* Only the least significant bits are used. */
5091 const unsigned long *widePtr = key;
5092 unsigned int intValue = (unsigned int)*widePtr;
5094 return Jim_IntHashFunction(intValue);
5097 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5099 void *copy = Jim_Alloc(sizeof(unsigned long));
5101 JIM_NOTUSED(privdata);
5103 memcpy(copy, key, sizeof(unsigned long));
5104 return copy;
5107 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5109 JIM_NOTUSED(privdata);
5111 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5114 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5116 JIM_NOTUSED(privdata);
5118 Jim_Free(key);
5121 static const Jim_HashTableType JimReferencesHashTableType = {
5122 JimReferencesHTHashFunction, /* hash function */
5123 JimReferencesHTKeyDup, /* key dup */
5124 NULL, /* val dup */
5125 JimReferencesHTKeyCompare, /* key compare */
5126 JimReferencesHTKeyDestructor, /* key destructor */
5127 JimReferencesHTValDestructor /* val destructor */
5130 /* -----------------------------------------------------------------------------
5131 * Reference object type and References API
5132 * ---------------------------------------------------------------------------*/
5134 /* The string representation of references has two features in order
5135 * to make the GC faster. The first is that every reference starts
5136 * with a non common character '<', in order to make the string matching
5137 * faster. The second is that the reference string rep is 42 characters
5138 * in length, this means that it is not necessary to check any object with a string
5139 * repr < 42, and usually there aren't many of these objects. */
5141 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5143 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5145 const char *fmt = "<reference.<%s>.%020lu>";
5147 sprintf(buf, fmt, refPtr->tag, id);
5148 return JIM_REFERENCE_SPACE;
5151 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5153 static const Jim_ObjType referenceObjType = {
5154 "reference",
5155 NULL,
5156 NULL,
5157 UpdateStringOfReference,
5158 JIM_TYPE_REFERENCES,
5161 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5163 char buf[JIM_REFERENCE_SPACE + 1];
5165 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5166 JimSetStringBytes(objPtr, buf);
5169 /* returns true if 'c' is a valid reference tag character.
5170 * i.e. inside the range [_a-zA-Z0-9] */
5171 static int isrefchar(int c)
5173 return (c == '_' || isalnum(c));
5176 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5178 unsigned long value;
5179 int i, len;
5180 const char *str, *start, *end;
5181 char refId[21];
5182 Jim_Reference *refPtr;
5183 Jim_HashEntry *he;
5184 char *endptr;
5186 /* Get the string representation */
5187 str = Jim_GetString(objPtr, &len);
5188 /* Check if it looks like a reference */
5189 if (len < JIM_REFERENCE_SPACE)
5190 goto badformat;
5191 /* Trim spaces */
5192 start = str;
5193 end = str + len - 1;
5194 while (*start == ' ')
5195 start++;
5196 while (*end == ' ' && end > start)
5197 end--;
5198 if (end - start + 1 != JIM_REFERENCE_SPACE)
5199 goto badformat;
5200 /* <reference.<1234567>.%020> */
5201 if (memcmp(start, "<reference.<", 12) != 0)
5202 goto badformat;
5203 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5204 goto badformat;
5205 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5206 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5207 if (!isrefchar(start[12 + i]))
5208 goto badformat;
5210 /* Extract info from the reference. */
5211 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5212 refId[20] = '\0';
5213 /* Try to convert the ID into an unsigned long */
5214 value = strtoul(refId, &endptr, 10);
5215 if (JimCheckConversion(refId, endptr) != JIM_OK)
5216 goto badformat;
5217 /* Check if the reference really exists! */
5218 he = Jim_FindHashEntry(&interp->references, &value);
5219 if (he == NULL) {
5220 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5221 return JIM_ERR;
5223 refPtr = Jim_GetHashEntryVal(he);
5224 /* Free the old internal repr and set the new one. */
5225 Jim_FreeIntRep(interp, objPtr);
5226 objPtr->typePtr = &referenceObjType;
5227 objPtr->internalRep.refValue.id = value;
5228 objPtr->internalRep.refValue.refPtr = refPtr;
5229 return JIM_OK;
5231 badformat:
5232 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5233 return JIM_ERR;
5236 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5237 * as finalizer command (or NULL if there is no finalizer).
5238 * The returned reference object has refcount = 0. */
5239 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5241 struct Jim_Reference *refPtr;
5242 unsigned long id;
5243 Jim_Obj *refObjPtr;
5244 const char *tag;
5245 int tagLen, i;
5247 /* Perform the Garbage Collection if needed. */
5248 Jim_CollectIfNeeded(interp);
5250 refPtr = Jim_Alloc(sizeof(*refPtr));
5251 refPtr->objPtr = objPtr;
5252 Jim_IncrRefCount(objPtr);
5253 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5254 if (cmdNamePtr)
5255 Jim_IncrRefCount(cmdNamePtr);
5256 id = interp->referenceNextId++;
5257 Jim_AddHashEntry(&interp->references, &id, refPtr);
5258 refObjPtr = Jim_NewObj(interp);
5259 refObjPtr->typePtr = &referenceObjType;
5260 refObjPtr->bytes = NULL;
5261 refObjPtr->internalRep.refValue.id = id;
5262 refObjPtr->internalRep.refValue.refPtr = refPtr;
5263 interp->referenceNextId++;
5264 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5265 * that does not pass the 'isrefchar' test is replaced with '_' */
5266 tag = Jim_GetString(tagPtr, &tagLen);
5267 if (tagLen > JIM_REFERENCE_TAGLEN)
5268 tagLen = JIM_REFERENCE_TAGLEN;
5269 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5270 if (i < tagLen && isrefchar(tag[i]))
5271 refPtr->tag[i] = tag[i];
5272 else
5273 refPtr->tag[i] = '_';
5275 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5276 return refObjPtr;
5279 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5281 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5282 return NULL;
5283 return objPtr->internalRep.refValue.refPtr;
5286 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5288 Jim_Reference *refPtr;
5290 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5291 return JIM_ERR;
5292 Jim_IncrRefCount(cmdNamePtr);
5293 if (refPtr->finalizerCmdNamePtr)
5294 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5295 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5296 return JIM_OK;
5299 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5301 Jim_Reference *refPtr;
5303 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5304 return JIM_ERR;
5305 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5306 return JIM_OK;
5309 /* -----------------------------------------------------------------------------
5310 * References Garbage Collection
5311 * ---------------------------------------------------------------------------*/
5313 /* This the hash table type for the "MARK" phase of the GC */
5314 static const Jim_HashTableType JimRefMarkHashTableType = {
5315 JimReferencesHTHashFunction, /* hash function */
5316 JimReferencesHTKeyDup, /* key dup */
5317 NULL, /* val dup */
5318 JimReferencesHTKeyCompare, /* key compare */
5319 JimReferencesHTKeyDestructor, /* key destructor */
5320 NULL /* val destructor */
5323 /* Performs the garbage collection. */
5324 int Jim_Collect(Jim_Interp *interp)
5326 int collected = 0;
5327 Jim_HashTable marks;
5328 Jim_HashTableIterator htiter;
5329 Jim_HashEntry *he;
5330 Jim_Obj *objPtr;
5332 /* Avoid recursive calls */
5333 if (interp->lastCollectId == -1) {
5334 /* Jim_Collect() already running. Return just now. */
5335 return 0;
5337 interp->lastCollectId = -1;
5339 /* Mark all the references found into the 'mark' hash table.
5340 * The references are searched in every live object that
5341 * is of a type that can contain references. */
5342 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5343 objPtr = interp->liveList;
5344 while (objPtr) {
5345 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5346 const char *str, *p;
5347 int len;
5349 /* If the object is of type reference, to get the
5350 * Id is simple... */
5351 if (objPtr->typePtr == &referenceObjType) {
5352 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5353 #ifdef JIM_DEBUG_GC
5354 printf("MARK (reference): %d refcount: %d\n",
5355 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5356 #endif
5357 objPtr = objPtr->nextObjPtr;
5358 continue;
5360 /* Get the string repr of the object we want
5361 * to scan for references. */
5362 p = str = Jim_GetString(objPtr, &len);
5363 /* Skip objects too little to contain references. */
5364 if (len < JIM_REFERENCE_SPACE) {
5365 objPtr = objPtr->nextObjPtr;
5366 continue;
5368 /* Extract references from the object string repr. */
5369 while (1) {
5370 int i;
5371 unsigned long id;
5373 if ((p = strstr(p, "<reference.<")) == NULL)
5374 break;
5375 /* Check if it's a valid reference. */
5376 if (len - (p - str) < JIM_REFERENCE_SPACE)
5377 break;
5378 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5379 break;
5380 for (i = 21; i <= 40; i++)
5381 if (!isdigit(UCHAR(p[i])))
5382 break;
5383 /* Get the ID */
5384 id = strtoul(p + 21, NULL, 10);
5386 /* Ok, a reference for the given ID
5387 * was found. Mark it. */
5388 Jim_AddHashEntry(&marks, &id, NULL);
5389 #ifdef JIM_DEBUG_GC
5390 printf("MARK: %d\n", (int)id);
5391 #endif
5392 p += JIM_REFERENCE_SPACE;
5395 objPtr = objPtr->nextObjPtr;
5398 /* Run the references hash table to destroy every reference that
5399 * is not referenced outside (not present in the mark HT). */
5400 JimInitHashTableIterator(&interp->references, &htiter);
5401 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5402 const unsigned long *refId;
5403 Jim_Reference *refPtr;
5405 refId = he->key;
5406 /* Check if in the mark phase we encountered
5407 * this reference. */
5408 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5409 #ifdef JIM_DEBUG_GC
5410 printf("COLLECTING %d\n", (int)*refId);
5411 #endif
5412 collected++;
5413 /* Drop the reference, but call the
5414 * finalizer first if registered. */
5415 refPtr = Jim_GetHashEntryVal(he);
5416 if (refPtr->finalizerCmdNamePtr) {
5417 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5418 Jim_Obj *objv[3], *oldResult;
5420 JimFormatReference(refstr, refPtr, *refId);
5422 objv[0] = refPtr->finalizerCmdNamePtr;
5423 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5424 objv[2] = refPtr->objPtr;
5426 /* Drop the reference itself */
5427 /* Avoid the finaliser being freed here */
5428 Jim_IncrRefCount(objv[0]);
5429 /* Don't remove the reference from the hash table just yet
5430 * since that will free refPtr, and hence refPtr->objPtr
5433 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5434 oldResult = interp->result;
5435 Jim_IncrRefCount(oldResult);
5436 Jim_EvalObjVector(interp, 3, objv);
5437 Jim_SetResult(interp, oldResult);
5438 Jim_DecrRefCount(interp, oldResult);
5440 Jim_DecrRefCount(interp, objv[0]);
5442 Jim_DeleteHashEntry(&interp->references, refId);
5445 Jim_FreeHashTable(&marks);
5446 interp->lastCollectId = interp->referenceNextId;
5447 interp->lastCollectTime = time(NULL);
5448 return collected;
5451 #define JIM_COLLECT_ID_PERIOD 5000
5452 #define JIM_COLLECT_TIME_PERIOD 300
5454 void Jim_CollectIfNeeded(Jim_Interp *interp)
5456 unsigned long elapsedId;
5457 int elapsedTime;
5459 elapsedId = interp->referenceNextId - interp->lastCollectId;
5460 elapsedTime = time(NULL) - interp->lastCollectTime;
5463 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5464 Jim_Collect(interp);
5467 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5469 int Jim_IsBigEndian(void)
5471 union {
5472 unsigned short s;
5473 unsigned char c[2];
5474 } uval = {0x0102};
5476 return uval.c[0] == 1;
5479 /* -----------------------------------------------------------------------------
5480 * Interpreter related functions
5481 * ---------------------------------------------------------------------------*/
5483 Jim_Interp *Jim_CreateInterp(void)
5485 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5487 memset(i, 0, sizeof(*i));
5489 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5490 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5491 i->lastCollectTime = time(NULL);
5493 /* Note that we can create objects only after the
5494 * interpreter liveList and freeList pointers are
5495 * initialized to NULL. */
5496 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5497 #ifdef JIM_REFERENCES
5498 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5499 #endif
5500 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5501 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5502 i->emptyObj = Jim_NewEmptyStringObj(i);
5503 i->trueObj = Jim_NewIntObj(i, 1);
5504 i->falseObj = Jim_NewIntObj(i, 0);
5505 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5506 i->errorFileNameObj = i->emptyObj;
5507 i->result = i->emptyObj;
5508 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5509 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5510 i->errorProc = i->emptyObj;
5511 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5512 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5513 Jim_IncrRefCount(i->emptyObj);
5514 Jim_IncrRefCount(i->errorFileNameObj);
5515 Jim_IncrRefCount(i->result);
5516 Jim_IncrRefCount(i->stackTrace);
5517 Jim_IncrRefCount(i->unknown);
5518 Jim_IncrRefCount(i->currentScriptObj);
5519 Jim_IncrRefCount(i->nullScriptObj);
5520 Jim_IncrRefCount(i->errorProc);
5521 Jim_IncrRefCount(i->trueObj);
5522 Jim_IncrRefCount(i->falseObj);
5524 /* Initialize key variables every interpreter should contain */
5525 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5526 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5528 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5529 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5530 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5531 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5532 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5533 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5534 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5535 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5537 return i;
5540 void Jim_FreeInterp(Jim_Interp *i)
5542 Jim_CallFrame *cf, *cfx;
5544 Jim_Obj *objPtr, *nextObjPtr;
5546 /* Free the active call frames list - must be done before i->commands is destroyed */
5547 for (cf = i->framePtr; cf; cf = cfx) {
5548 cfx = cf->parent;
5549 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5552 Jim_DecrRefCount(i, i->emptyObj);
5553 Jim_DecrRefCount(i, i->trueObj);
5554 Jim_DecrRefCount(i, i->falseObj);
5555 Jim_DecrRefCount(i, i->result);
5556 Jim_DecrRefCount(i, i->stackTrace);
5557 Jim_DecrRefCount(i, i->errorProc);
5558 Jim_DecrRefCount(i, i->unknown);
5559 Jim_DecrRefCount(i, i->errorFileNameObj);
5560 Jim_DecrRefCount(i, i->currentScriptObj);
5561 Jim_DecrRefCount(i, i->nullScriptObj);
5562 Jim_FreeHashTable(&i->commands);
5563 #ifdef JIM_REFERENCES
5564 Jim_FreeHashTable(&i->references);
5565 #endif
5566 Jim_FreeHashTable(&i->packages);
5567 Jim_Free(i->prngState);
5568 Jim_FreeHashTable(&i->assocData);
5570 /* Check that the live object list is empty, otherwise
5571 * there is a memory leak. */
5572 #ifdef JIM_MAINTAINER
5573 if (i->liveList != NULL) {
5574 objPtr = i->liveList;
5576 printf("\n-------------------------------------\n");
5577 printf("Objects still in the free list:\n");
5578 while (objPtr) {
5579 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5580 Jim_String(objPtr);
5582 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5583 printf("%p (%d) %-10s: '%.20s...'\n",
5584 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5586 else {
5587 printf("%p (%d) %-10s: '%s'\n",
5588 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5590 if (objPtr->typePtr == &sourceObjType) {
5591 printf("FILE %s LINE %d\n",
5592 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5593 objPtr->internalRep.sourceValue.lineNumber);
5595 objPtr = objPtr->nextObjPtr;
5597 printf("-------------------------------------\n\n");
5598 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5600 #endif
5602 /* Free all the freed objects. */
5603 objPtr = i->freeList;
5604 while (objPtr) {
5605 nextObjPtr = objPtr->nextObjPtr;
5606 Jim_Free(objPtr);
5607 objPtr = nextObjPtr;
5610 /* Free the free call frames list */
5611 for (cf = i->freeFramesList; cf; cf = cfx) {
5612 cfx = cf->next;
5613 if (cf->vars.table)
5614 Jim_FreeHashTable(&cf->vars);
5615 Jim_Free(cf);
5618 /* Free the interpreter structure. */
5619 Jim_Free(i);
5622 /* Returns the call frame relative to the level represented by
5623 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5625 * This function accepts the 'level' argument in the form
5626 * of the commands [uplevel] and [upvar].
5628 * Returns NULL on error.
5630 * Note: for a function accepting a relative integer as level suitable
5631 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5633 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5635 long level;
5636 const char *str;
5637 Jim_CallFrame *framePtr;
5639 if (levelObjPtr) {
5640 str = Jim_String(levelObjPtr);
5641 if (str[0] == '#') {
5642 char *endptr;
5644 level = jim_strtol(str + 1, &endptr);
5645 if (str[1] == '\0' || endptr[0] != '\0') {
5646 level = -1;
5649 else {
5650 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5651 level = -1;
5653 else {
5654 /* Convert from a relative to an absolute level */
5655 level = interp->framePtr->level - level;
5659 else {
5660 str = "1"; /* Needed to format the error message. */
5661 level = interp->framePtr->level - 1;
5664 if (level == 0) {
5665 return interp->topFramePtr;
5667 if (level > 0) {
5668 /* Lookup */
5669 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5670 if (framePtr->level == level) {
5671 return framePtr;
5676 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5677 return NULL;
5680 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5681 * as a relative integer like in the [info level ?level?] command.
5683 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5685 long level;
5686 Jim_CallFrame *framePtr;
5688 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5689 if (level <= 0) {
5690 /* Convert from a relative to an absolute level */
5691 level = interp->framePtr->level + level;
5694 if (level == 0) {
5695 return interp->topFramePtr;
5698 /* Lookup */
5699 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5700 if (framePtr->level == level) {
5701 return framePtr;
5706 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5707 return NULL;
5710 static void JimResetStackTrace(Jim_Interp *interp)
5712 Jim_DecrRefCount(interp, interp->stackTrace);
5713 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5714 Jim_IncrRefCount(interp->stackTrace);
5717 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5719 int len;
5721 /* Increment reference first in case these are the same object */
5722 Jim_IncrRefCount(stackTraceObj);
5723 Jim_DecrRefCount(interp, interp->stackTrace);
5724 interp->stackTrace = stackTraceObj;
5725 interp->errorFlag = 1;
5727 /* This is a bit ugly.
5728 * If the filename of the last entry of the stack trace is empty,
5729 * the next stack level should be added.
5731 len = Jim_ListLength(interp, interp->stackTrace);
5732 if (len >= 3) {
5733 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5734 interp->addStackTrace = 1;
5739 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5740 Jim_Obj *fileNameObj, int linenr)
5742 if (strcmp(procname, "unknown") == 0) {
5743 procname = "";
5745 if (!*procname && !Jim_Length(fileNameObj)) {
5746 /* No useful info here */
5747 return;
5750 if (Jim_IsShared(interp->stackTrace)) {
5751 Jim_DecrRefCount(interp, interp->stackTrace);
5752 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5753 Jim_IncrRefCount(interp->stackTrace);
5756 /* If we have no procname but the previous element did, merge with that frame */
5757 if (!*procname && Jim_Length(fileNameObj)) {
5758 /* Just a filename. Check the previous entry */
5759 int len = Jim_ListLength(interp, interp->stackTrace);
5761 if (len >= 3) {
5762 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5763 if (Jim_Length(objPtr)) {
5764 /* Yes, the previous level had procname */
5765 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5766 if (Jim_Length(objPtr) == 0) {
5767 /* But no filename, so merge the new info with that frame */
5768 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5769 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5770 return;
5776 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5777 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5778 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5781 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5782 void *data)
5784 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5786 assocEntryPtr->delProc = delProc;
5787 assocEntryPtr->data = data;
5788 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5791 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5793 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5795 if (entryPtr != NULL) {
5796 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5797 return assocEntryPtr->data;
5799 return NULL;
5802 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5804 return Jim_DeleteHashEntry(&interp->assocData, key);
5807 int Jim_GetExitCode(Jim_Interp *interp)
5809 return interp->exitCode;
5812 /* -----------------------------------------------------------------------------
5813 * Integer object
5814 * ---------------------------------------------------------------------------*/
5815 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5816 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5818 static const Jim_ObjType intObjType = {
5819 "int",
5820 NULL,
5821 NULL,
5822 UpdateStringOfInt,
5823 JIM_TYPE_NONE,
5826 /* A coerced double is closer to an int than a double.
5827 * It is an int value temporarily masquerading as a double value.
5828 * i.e. it has the same string value as an int and Jim_GetWide()
5829 * succeeds, but also Jim_GetDouble() returns the value directly.
5831 static const Jim_ObjType coercedDoubleObjType = {
5832 "coerced-double",
5833 NULL,
5834 NULL,
5835 UpdateStringOfInt,
5836 JIM_TYPE_NONE,
5840 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5842 char buf[JIM_INTEGER_SPACE + 1];
5843 jim_wide wideValue = JimWideValue(objPtr);
5844 int pos = 0;
5846 if (wideValue == 0) {
5847 buf[pos++] = '0';
5849 else {
5850 char tmp[JIM_INTEGER_SPACE];
5851 int num = 0;
5852 int i;
5854 if (wideValue < 0) {
5855 buf[pos++] = '-';
5856 i = wideValue % 10;
5857 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5858 * whereas C99 is always -6
5859 * coverity[dead_error_line]
5861 tmp[num++] = (i > 0) ? (10 - i) : -i;
5862 wideValue /= -10;
5865 while (wideValue) {
5866 tmp[num++] = wideValue % 10;
5867 wideValue /= 10;
5870 for (i = 0; i < num; i++) {
5871 buf[pos++] = '0' + tmp[num - i - 1];
5874 buf[pos] = 0;
5876 JimSetStringBytes(objPtr, buf);
5879 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5881 jim_wide wideValue;
5882 const char *str;
5884 if (objPtr->typePtr == &coercedDoubleObjType) {
5885 /* Simple switch */
5886 objPtr->typePtr = &intObjType;
5887 return JIM_OK;
5890 /* Get the string representation */
5891 str = Jim_String(objPtr);
5892 /* Try to convert into a jim_wide */
5893 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5894 if (flags & JIM_ERRMSG) {
5895 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5897 return JIM_ERR;
5899 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5900 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5901 return JIM_ERR;
5903 /* Free the old internal repr and set the new one. */
5904 Jim_FreeIntRep(interp, objPtr);
5905 objPtr->typePtr = &intObjType;
5906 objPtr->internalRep.wideValue = wideValue;
5907 return JIM_OK;
5910 #ifdef JIM_OPTIMIZATION
5911 static int JimIsWide(Jim_Obj *objPtr)
5913 return objPtr->typePtr == &intObjType;
5915 #endif
5917 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5919 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5920 return JIM_ERR;
5921 *widePtr = JimWideValue(objPtr);
5922 return JIM_OK;
5925 /* Get a wide but does not set an error if the format is bad. */
5926 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5928 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5929 return JIM_ERR;
5930 *widePtr = JimWideValue(objPtr);
5931 return JIM_OK;
5934 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5936 jim_wide wideValue;
5937 int retval;
5939 retval = Jim_GetWide(interp, objPtr, &wideValue);
5940 if (retval == JIM_OK) {
5941 *longPtr = (long)wideValue;
5942 return JIM_OK;
5944 return JIM_ERR;
5947 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5949 Jim_Obj *objPtr;
5951 objPtr = Jim_NewObj(interp);
5952 objPtr->typePtr = &intObjType;
5953 objPtr->bytes = NULL;
5954 objPtr->internalRep.wideValue = wideValue;
5955 return objPtr;
5958 /* -----------------------------------------------------------------------------
5959 * Double object
5960 * ---------------------------------------------------------------------------*/
5961 #define JIM_DOUBLE_SPACE 30
5963 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5964 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5966 static const Jim_ObjType doubleObjType = {
5967 "double",
5968 NULL,
5969 NULL,
5970 UpdateStringOfDouble,
5971 JIM_TYPE_NONE,
5974 #ifndef HAVE_ISNAN
5975 #undef isnan
5976 #define isnan(X) ((X) != (X))
5977 #endif
5978 #ifndef HAVE_ISINF
5979 #undef isinf
5980 #define isinf(X) (1.0 / (X) == 0.0)
5981 #endif
5983 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5985 double value = objPtr->internalRep.doubleValue;
5987 if (isnan(value)) {
5988 JimSetStringBytes(objPtr, "NaN");
5989 return;
5991 if (isinf(value)) {
5992 if (value < 0) {
5993 JimSetStringBytes(objPtr, "-Inf");
5995 else {
5996 JimSetStringBytes(objPtr, "Inf");
5998 return;
6001 char buf[JIM_DOUBLE_SPACE + 1];
6002 int i;
6003 int len = sprintf(buf, "%.12g", value);
6005 /* Add a final ".0" if necessary */
6006 for (i = 0; i < len; i++) {
6007 if (buf[i] == '.' || buf[i] == 'e') {
6008 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
6009 /* If 'buf' ends in e-0nn or e+0nn, remove
6010 * the 0 after the + or - and reduce the length by 1
6012 char *e = strchr(buf, 'e');
6013 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
6014 /* Move it up */
6015 e += 2;
6016 memmove(e, e + 1, len - (e - buf));
6018 #endif
6019 break;
6022 if (buf[i] == '\0') {
6023 buf[i++] = '.';
6024 buf[i++] = '0';
6025 buf[i] = '\0';
6027 JimSetStringBytes(objPtr, buf);
6031 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6033 double doubleValue;
6034 jim_wide wideValue;
6035 const char *str;
6037 #ifdef HAVE_LONG_LONG
6038 /* Assume a 53 bit mantissa */
6039 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6040 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6042 if (objPtr->typePtr == &intObjType
6043 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6044 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6046 /* Direct conversion to coerced double */
6047 objPtr->typePtr = &coercedDoubleObjType;
6048 return JIM_OK;
6050 #endif
6051 /* Preserve the string representation.
6052 * Needed so we can convert back to int without loss
6054 str = Jim_String(objPtr);
6056 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6057 /* Managed to convert to an int, so we can use this as a cooerced double */
6058 Jim_FreeIntRep(interp, objPtr);
6059 objPtr->typePtr = &coercedDoubleObjType;
6060 objPtr->internalRep.wideValue = wideValue;
6061 return JIM_OK;
6063 else {
6064 /* Try to convert into a double */
6065 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6066 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6067 return JIM_ERR;
6069 /* Free the old internal repr and set the new one. */
6070 Jim_FreeIntRep(interp, objPtr);
6072 objPtr->typePtr = &doubleObjType;
6073 objPtr->internalRep.doubleValue = doubleValue;
6074 return JIM_OK;
6077 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6079 if (objPtr->typePtr == &coercedDoubleObjType) {
6080 *doublePtr = JimWideValue(objPtr);
6081 return JIM_OK;
6083 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6084 return JIM_ERR;
6086 if (objPtr->typePtr == &coercedDoubleObjType) {
6087 *doublePtr = JimWideValue(objPtr);
6089 else {
6090 *doublePtr = objPtr->internalRep.doubleValue;
6092 return JIM_OK;
6095 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6097 Jim_Obj *objPtr;
6099 objPtr = Jim_NewObj(interp);
6100 objPtr->typePtr = &doubleObjType;
6101 objPtr->bytes = NULL;
6102 objPtr->internalRep.doubleValue = doubleValue;
6103 return objPtr;
6106 /* -----------------------------------------------------------------------------
6107 * Boolean conversion
6108 * ---------------------------------------------------------------------------*/
6109 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6111 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6113 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6114 return JIM_ERR;
6115 *booleanPtr = (int) JimWideValue(objPtr);
6116 return JIM_OK;
6119 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6121 static const char * const falses[] = {
6122 "0", "false", "no", "off", NULL
6124 static const char * const trues[] = {
6125 "1", "true", "yes", "on", NULL
6128 int boolean;
6130 int index;
6131 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6132 boolean = 0;
6133 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6134 boolean = 1;
6135 } else {
6136 if (flags & JIM_ERRMSG) {
6137 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6139 return JIM_ERR;
6142 /* Free the old internal repr and set the new one. */
6143 Jim_FreeIntRep(interp, objPtr);
6144 objPtr->typePtr = &intObjType;
6145 objPtr->internalRep.wideValue = boolean;
6146 return JIM_OK;
6149 /* -----------------------------------------------------------------------------
6150 * List object
6151 * ---------------------------------------------------------------------------*/
6152 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6153 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6154 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6155 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6156 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6157 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6159 /* Note that while the elements of the list may contain references,
6160 * the list object itself can't. This basically means that the
6161 * list object string representation as a whole can't contain references
6162 * that are not presents in the single elements. */
6163 static const Jim_ObjType listObjType = {
6164 "list",
6165 FreeListInternalRep,
6166 DupListInternalRep,
6167 UpdateStringOfList,
6168 JIM_TYPE_NONE,
6171 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6173 int i;
6175 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6176 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6178 Jim_Free(objPtr->internalRep.listValue.ele);
6181 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6183 int i;
6185 JIM_NOTUSED(interp);
6187 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6188 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6189 dupPtr->internalRep.listValue.ele =
6190 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6191 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6192 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6193 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6194 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6196 dupPtr->typePtr = &listObjType;
6199 /* The following function checks if a given string can be encoded
6200 * into a list element without any kind of quoting, surrounded by braces,
6201 * or using escapes to quote. */
6202 #define JIM_ELESTR_SIMPLE 0
6203 #define JIM_ELESTR_BRACE 1
6204 #define JIM_ELESTR_QUOTE 2
6205 static unsigned char ListElementQuotingType(const char *s, int len)
6207 int i, level, blevel, trySimple = 1;
6209 /* Try with the SIMPLE case */
6210 if (len == 0)
6211 return JIM_ELESTR_BRACE;
6212 if (s[0] == '"' || s[0] == '{') {
6213 trySimple = 0;
6214 goto testbrace;
6216 for (i = 0; i < len; i++) {
6217 switch (s[i]) {
6218 case ' ':
6219 case '$':
6220 case '"':
6221 case '[':
6222 case ']':
6223 case ';':
6224 case '\\':
6225 case '\r':
6226 case '\n':
6227 case '\t':
6228 case '\f':
6229 case '\v':
6230 trySimple = 0;
6231 /* fall through */
6232 case '{':
6233 case '}':
6234 goto testbrace;
6237 return JIM_ELESTR_SIMPLE;
6239 testbrace:
6240 /* Test if it's possible to do with braces */
6241 if (s[len - 1] == '\\')
6242 return JIM_ELESTR_QUOTE;
6243 level = 0;
6244 blevel = 0;
6245 for (i = 0; i < len; i++) {
6246 switch (s[i]) {
6247 case '{':
6248 level++;
6249 break;
6250 case '}':
6251 level--;
6252 if (level < 0)
6253 return JIM_ELESTR_QUOTE;
6254 break;
6255 case '[':
6256 blevel++;
6257 break;
6258 case ']':
6259 blevel--;
6260 break;
6261 case '\\':
6262 if (s[i + 1] == '\n')
6263 return JIM_ELESTR_QUOTE;
6264 else if (s[i + 1] != '\0')
6265 i++;
6266 break;
6269 if (blevel < 0) {
6270 return JIM_ELESTR_QUOTE;
6273 if (level == 0) {
6274 if (!trySimple)
6275 return JIM_ELESTR_BRACE;
6276 for (i = 0; i < len; i++) {
6277 switch (s[i]) {
6278 case ' ':
6279 case '$':
6280 case '"':
6281 case '[':
6282 case ']':
6283 case ';':
6284 case '\\':
6285 case '\r':
6286 case '\n':
6287 case '\t':
6288 case '\f':
6289 case '\v':
6290 return JIM_ELESTR_BRACE;
6291 break;
6294 return JIM_ELESTR_SIMPLE;
6296 return JIM_ELESTR_QUOTE;
6299 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6300 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6301 * scenario.
6302 * Returns the length of the result.
6304 static int BackslashQuoteString(const char *s, int len, char *q)
6306 char *p = q;
6308 while (len--) {
6309 switch (*s) {
6310 case ' ':
6311 case '$':
6312 case '"':
6313 case '[':
6314 case ']':
6315 case '{':
6316 case '}':
6317 case ';':
6318 case '\\':
6319 *p++ = '\\';
6320 *p++ = *s++;
6321 break;
6322 case '\n':
6323 *p++ = '\\';
6324 *p++ = 'n';
6325 s++;
6326 break;
6327 case '\r':
6328 *p++ = '\\';
6329 *p++ = 'r';
6330 s++;
6331 break;
6332 case '\t':
6333 *p++ = '\\';
6334 *p++ = 't';
6335 s++;
6336 break;
6337 case '\f':
6338 *p++ = '\\';
6339 *p++ = 'f';
6340 s++;
6341 break;
6342 case '\v':
6343 *p++ = '\\';
6344 *p++ = 'v';
6345 s++;
6346 break;
6347 default:
6348 *p++ = *s++;
6349 break;
6352 *p = '\0';
6354 return p - q;
6357 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6359 #define STATIC_QUOTING_LEN 32
6360 int i, bufLen, realLength;
6361 const char *strRep;
6362 char *p;
6363 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6365 /* Estimate the space needed. */
6366 if (objc > STATIC_QUOTING_LEN) {
6367 quotingType = Jim_Alloc(objc);
6369 else {
6370 quotingType = staticQuoting;
6372 bufLen = 0;
6373 for (i = 0; i < objc; i++) {
6374 int len;
6376 strRep = Jim_GetString(objv[i], &len);
6377 quotingType[i] = ListElementQuotingType(strRep, len);
6378 switch (quotingType[i]) {
6379 case JIM_ELESTR_SIMPLE:
6380 if (i != 0 || strRep[0] != '#') {
6381 bufLen += len;
6382 break;
6384 /* Special case '#' on first element needs braces */
6385 quotingType[i] = JIM_ELESTR_BRACE;
6386 /* fall through */
6387 case JIM_ELESTR_BRACE:
6388 bufLen += len + 2;
6389 break;
6390 case JIM_ELESTR_QUOTE:
6391 bufLen += len * 2;
6392 break;
6394 bufLen++; /* elements separator. */
6396 bufLen++;
6398 /* Generate the string rep. */
6399 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6400 realLength = 0;
6401 for (i = 0; i < objc; i++) {
6402 int len, qlen;
6404 strRep = Jim_GetString(objv[i], &len);
6406 switch (quotingType[i]) {
6407 case JIM_ELESTR_SIMPLE:
6408 memcpy(p, strRep, len);
6409 p += len;
6410 realLength += len;
6411 break;
6412 case JIM_ELESTR_BRACE:
6413 *p++ = '{';
6414 memcpy(p, strRep, len);
6415 p += len;
6416 *p++ = '}';
6417 realLength += len + 2;
6418 break;
6419 case JIM_ELESTR_QUOTE:
6420 if (i == 0 && strRep[0] == '#') {
6421 *p++ = '\\';
6422 realLength++;
6424 qlen = BackslashQuoteString(strRep, len, p);
6425 p += qlen;
6426 realLength += qlen;
6427 break;
6429 /* Add a separating space */
6430 if (i + 1 != objc) {
6431 *p++ = ' ';
6432 realLength++;
6435 *p = '\0'; /* nul term. */
6436 objPtr->length = realLength;
6438 if (quotingType != staticQuoting) {
6439 Jim_Free(quotingType);
6443 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6445 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6448 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6450 struct JimParserCtx parser;
6451 const char *str;
6452 int strLen;
6453 Jim_Obj *fileNameObj;
6454 int linenr;
6456 if (objPtr->typePtr == &listObjType) {
6457 return JIM_OK;
6460 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6461 * it also preserves any source location of the dict elements
6462 * which can be very useful
6464 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6465 Jim_Obj **listObjPtrPtr;
6466 int len;
6467 int i;
6469 listObjPtrPtr = JimDictPairs(objPtr, &len);
6470 for (i = 0; i < len; i++) {
6471 Jim_IncrRefCount(listObjPtrPtr[i]);
6474 /* Now just switch the internal rep */
6475 Jim_FreeIntRep(interp, objPtr);
6476 objPtr->typePtr = &listObjType;
6477 objPtr->internalRep.listValue.len = len;
6478 objPtr->internalRep.listValue.maxLen = len;
6479 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6481 return JIM_OK;
6484 /* Try to preserve information about filename / line number */
6485 if (objPtr->typePtr == &sourceObjType) {
6486 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6487 linenr = objPtr->internalRep.sourceValue.lineNumber;
6489 else {
6490 fileNameObj = interp->emptyObj;
6491 linenr = 1;
6493 Jim_IncrRefCount(fileNameObj);
6495 /* Get the string representation */
6496 str = Jim_GetString(objPtr, &strLen);
6498 /* Free the old internal repr just now and initialize the
6499 * new one just now. The string->list conversion can't fail. */
6500 Jim_FreeIntRep(interp, objPtr);
6501 objPtr->typePtr = &listObjType;
6502 objPtr->internalRep.listValue.len = 0;
6503 objPtr->internalRep.listValue.maxLen = 0;
6504 objPtr->internalRep.listValue.ele = NULL;
6506 /* Convert into a list */
6507 if (strLen) {
6508 JimParserInit(&parser, str, strLen, linenr);
6509 while (!parser.eof) {
6510 Jim_Obj *elementPtr;
6512 JimParseList(&parser);
6513 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6514 continue;
6515 elementPtr = JimParserGetTokenObj(interp, &parser);
6516 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6517 ListAppendElement(objPtr, elementPtr);
6520 Jim_DecrRefCount(interp, fileNameObj);
6521 return JIM_OK;
6524 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6526 Jim_Obj *objPtr;
6528 objPtr = Jim_NewObj(interp);
6529 objPtr->typePtr = &listObjType;
6530 objPtr->bytes = NULL;
6531 objPtr->internalRep.listValue.ele = NULL;
6532 objPtr->internalRep.listValue.len = 0;
6533 objPtr->internalRep.listValue.maxLen = 0;
6535 if (len) {
6536 ListInsertElements(objPtr, 0, len, elements);
6539 return objPtr;
6542 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6543 * length of the vector. Note that the user of this function should make
6544 * sure that the list object can't shimmer while the vector returned
6545 * is in use, this vector is the one stored inside the internal representation
6546 * of the list object. This function is not exported, extensions should
6547 * always access to the List object elements using Jim_ListIndex(). */
6548 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6549 Jim_Obj ***listVec)
6551 *listLen = Jim_ListLength(interp, listObj);
6552 *listVec = listObj->internalRep.listValue.ele;
6555 /* Sorting uses ints, but commands may return wide */
6556 static int JimSign(jim_wide w)
6558 if (w == 0) {
6559 return 0;
6561 else if (w < 0) {
6562 return -1;
6564 return 1;
6567 /* ListSortElements type values */
6568 struct lsort_info {
6569 jmp_buf jmpbuf;
6570 Jim_Obj *command;
6571 Jim_Interp *interp;
6572 enum {
6573 JIM_LSORT_ASCII,
6574 JIM_LSORT_NOCASE,
6575 JIM_LSORT_INTEGER,
6576 JIM_LSORT_REAL,
6577 JIM_LSORT_COMMAND
6578 } type;
6579 int order;
6580 int index;
6581 int indexed;
6582 int unique;
6583 int (*subfn)(Jim_Obj **, Jim_Obj **);
6586 static struct lsort_info *sort_info;
6588 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6590 Jim_Obj *lObj, *rObj;
6592 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6593 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6594 longjmp(sort_info->jmpbuf, JIM_ERR);
6596 return sort_info->subfn(&lObj, &rObj);
6599 /* Sort the internal rep of a list. */
6600 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6602 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6605 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6607 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6610 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6612 jim_wide lhs = 0, rhs = 0;
6614 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6615 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6616 longjmp(sort_info->jmpbuf, JIM_ERR);
6619 return JimSign(lhs - rhs) * sort_info->order;
6622 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6624 double lhs = 0, rhs = 0;
6626 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6627 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6628 longjmp(sort_info->jmpbuf, JIM_ERR);
6630 if (lhs == rhs) {
6631 return 0;
6633 if (lhs > rhs) {
6634 return sort_info->order;
6636 return -sort_info->order;
6639 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6641 Jim_Obj *compare_script;
6642 int rc;
6644 jim_wide ret = 0;
6646 /* This must be a valid list */
6647 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6648 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6649 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6651 rc = Jim_EvalObj(sort_info->interp, compare_script);
6653 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6654 longjmp(sort_info->jmpbuf, rc);
6657 return JimSign(ret) * sort_info->order;
6660 /* Remove duplicate elements from the (sorted) list in-place, according to the
6661 * comparison function, comp.
6663 * Note that the last unique value is kept, not the first
6665 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6667 int src;
6668 int dst = 0;
6669 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6671 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6672 if (comp(&ele[dst], &ele[src]) == 0) {
6673 /* Match, so replace the dest with the current source */
6674 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6676 else {
6677 /* No match, so keep the current source and move to the next destination */
6678 dst++;
6680 ele[dst] = ele[src];
6683 /* At end of list, keep the final element unless all elements were kept */
6684 dst++;
6685 if (dst < listObjPtr->internalRep.listValue.len) {
6686 ele[dst] = ele[src];
6689 /* Set the new length */
6690 listObjPtr->internalRep.listValue.len = dst;
6693 /* Sort a list *in place*. MUST be called with a non-shared list. */
6694 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6696 struct lsort_info *prev_info;
6698 typedef int (qsort_comparator) (const void *, const void *);
6699 int (*fn) (Jim_Obj **, Jim_Obj **);
6700 Jim_Obj **vector;
6701 int len;
6702 int rc;
6704 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6705 SetListFromAny(interp, listObjPtr);
6707 /* Allow lsort to be called reentrantly */
6708 prev_info = sort_info;
6709 sort_info = info;
6711 vector = listObjPtr->internalRep.listValue.ele;
6712 len = listObjPtr->internalRep.listValue.len;
6713 switch (info->type) {
6714 case JIM_LSORT_ASCII:
6715 fn = ListSortString;
6716 break;
6717 case JIM_LSORT_NOCASE:
6718 fn = ListSortStringNoCase;
6719 break;
6720 case JIM_LSORT_INTEGER:
6721 fn = ListSortInteger;
6722 break;
6723 case JIM_LSORT_REAL:
6724 fn = ListSortReal;
6725 break;
6726 case JIM_LSORT_COMMAND:
6727 fn = ListSortCommand;
6728 break;
6729 default:
6730 fn = NULL; /* avoid warning */
6731 JimPanic((1, "ListSort called with invalid sort type"));
6732 return -1; /* Should not be run but keeps static analysers happy */
6735 if (info->indexed) {
6736 /* Need to interpose a "list index" function */
6737 info->subfn = fn;
6738 fn = ListSortIndexHelper;
6741 if ((rc = setjmp(info->jmpbuf)) == 0) {
6742 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6744 if (info->unique && len > 1) {
6745 ListRemoveDuplicates(listObjPtr, fn);
6748 Jim_InvalidateStringRep(listObjPtr);
6750 sort_info = prev_info;
6752 return rc;
6755 /* This is the low-level function to insert elements into a list.
6756 * The higher-level Jim_ListInsertElements() performs shared object
6757 * check and invalidates the string repr. This version is used
6758 * in the internals of the List Object and is not exported.
6760 * NOTE: this function can be called only against objects
6761 * with internal type of List.
6763 * An insertion point (idx) of -1 means end-of-list.
6765 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6767 int currentLen = listPtr->internalRep.listValue.len;
6768 int requiredLen = currentLen + elemc;
6769 int i;
6770 Jim_Obj **point;
6772 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6773 if (requiredLen < 2) {
6774 /* Don't do allocations of under 4 pointers. */
6775 requiredLen = 4;
6777 else {
6778 requiredLen *= 2;
6781 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6782 sizeof(Jim_Obj *) * requiredLen);
6784 listPtr->internalRep.listValue.maxLen = requiredLen;
6786 if (idx < 0) {
6787 idx = currentLen;
6789 point = listPtr->internalRep.listValue.ele + idx;
6790 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6791 for (i = 0; i < elemc; ++i) {
6792 point[i] = elemVec[i];
6793 Jim_IncrRefCount(point[i]);
6795 listPtr->internalRep.listValue.len += elemc;
6798 /* Convenience call to ListInsertElements() to append a single element.
6800 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6802 ListInsertElements(listPtr, -1, 1, &objPtr);
6805 /* Appends every element of appendListPtr into listPtr.
6806 * Both have to be of the list type.
6807 * Convenience call to ListInsertElements()
6809 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6811 ListInsertElements(listPtr, -1,
6812 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6815 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6817 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6818 SetListFromAny(interp, listPtr);
6819 Jim_InvalidateStringRep(listPtr);
6820 ListAppendElement(listPtr, objPtr);
6823 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6825 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6826 SetListFromAny(interp, listPtr);
6827 SetListFromAny(interp, appendListPtr);
6828 Jim_InvalidateStringRep(listPtr);
6829 ListAppendList(listPtr, appendListPtr);
6832 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6834 SetListFromAny(interp, objPtr);
6835 return objPtr->internalRep.listValue.len;
6838 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6839 int objc, Jim_Obj *const *objVec)
6841 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6842 SetListFromAny(interp, listPtr);
6843 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6844 idx = listPtr->internalRep.listValue.len;
6845 else if (idx < 0)
6846 idx = 0;
6847 Jim_InvalidateStringRep(listPtr);
6848 ListInsertElements(listPtr, idx, objc, objVec);
6851 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6853 SetListFromAny(interp, listPtr);
6854 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6855 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6856 return NULL;
6858 if (idx < 0)
6859 idx = listPtr->internalRep.listValue.len + idx;
6860 return listPtr->internalRep.listValue.ele[idx];
6863 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6865 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6866 if (*objPtrPtr == NULL) {
6867 if (flags & JIM_ERRMSG) {
6868 Jim_SetResultString(interp, "list index out of range", -1);
6870 return JIM_ERR;
6872 return JIM_OK;
6875 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6876 Jim_Obj *newObjPtr, int flags)
6878 SetListFromAny(interp, listPtr);
6879 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6880 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6881 if (flags & JIM_ERRMSG) {
6882 Jim_SetResultString(interp, "list index out of range", -1);
6884 return JIM_ERR;
6886 if (idx < 0)
6887 idx = listPtr->internalRep.listValue.len + idx;
6888 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6889 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6890 Jim_IncrRefCount(newObjPtr);
6891 return JIM_OK;
6894 /* Modify the list stored in the variable named 'varNamePtr'
6895 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6896 * with the new element 'newObjptr'. (implements the [lset] command) */
6897 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6898 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6900 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6901 int shared, i, idx;
6903 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6904 if (objPtr == NULL)
6905 return JIM_ERR;
6906 if ((shared = Jim_IsShared(objPtr)))
6907 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6908 for (i = 0; i < indexc - 1; i++) {
6909 listObjPtr = objPtr;
6910 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6911 goto err;
6912 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6913 goto err;
6915 if (Jim_IsShared(objPtr)) {
6916 objPtr = Jim_DuplicateObj(interp, objPtr);
6917 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6919 Jim_InvalidateStringRep(listObjPtr);
6921 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6922 goto err;
6923 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6924 goto err;
6925 Jim_InvalidateStringRep(objPtr);
6926 Jim_InvalidateStringRep(varObjPtr);
6927 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6928 goto err;
6929 Jim_SetResult(interp, varObjPtr);
6930 return JIM_OK;
6931 err:
6932 if (shared) {
6933 Jim_FreeNewObj(interp, varObjPtr);
6935 return JIM_ERR;
6938 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6940 int i;
6941 int listLen = Jim_ListLength(interp, listObjPtr);
6942 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6944 for (i = 0; i < listLen; ) {
6945 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6946 if (++i != listLen) {
6947 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6950 return resObjPtr;
6953 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6955 int i;
6957 /* If all the objects in objv are lists,
6958 * it's possible to return a list as result, that's the
6959 * concatenation of all the lists. */
6960 for (i = 0; i < objc; i++) {
6961 if (!Jim_IsList(objv[i]))
6962 break;
6964 if (i == objc) {
6965 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6967 for (i = 0; i < objc; i++)
6968 ListAppendList(objPtr, objv[i]);
6969 return objPtr;
6971 else {
6972 /* Else... we have to glue strings together */
6973 int len = 0, objLen;
6974 char *bytes, *p;
6976 /* Compute the length */
6977 for (i = 0; i < objc; i++) {
6978 len += Jim_Length(objv[i]);
6980 if (objc)
6981 len += objc - 1;
6982 /* Create the string rep, and a string object holding it. */
6983 p = bytes = Jim_Alloc(len + 1);
6984 for (i = 0; i < objc; i++) {
6985 const char *s = Jim_GetString(objv[i], &objLen);
6987 /* Remove leading space */
6988 while (objLen && isspace(UCHAR(*s))) {
6989 s++;
6990 objLen--;
6991 len--;
6993 /* And trailing space */
6994 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6995 /* Handle trailing backslash-space case */
6996 if (objLen > 1 && s[objLen - 2] == '\\') {
6997 break;
6999 objLen--;
7000 len--;
7002 memcpy(p, s, objLen);
7003 p += objLen;
7004 if (i + 1 != objc) {
7005 if (objLen)
7006 *p++ = ' ';
7007 else {
7008 /* Drop the space calculated for this
7009 * element that is instead null. */
7010 len--;
7014 *p = '\0';
7015 return Jim_NewStringObjNoAlloc(interp, bytes, len);
7019 /* Returns a list composed of the elements in the specified range.
7020 * first and start are directly accepted as Jim_Objects and
7021 * processed for the end?-index? case. */
7022 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7023 Jim_Obj *lastObjPtr)
7025 int first, last;
7026 int len, rangeLen;
7028 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7029 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7030 return NULL;
7031 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7032 first = JimRelToAbsIndex(len, first);
7033 last = JimRelToAbsIndex(len, last);
7034 JimRelToAbsRange(len, &first, &last, &rangeLen);
7035 if (first == 0 && last == len) {
7036 return listObjPtr;
7038 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7041 /* -----------------------------------------------------------------------------
7042 * Dict object
7043 * ---------------------------------------------------------------------------*/
7044 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7045 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7046 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7047 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7049 /* Dict HashTable Type.
7051 * Keys and Values are Jim objects. */
7053 static unsigned int JimObjectHTHashFunction(const void *key)
7055 int len;
7056 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7057 return Jim_GenHashFunction((const unsigned char *)str, len);
7060 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7062 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7065 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7067 Jim_IncrRefCount((Jim_Obj *)val);
7068 return (void *)val;
7071 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7073 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7076 static const Jim_HashTableType JimDictHashTableType = {
7077 JimObjectHTHashFunction, /* hash function */
7078 JimObjectHTKeyValDup, /* key dup */
7079 JimObjectHTKeyValDup, /* val dup */
7080 JimObjectHTKeyCompare, /* key compare */
7081 JimObjectHTKeyValDestructor, /* key destructor */
7082 JimObjectHTKeyValDestructor /* val destructor */
7085 /* Note that while the elements of the dict may contain references,
7086 * the list object itself can't. This basically means that the
7087 * dict object string representation as a whole can't contain references
7088 * that are not presents in the single elements. */
7089 static const Jim_ObjType dictObjType = {
7090 "dict",
7091 FreeDictInternalRep,
7092 DupDictInternalRep,
7093 UpdateStringOfDict,
7094 JIM_TYPE_NONE,
7097 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7099 JIM_NOTUSED(interp);
7101 Jim_FreeHashTable(objPtr->internalRep.ptr);
7102 Jim_Free(objPtr->internalRep.ptr);
7105 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7107 Jim_HashTable *ht, *dupHt;
7108 Jim_HashTableIterator htiter;
7109 Jim_HashEntry *he;
7111 /* Create a new hash table */
7112 ht = srcPtr->internalRep.ptr;
7113 dupHt = Jim_Alloc(sizeof(*dupHt));
7114 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7115 if (ht->size != 0)
7116 Jim_ExpandHashTable(dupHt, ht->size);
7117 /* Copy every element from the source to the dup hash table */
7118 JimInitHashTableIterator(ht, &htiter);
7119 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7120 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7123 dupPtr->internalRep.ptr = dupHt;
7124 dupPtr->typePtr = &dictObjType;
7127 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7129 Jim_HashTable *ht;
7130 Jim_HashTableIterator htiter;
7131 Jim_HashEntry *he;
7132 Jim_Obj **objv;
7133 int i;
7135 ht = dictPtr->internalRep.ptr;
7137 /* Turn the hash table into a flat vector of Jim_Objects. */
7138 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7139 JimInitHashTableIterator(ht, &htiter);
7140 i = 0;
7141 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7142 objv[i++] = Jim_GetHashEntryKey(he);
7143 objv[i++] = Jim_GetHashEntryVal(he);
7145 *len = i;
7146 return objv;
7149 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7151 /* Turn the hash table into a flat vector of Jim_Objects. */
7152 int len;
7153 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7155 /* And now generate the string rep as a list */
7156 JimMakeListStringRep(objPtr, objv, len);
7158 Jim_Free(objv);
7161 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7163 int listlen;
7165 if (objPtr->typePtr == &dictObjType) {
7166 return JIM_OK;
7169 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7170 /* A shared list, so get the string representation now to avoid
7171 * changing the order in case of fast conversion to dict.
7173 Jim_String(objPtr);
7176 /* For simplicity, convert a non-list object to a list and then to a dict */
7177 listlen = Jim_ListLength(interp, objPtr);
7178 if (listlen % 2) {
7179 Jim_SetResultString(interp, "missing value to go with key", -1);
7180 return JIM_ERR;
7182 else {
7183 /* Converting from a list to a dict can't fail */
7184 Jim_HashTable *ht;
7185 int i;
7187 ht = Jim_Alloc(sizeof(*ht));
7188 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7190 for (i = 0; i < listlen; i += 2) {
7191 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7192 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7194 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7197 Jim_FreeIntRep(interp, objPtr);
7198 objPtr->typePtr = &dictObjType;
7199 objPtr->internalRep.ptr = ht;
7201 return JIM_OK;
7205 /* Dict object API */
7207 /* Add an element to a dict. objPtr must be of the "dict" type.
7208 * The higher-level exported function is Jim_DictAddElement().
7209 * If an element with the specified key already exists, the value
7210 * associated is replaced with the new one.
7212 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7213 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7214 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7216 Jim_HashTable *ht = objPtr->internalRep.ptr;
7218 if (valueObjPtr == NULL) { /* unset */
7219 return Jim_DeleteHashEntry(ht, keyObjPtr);
7221 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7222 return JIM_OK;
7225 /* Add an element, higher-level interface for DictAddElement().
7226 * If valueObjPtr == NULL, the key is removed if it exists. */
7227 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7228 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7230 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7231 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7232 return JIM_ERR;
7234 Jim_InvalidateStringRep(objPtr);
7235 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7238 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7240 Jim_Obj *objPtr;
7241 int i;
7243 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7245 objPtr = Jim_NewObj(interp);
7246 objPtr->typePtr = &dictObjType;
7247 objPtr->bytes = NULL;
7248 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7249 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7250 for (i = 0; i < len; i += 2)
7251 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7252 return objPtr;
7255 /* Return the value associated to the specified dict key
7256 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7258 * Sets *objPtrPtr to non-NULL only upon success.
7260 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7261 Jim_Obj **objPtrPtr, int flags)
7263 Jim_HashEntry *he;
7264 Jim_HashTable *ht;
7266 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7267 return -1;
7269 ht = dictPtr->internalRep.ptr;
7270 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7271 if (flags & JIM_ERRMSG) {
7272 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7274 return JIM_ERR;
7276 else {
7277 *objPtrPtr = Jim_GetHashEntryVal(he);
7278 return JIM_OK;
7282 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7283 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7285 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7286 return JIM_ERR;
7288 *objPtrPtr = JimDictPairs(dictPtr, len);
7290 return JIM_OK;
7294 /* Return the value associated to the specified dict keys */
7295 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7296 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7298 int i;
7300 if (keyc == 0) {
7301 *objPtrPtr = dictPtr;
7302 return JIM_OK;
7305 for (i = 0; i < keyc; i++) {
7306 Jim_Obj *objPtr;
7308 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7309 if (rc != JIM_OK) {
7310 return rc;
7312 dictPtr = objPtr;
7314 *objPtrPtr = dictPtr;
7315 return JIM_OK;
7318 /* Modify the dict stored into the variable named 'varNamePtr'
7319 * setting the element specified by the 'keyc' keys objects in 'keyv',
7320 * with the new value of the element 'newObjPtr'.
7322 * If newObjPtr == NULL the operation is to remove the given key
7323 * from the dictionary.
7325 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7326 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7328 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7329 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7331 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7332 int shared, i;
7334 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7335 if (objPtr == NULL) {
7336 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7337 /* Cannot remove a key from non existing var */
7338 return JIM_ERR;
7340 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7341 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7342 Jim_FreeNewObj(interp, varObjPtr);
7343 return JIM_ERR;
7346 if ((shared = Jim_IsShared(objPtr)))
7347 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7348 for (i = 0; i < keyc; i++) {
7349 dictObjPtr = objPtr;
7351 /* Check if it's a valid dictionary */
7352 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7353 goto err;
7356 if (i == keyc - 1) {
7357 /* Last key: Note that error on unset with missing last key is OK */
7358 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7359 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7360 goto err;
7363 break;
7366 /* Check if the given key exists. */
7367 Jim_InvalidateStringRep(dictObjPtr);
7368 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7369 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7370 /* This key exists at the current level.
7371 * Make sure it's not shared!. */
7372 if (Jim_IsShared(objPtr)) {
7373 objPtr = Jim_DuplicateObj(interp, objPtr);
7374 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7377 else {
7378 /* Key not found. If it's an [unset] operation
7379 * this is an error. Only the last key may not
7380 * exist. */
7381 if (newObjPtr == NULL) {
7382 goto err;
7384 /* Otherwise set an empty dictionary
7385 * as key's value. */
7386 objPtr = Jim_NewDictObj(interp, NULL, 0);
7387 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7390 /* XXX: Is this necessary? */
7391 Jim_InvalidateStringRep(objPtr);
7392 Jim_InvalidateStringRep(varObjPtr);
7393 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7394 goto err;
7396 Jim_SetResult(interp, varObjPtr);
7397 return JIM_OK;
7398 err:
7399 if (shared) {
7400 Jim_FreeNewObj(interp, varObjPtr);
7402 return JIM_ERR;
7405 /* -----------------------------------------------------------------------------
7406 * Index object
7407 * ---------------------------------------------------------------------------*/
7408 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7409 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7411 static const Jim_ObjType indexObjType = {
7412 "index",
7413 NULL,
7414 NULL,
7415 UpdateStringOfIndex,
7416 JIM_TYPE_NONE,
7419 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7421 if (objPtr->internalRep.intValue == -1) {
7422 JimSetStringBytes(objPtr, "end");
7424 else {
7425 char buf[JIM_INTEGER_SPACE + 1];
7426 if (objPtr->internalRep.intValue >= 0) {
7427 sprintf(buf, "%d", objPtr->internalRep.intValue);
7429 else {
7430 /* Must be <= -2 */
7431 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7433 JimSetStringBytes(objPtr, buf);
7437 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7439 int idx, end = 0;
7440 const char *str;
7441 char *endptr;
7443 /* Get the string representation */
7444 str = Jim_String(objPtr);
7446 /* Try to convert into an index */
7447 if (strncmp(str, "end", 3) == 0) {
7448 end = 1;
7449 str += 3;
7450 idx = 0;
7452 else {
7453 idx = jim_strtol(str, &endptr);
7455 if (endptr == str) {
7456 goto badindex;
7458 str = endptr;
7461 /* Now str may include or +<num> or -<num> */
7462 if (*str == '+' || *str == '-') {
7463 int sign = (*str == '+' ? 1 : -1);
7465 idx += sign * jim_strtol(++str, &endptr);
7466 if (str == endptr || *endptr) {
7467 goto badindex;
7469 str = endptr;
7471 /* The only thing left should be spaces */
7472 while (isspace(UCHAR(*str))) {
7473 str++;
7475 if (*str) {
7476 goto badindex;
7478 if (end) {
7479 if (idx > 0) {
7480 idx = INT_MAX;
7482 else {
7483 /* end-1 is repesented as -2 */
7484 idx--;
7487 else if (idx < 0) {
7488 idx = -INT_MAX;
7491 /* Free the old internal repr and set the new one. */
7492 Jim_FreeIntRep(interp, objPtr);
7493 objPtr->typePtr = &indexObjType;
7494 objPtr->internalRep.intValue = idx;
7495 return JIM_OK;
7497 badindex:
7498 Jim_SetResultFormatted(interp,
7499 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7500 return JIM_ERR;
7503 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7505 /* Avoid shimmering if the object is an integer. */
7506 if (objPtr->typePtr == &intObjType) {
7507 jim_wide val = JimWideValue(objPtr);
7509 if (val < 0)
7510 *indexPtr = -INT_MAX;
7511 else if (val > INT_MAX)
7512 *indexPtr = INT_MAX;
7513 else
7514 *indexPtr = (int)val;
7515 return JIM_OK;
7517 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7518 return JIM_ERR;
7519 *indexPtr = objPtr->internalRep.intValue;
7520 return JIM_OK;
7523 /* -----------------------------------------------------------------------------
7524 * Return Code Object.
7525 * ---------------------------------------------------------------------------*/
7527 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7528 static const char * const jimReturnCodes[] = {
7529 "ok",
7530 "error",
7531 "return",
7532 "break",
7533 "continue",
7534 "signal",
7535 "exit",
7536 "eval",
7537 NULL
7540 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7542 static const Jim_ObjType returnCodeObjType = {
7543 "return-code",
7544 NULL,
7545 NULL,
7546 NULL,
7547 JIM_TYPE_NONE,
7550 /* Converts a (standard) return code to a string. Returns "?" for
7551 * non-standard return codes.
7553 const char *Jim_ReturnCode(int code)
7555 if (code < 0 || code >= (int)jimReturnCodesSize) {
7556 return "?";
7558 else {
7559 return jimReturnCodes[code];
7563 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7565 int returnCode;
7566 jim_wide wideValue;
7568 /* Try to convert into an integer */
7569 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7570 returnCode = (int)wideValue;
7571 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7572 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7573 return JIM_ERR;
7575 /* Free the old internal repr and set the new one. */
7576 Jim_FreeIntRep(interp, objPtr);
7577 objPtr->typePtr = &returnCodeObjType;
7578 objPtr->internalRep.intValue = returnCode;
7579 return JIM_OK;
7582 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7584 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7585 return JIM_ERR;
7586 *intPtr = objPtr->internalRep.intValue;
7587 return JIM_OK;
7590 /* -----------------------------------------------------------------------------
7591 * Expression Parsing
7592 * ---------------------------------------------------------------------------*/
7593 static int JimParseExprOperator(struct JimParserCtx *pc);
7594 static int JimParseExprNumber(struct JimParserCtx *pc);
7595 static int JimParseExprIrrational(struct JimParserCtx *pc);
7596 static int JimParseExprBoolean(struct JimParserCtx *pc);
7598 /* expr operator opcodes. */
7599 enum
7601 /* Continues on from the JIM_TT_ space */
7603 /* Binary operators (numbers) */
7604 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7605 JIM_EXPROP_DIV,
7606 JIM_EXPROP_MOD,
7607 JIM_EXPROP_SUB,
7608 JIM_EXPROP_ADD,
7609 JIM_EXPROP_LSHIFT,
7610 JIM_EXPROP_RSHIFT,
7611 JIM_EXPROP_ROTL,
7612 JIM_EXPROP_ROTR,
7613 JIM_EXPROP_LT,
7614 JIM_EXPROP_GT,
7615 JIM_EXPROP_LTE,
7616 JIM_EXPROP_GTE,
7617 JIM_EXPROP_NUMEQ,
7618 JIM_EXPROP_NUMNE,
7619 JIM_EXPROP_BITAND, /* 35 */
7620 JIM_EXPROP_BITXOR,
7621 JIM_EXPROP_BITOR,
7622 JIM_EXPROP_LOGICAND, /* 38 */
7623 JIM_EXPROP_LOGICOR, /* 39 */
7624 JIM_EXPROP_TERNARY, /* 40 */
7625 JIM_EXPROP_COLON, /* 41 */
7626 JIM_EXPROP_POW, /* 42 */
7628 /* Binary operators (strings) */
7629 JIM_EXPROP_STREQ, /* 43 */
7630 JIM_EXPROP_STRNE,
7631 JIM_EXPROP_STRIN,
7632 JIM_EXPROP_STRNI,
7634 /* Unary operators (numbers) */
7635 JIM_EXPROP_NOT, /* 47 */
7636 JIM_EXPROP_BITNOT,
7637 JIM_EXPROP_UNARYMINUS,
7638 JIM_EXPROP_UNARYPLUS,
7640 /* Functions */
7641 JIM_EXPROP_FUNC_INT, /* 51 */
7642 JIM_EXPROP_FUNC_WIDE,
7643 JIM_EXPROP_FUNC_ABS,
7644 JIM_EXPROP_FUNC_DOUBLE,
7645 JIM_EXPROP_FUNC_ROUND,
7646 JIM_EXPROP_FUNC_RAND,
7647 JIM_EXPROP_FUNC_SRAND,
7649 /* math functions from libm */
7650 JIM_EXPROP_FUNC_SIN, /* 65 */
7651 JIM_EXPROP_FUNC_COS,
7652 JIM_EXPROP_FUNC_TAN,
7653 JIM_EXPROP_FUNC_ASIN,
7654 JIM_EXPROP_FUNC_ACOS,
7655 JIM_EXPROP_FUNC_ATAN,
7656 JIM_EXPROP_FUNC_ATAN2,
7657 JIM_EXPROP_FUNC_SINH,
7658 JIM_EXPROP_FUNC_COSH,
7659 JIM_EXPROP_FUNC_TANH,
7660 JIM_EXPROP_FUNC_CEIL,
7661 JIM_EXPROP_FUNC_FLOOR,
7662 JIM_EXPROP_FUNC_EXP,
7663 JIM_EXPROP_FUNC_LOG,
7664 JIM_EXPROP_FUNC_LOG10,
7665 JIM_EXPROP_FUNC_SQRT,
7666 JIM_EXPROP_FUNC_POW,
7667 JIM_EXPROP_FUNC_HYPOT,
7668 JIM_EXPROP_FUNC_FMOD,
7671 /* A expression node is either a term or an operator
7672 * If a node is an operator, 'op' points to the details of the operator and it's terms.
7674 struct JimExprNode {
7675 int type; /* JIM_TT_xxx */
7676 struct Jim_Obj *objPtr; /* The object for a term, or NULL for an operator */
7678 struct JimExprNode *left; /* For all operators */
7679 struct JimExprNode *right; /* For binary operators */
7680 struct JimExprNode *ternary; /* For ternary operator only */
7683 /* Operators table */
7684 typedef struct Jim_ExprOperator
7686 const char *name;
7687 int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode);
7688 unsigned char precedence;
7689 unsigned char arity;
7690 unsigned char attr;
7691 unsigned char namelen;
7692 } Jim_ExprOperator;
7694 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr);
7695 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node);
7696 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node);
7698 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node)
7700 int intresult = 1;
7701 int rc;
7702 double dA, dC = 0;
7703 jim_wide wA, wC = 0;
7704 Jim_Obj *A;
7706 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7707 return rc;
7710 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7711 switch (node->type) {
7712 case JIM_EXPROP_FUNC_INT:
7713 case JIM_EXPROP_FUNC_WIDE:
7714 case JIM_EXPROP_FUNC_ROUND:
7715 case JIM_EXPROP_UNARYPLUS:
7716 wC = wA;
7717 break;
7718 case JIM_EXPROP_FUNC_DOUBLE:
7719 dC = wA;
7720 intresult = 0;
7721 break;
7722 case JIM_EXPROP_FUNC_ABS:
7723 wC = wA >= 0 ? wA : -wA;
7724 break;
7725 case JIM_EXPROP_UNARYMINUS:
7726 wC = -wA;
7727 break;
7728 case JIM_EXPROP_NOT:
7729 wC = !wA;
7730 break;
7731 default:
7732 abort();
7735 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7736 switch (node->type) {
7737 case JIM_EXPROP_FUNC_INT:
7738 case JIM_EXPROP_FUNC_WIDE:
7739 wC = dA;
7740 break;
7741 case JIM_EXPROP_FUNC_ROUND:
7742 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7743 break;
7744 case JIM_EXPROP_FUNC_DOUBLE:
7745 case JIM_EXPROP_UNARYPLUS:
7746 dC = dA;
7747 intresult = 0;
7748 break;
7749 case JIM_EXPROP_FUNC_ABS:
7750 #ifdef JIM_MATH_FUNCTIONS
7751 dC = fabs(dA);
7752 #else
7753 dC = dA >= 0 ? dA : -dA;
7754 #endif
7755 intresult = 0;
7756 break;
7757 case JIM_EXPROP_UNARYMINUS:
7758 dC = -dA;
7759 intresult = 0;
7760 break;
7761 case JIM_EXPROP_NOT:
7762 wC = !dA;
7763 break;
7764 default:
7765 abort();
7769 if (rc == JIM_OK) {
7770 if (intresult) {
7771 Jim_SetResultInt(interp, wC);
7773 else {
7774 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7778 Jim_DecrRefCount(interp, A);
7780 return rc;
7783 static double JimRandDouble(Jim_Interp *interp)
7785 unsigned long x;
7786 JimRandomBytes(interp, &x, sizeof(x));
7788 return (double)x / (unsigned long)~0;
7791 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node)
7793 jim_wide wA;
7794 Jim_Obj *A;
7795 int rc;
7797 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7798 return rc;
7801 rc = Jim_GetWide(interp, A, &wA);
7802 if (rc == JIM_OK) {
7803 switch (node->type) {
7804 case JIM_EXPROP_BITNOT:
7805 Jim_SetResultInt(interp, ~wA);
7806 break;
7807 case JIM_EXPROP_FUNC_SRAND:
7808 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7809 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7810 break;
7811 default:
7812 abort();
7816 Jim_DecrRefCount(interp, A);
7818 return rc;
7821 static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node)
7823 JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7825 Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7827 return JIM_OK;
7830 #ifdef JIM_MATH_FUNCTIONS
7831 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node)
7833 int rc;
7834 double dA, dC;
7835 Jim_Obj *A;
7837 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7838 return rc;
7841 rc = Jim_GetDouble(interp, A, &dA);
7842 if (rc == JIM_OK) {
7843 switch (node->type) {
7844 case JIM_EXPROP_FUNC_SIN:
7845 dC = sin(dA);
7846 break;
7847 case JIM_EXPROP_FUNC_COS:
7848 dC = cos(dA);
7849 break;
7850 case JIM_EXPROP_FUNC_TAN:
7851 dC = tan(dA);
7852 break;
7853 case JIM_EXPROP_FUNC_ASIN:
7854 dC = asin(dA);
7855 break;
7856 case JIM_EXPROP_FUNC_ACOS:
7857 dC = acos(dA);
7858 break;
7859 case JIM_EXPROP_FUNC_ATAN:
7860 dC = atan(dA);
7861 break;
7862 case JIM_EXPROP_FUNC_SINH:
7863 dC = sinh(dA);
7864 break;
7865 case JIM_EXPROP_FUNC_COSH:
7866 dC = cosh(dA);
7867 break;
7868 case JIM_EXPROP_FUNC_TANH:
7869 dC = tanh(dA);
7870 break;
7871 case JIM_EXPROP_FUNC_CEIL:
7872 dC = ceil(dA);
7873 break;
7874 case JIM_EXPROP_FUNC_FLOOR:
7875 dC = floor(dA);
7876 break;
7877 case JIM_EXPROP_FUNC_EXP:
7878 dC = exp(dA);
7879 break;
7880 case JIM_EXPROP_FUNC_LOG:
7881 dC = log(dA);
7882 break;
7883 case JIM_EXPROP_FUNC_LOG10:
7884 dC = log10(dA);
7885 break;
7886 case JIM_EXPROP_FUNC_SQRT:
7887 dC = sqrt(dA);
7888 break;
7889 default:
7890 abort();
7892 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
7895 Jim_DecrRefCount(interp, A);
7897 return rc;
7899 #endif
7901 /* A binary operation on two ints */
7902 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node)
7904 jim_wide wA, wB;
7905 int rc;
7906 Jim_Obj *A, *B;
7908 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
7909 return rc;
7911 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
7912 Jim_DecrRefCount(interp, A);
7913 return rc;
7916 rc = JIM_ERR;
7918 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7919 jim_wide wC;
7921 rc = JIM_OK;
7923 switch (node->type) {
7924 case JIM_EXPROP_LSHIFT:
7925 wC = wA << wB;
7926 break;
7927 case JIM_EXPROP_RSHIFT:
7928 wC = wA >> wB;
7929 break;
7930 case JIM_EXPROP_BITAND:
7931 wC = wA & wB;
7932 break;
7933 case JIM_EXPROP_BITXOR:
7934 wC = wA ^ wB;
7935 break;
7936 case JIM_EXPROP_BITOR:
7937 wC = wA | wB;
7938 break;
7939 case JIM_EXPROP_MOD:
7940 if (wB == 0) {
7941 wC = 0;
7942 Jim_SetResultString(interp, "Division by zero", -1);
7943 rc = JIM_ERR;
7945 else {
7947 * From Tcl 8.x
7949 * This code is tricky: C doesn't guarantee much
7950 * about the quotient or remainder, but Tcl does.
7951 * The remainder always has the same sign as the
7952 * divisor and a smaller absolute value.
7954 int negative = 0;
7956 if (wB < 0) {
7957 wB = -wB;
7958 wA = -wA;
7959 negative = 1;
7961 wC = wA % wB;
7962 if (wC < 0) {
7963 wC += wB;
7965 if (negative) {
7966 wC = -wC;
7969 break;
7970 case JIM_EXPROP_ROTL:
7971 case JIM_EXPROP_ROTR:{
7972 /* uint32_t would be better. But not everyone has inttypes.h? */
7973 unsigned long uA = (unsigned long)wA;
7974 unsigned long uB = (unsigned long)wB;
7975 const unsigned int S = sizeof(unsigned long) * 8;
7977 /* Shift left by the word size or more is undefined. */
7978 uB %= S;
7980 if (node->type == JIM_EXPROP_ROTR) {
7981 uB = S - uB;
7983 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7984 break;
7986 default:
7987 abort();
7989 Jim_SetResultInt(interp, wC);
7992 Jim_DecrRefCount(interp, A);
7993 Jim_DecrRefCount(interp, B);
7995 return rc;
7999 /* A binary operation on two ints or two doubles (or two strings for some ops) */
8000 static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node)
8002 int rc = JIM_OK;
8003 double dA, dB, dC = 0;
8004 jim_wide wA, wB, wC = 0;
8005 Jim_Obj *A, *B;
8007 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8008 return rc;
8010 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8011 Jim_DecrRefCount(interp, A);
8012 return rc;
8015 if ((A->typePtr != &doubleObjType || A->bytes) &&
8016 (B->typePtr != &doubleObjType || B->bytes) &&
8017 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
8019 /* Both are ints */
8021 switch (node->type) {
8022 case JIM_EXPROP_POW:
8023 case JIM_EXPROP_FUNC_POW:
8024 if (wA == 0 && wB < 0) {
8025 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8026 rc = JIM_ERR;
8027 goto done;
8029 wC = JimPowWide(wA, wB);
8030 goto intresult;
8031 case JIM_EXPROP_ADD:
8032 wC = wA + wB;
8033 goto intresult;
8034 case JIM_EXPROP_SUB:
8035 wC = wA - wB;
8036 goto intresult;
8037 case JIM_EXPROP_MUL:
8038 wC = wA * wB;
8039 goto intresult;
8040 case JIM_EXPROP_DIV:
8041 if (wB == 0) {
8042 Jim_SetResultString(interp, "Division by zero", -1);
8043 rc = JIM_ERR;
8044 goto done;
8046 else {
8048 * From Tcl 8.x
8050 * This code is tricky: C doesn't guarantee much
8051 * about the quotient or remainder, but Tcl does.
8052 * The remainder always has the same sign as the
8053 * divisor and a smaller absolute value.
8055 if (wB < 0) {
8056 wB = -wB;
8057 wA = -wA;
8059 wC = wA / wB;
8060 if (wA % wB < 0) {
8061 wC--;
8063 goto intresult;
8065 case JIM_EXPROP_LT:
8066 wC = wA < wB;
8067 goto intresult;
8068 case JIM_EXPROP_GT:
8069 wC = wA > wB;
8070 goto intresult;
8071 case JIM_EXPROP_LTE:
8072 wC = wA <= wB;
8073 goto intresult;
8074 case JIM_EXPROP_GTE:
8075 wC = wA >= wB;
8076 goto intresult;
8077 case JIM_EXPROP_NUMEQ:
8078 wC = wA == wB;
8079 goto intresult;
8080 case JIM_EXPROP_NUMNE:
8081 wC = wA != wB;
8082 goto intresult;
8085 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8086 switch (node->type) {
8087 #ifndef JIM_MATH_FUNCTIONS
8088 case JIM_EXPROP_POW:
8089 case JIM_EXPROP_FUNC_POW:
8090 case JIM_EXPROP_FUNC_ATAN2:
8091 case JIM_EXPROP_FUNC_HYPOT:
8092 case JIM_EXPROP_FUNC_FMOD:
8093 Jim_SetResultString(interp, "unsupported", -1);
8094 rc = JIM_ERR;
8095 goto done;
8096 #else
8097 case JIM_EXPROP_POW:
8098 case JIM_EXPROP_FUNC_POW:
8099 dC = pow(dA, dB);
8100 goto doubleresult;
8101 case JIM_EXPROP_FUNC_ATAN2:
8102 dC = atan2(dA, dB);
8103 goto doubleresult;
8104 case JIM_EXPROP_FUNC_HYPOT:
8105 dC = hypot(dA, dB);
8106 goto doubleresult;
8107 case JIM_EXPROP_FUNC_FMOD:
8108 dC = fmod(dA, dB);
8109 goto doubleresult;
8110 #endif
8111 case JIM_EXPROP_ADD:
8112 dC = dA + dB;
8113 goto doubleresult;
8114 case JIM_EXPROP_SUB:
8115 dC = dA - dB;
8116 goto doubleresult;
8117 case JIM_EXPROP_MUL:
8118 dC = dA * dB;
8119 goto doubleresult;
8120 case JIM_EXPROP_DIV:
8121 if (dB == 0) {
8122 #ifdef INFINITY
8123 dC = dA < 0 ? -INFINITY : INFINITY;
8124 #else
8125 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8126 #endif
8128 else {
8129 dC = dA / dB;
8131 goto doubleresult;
8132 case JIM_EXPROP_LT:
8133 wC = dA < dB;
8134 goto intresult;
8135 case JIM_EXPROP_GT:
8136 wC = dA > dB;
8137 goto intresult;
8138 case JIM_EXPROP_LTE:
8139 wC = dA <= dB;
8140 goto intresult;
8141 case JIM_EXPROP_GTE:
8142 wC = dA >= dB;
8143 goto intresult;
8144 case JIM_EXPROP_NUMEQ:
8145 wC = dA == dB;
8146 goto intresult;
8147 case JIM_EXPROP_NUMNE:
8148 wC = dA != dB;
8149 goto intresult;
8152 else {
8153 /* Handle the string case */
8155 /* XXX: Could optimise the eq/ne case by checking lengths */
8156 int i = Jim_StringCompareObj(interp, A, B, 0);
8158 switch (node->type) {
8159 case JIM_EXPROP_LT:
8160 wC = i < 0;
8161 goto intresult;
8162 case JIM_EXPROP_GT:
8163 wC = i > 0;
8164 goto intresult;
8165 case JIM_EXPROP_LTE:
8166 wC = i <= 0;
8167 goto intresult;
8168 case JIM_EXPROP_GTE:
8169 wC = i >= 0;
8170 goto intresult;
8171 case JIM_EXPROP_NUMEQ:
8172 wC = i == 0;
8173 goto intresult;
8174 case JIM_EXPROP_NUMNE:
8175 wC = i != 0;
8176 goto intresult;
8179 /* If we get here, it is an error */
8180 rc = JIM_ERR;
8181 done:
8182 Jim_DecrRefCount(interp, A);
8183 Jim_DecrRefCount(interp, B);
8184 return rc;
8185 intresult:
8186 Jim_SetResultInt(interp, wC);
8187 goto done;
8188 doubleresult:
8189 Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC));
8190 goto done;
8193 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8195 int listlen;
8196 int i;
8198 listlen = Jim_ListLength(interp, listObjPtr);
8199 for (i = 0; i < listlen; i++) {
8200 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8201 return 1;
8204 return 0;
8209 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node)
8211 Jim_Obj *A, *B;
8212 jim_wide wC;
8213 int rc;
8215 if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8216 return rc;
8218 if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) {
8219 Jim_DecrRefCount(interp, A);
8220 return rc;
8223 switch (node->type) {
8224 case JIM_EXPROP_STREQ:
8225 case JIM_EXPROP_STRNE:
8226 wC = Jim_StringEqObj(A, B);
8227 if (node->type == JIM_EXPROP_STRNE) {
8228 wC = !wC;
8230 break;
8231 case JIM_EXPROP_STRIN:
8232 wC = JimSearchList(interp, B, A);
8233 break;
8234 case JIM_EXPROP_STRNI:
8235 wC = !JimSearchList(interp, B, A);
8236 break;
8237 default:
8238 abort();
8240 Jim_SetResultInt(interp, wC);
8242 Jim_DecrRefCount(interp, A);
8243 Jim_DecrRefCount(interp, B);
8245 return rc;
8248 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8250 long l;
8251 double d;
8252 int b;
8253 int ret = -1;
8255 /* In case the object is interp->result with refcount 1*/
8256 Jim_IncrRefCount(obj);
8258 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8259 ret = (l != 0);
8261 else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8262 ret = (d != 0);
8264 else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8265 ret = (b != 0);
8268 Jim_DecrRefCount(interp, obj);
8269 return ret;
8272 static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node)
8274 /* evaluate left */
8275 int result = JimExprGetTermBoolean(interp, node->left);
8277 if (result == 1) {
8278 /* true so evaluate right */
8279 result = JimExprGetTermBoolean(interp, node->right);
8281 if (result == -1) {
8282 return JIM_ERR;
8284 Jim_SetResultInt(interp, result);
8285 return JIM_OK;
8288 static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node)
8290 /* evaluate left */
8291 int result = JimExprGetTermBoolean(interp, node->left);
8293 if (result == 0) {
8294 /* false so evaluate right */
8295 result = JimExprGetTermBoolean(interp, node->right);
8297 if (result == -1) {
8298 return JIM_ERR;
8300 Jim_SetResultInt(interp, result);
8301 return JIM_OK;
8304 static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node)
8306 /* evaluate left */
8307 int result = JimExprGetTermBoolean(interp, node->left);
8309 if (result == 1) {
8310 /* true so select right */
8311 return JimExprEvalTermNode(interp, node->right);
8313 else if (result == 0) {
8314 /* false so select ternary */
8315 return JimExprEvalTermNode(interp, node->ternary);
8317 /* error */
8318 return JIM_ERR;
8321 enum
8323 OP_FUNC = 0x0001, /* function syntax */
8324 OP_RIGHT_ASSOC = 0x0002, /* right associative */
8327 /* name - precedence - arity - opcode
8329 * This array *must* be kept in sync with the JIM_EXPROP enum.
8331 * The following macros pre-compute the string length at compile time.
8333 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8334 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0)
8336 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8337 OPRINIT("*", 110, 2, JimExprOpBin),
8338 OPRINIT("/", 110, 2, JimExprOpBin),
8339 OPRINIT("%", 110, 2, JimExprOpIntBin),
8341 OPRINIT("-", 100, 2, JimExprOpBin),
8342 OPRINIT("+", 100, 2, JimExprOpBin),
8344 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8345 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8347 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8348 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8350 OPRINIT("<", 80, 2, JimExprOpBin),
8351 OPRINIT(">", 80, 2, JimExprOpBin),
8352 OPRINIT("<=", 80, 2, JimExprOpBin),
8353 OPRINIT(">=", 80, 2, JimExprOpBin),
8355 OPRINIT("==", 70, 2, JimExprOpBin),
8356 OPRINIT("!=", 70, 2, JimExprOpBin),
8358 OPRINIT("&", 50, 2, JimExprOpIntBin),
8359 OPRINIT("^", 49, 2, JimExprOpIntBin),
8360 OPRINIT("|", 48, 2, JimExprOpIntBin),
8362 OPRINIT("&&", 10, 2, JimExprOpAnd),
8363 OPRINIT("||", 9, 2, JimExprOpOr),
8364 OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC),
8365 OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC),
8367 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8368 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC),
8370 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8371 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8373 OPRINIT("in", 55, 2, JimExprOpStrBin),
8374 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8376 OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8377 OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),
8378 OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8379 OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8383 OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC),
8384 OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC),
8385 OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC),
8386 OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC),
8387 OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC),
8388 OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC),
8389 OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC),
8391 #ifdef JIM_MATH_FUNCTIONS
8392 OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8393 OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8394 OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8395 OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8396 OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8397 OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8398 OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC),
8399 OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8400 OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8401 OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8402 OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8403 OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8404 OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8405 OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8406 OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8407 OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC),
8408 OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC),
8409 OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC),
8410 OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC),
8411 #endif
8413 #undef OPRINIT
8414 #undef OPRINIT_ATTR
8416 #define JIM_EXPR_OPERATORS_NUM \
8417 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8419 static int JimParseExpression(struct JimParserCtx *pc)
8421 /* Discard spaces and quoted newline */
8422 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8423 if (*pc->p == '\n') {
8424 pc->linenr++;
8426 pc->p++;
8427 pc->len--;
8430 /* Common case */
8431 pc->tline = pc->linenr;
8432 pc->tstart = pc->p;
8434 if (pc->len == 0) {
8435 pc->tend = pc->p;
8436 pc->tt = JIM_TT_EOL;
8437 pc->eof = 1;
8438 return JIM_OK;
8440 switch (*(pc->p)) {
8441 case '(':
8442 pc->tt = JIM_TT_SUBEXPR_START;
8443 goto singlechar;
8444 case ')':
8445 pc->tt = JIM_TT_SUBEXPR_END;
8446 goto singlechar;
8447 case ',':
8448 pc->tt = JIM_TT_SUBEXPR_COMMA;
8449 singlechar:
8450 pc->tend = pc->p;
8451 pc->p++;
8452 pc->len--;
8453 break;
8454 case '[':
8455 return JimParseCmd(pc);
8456 case '$':
8457 if (JimParseVar(pc) == JIM_ERR)
8458 return JimParseExprOperator(pc);
8459 else {
8460 /* Don't allow expr sugar in expressions */
8461 if (pc->tt == JIM_TT_EXPRSUGAR) {
8462 return JIM_ERR;
8464 return JIM_OK;
8466 break;
8467 case '0':
8468 case '1':
8469 case '2':
8470 case '3':
8471 case '4':
8472 case '5':
8473 case '6':
8474 case '7':
8475 case '8':
8476 case '9':
8477 case '.':
8478 return JimParseExprNumber(pc);
8479 case '"':
8480 return JimParseQuote(pc);
8481 case '{':
8482 return JimParseBrace(pc);
8484 case 'N':
8485 case 'I':
8486 case 'n':
8487 case 'i':
8488 if (JimParseExprIrrational(pc) == JIM_ERR)
8489 if (JimParseExprBoolean(pc) == JIM_ERR)
8490 return JimParseExprOperator(pc);
8491 break;
8492 case 't':
8493 case 'f':
8494 case 'o':
8495 case 'y':
8496 if (JimParseExprBoolean(pc) == JIM_ERR)
8497 return JimParseExprOperator(pc);
8498 break;
8499 default:
8500 return JimParseExprOperator(pc);
8501 break;
8503 return JIM_OK;
8506 static int JimParseExprNumber(struct JimParserCtx *pc)
8508 char *end;
8510 /* Assume an integer for now */
8511 pc->tt = JIM_TT_EXPR_INT;
8513 jim_strtoull(pc->p, (char **)&pc->p);
8514 /* Tried as an integer, but perhaps it parses as a double */
8515 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8516 /* Some stupid compilers insist they are cleverer that
8517 * we are. Even a (void) cast doesn't prevent this warning!
8519 if (strtod(pc->tstart, &end)) { /* nothing */ }
8520 if (end == pc->tstart)
8521 return JIM_ERR;
8522 if (end > pc->p) {
8523 /* Yes, double captured more chars */
8524 pc->tt = JIM_TT_EXPR_DOUBLE;
8525 pc->p = end;
8528 pc->tend = pc->p - 1;
8529 pc->len -= (pc->p - pc->tstart);
8530 return JIM_OK;
8533 static int JimParseExprIrrational(struct JimParserCtx *pc)
8535 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8536 int i;
8538 for (i = 0; irrationals[i]; i++) {
8539 const char *irr = irrationals[i];
8541 if (strncmp(irr, pc->p, 3) == 0) {
8542 pc->p += 3;
8543 pc->len -= 3;
8544 pc->tend = pc->p - 1;
8545 pc->tt = JIM_TT_EXPR_DOUBLE;
8546 return JIM_OK;
8549 return JIM_ERR;
8552 static int JimParseExprBoolean(struct JimParserCtx *pc)
8554 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8555 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8556 int i;
8558 for (i = 0; booleans[i]; i++) {
8559 const char *boolean = booleans[i];
8560 int length = lengths[i];
8562 if (strncmp(boolean, pc->p, length) == 0) {
8563 pc->p += length;
8564 pc->len -= length;
8565 pc->tend = pc->p - 1;
8566 pc->tt = JIM_TT_EXPR_BOOLEAN;
8567 return JIM_OK;
8570 return JIM_ERR;
8573 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8575 static Jim_ExprOperator dummy_op;
8576 if (opcode < JIM_TT_EXPR_OP) {
8577 return &dummy_op;
8579 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8582 static int JimParseExprOperator(struct JimParserCtx *pc)
8584 int i;
8585 const struct Jim_ExprOperator *bestOp = NULL;
8586 int bestLen = 0;
8588 /* Try to get the longest match. */
8589 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8590 const struct Jim_ExprOperator *op = &Jim_ExprOperators[i];
8592 if (op->name[0] != pc->p[0]) {
8593 continue;
8596 if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) {
8597 bestOp = op;
8598 bestLen = op->namelen;
8601 if (bestOp == NULL) {
8602 return JIM_ERR;
8605 /* Validate paretheses around function arguments */
8606 if (bestOp->attr & OP_FUNC) {
8607 const char *p = pc->p + bestLen;
8608 int len = pc->len - bestLen;
8610 while (len && isspace(UCHAR(*p))) {
8611 len--;
8612 p++;
8614 if (*p != '(') {
8615 return JIM_ERR;
8618 pc->tend = pc->p + bestLen - 1;
8619 pc->p += bestLen;
8620 pc->len -= bestLen;
8622 pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP;
8623 return JIM_OK;
8626 const char *jim_tt_name(int type)
8628 static const char * const tt_names[JIM_TT_EXPR_OP] =
8629 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8630 "DBL", "BOO", "$()" };
8631 if (type < JIM_TT_EXPR_OP) {
8632 return tt_names[type];
8634 else if (type == JIM_EXPROP_UNARYMINUS) {
8635 return "-VE";
8637 else if (type == JIM_EXPROP_UNARYPLUS) {
8638 return "+VE";
8640 else {
8641 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8642 static char buf[20];
8644 if (op->name) {
8645 return op->name;
8647 sprintf(buf, "(%d)", type);
8648 return buf;
8652 /* -----------------------------------------------------------------------------
8653 * Expression Object
8654 * ---------------------------------------------------------------------------*/
8655 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8656 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8657 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8659 static const Jim_ObjType exprObjType = {
8660 "expression",
8661 FreeExprInternalRep,
8662 DupExprInternalRep,
8663 NULL,
8664 JIM_TYPE_REFERENCES,
8667 /* expr tree structure */
8668 struct ExprTree
8670 struct JimExprNode *expr; /* The first operator or term */
8671 struct JimExprNode *nodes; /* Storage of all nodes in the tree */
8672 int len; /* Number of nodes in use */
8673 int inUse; /* Used for sharing. */
8676 static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num)
8678 int i;
8679 for (i = 0; i < num; i++) {
8680 if (nodes[i].objPtr) {
8681 Jim_DecrRefCount(interp, nodes[i].objPtr);
8684 Jim_Free(nodes);
8687 static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr)
8689 ExprTreeFreeNodes(interp, expr->nodes, expr->len);
8690 Jim_Free(expr);
8693 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8695 struct ExprTree *expr = (void *)objPtr->internalRep.ptr;
8697 if (expr) {
8698 if (--expr->inUse != 0) {
8699 return;
8702 ExprTreeFree(interp, expr);
8706 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8708 JIM_NOTUSED(interp);
8709 JIM_NOTUSED(srcPtr);
8711 /* Just returns an simple string. */
8712 dupPtr->typePtr = NULL;
8715 struct ExprBuilder {
8716 int parencount; /* count of outstanding parentheses */
8717 int level; /* recursion depth */
8718 ParseToken *token; /* The current token */
8719 ParseToken *first_token; /* The first token */
8720 Jim_Stack stack; /* stack of pending terms */
8721 Jim_Obj *exprObjPtr; /* the original expression */
8722 Jim_Obj *fileNameObj; /* filename of the original expression */
8723 struct JimExprNode *nodes; /* storage for all nodes */
8724 struct JimExprNode *next; /* storage for the next node */
8727 #ifdef DEBUG_SHOW_EXPR
8728 static void JimShowExprNode(struct JimExprNode *node, int level)
8730 int i;
8731 for (i = 0; i < level; i++) {
8732 printf(" ");
8734 if (TOKEN_IS_EXPR_OP(node->type)) {
8735 printf("%s\n", jim_tt_name(node->type));
8736 if (node->left) {
8737 JimShowExprNode(node->left, level + 1);
8739 if (node->right) {
8740 JimShowExprNode(node->right, level + 1);
8742 if (node->ternary) {
8743 JimShowExprNode(node->ternary, level + 1);
8746 else {
8747 printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr));
8750 #endif
8752 #define EXPR_UNTIL_CLOSE 0x0001
8753 #define EXPR_FUNC_ARGS 0x0002
8754 #define EXPR_TERNARY 0x0004
8757 * Parse the subexpression at builder->token and return with the node on the stack.
8758 * builder->token is advanced to the next unconsumed token.
8759 * Returns JIM_OK if OK or JIM_ERR on error and leaves a message in the interpreter result.
8761 * 'precedence' is the precedence of the current operator. Tokens are consumed until an operator
8762 * with an equal or lower precedence is reached (or strictly lower if right associative).
8764 * If EXPR_UNTIL_CLOSE is set, the subexpression extends up to and including the next close parenthesis.
8765 * If EXPR_FUNC_ARGS is set, multiple subexpressions (terms) are expected separated by comma
8766 * If EXPR_TERNARY is set, two subexpressions (terms) are expected separated by colon
8768 * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8770 static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms)
8772 int rc;
8773 struct JimExprNode *node;
8774 /* Calculate the stack length expected after pushing the number of expected terms */
8775 int exp_stacklen = builder->stack.len + exp_numterms;
8777 builder->level++;
8779 while (builder->token->type != JIM_TT_EOL) {
8780 ParseToken *t = builder->token++;
8781 int prevtt;
8783 if (t == builder->first_token) {
8784 prevtt = JIM_TT_NONE;
8786 else {
8787 prevtt = t[-1].type;
8790 if (t->type == JIM_TT_SUBEXPR_START) {
8791 if (builder->stack.len == exp_stacklen) {
8792 Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8793 return JIM_ERR;
8795 builder->parencount++;
8796 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1);
8797 if (rc != JIM_OK) {
8798 return rc;
8800 /* A complete subexpression is on the stack */
8802 else if (t->type == JIM_TT_SUBEXPR_END) {
8803 if (!(flags & EXPR_UNTIL_CLOSE)) {
8804 if (builder->stack.len == exp_stacklen && builder->level > 1) {
8805 builder->token--;
8806 builder->level--;
8807 return JIM_OK;
8809 Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr);
8810 return JIM_ERR;
8812 builder->parencount--;
8813 if (builder->stack.len == exp_stacklen) {
8814 /* Return with the expected number of subexpressions on the stack */
8815 break;
8818 else if (t->type == JIM_TT_SUBEXPR_COMMA) {
8819 if (!(flags & EXPR_FUNC_ARGS)) {
8820 if (builder->stack.len == exp_stacklen) {
8821 /* handle the comma back at the parent level */
8822 builder->token--;
8823 builder->level--;
8824 return JIM_OK;
8826 Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr);
8827 return JIM_ERR;
8829 else {
8830 /* If we see more terms than expected, it is an error */
8831 if (builder->stack.len > exp_stacklen) {
8832 Jim_SetResultFormatted(interp, "too many arguments to math function");
8833 return JIM_ERR;
8836 /* just go onto the next arg */
8838 else if (t->type == JIM_EXPROP_COLON) {
8839 if (!(flags & EXPR_TERNARY)) {
8840 if (builder->level != 1) {
8841 /* handle the comma back at the parent level */
8842 builder->token--;
8843 builder->level--;
8844 return JIM_OK;
8846 Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr);
8847 return JIM_ERR;
8849 if (builder->stack.len == exp_stacklen) {
8850 /* handle the comma back at the parent level */
8851 builder->token--;
8852 builder->level--;
8853 return JIM_OK;
8855 /* just go onto the next term */
8857 else if (TOKEN_IS_EXPR_OP(t->type)) {
8858 const struct Jim_ExprOperator *op;
8860 /* Convert -/+ to unary minus or unary plus if necessary */
8861 if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) {
8862 if (t->type == JIM_EXPROP_SUB) {
8863 t->type = JIM_EXPROP_UNARYMINUS;
8865 else if (t->type == JIM_EXPROP_ADD) {
8866 t->type = JIM_EXPROP_UNARYPLUS;
8870 op = JimExprOperatorInfoByOpcode(t->type);
8872 if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) {
8873 /* next op is lower precedence, or equal and left associative, so done here */
8874 builder->token--;
8875 break;
8878 if (op->attr & OP_FUNC) {
8879 if (builder->token->type != JIM_TT_SUBEXPR_START) {
8880 Jim_SetResultString(interp, "missing arguments for math function", -1);
8881 return JIM_ERR;
8883 builder->token++;
8884 if (op->arity == 0) {
8885 if (builder->token->type != JIM_TT_SUBEXPR_END) {
8886 Jim_SetResultString(interp, "too many arguments for math function", -1);
8887 return JIM_ERR;
8889 builder->token++;
8890 goto noargs;
8892 builder->parencount++;
8894 /* This will push left and return right */
8895 rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity);
8897 else if (t->type == JIM_EXPROP_TERNARY) {
8898 /* Collect the two arguments to the ternary operator */
8899 rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2);
8901 else {
8902 /* Recursively handle everything on the right until we see a precendence <= op->precedence or == and right associative
8903 * and push that on the term stack
8905 rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1);
8908 if (rc != JIM_OK) {
8909 return rc;
8912 noargs:
8913 node = builder->next++;
8914 node->type = t->type;
8916 if (op->arity >= 3) {
8917 node->ternary = Jim_StackPop(&builder->stack);
8918 if (node->ternary == NULL) {
8919 goto missingoperand;
8922 if (op->arity >= 2) {
8923 node->right = Jim_StackPop(&builder->stack);
8924 if (node->right == NULL) {
8925 goto missingoperand;
8928 if (op->arity >= 1) {
8929 node->left = Jim_StackPop(&builder->stack);
8930 if (node->left == NULL) {
8931 missingoperand:
8932 Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr);
8933 builder->next--;
8934 return JIM_ERR;
8939 /* Now push the node */
8940 Jim_StackPush(&builder->stack, node);
8942 else {
8943 Jim_Obj *objPtr = NULL;
8945 /* This is a simple non-operator term, so create and push the appropriate object */
8947 /* Two consecutive terms without an operator is invalid */
8948 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
8949 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr);
8950 return JIM_ERR;
8953 /* Immediately create a double or int object? */
8954 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
8955 char *endptr;
8956 if (t->type == JIM_TT_EXPR_INT) {
8957 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8959 else {
8960 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8962 if (endptr != t->token + t->len) {
8963 /* Conversion failed, so just store it as a string */
8964 Jim_FreeNewObj(interp, objPtr);
8965 objPtr = NULL;
8969 if (!objPtr) {
8970 /* Everything else is stored a simple string term */
8971 objPtr = Jim_NewStringObj(interp, t->token, t->len);
8972 if (t->type == JIM_TT_CMD) {
8973 /* Only commands need source info */
8974 JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line);
8978 /* Now push a term node */
8979 node = builder->next++;
8980 node->objPtr = objPtr;
8981 Jim_IncrRefCount(node->objPtr);
8982 node->type = t->type;
8983 Jim_StackPush(&builder->stack, node);
8987 if (builder->stack.len == exp_stacklen) {
8988 builder->level--;
8989 return JIM_OK;
8992 if ((flags & EXPR_FUNC_ARGS)) {
8993 Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many");
8995 else {
8996 if (builder->stack.len < exp_stacklen) {
8997 if (builder->level == 0) {
8998 Jim_SetResultFormatted(interp, "empty expression");
9000 else {
9001 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr);
9004 else {
9005 Jim_SetResultFormatted(interp, "extra terms after expression");
9009 return JIM_ERR;
9012 static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9014 struct ExprTree *expr;
9015 struct ExprBuilder builder;
9016 int rc;
9017 struct JimExprNode *top;
9019 builder.parencount = 0;
9020 builder.level = 0;
9021 builder.token = builder.first_token = tokenlist->list;
9022 builder.exprObjPtr = exprObjPtr;
9023 builder.fileNameObj = fileNameObj;
9024 /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9025 builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9026 memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9027 builder.next = builder.nodes;
9028 Jim_InitStack(&builder.stack);
9030 rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1);
9032 if (rc == JIM_OK) {
9033 top = Jim_StackPop(&builder.stack);
9035 if (builder.parencount) {
9036 Jim_SetResultString(interp, "missing close parenthesis", -1);
9037 rc = JIM_ERR;
9041 /* Free the stack used for the compilation. */
9042 Jim_FreeStack(&builder.stack);
9044 if (rc != JIM_OK) {
9045 ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes);
9046 return NULL;
9049 expr = Jim_Alloc(sizeof(*expr));
9050 expr->inUse = 1;
9051 expr->expr = top;
9052 expr->nodes = builder.nodes;
9053 expr->len = builder.next - builder.nodes;
9055 assert(expr->len <= tokenlist->count - 1);
9057 return expr;
9060 /* This method takes the string representation of an expression
9061 * and generates a program for the expr engine */
9062 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9064 int exprTextLen;
9065 const char *exprText;
9066 struct JimParserCtx parser;
9067 struct ExprTree *expr;
9068 ParseTokenList tokenlist;
9069 int line;
9070 Jim_Obj *fileNameObj;
9071 int rc = JIM_ERR;
9073 /* Try to get information about filename / line number */
9074 if (objPtr->typePtr == &sourceObjType) {
9075 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9076 line = objPtr->internalRep.sourceValue.lineNumber;
9078 else {
9079 fileNameObj = interp->emptyObj;
9080 line = 1;
9082 Jim_IncrRefCount(fileNameObj);
9084 exprText = Jim_GetString(objPtr, &exprTextLen);
9086 /* Initially tokenise the expression into tokenlist */
9087 ScriptTokenListInit(&tokenlist);
9089 JimParserInit(&parser, exprText, exprTextLen, line);
9090 while (!parser.eof) {
9091 if (JimParseExpression(&parser) != JIM_OK) {
9092 ScriptTokenListFree(&tokenlist);
9093 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9094 expr = NULL;
9095 goto err;
9098 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9099 parser.tline);
9102 #ifdef DEBUG_SHOW_EXPR_TOKENS
9104 int i;
9105 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9106 for (i = 0; i < tokenlist.count; i++) {
9107 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9108 tokenlist.list[i].len, tokenlist.list[i].token);
9111 #endif
9113 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9114 ScriptTokenListFree(&tokenlist);
9115 Jim_DecrRefCount(interp, fileNameObj);
9116 return JIM_ERR;
9119 /* Now create the expression bytecode from the tokenlist */
9120 expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj);
9122 /* No longer need the token list */
9123 ScriptTokenListFree(&tokenlist);
9125 if (!expr) {
9126 goto err;
9129 #ifdef DEBUG_SHOW_EXPR
9130 printf("==== Expr ====\n");
9131 JimShowExprNode(expr->expr, 0);
9132 #endif
9134 rc = JIM_OK;
9136 err:
9137 /* Free the old internal rep and set the new one. */
9138 Jim_DecrRefCount(interp, fileNameObj);
9139 Jim_FreeIntRep(interp, objPtr);
9140 Jim_SetIntRepPtr(objPtr, expr);
9141 objPtr->typePtr = &exprObjType;
9142 return rc;
9145 static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9147 if (objPtr->typePtr != &exprObjType) {
9148 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9149 return NULL;
9152 return (struct ExprTree *) Jim_GetIntRepPtr(objPtr);
9155 #ifdef JIM_OPTIMIZATION
9156 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node)
9158 if (node->type == JIM_TT_EXPR_INT)
9159 return node->objPtr;
9160 else if (node->type == JIM_TT_VAR)
9161 return Jim_GetVariable(interp, node->objPtr, JIM_NONE);
9162 else if (node->type == JIM_TT_DICTSUGAR)
9163 return JimExpandDictSugar(interp, node->objPtr);
9164 else
9165 return NULL;
9167 #endif
9169 /* -----------------------------------------------------------------------------
9170 * Expressions evaluation.
9171 * Jim uses a recursive evaluation engine for expressions,
9172 * that takes advantage of the fact that expr's operators
9173 * can't be redefined.
9175 * Jim_EvalExpression() uses the expression tree compiled by
9176 * SetExprFromAny() method of the "expression" object.
9178 * On success a Tcl Object containing the result of the evaluation
9179 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9180 * returned.
9181 * On error the function returns a retcode != to JIM_OK and set a suitable
9182 * error on the interp.
9183 * ---------------------------------------------------------------------------*/
9185 static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node)
9187 if (TOKEN_IS_EXPR_OP(node->type)) {
9188 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type);
9189 return op->funcop(interp, node);
9191 else {
9192 Jim_Obj *objPtr;
9194 /* A term */
9195 switch (node->type) {
9196 case JIM_TT_EXPR_INT:
9197 case JIM_TT_EXPR_DOUBLE:
9198 case JIM_TT_EXPR_BOOLEAN:
9199 case JIM_TT_STR:
9200 Jim_SetResult(interp, node->objPtr);
9201 return JIM_OK;
9203 case JIM_TT_VAR:
9204 objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG);
9205 if (objPtr) {
9206 Jim_SetResult(interp, objPtr);
9207 return JIM_OK;
9209 return JIM_ERR;
9211 case JIM_TT_DICTSUGAR:
9212 objPtr = JimExpandDictSugar(interp, node->objPtr);
9213 if (objPtr) {
9214 Jim_SetResult(interp, objPtr);
9215 return JIM_OK;
9217 return JIM_ERR;
9219 case JIM_TT_ESC:
9220 if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9221 Jim_SetResult(interp, objPtr);
9222 return JIM_OK;
9224 return JIM_ERR;
9226 case JIM_TT_CMD:
9227 return Jim_EvalObj(interp, node->objPtr);
9229 default:
9230 /* Should never get here */
9231 return JIM_ERR;
9236 static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr)
9238 int rc = JimExprEvalTermNode(interp, node);
9239 if (rc == JIM_OK) {
9240 *objPtrPtr = Jim_GetResult(interp);
9241 Jim_IncrRefCount(*objPtrPtr);
9243 return rc;
9246 static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node)
9248 if (JimExprEvalTermNode(interp, node) == JIM_OK) {
9249 return ExprBool(interp, Jim_GetResult(interp));
9251 return -1;
9254 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr)
9256 struct ExprTree *expr;
9257 int retcode = JIM_OK;
9259 expr = JimGetExpression(interp, exprObjPtr);
9260 if (!expr) {
9261 return JIM_ERR; /* error in expression. */
9264 #ifdef JIM_OPTIMIZATION
9265 /* Check for one of the following common expressions used by while/for
9267 * CONST
9268 * $a
9269 * !$a
9270 * $a < CONST, $a < $b
9271 * $a <= CONST, $a <= $b
9272 * $a > CONST, $a > $b
9273 * $a >= CONST, $a >= $b
9274 * $a != CONST, $a != $b
9275 * $a == CONST, $a == $b
9278 Jim_Obj *objPtr;
9280 /* STEP 1 -- Check if there are the conditions to run the specialized
9281 * version of while */
9283 switch (expr->len) {
9284 case 1:
9285 objPtr = JimExprIntValOrVar(interp, expr->expr);
9286 if (objPtr) {
9287 Jim_SetResult(interp, objPtr);
9288 return JIM_OK;
9290 break;
9292 case 2:
9293 if (expr->expr->type == JIM_EXPROP_NOT) {
9294 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9296 if (objPtr && JimIsWide(objPtr)) {
9297 Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9298 return JIM_OK;
9301 break;
9303 case 3:
9304 objPtr = JimExprIntValOrVar(interp, expr->expr->left);
9305 if (objPtr && JimIsWide(objPtr)) {
9306 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right);
9307 if (objPtr2 && JimIsWide(objPtr2)) {
9308 jim_wide wideValueA = JimWideValue(objPtr);
9309 jim_wide wideValueB = JimWideValue(objPtr2);
9310 int cmpRes;
9311 switch (expr->expr->type) {
9312 case JIM_EXPROP_LT:
9313 cmpRes = wideValueA < wideValueB;
9314 break;
9315 case JIM_EXPROP_LTE:
9316 cmpRes = wideValueA <= wideValueB;
9317 break;
9318 case JIM_EXPROP_GT:
9319 cmpRes = wideValueA > wideValueB;
9320 break;
9321 case JIM_EXPROP_GTE:
9322 cmpRes = wideValueA >= wideValueB;
9323 break;
9324 case JIM_EXPROP_NUMEQ:
9325 cmpRes = wideValueA == wideValueB;
9326 break;
9327 case JIM_EXPROP_NUMNE:
9328 cmpRes = wideValueA != wideValueB;
9329 break;
9330 default:
9331 goto noopt;
9333 Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9334 return JIM_OK;
9337 break;
9340 noopt:
9341 #endif
9343 /* In order to avoid the internal repr being freed due to
9344 * shimmering of the exprObjPtr's object, we make the internal rep
9345 * shared. */
9346 expr->inUse++;
9348 /* Evaluate with the recursive expr engine */
9349 retcode = JimExprEvalTermNode(interp, expr->expr);
9351 expr->inUse--;
9353 return retcode;
9356 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9358 int retcode = Jim_EvalExpression(interp, exprObjPtr);
9360 if (retcode == JIM_OK) {
9361 switch (ExprBool(interp, Jim_GetResult(interp))) {
9362 case 0:
9363 *boolPtr = 0;
9364 break;
9366 case 1:
9367 *boolPtr = 1;
9368 break;
9370 case -1:
9371 retcode = JIM_ERR;
9372 break;
9375 return retcode;
9378 /* -----------------------------------------------------------------------------
9379 * ScanFormat String Object
9380 * ---------------------------------------------------------------------------*/
9382 /* This Jim_Obj will held a parsed representation of a format string passed to
9383 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9384 * to be parsed in its entirely first and then, if correct, can be used for
9385 * scanning. To avoid endless re-parsing, the parsed representation will be
9386 * stored in an internal representation and re-used for performance reason. */
9388 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9389 * scanformat string. This part will later be used to extract information
9390 * out from the string to be parsed by Jim_ScanString */
9392 typedef struct ScanFmtPartDescr
9394 char *arg; /* Specification of a CHARSET conversion */
9395 char *prefix; /* Prefix to be scanned literally before conversion */
9396 size_t width; /* Maximal width of input to be converted */
9397 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9398 char type; /* Type of conversion (e.g. c, d, f) */
9399 char modifier; /* Modify type (e.g. l - long, h - short */
9400 } ScanFmtPartDescr;
9402 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9403 * string parsed and separated in part descriptions. Furthermore it contains
9404 * the original string representation of the scanformat string to allow for
9405 * fast update of the Jim_Obj's string representation part.
9407 * As an add-on the internal object representation adds some scratch pad area
9408 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9409 * memory for purpose of string scanning.
9411 * The error member points to a static allocated string in case of a mal-
9412 * formed scanformat string or it contains '0' (NULL) in case of a valid
9413 * parse representation.
9415 * The whole memory of the internal representation is allocated as a single
9416 * area of memory that will be internally separated. So freeing and duplicating
9417 * of such an object is cheap */
9419 typedef struct ScanFmtStringObj
9421 jim_wide size; /* Size of internal repr in bytes */
9422 char *stringRep; /* Original string representation */
9423 size_t count; /* Number of ScanFmtPartDescr contained */
9424 size_t convCount; /* Number of conversions that will assign */
9425 size_t maxPos; /* Max position index if XPG3 is used */
9426 const char *error; /* Ptr to error text (NULL if no error */
9427 char *scratch; /* Some scratch pad used by Jim_ScanString */
9428 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9429 } ScanFmtStringObj;
9432 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9433 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9434 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9436 static const Jim_ObjType scanFmtStringObjType = {
9437 "scanformatstring",
9438 FreeScanFmtInternalRep,
9439 DupScanFmtInternalRep,
9440 UpdateStringOfScanFmt,
9441 JIM_TYPE_NONE,
9444 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9446 JIM_NOTUSED(interp);
9447 Jim_Free((char *)objPtr->internalRep.ptr);
9448 objPtr->internalRep.ptr = 0;
9451 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9453 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9454 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9456 JIM_NOTUSED(interp);
9457 memcpy(newVec, srcPtr->internalRep.ptr, size);
9458 dupPtr->internalRep.ptr = newVec;
9459 dupPtr->typePtr = &scanFmtStringObjType;
9462 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9464 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9467 /* SetScanFmtFromAny will parse a given string and create the internal
9468 * representation of the format specification. In case of an error
9469 * the error data member of the internal representation will be set
9470 * to an descriptive error text and the function will be left with
9471 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9472 * specification */
9474 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9476 ScanFmtStringObj *fmtObj;
9477 char *buffer;
9478 int maxCount, i, approxSize, lastPos = -1;
9479 const char *fmt = Jim_String(objPtr);
9480 int maxFmtLen = Jim_Length(objPtr);
9481 const char *fmtEnd = fmt + maxFmtLen;
9482 int curr;
9484 Jim_FreeIntRep(interp, objPtr);
9485 /* Count how many conversions could take place maximally */
9486 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9487 if (fmt[i] == '%')
9488 ++maxCount;
9489 /* Calculate an approximation of the memory necessary */
9490 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9491 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9492 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9493 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9494 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9495 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9496 +1; /* safety byte */
9497 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9498 memset(fmtObj, 0, approxSize);
9499 fmtObj->size = approxSize;
9500 fmtObj->maxPos = 0;
9501 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9502 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9503 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9504 buffer = fmtObj->stringRep + maxFmtLen + 1;
9505 objPtr->internalRep.ptr = fmtObj;
9506 objPtr->typePtr = &scanFmtStringObjType;
9507 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9508 int width = 0, skip;
9509 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9511 fmtObj->count++;
9512 descr->width = 0; /* Assume width unspecified */
9513 /* Overread and store any "literal" prefix */
9514 if (*fmt != '%' || fmt[1] == '%') {
9515 descr->type = 0;
9516 descr->prefix = &buffer[i];
9517 for (; fmt < fmtEnd; ++fmt) {
9518 if (*fmt == '%') {
9519 if (fmt[1] != '%')
9520 break;
9521 ++fmt;
9523 buffer[i++] = *fmt;
9525 buffer[i++] = 0;
9527 /* Skip the conversion introducing '%' sign */
9528 ++fmt;
9529 /* End reached due to non-conversion literal only? */
9530 if (fmt >= fmtEnd)
9531 goto done;
9532 descr->pos = 0; /* Assume "natural" positioning */
9533 if (*fmt == '*') {
9534 descr->pos = -1; /* Okay, conversion will not be assigned */
9535 ++fmt;
9537 else
9538 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9539 /* Check if next token is a number (could be width or pos */
9540 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9541 fmt += skip;
9542 /* Was the number a XPG3 position specifier? */
9543 if (descr->pos != -1 && *fmt == '$') {
9544 int prev;
9546 ++fmt;
9547 descr->pos = width;
9548 width = 0;
9549 /* Look if "natural" postioning and XPG3 one was mixed */
9550 if ((lastPos == 0 && descr->pos > 0)
9551 || (lastPos > 0 && descr->pos == 0)) {
9552 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9553 return JIM_ERR;
9555 /* Look if this position was already used */
9556 for (prev = 0; prev < curr; ++prev) {
9557 if (fmtObj->descr[prev].pos == -1)
9558 continue;
9559 if (fmtObj->descr[prev].pos == descr->pos) {
9560 fmtObj->error =
9561 "variable is assigned by multiple \"%n$\" conversion specifiers";
9562 return JIM_ERR;
9565 if (descr->pos < 0) {
9566 fmtObj->error =
9567 "\"%n$\" conversion specifier is negative";
9568 return JIM_ERR;
9570 /* Try to find a width after the XPG3 specifier */
9571 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9572 descr->width = width;
9573 fmt += skip;
9575 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9576 fmtObj->maxPos = descr->pos;
9578 else {
9579 /* Number was not a XPG3, so it has to be a width */
9580 descr->width = width;
9583 /* If positioning mode was undetermined yet, fix this */
9584 if (lastPos == -1)
9585 lastPos = descr->pos;
9586 /* Handle CHARSET conversion type ... */
9587 if (*fmt == '[') {
9588 int swapped = 1, beg = i, end, j;
9590 descr->type = '[';
9591 descr->arg = &buffer[i];
9592 ++fmt;
9593 if (*fmt == '^')
9594 buffer[i++] = *fmt++;
9595 if (*fmt == ']')
9596 buffer[i++] = *fmt++;
9597 while (*fmt && *fmt != ']')
9598 buffer[i++] = *fmt++;
9599 if (*fmt != ']') {
9600 fmtObj->error = "unmatched [ in format string";
9601 return JIM_ERR;
9603 end = i;
9604 buffer[i++] = 0;
9605 /* In case a range fence was given "backwards", swap it */
9606 while (swapped) {
9607 swapped = 0;
9608 for (j = beg + 1; j < end - 1; ++j) {
9609 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9610 char tmp = buffer[j - 1];
9612 buffer[j - 1] = buffer[j + 1];
9613 buffer[j + 1] = tmp;
9614 swapped = 1;
9619 else {
9620 /* Remember any valid modifier if given */
9621 if (fmt < fmtEnd && strchr("hlL", *fmt))
9622 descr->modifier = tolower((int)*fmt++);
9624 if (fmt >= fmtEnd) {
9625 fmtObj->error = "missing scan conversion character";
9626 return JIM_ERR;
9629 descr->type = *fmt;
9630 if (strchr("efgcsndoxui", *fmt) == 0) {
9631 fmtObj->error = "bad scan conversion character";
9632 return JIM_ERR;
9634 else if (*fmt == 'c' && descr->width != 0) {
9635 fmtObj->error = "field width may not be specified in %c " "conversion";
9636 return JIM_ERR;
9638 else if (*fmt == 'u' && descr->modifier == 'l') {
9639 fmtObj->error = "unsigned wide not supported";
9640 return JIM_ERR;
9643 curr++;
9645 done:
9646 return JIM_OK;
9649 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9651 #define FormatGetCnvCount(_fo_) \
9652 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9653 #define FormatGetMaxPos(_fo_) \
9654 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9655 #define FormatGetError(_fo_) \
9656 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9658 /* JimScanAString is used to scan an unspecified string that ends with
9659 * next WS, or a string that is specified via a charset.
9662 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9664 char *buffer = Jim_StrDup(str);
9665 char *p = buffer;
9667 while (*str) {
9668 int c;
9669 int n;
9671 if (!sdescr && isspace(UCHAR(*str)))
9672 break; /* EOS via WS if unspecified */
9674 n = utf8_tounicode(str, &c);
9675 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9676 break;
9677 while (n--)
9678 *p++ = *str++;
9680 *p = 0;
9681 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9684 /* ScanOneEntry will scan one entry out of the string passed as argument.
9685 * It use the sscanf() function for this task. After extracting and
9686 * converting of the value, the count of scanned characters will be
9687 * returned of -1 in case of no conversion tool place and string was
9688 * already scanned thru */
9690 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9691 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9693 const char *tok;
9694 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9695 size_t scanned = 0;
9696 size_t anchor = pos;
9697 int i;
9698 Jim_Obj *tmpObj = NULL;
9700 /* First pessimistically assume, we will not scan anything :-) */
9701 *valObjPtr = 0;
9702 if (descr->prefix) {
9703 /* There was a prefix given before the conversion, skip it and adjust
9704 * the string-to-be-parsed accordingly */
9705 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9706 /* If prefix require, skip WS */
9707 if (isspace(UCHAR(descr->prefix[i])))
9708 while (pos < strLen && isspace(UCHAR(str[pos])))
9709 ++pos;
9710 else if (descr->prefix[i] != str[pos])
9711 break; /* Prefix do not match here, leave the loop */
9712 else
9713 ++pos; /* Prefix matched so far, next round */
9715 if (pos >= strLen) {
9716 return -1; /* All of str consumed: EOF condition */
9718 else if (descr->prefix[i] != 0)
9719 return 0; /* Not whole prefix consumed, no conversion possible */
9721 /* For all but following conversion, skip leading WS */
9722 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9723 while (isspace(UCHAR(str[pos])))
9724 ++pos;
9725 /* Determine how much skipped/scanned so far */
9726 scanned = pos - anchor;
9728 /* %c is a special, simple case. no width */
9729 if (descr->type == 'n') {
9730 /* Return pseudo conversion means: how much scanned so far? */
9731 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9733 else if (pos >= strLen) {
9734 /* Cannot scan anything, as str is totally consumed */
9735 return -1;
9737 else if (descr->type == 'c') {
9738 int c;
9739 scanned += utf8_tounicode(&str[pos], &c);
9740 *valObjPtr = Jim_NewIntObj(interp, c);
9741 return scanned;
9743 else {
9744 /* Processing of conversions follows ... */
9745 if (descr->width > 0) {
9746 /* Do not try to scan as fas as possible but only the given width.
9747 * To ensure this, we copy the part that should be scanned. */
9748 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9749 size_t tLen = descr->width > sLen ? sLen : descr->width;
9751 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9752 tok = tmpObj->bytes;
9754 else {
9755 /* As no width was given, simply refer to the original string */
9756 tok = &str[pos];
9758 switch (descr->type) {
9759 case 'd':
9760 case 'o':
9761 case 'x':
9762 case 'u':
9763 case 'i':{
9764 char *endp; /* Position where the number finished */
9765 jim_wide w;
9767 int base = descr->type == 'o' ? 8
9768 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9770 /* Try to scan a number with the given base */
9771 if (base == 0) {
9772 w = jim_strtoull(tok, &endp);
9774 else {
9775 w = strtoull(tok, &endp, base);
9778 if (endp != tok) {
9779 /* There was some number sucessfully scanned! */
9780 *valObjPtr = Jim_NewIntObj(interp, w);
9782 /* Adjust the number-of-chars scanned so far */
9783 scanned += endp - tok;
9785 else {
9786 /* Nothing was scanned. We have to determine if this
9787 * happened due to e.g. prefix mismatch or input str
9788 * exhausted */
9789 scanned = *tok ? 0 : -1;
9791 break;
9793 case 's':
9794 case '[':{
9795 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9796 scanned += Jim_Length(*valObjPtr);
9797 break;
9799 case 'e':
9800 case 'f':
9801 case 'g':{
9802 char *endp;
9803 double value = strtod(tok, &endp);
9805 if (endp != tok) {
9806 /* There was some number sucessfully scanned! */
9807 *valObjPtr = Jim_NewDoubleObj(interp, value);
9808 /* Adjust the number-of-chars scanned so far */
9809 scanned += endp - tok;
9811 else {
9812 /* Nothing was scanned. We have to determine if this
9813 * happened due to e.g. prefix mismatch or input str
9814 * exhausted */
9815 scanned = *tok ? 0 : -1;
9817 break;
9820 /* If a substring was allocated (due to pre-defined width) do not
9821 * forget to free it */
9822 if (tmpObj) {
9823 Jim_FreeNewObj(interp, tmpObj);
9826 return scanned;
9829 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9830 * string and returns all converted (and not ignored) values in a list back
9831 * to the caller. If an error occured, a NULL pointer will be returned */
9833 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9835 size_t i, pos;
9836 int scanned = 1;
9837 const char *str = Jim_String(strObjPtr);
9838 int strLen = Jim_Utf8Length(interp, strObjPtr);
9839 Jim_Obj *resultList = 0;
9840 Jim_Obj **resultVec = 0;
9841 int resultc;
9842 Jim_Obj *emptyStr = 0;
9843 ScanFmtStringObj *fmtObj;
9845 /* This should never happen. The format object should already be of the correct type */
9846 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9848 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9849 /* Check if format specification was valid */
9850 if (fmtObj->error != 0) {
9851 if (flags & JIM_ERRMSG)
9852 Jim_SetResultString(interp, fmtObj->error, -1);
9853 return 0;
9855 /* Allocate a new "shared" empty string for all unassigned conversions */
9856 emptyStr = Jim_NewEmptyStringObj(interp);
9857 Jim_IncrRefCount(emptyStr);
9858 /* Create a list and fill it with empty strings up to max specified XPG3 */
9859 resultList = Jim_NewListObj(interp, NULL, 0);
9860 if (fmtObj->maxPos > 0) {
9861 for (i = 0; i < fmtObj->maxPos; ++i)
9862 Jim_ListAppendElement(interp, resultList, emptyStr);
9863 JimListGetElements(interp, resultList, &resultc, &resultVec);
9865 /* Now handle every partial format description */
9866 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9867 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9868 Jim_Obj *value = 0;
9870 /* Only last type may be "literal" w/o conversion - skip it! */
9871 if (descr->type == 0)
9872 continue;
9873 /* As long as any conversion could be done, we will proceed */
9874 if (scanned > 0)
9875 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9876 /* In case our first try results in EOF, we will leave */
9877 if (scanned == -1 && i == 0)
9878 goto eof;
9879 /* Advance next pos-to-be-scanned for the amount scanned already */
9880 pos += scanned;
9882 /* value == 0 means no conversion took place so take empty string */
9883 if (value == 0)
9884 value = Jim_NewEmptyStringObj(interp);
9885 /* If value is a non-assignable one, skip it */
9886 if (descr->pos == -1) {
9887 Jim_FreeNewObj(interp, value);
9889 else if (descr->pos == 0)
9890 /* Otherwise append it to the result list if no XPG3 was given */
9891 Jim_ListAppendElement(interp, resultList, value);
9892 else if (resultVec[descr->pos - 1] == emptyStr) {
9893 /* But due to given XPG3, put the value into the corr. slot */
9894 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9895 Jim_IncrRefCount(value);
9896 resultVec[descr->pos - 1] = value;
9898 else {
9899 /* Otherwise, the slot was already used - free obj and ERROR */
9900 Jim_FreeNewObj(interp, value);
9901 goto err;
9904 Jim_DecrRefCount(interp, emptyStr);
9905 return resultList;
9906 eof:
9907 Jim_DecrRefCount(interp, emptyStr);
9908 Jim_FreeNewObj(interp, resultList);
9909 return (Jim_Obj *)EOF;
9910 err:
9911 Jim_DecrRefCount(interp, emptyStr);
9912 Jim_FreeNewObj(interp, resultList);
9913 return 0;
9916 /* -----------------------------------------------------------------------------
9917 * Pseudo Random Number Generation
9918 * ---------------------------------------------------------------------------*/
9919 /* Initialize the sbox with the numbers from 0 to 255 */
9920 static void JimPrngInit(Jim_Interp *interp)
9922 #define PRNG_SEED_SIZE 256
9923 int i;
9924 unsigned int *seed;
9925 time_t t = time(NULL);
9927 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9929 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9930 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9931 seed[i] = (rand() ^ t ^ clock());
9933 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9934 Jim_Free(seed);
9937 /* Generates N bytes of random data */
9938 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9940 Jim_PrngState *prng;
9941 unsigned char *destByte = (unsigned char *)dest;
9942 unsigned int si, sj, x;
9944 /* initialization, only needed the first time */
9945 if (interp->prngState == NULL)
9946 JimPrngInit(interp);
9947 prng = interp->prngState;
9948 /* generates 'len' bytes of pseudo-random numbers */
9949 for (x = 0; x < len; x++) {
9950 prng->i = (prng->i + 1) & 0xff;
9951 si = prng->sbox[prng->i];
9952 prng->j = (prng->j + si) & 0xff;
9953 sj = prng->sbox[prng->j];
9954 prng->sbox[prng->i] = sj;
9955 prng->sbox[prng->j] = si;
9956 *destByte++ = prng->sbox[(si + sj) & 0xff];
9960 /* Re-seed the generator with user-provided bytes */
9961 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
9963 int i;
9964 Jim_PrngState *prng;
9966 /* initialization, only needed the first time */
9967 if (interp->prngState == NULL)
9968 JimPrngInit(interp);
9969 prng = interp->prngState;
9971 /* Set the sbox[i] with i */
9972 for (i = 0; i < 256; i++)
9973 prng->sbox[i] = i;
9974 /* Now use the seed to perform a random permutation of the sbox */
9975 for (i = 0; i < seedLen; i++) {
9976 unsigned char t;
9978 t = prng->sbox[i & 0xFF];
9979 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
9980 prng->sbox[seed[i]] = t;
9982 prng->i = prng->j = 0;
9984 /* discard at least the first 256 bytes of stream.
9985 * borrow the seed buffer for this
9987 for (i = 0; i < 256; i += seedLen) {
9988 JimRandomBytes(interp, seed, seedLen);
9992 /* [incr] */
9993 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
9995 jim_wide wideValue, increment = 1;
9996 Jim_Obj *intObjPtr;
9998 if (argc != 2 && argc != 3) {
9999 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10000 return JIM_ERR;
10002 if (argc == 3) {
10003 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10004 return JIM_ERR;
10006 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10007 if (!intObjPtr) {
10008 /* Set missing variable to 0 */
10009 wideValue = 0;
10011 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10012 return JIM_ERR;
10014 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10015 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10016 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10017 Jim_FreeNewObj(interp, intObjPtr);
10018 return JIM_ERR;
10021 else {
10022 /* Can do it the quick way */
10023 Jim_InvalidateStringRep(intObjPtr);
10024 JimWideValue(intObjPtr) = wideValue + increment;
10026 /* The following step is required in order to invalidate the
10027 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10028 if (argv[1]->typePtr != &variableObjType) {
10029 /* Note that this can't fail since GetVariable already succeeded */
10030 Jim_SetVariable(interp, argv[1], intObjPtr);
10033 Jim_SetResult(interp, intObjPtr);
10034 return JIM_OK;
10038 /* -----------------------------------------------------------------------------
10039 * Eval
10040 * ---------------------------------------------------------------------------*/
10041 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10042 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10044 /* Handle calls to the [unknown] command */
10045 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10047 int retcode;
10049 /* If JimUnknown() is recursively called too many times...
10050 * done here
10052 if (interp->unknown_called > 50) {
10053 return JIM_ERR;
10056 /* The object interp->unknown just contains
10057 * the "unknown" string, it is used in order to
10058 * avoid to lookup the unknown command every time
10059 * but instead to cache the result. */
10061 /* If the [unknown] command does not exist ... */
10062 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10063 return JIM_ERR;
10065 interp->unknown_called++;
10066 /* XXX: Are we losing fileNameObj and linenr? */
10067 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10068 interp->unknown_called--;
10070 return retcode;
10073 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10075 int retcode;
10076 Jim_Cmd *cmdPtr;
10078 #if 0
10079 printf("invoke");
10080 int j;
10081 for (j = 0; j < objc; j++) {
10082 printf(" '%s'", Jim_String(objv[j]));
10084 printf("\n");
10085 #endif
10087 if (interp->framePtr->tailcallCmd) {
10088 /* Special tailcall command was pre-resolved */
10089 cmdPtr = interp->framePtr->tailcallCmd;
10090 interp->framePtr->tailcallCmd = NULL;
10092 else {
10093 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10094 if (cmdPtr == NULL) {
10095 return JimUnknown(interp, objc, objv);
10097 JimIncrCmdRefCount(cmdPtr);
10100 if (interp->evalDepth == interp->maxEvalDepth) {
10101 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10102 retcode = JIM_ERR;
10103 goto out;
10105 interp->evalDepth++;
10107 /* Call it -- Make sure result is an empty object. */
10108 Jim_SetEmptyResult(interp);
10109 if (cmdPtr->isproc) {
10110 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10112 else {
10113 interp->cmdPrivData = cmdPtr->u.native.privData;
10114 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10116 interp->evalDepth--;
10118 out:
10119 JimDecrCmdRefCount(interp, cmdPtr);
10121 return retcode;
10124 /* Eval the object vector 'objv' composed of 'objc' elements.
10125 * Every element is used as single argument.
10126 * Jim_EvalObj() will call this function every time its object
10127 * argument is of "list" type, with no string representation.
10129 * This is possible because the string representation of a
10130 * list object generated by the UpdateStringOfList is made
10131 * in a way that ensures that every list element is a different
10132 * command argument. */
10133 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10135 int i, retcode;
10137 /* Incr refcount of arguments. */
10138 for (i = 0; i < objc; i++)
10139 Jim_IncrRefCount(objv[i]);
10141 retcode = JimInvokeCommand(interp, objc, objv);
10143 /* Decr refcount of arguments and return the retcode */
10144 for (i = 0; i < objc; i++)
10145 Jim_DecrRefCount(interp, objv[i]);
10147 return retcode;
10151 * Invokes 'prefix' as a command with the objv array as arguments.
10153 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10155 int ret;
10156 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10158 nargv[0] = prefix;
10159 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10160 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10161 Jim_Free(nargv);
10162 return ret;
10165 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10167 if (!interp->errorFlag) {
10168 /* This is the first error, so save the file/line information and reset the stack */
10169 interp->errorFlag = 1;
10170 Jim_IncrRefCount(script->fileNameObj);
10171 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10172 interp->errorFileNameObj = script->fileNameObj;
10173 interp->errorLine = script->linenr;
10175 JimResetStackTrace(interp);
10176 /* Always add a level where the error first occurs */
10177 interp->addStackTrace++;
10180 /* Now if this is an "interesting" level, add it to the stack trace */
10181 if (interp->addStackTrace > 0) {
10182 /* Add the stack info for the current level */
10184 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10186 /* Note: if we didn't have a filename for this level,
10187 * don't clear the addStackTrace flag
10188 * so we can pick it up at the next level
10190 if (Jim_Length(script->fileNameObj)) {
10191 interp->addStackTrace = 0;
10194 Jim_DecrRefCount(interp, interp->errorProc);
10195 interp->errorProc = interp->emptyObj;
10196 Jim_IncrRefCount(interp->errorProc);
10200 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10202 Jim_Obj *objPtr;
10204 switch (token->type) {
10205 case JIM_TT_STR:
10206 case JIM_TT_ESC:
10207 objPtr = token->objPtr;
10208 break;
10209 case JIM_TT_VAR:
10210 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10211 break;
10212 case JIM_TT_DICTSUGAR:
10213 objPtr = JimExpandDictSugar(interp, token->objPtr);
10214 break;
10215 case JIM_TT_EXPRSUGAR:
10216 objPtr = JimExpandExprSugar(interp, token->objPtr);
10217 break;
10218 case JIM_TT_CMD:
10219 switch (Jim_EvalObj(interp, token->objPtr)) {
10220 case JIM_OK:
10221 case JIM_RETURN:
10222 objPtr = interp->result;
10223 break;
10224 case JIM_BREAK:
10225 /* Stop substituting */
10226 return JIM_BREAK;
10227 case JIM_CONTINUE:
10228 /* just skip this one */
10229 return JIM_CONTINUE;
10230 default:
10231 return JIM_ERR;
10233 break;
10234 default:
10235 JimPanic((1,
10236 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10237 objPtr = NULL;
10238 break;
10240 if (objPtr) {
10241 *objPtrPtr = objPtr;
10242 return JIM_OK;
10244 return JIM_ERR;
10247 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10248 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10249 * The returned object has refcount = 0.
10251 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10253 int totlen = 0, i;
10254 Jim_Obj **intv;
10255 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10256 Jim_Obj *objPtr;
10257 char *s;
10259 if (tokens <= JIM_EVAL_SINTV_LEN)
10260 intv = sintv;
10261 else
10262 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10264 /* Compute every token forming the argument
10265 * in the intv objects vector. */
10266 for (i = 0; i < tokens; i++) {
10267 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10268 case JIM_OK:
10269 case JIM_RETURN:
10270 break;
10271 case JIM_BREAK:
10272 if (flags & JIM_SUBST_FLAG) {
10273 /* Stop here */
10274 tokens = i;
10275 continue;
10277 /* XXX: Should probably set an error about break outside loop */
10278 /* fall through to error */
10279 case JIM_CONTINUE:
10280 if (flags & JIM_SUBST_FLAG) {
10281 intv[i] = NULL;
10282 continue;
10284 /* XXX: Ditto continue outside loop */
10285 /* fall through to error */
10286 default:
10287 while (i--) {
10288 Jim_DecrRefCount(interp, intv[i]);
10290 if (intv != sintv) {
10291 Jim_Free(intv);
10293 return NULL;
10295 Jim_IncrRefCount(intv[i]);
10296 Jim_String(intv[i]);
10297 totlen += intv[i]->length;
10300 /* Fast path return for a single token */
10301 if (tokens == 1 && intv[0] && intv == sintv) {
10302 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10303 intv[0]->refCount--;
10304 return intv[0];
10307 /* Concatenate every token in an unique
10308 * object. */
10309 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10311 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10312 && token[2].type == JIM_TT_VAR) {
10313 /* May be able to do fast interpolated object -> dictSubst */
10314 objPtr->typePtr = &interpolatedObjType;
10315 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10316 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10317 Jim_IncrRefCount(intv[2]);
10319 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10320 /* The first interpolated token is source, so preserve the source info */
10321 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10325 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10326 objPtr->length = totlen;
10327 for (i = 0; i < tokens; i++) {
10328 if (intv[i]) {
10329 memcpy(s, intv[i]->bytes, intv[i]->length);
10330 s += intv[i]->length;
10331 Jim_DecrRefCount(interp, intv[i]);
10334 objPtr->bytes[totlen] = '\0';
10335 /* Free the intv vector if not static. */
10336 if (intv != sintv) {
10337 Jim_Free(intv);
10340 return objPtr;
10344 /* listPtr *must* be a list.
10345 * The contents of the list is evaluated with the first element as the command and
10346 * the remaining elements as the arguments.
10348 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10350 int retcode = JIM_OK;
10352 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10354 if (listPtr->internalRep.listValue.len) {
10355 Jim_IncrRefCount(listPtr);
10356 retcode = JimInvokeCommand(interp,
10357 listPtr->internalRep.listValue.len,
10358 listPtr->internalRep.listValue.ele);
10359 Jim_DecrRefCount(interp, listPtr);
10361 return retcode;
10364 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10366 SetListFromAny(interp, listPtr);
10367 return JimEvalObjList(interp, listPtr);
10370 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10372 int i;
10373 ScriptObj *script;
10374 ScriptToken *token;
10375 int retcode = JIM_OK;
10376 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10377 Jim_Obj *prevScriptObj;
10379 /* If the object is of type "list", with no string rep we can call
10380 * a specialized version of Jim_EvalObj() */
10381 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10382 return JimEvalObjList(interp, scriptObjPtr);
10385 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10386 script = JimGetScript(interp, scriptObjPtr);
10387 if (!JimScriptValid(interp, script)) {
10388 Jim_DecrRefCount(interp, scriptObjPtr);
10389 return JIM_ERR;
10392 /* Reset the interpreter result. This is useful to
10393 * return the empty result in the case of empty program. */
10394 Jim_SetEmptyResult(interp);
10396 token = script->token;
10398 #ifdef JIM_OPTIMIZATION
10399 /* Check for one of the following common scripts used by for, while
10401 * {}
10402 * incr a
10404 if (script->len == 0) {
10405 Jim_DecrRefCount(interp, scriptObjPtr);
10406 return JIM_OK;
10408 if (script->len == 3
10409 && token[1].objPtr->typePtr == &commandObjType
10410 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10411 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10412 && token[2].objPtr->typePtr == &variableObjType) {
10414 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10416 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10417 JimWideValue(objPtr)++;
10418 Jim_InvalidateStringRep(objPtr);
10419 Jim_DecrRefCount(interp, scriptObjPtr);
10420 Jim_SetResult(interp, objPtr);
10421 return JIM_OK;
10424 #endif
10426 /* Now we have to make sure the internal repr will not be
10427 * freed on shimmering.
10429 * Think for example to this:
10431 * set x {llength $x; ... some more code ...}; eval $x
10433 * In order to preserve the internal rep, we increment the
10434 * inUse field of the script internal rep structure. */
10435 script->inUse++;
10437 /* Stash the current script */
10438 prevScriptObj = interp->currentScriptObj;
10439 interp->currentScriptObj = scriptObjPtr;
10441 interp->errorFlag = 0;
10442 argv = sargv;
10444 /* Execute every command sequentially until the end of the script
10445 * or an error occurs.
10447 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10448 int argc;
10449 int j;
10451 /* First token of the line is always JIM_TT_LINE */
10452 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10453 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10455 /* Allocate the arguments vector if required */
10456 if (argc > JIM_EVAL_SARGV_LEN)
10457 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10459 /* Skip the JIM_TT_LINE token */
10460 i++;
10462 /* Populate the arguments objects.
10463 * If an error occurs, retcode will be set and
10464 * 'j' will be set to the number of args expanded
10466 for (j = 0; j < argc; j++) {
10467 long wordtokens = 1;
10468 int expand = 0;
10469 Jim_Obj *wordObjPtr = NULL;
10471 if (token[i].type == JIM_TT_WORD) {
10472 wordtokens = JimWideValue(token[i++].objPtr);
10473 if (wordtokens < 0) {
10474 expand = 1;
10475 wordtokens = -wordtokens;
10479 if (wordtokens == 1) {
10480 /* Fast path if the token does not
10481 * need interpolation */
10483 switch (token[i].type) {
10484 case JIM_TT_ESC:
10485 case JIM_TT_STR:
10486 wordObjPtr = token[i].objPtr;
10487 break;
10488 case JIM_TT_VAR:
10489 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10490 break;
10491 case JIM_TT_EXPRSUGAR:
10492 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10493 break;
10494 case JIM_TT_DICTSUGAR:
10495 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10496 break;
10497 case JIM_TT_CMD:
10498 retcode = Jim_EvalObj(interp, token[i].objPtr);
10499 if (retcode == JIM_OK) {
10500 wordObjPtr = Jim_GetResult(interp);
10502 break;
10503 default:
10504 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10507 else {
10508 /* For interpolation we call a helper
10509 * function to do the work for us. */
10510 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10513 if (!wordObjPtr) {
10514 if (retcode == JIM_OK) {
10515 retcode = JIM_ERR;
10517 break;
10520 Jim_IncrRefCount(wordObjPtr);
10521 i += wordtokens;
10523 if (!expand) {
10524 argv[j] = wordObjPtr;
10526 else {
10527 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10528 int len = Jim_ListLength(interp, wordObjPtr);
10529 int newargc = argc + len - 1;
10530 int k;
10532 if (len > 1) {
10533 if (argv == sargv) {
10534 if (newargc > JIM_EVAL_SARGV_LEN) {
10535 argv = Jim_Alloc(sizeof(*argv) * newargc);
10536 memcpy(argv, sargv, sizeof(*argv) * j);
10539 else {
10540 /* Need to realloc to make room for (len - 1) more entries */
10541 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10545 /* Now copy in the expanded version */
10546 for (k = 0; k < len; k++) {
10547 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10548 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10551 /* The original object reference is no longer needed,
10552 * after the expansion it is no longer present on
10553 * the argument vector, but the single elements are
10554 * in its place. */
10555 Jim_DecrRefCount(interp, wordObjPtr);
10557 /* And update the indexes */
10558 j--;
10559 argc += len - 1;
10563 if (retcode == JIM_OK && argc) {
10564 /* Invoke the command */
10565 retcode = JimInvokeCommand(interp, argc, argv);
10566 /* Check for a signal after each command */
10567 if (Jim_CheckSignal(interp)) {
10568 retcode = JIM_SIGNAL;
10572 /* Finished with the command, so decrement ref counts of each argument */
10573 while (j-- > 0) {
10574 Jim_DecrRefCount(interp, argv[j]);
10577 if (argv != sargv) {
10578 Jim_Free(argv);
10579 argv = sargv;
10583 /* Possibly add to the error stack trace */
10584 if (retcode == JIM_ERR) {
10585 JimAddErrorToStack(interp, script);
10587 /* Propagate the addStackTrace value through 'return -code error' */
10588 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10589 /* No need to add stack trace */
10590 interp->addStackTrace = 0;
10593 /* Restore the current script */
10594 interp->currentScriptObj = prevScriptObj;
10596 /* Note that we don't have to decrement inUse, because the
10597 * following code transfers our use of the reference again to
10598 * the script object. */
10599 Jim_FreeIntRep(interp, scriptObjPtr);
10600 scriptObjPtr->typePtr = &scriptObjType;
10601 Jim_SetIntRepPtr(scriptObjPtr, script);
10602 Jim_DecrRefCount(interp, scriptObjPtr);
10604 return retcode;
10607 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10609 int retcode;
10610 /* If argObjPtr begins with '&', do an automatic upvar */
10611 const char *varname = Jim_String(argNameObj);
10612 if (*varname == '&') {
10613 /* First check that the target variable exists */
10614 Jim_Obj *objPtr;
10615 Jim_CallFrame *savedCallFrame = interp->framePtr;
10617 interp->framePtr = interp->framePtr->parent;
10618 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10619 interp->framePtr = savedCallFrame;
10620 if (!objPtr) {
10621 return JIM_ERR;
10624 /* It exists, so perform the binding. */
10625 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10626 Jim_IncrRefCount(objPtr);
10627 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10628 Jim_DecrRefCount(interp, objPtr);
10630 else {
10631 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10633 return retcode;
10637 * Sets the interp result to be an error message indicating the required proc args.
10639 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10641 /* Create a nice error message, consistent with Tcl 8.5 */
10642 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10643 int i;
10645 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10646 Jim_AppendString(interp, argmsg, " ", 1);
10648 if (i == cmd->u.proc.argsPos) {
10649 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10650 /* Renamed args */
10651 Jim_AppendString(interp, argmsg, "?", 1);
10652 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10653 Jim_AppendString(interp, argmsg, " ...?", -1);
10655 else {
10656 /* We have plain args */
10657 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10660 else {
10661 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10662 Jim_AppendString(interp, argmsg, "?", 1);
10663 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10664 Jim_AppendString(interp, argmsg, "?", 1);
10666 else {
10667 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10668 if (*arg == '&') {
10669 arg++;
10671 Jim_AppendString(interp, argmsg, arg, -1);
10675 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10678 #ifdef jim_ext_namespace
10680 * [namespace eval]
10682 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10684 Jim_CallFrame *callFramePtr;
10685 int retcode;
10687 /* Create a new callframe */
10688 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10689 callFramePtr->argv = &interp->emptyObj;
10690 callFramePtr->argc = 0;
10691 callFramePtr->procArgsObjPtr = NULL;
10692 callFramePtr->procBodyObjPtr = scriptObj;
10693 callFramePtr->staticVars = NULL;
10694 callFramePtr->fileNameObj = interp->emptyObj;
10695 callFramePtr->line = 0;
10696 Jim_IncrRefCount(scriptObj);
10697 interp->framePtr = callFramePtr;
10699 /* Check if there are too nested calls */
10700 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10701 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10702 retcode = JIM_ERR;
10704 else {
10705 /* Eval the body */
10706 retcode = Jim_EvalObj(interp, scriptObj);
10709 /* Destroy the callframe */
10710 interp->framePtr = interp->framePtr->parent;
10711 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10713 return retcode;
10715 #endif
10717 /* Call a procedure implemented in Tcl.
10718 * It's possible to speed-up a lot this function, currently
10719 * the callframes are not cached, but allocated and
10720 * destroied every time. What is expecially costly is
10721 * to create/destroy the local vars hash table every time.
10723 * This can be fixed just implementing callframes caching
10724 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10725 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10727 Jim_CallFrame *callFramePtr;
10728 int i, d, retcode, optargs;
10729 ScriptObj *script;
10731 /* Check arity */
10732 if (argc - 1 < cmd->u.proc.reqArity ||
10733 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10734 JimSetProcWrongArgs(interp, argv[0], cmd);
10735 return JIM_ERR;
10738 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10739 /* Optimise for procedure with no body - useful for optional debugging */
10740 return JIM_OK;
10743 /* Check if there are too nested calls */
10744 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10745 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10746 return JIM_ERR;
10749 /* Create a new callframe */
10750 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10751 callFramePtr->argv = argv;
10752 callFramePtr->argc = argc;
10753 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10754 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10755 callFramePtr->staticVars = cmd->u.proc.staticVars;
10757 /* Remember where we were called from. */
10758 script = JimGetScript(interp, interp->currentScriptObj);
10759 callFramePtr->fileNameObj = script->fileNameObj;
10760 callFramePtr->line = script->linenr;
10762 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10763 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10764 interp->framePtr = callFramePtr;
10766 /* How many optional args are available */
10767 optargs = (argc - 1 - cmd->u.proc.reqArity);
10769 /* Step 'i' along the actual args, and step 'd' along the formal args */
10770 i = 1;
10771 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10772 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10773 if (d == cmd->u.proc.argsPos) {
10774 /* assign $args */
10775 Jim_Obj *listObjPtr;
10776 int argsLen = 0;
10777 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10778 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10780 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10782 /* It is possible to rename args. */
10783 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10784 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10786 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10787 if (retcode != JIM_OK) {
10788 goto badargset;
10791 i += argsLen;
10792 continue;
10795 /* Optional or required? */
10796 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10797 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10799 else {
10800 /* Ran out, so use the default */
10801 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10803 if (retcode != JIM_OK) {
10804 goto badargset;
10808 /* Eval the body */
10809 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10811 badargset:
10813 /* Free the callframe */
10814 interp->framePtr = interp->framePtr->parent;
10815 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10817 /* Now chain any tailcalls in the parent frame */
10818 if (interp->framePtr->tailcallObj) {
10819 do {
10820 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10822 interp->framePtr->tailcallObj = NULL;
10824 if (retcode == JIM_EVAL) {
10825 retcode = Jim_EvalObjList(interp, tailcallObj);
10826 if (retcode == JIM_RETURN) {
10827 /* If the result of the tailcall is 'return', push
10828 * it up to the caller
10830 interp->returnLevel++;
10833 Jim_DecrRefCount(interp, tailcallObj);
10834 } while (interp->framePtr->tailcallObj);
10836 /* If the tailcall chain finished early, may need to manually discard the command */
10837 if (interp->framePtr->tailcallCmd) {
10838 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10839 interp->framePtr->tailcallCmd = NULL;
10843 /* Handle the JIM_RETURN return code */
10844 if (retcode == JIM_RETURN) {
10845 if (--interp->returnLevel <= 0) {
10846 retcode = interp->returnCode;
10847 interp->returnCode = JIM_OK;
10848 interp->returnLevel = 0;
10851 else if (retcode == JIM_ERR) {
10852 interp->addStackTrace++;
10853 Jim_DecrRefCount(interp, interp->errorProc);
10854 interp->errorProc = argv[0];
10855 Jim_IncrRefCount(interp->errorProc);
10858 return retcode;
10861 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10863 int retval;
10864 Jim_Obj *scriptObjPtr;
10866 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10867 Jim_IncrRefCount(scriptObjPtr);
10869 if (filename) {
10870 Jim_Obj *prevScriptObj;
10872 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10874 prevScriptObj = interp->currentScriptObj;
10875 interp->currentScriptObj = scriptObjPtr;
10877 retval = Jim_EvalObj(interp, scriptObjPtr);
10879 interp->currentScriptObj = prevScriptObj;
10881 else {
10882 retval = Jim_EvalObj(interp, scriptObjPtr);
10884 Jim_DecrRefCount(interp, scriptObjPtr);
10885 return retval;
10888 int Jim_Eval(Jim_Interp *interp, const char *script)
10890 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10893 /* Execute script in the scope of the global level */
10894 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10896 int retval;
10897 Jim_CallFrame *savedFramePtr = interp->framePtr;
10899 interp->framePtr = interp->topFramePtr;
10900 retval = Jim_Eval(interp, script);
10901 interp->framePtr = savedFramePtr;
10903 return retval;
10906 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10908 int retval;
10909 Jim_CallFrame *savedFramePtr = interp->framePtr;
10911 interp->framePtr = interp->topFramePtr;
10912 retval = Jim_EvalFile(interp, filename);
10913 interp->framePtr = savedFramePtr;
10915 return retval;
10918 #include <sys/stat.h>
10920 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10922 FILE *fp;
10923 char *buf;
10924 Jim_Obj *scriptObjPtr;
10925 Jim_Obj *prevScriptObj;
10926 struct stat sb;
10927 int retcode;
10928 int readlen;
10930 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10931 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10932 return JIM_ERR;
10934 if (sb.st_size == 0) {
10935 fclose(fp);
10936 return JIM_OK;
10939 buf = Jim_Alloc(sb.st_size + 1);
10940 readlen = fread(buf, 1, sb.st_size, fp);
10941 if (ferror(fp)) {
10942 fclose(fp);
10943 Jim_Free(buf);
10944 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10945 return JIM_ERR;
10947 fclose(fp);
10948 buf[readlen] = 0;
10950 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10951 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
10952 Jim_IncrRefCount(scriptObjPtr);
10954 prevScriptObj = interp->currentScriptObj;
10955 interp->currentScriptObj = scriptObjPtr;
10957 retcode = Jim_EvalObj(interp, scriptObjPtr);
10959 /* Handle the JIM_RETURN return code */
10960 if (retcode == JIM_RETURN) {
10961 if (--interp->returnLevel <= 0) {
10962 retcode = interp->returnCode;
10963 interp->returnCode = JIM_OK;
10964 interp->returnLevel = 0;
10967 if (retcode == JIM_ERR) {
10968 /* EvalFile changes context, so add a stack frame here */
10969 interp->addStackTrace++;
10972 interp->currentScriptObj = prevScriptObj;
10974 Jim_DecrRefCount(interp, scriptObjPtr);
10976 return retcode;
10979 /* -----------------------------------------------------------------------------
10980 * Subst
10981 * ---------------------------------------------------------------------------*/
10982 static void JimParseSubst(struct JimParserCtx *pc, int flags)
10984 pc->tstart = pc->p;
10985 pc->tline = pc->linenr;
10987 if (pc->len == 0) {
10988 pc->tend = pc->p;
10989 pc->tt = JIM_TT_EOL;
10990 pc->eof = 1;
10991 return;
10993 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
10994 JimParseCmd(pc);
10995 return;
10997 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
10998 if (JimParseVar(pc) == JIM_OK) {
10999 return;
11001 /* Not a var, so treat as a string */
11002 pc->tstart = pc->p;
11003 flags |= JIM_SUBST_NOVAR;
11005 while (pc->len) {
11006 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11007 break;
11009 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11010 break;
11012 if (*pc->p == '\\' && pc->len > 1) {
11013 pc->p++;
11014 pc->len--;
11016 pc->p++;
11017 pc->len--;
11019 pc->tend = pc->p - 1;
11020 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11023 /* The subst object type reuses most of the data structures and functions
11024 * of the script object. Script's data structures are a bit more complex
11025 * for what is needed for [subst]itution tasks, but the reuse helps to
11026 * deal with a single data structure at the cost of some more memory
11027 * usage for substitutions. */
11029 /* This method takes the string representation of an object
11030 * as a Tcl string where to perform [subst]itution, and generates
11031 * the pre-parsed internal representation. */
11032 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11034 int scriptTextLen;
11035 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11036 struct JimParserCtx parser;
11037 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11038 ParseTokenList tokenlist;
11040 /* Initially parse the subst into tokens (in tokenlist) */
11041 ScriptTokenListInit(&tokenlist);
11043 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11044 while (1) {
11045 JimParseSubst(&parser, flags);
11046 if (parser.eof) {
11047 /* Note that subst doesn't need the EOL token */
11048 break;
11050 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11051 parser.tline);
11054 /* Create the "real" subst/script tokens from the initial token list */
11055 script->inUse = 1;
11056 script->substFlags = flags;
11057 script->fileNameObj = interp->emptyObj;
11058 Jim_IncrRefCount(script->fileNameObj);
11059 SubstObjAddTokens(interp, script, &tokenlist);
11061 /* No longer need the token list */
11062 ScriptTokenListFree(&tokenlist);
11064 #ifdef DEBUG_SHOW_SUBST
11066 int i;
11068 printf("==== Subst ====\n");
11069 for (i = 0; i < script->len; i++) {
11070 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11071 Jim_String(script->token[i].objPtr));
11074 #endif
11076 /* Free the old internal rep and set the new one. */
11077 Jim_FreeIntRep(interp, objPtr);
11078 Jim_SetIntRepPtr(objPtr, script);
11079 objPtr->typePtr = &scriptObjType;
11080 return JIM_OK;
11083 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11085 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11086 SetSubstFromAny(interp, objPtr, flags);
11087 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11090 /* Performs commands,variables,blackslashes substitution,
11091 * storing the result object (with refcount 0) into
11092 * resObjPtrPtr. */
11093 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11095 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11097 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11098 /* In order to preserve the internal rep, we increment the
11099 * inUse field of the script internal rep structure. */
11100 script->inUse++;
11102 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11104 script->inUse--;
11105 Jim_DecrRefCount(interp, substObjPtr);
11106 if (*resObjPtrPtr == NULL) {
11107 return JIM_ERR;
11109 return JIM_OK;
11112 /* -----------------------------------------------------------------------------
11113 * Core commands utility functions
11114 * ---------------------------------------------------------------------------*/
11115 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11117 Jim_Obj *objPtr;
11118 Jim_Obj *listObjPtr;
11120 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11122 listObjPtr = Jim_NewListObj(interp, argv, argc);
11124 if (*msg) {
11125 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11127 Jim_IncrRefCount(listObjPtr);
11128 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11129 Jim_DecrRefCount(interp, listObjPtr);
11131 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11135 * May add the key and/or value to the list.
11137 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11138 Jim_HashEntry *he, int type);
11140 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11143 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11144 * invoke the callback to add entries to a list.
11145 * Returns the list.
11147 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11148 JimHashtableIteratorCallbackType *callback, int type)
11150 Jim_HashEntry *he;
11151 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11153 /* Check for the non-pattern case. We can do this much more efficiently. */
11154 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11155 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11156 if (he) {
11157 callback(interp, listObjPtr, he, type);
11160 else {
11161 Jim_HashTableIterator htiter;
11162 JimInitHashTableIterator(ht, &htiter);
11163 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11164 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11165 callback(interp, listObjPtr, he, type);
11169 return listObjPtr;
11172 /* Keep these in order */
11173 #define JIM_CMDLIST_COMMANDS 0
11174 #define JIM_CMDLIST_PROCS 1
11175 #define JIM_CMDLIST_CHANNELS 2
11178 * Adds matching command names (procs, channels) to the list.
11180 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11181 Jim_HashEntry *he, int type)
11183 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11184 Jim_Obj *objPtr;
11186 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11187 /* not a proc */
11188 return;
11191 objPtr = Jim_NewStringObj(interp, he->key, -1);
11192 Jim_IncrRefCount(objPtr);
11194 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11195 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11197 Jim_DecrRefCount(interp, objPtr);
11200 /* type is JIM_CMDLIST_xxx */
11201 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11203 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11206 /* Keep these in order */
11207 #define JIM_VARLIST_GLOBALS 0
11208 #define JIM_VARLIST_LOCALS 1
11209 #define JIM_VARLIST_VARS 2
11211 #define JIM_VARLIST_VALUES 0x1000
11214 * Adds matching variable names to the list.
11216 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11217 Jim_HashEntry *he, int type)
11219 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11221 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11222 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11223 if (type & JIM_VARLIST_VALUES) {
11224 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11229 /* mode is JIM_VARLIST_xxx */
11230 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11232 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11233 /* For [info locals], if we are at top level an emtpy list
11234 * is returned. I don't agree, but we aim at compatibility (SS) */
11235 return interp->emptyObj;
11237 else {
11238 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11239 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11243 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11244 Jim_Obj **objPtrPtr, int info_level_cmd)
11246 Jim_CallFrame *targetCallFrame;
11248 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11249 if (targetCallFrame == NULL) {
11250 return JIM_ERR;
11252 /* No proc call at toplevel callframe */
11253 if (targetCallFrame == interp->topFramePtr) {
11254 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11255 return JIM_ERR;
11257 if (info_level_cmd) {
11258 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11260 else {
11261 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11263 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11264 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11265 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11266 *objPtrPtr = listObj;
11268 return JIM_OK;
11271 /* -----------------------------------------------------------------------------
11272 * Core commands
11273 * ---------------------------------------------------------------------------*/
11275 /* fake [puts] -- not the real puts, just for debugging. */
11276 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11278 if (argc != 2 && argc != 3) {
11279 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11280 return JIM_ERR;
11282 if (argc == 3) {
11283 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11284 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11285 return JIM_ERR;
11287 else {
11288 fputs(Jim_String(argv[2]), stdout);
11291 else {
11292 puts(Jim_String(argv[1]));
11294 return JIM_OK;
11297 /* Helper for [+] and [*] */
11298 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11300 jim_wide wideValue, res;
11301 double doubleValue, doubleRes;
11302 int i;
11304 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11306 for (i = 1; i < argc; i++) {
11307 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11308 goto trydouble;
11309 if (op == JIM_EXPROP_ADD)
11310 res += wideValue;
11311 else
11312 res *= wideValue;
11314 Jim_SetResultInt(interp, res);
11315 return JIM_OK;
11316 trydouble:
11317 doubleRes = (double)res;
11318 for (; i < argc; i++) {
11319 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11320 return JIM_ERR;
11321 if (op == JIM_EXPROP_ADD)
11322 doubleRes += doubleValue;
11323 else
11324 doubleRes *= doubleValue;
11326 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11327 return JIM_OK;
11330 /* Helper for [-] and [/] */
11331 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11333 jim_wide wideValue, res = 0;
11334 double doubleValue, doubleRes = 0;
11335 int i = 2;
11337 if (argc < 2) {
11338 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11339 return JIM_ERR;
11341 else if (argc == 2) {
11342 /* The arity = 2 case is different. For [- x] returns -x,
11343 * while [/ x] returns 1/x. */
11344 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11345 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11346 return JIM_ERR;
11348 else {
11349 if (op == JIM_EXPROP_SUB)
11350 doubleRes = -doubleValue;
11351 else
11352 doubleRes = 1.0 / doubleValue;
11353 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11354 return JIM_OK;
11357 if (op == JIM_EXPROP_SUB) {
11358 res = -wideValue;
11359 Jim_SetResultInt(interp, res);
11361 else {
11362 doubleRes = 1.0 / wideValue;
11363 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11365 return JIM_OK;
11367 else {
11368 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11369 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11370 != JIM_OK) {
11371 return JIM_ERR;
11373 else {
11374 goto trydouble;
11378 for (i = 2; i < argc; i++) {
11379 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11380 doubleRes = (double)res;
11381 goto trydouble;
11383 if (op == JIM_EXPROP_SUB)
11384 res -= wideValue;
11385 else {
11386 if (wideValue == 0) {
11387 Jim_SetResultString(interp, "Division by zero", -1);
11388 return JIM_ERR;
11390 res /= wideValue;
11393 Jim_SetResultInt(interp, res);
11394 return JIM_OK;
11395 trydouble:
11396 for (; i < argc; i++) {
11397 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11398 return JIM_ERR;
11399 if (op == JIM_EXPROP_SUB)
11400 doubleRes -= doubleValue;
11401 else
11402 doubleRes /= doubleValue;
11404 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11405 return JIM_OK;
11409 /* [+] */
11410 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11412 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11415 /* [*] */
11416 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11418 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11421 /* [-] */
11422 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11424 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11427 /* [/] */
11428 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11430 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11433 /* [set] */
11434 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11436 if (argc != 2 && argc != 3) {
11437 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11438 return JIM_ERR;
11440 if (argc == 2) {
11441 Jim_Obj *objPtr;
11443 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11444 if (!objPtr)
11445 return JIM_ERR;
11446 Jim_SetResult(interp, objPtr);
11447 return JIM_OK;
11449 /* argc == 3 case. */
11450 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11451 return JIM_ERR;
11452 Jim_SetResult(interp, argv[2]);
11453 return JIM_OK;
11456 /* [unset]
11458 * unset ?-nocomplain? ?--? ?varName ...?
11460 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11462 int i = 1;
11463 int complain = 1;
11465 while (i < argc) {
11466 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11467 i++;
11468 break;
11470 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11471 complain = 0;
11472 i++;
11473 continue;
11475 break;
11478 while (i < argc) {
11479 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11480 && complain) {
11481 return JIM_ERR;
11483 i++;
11485 return JIM_OK;
11488 /* [while] */
11489 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11491 if (argc != 3) {
11492 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11493 return JIM_ERR;
11496 /* The general purpose implementation of while starts here */
11497 while (1) {
11498 int boolean, retval;
11500 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11501 return retval;
11502 if (!boolean)
11503 break;
11505 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11506 switch (retval) {
11507 case JIM_BREAK:
11508 goto out;
11509 break;
11510 case JIM_CONTINUE:
11511 continue;
11512 break;
11513 default:
11514 return retval;
11518 out:
11519 Jim_SetEmptyResult(interp);
11520 return JIM_OK;
11523 /* [for] */
11524 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11526 int retval;
11527 int boolean = 1;
11528 Jim_Obj *varNamePtr = NULL;
11529 Jim_Obj *stopVarNamePtr = NULL;
11531 if (argc != 5) {
11532 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11533 return JIM_ERR;
11536 /* Do the initialisation */
11537 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11538 return retval;
11541 /* And do the first test now. Better for optimisation
11542 * if we can do next/test at the bottom of the loop
11544 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11546 /* Ready to do the body as follows:
11547 * while (1) {
11548 * body // check retcode
11549 * next // check retcode
11550 * test // check retcode/test bool
11554 #ifdef JIM_OPTIMIZATION
11555 /* Check if the for is on the form:
11556 * for ... {$i < CONST} {incr i}
11557 * for ... {$i < $j} {incr i}
11559 if (retval == JIM_OK && boolean) {
11560 ScriptObj *incrScript;
11561 struct ExprTree *expr;
11562 jim_wide stop, currentVal;
11563 Jim_Obj *objPtr;
11564 int cmpOffset;
11566 /* Do it only if there aren't shared arguments */
11567 expr = JimGetExpression(interp, argv[2]);
11568 incrScript = JimGetScript(interp, argv[3]);
11570 /* Ensure proper lengths to start */
11571 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11572 goto evalstart;
11574 /* Ensure proper token types. */
11575 if (incrScript->token[1].type != JIM_TT_ESC) {
11576 goto evalstart;
11579 if (expr->expr->type == JIM_EXPROP_LT) {
11580 cmpOffset = 0;
11582 else if (expr->expr->type == JIM_EXPROP_LTE) {
11583 cmpOffset = 1;
11585 else {
11586 goto evalstart;
11589 if (expr->expr->left->type != JIM_TT_VAR) {
11590 goto evalstart;
11593 if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) {
11594 goto evalstart;
11597 /* Update command must be incr */
11598 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11599 goto evalstart;
11602 /* incr, expression must be about the same variable */
11603 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) {
11604 goto evalstart;
11607 /* Get the stop condition (must be a variable or integer) */
11608 if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11609 if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11610 goto evalstart;
11613 else {
11614 stopVarNamePtr = expr->expr->right->objPtr;
11615 Jim_IncrRefCount(stopVarNamePtr);
11616 /* Keep the compiler happy */
11617 stop = 0;
11620 /* Initialization */
11621 varNamePtr = expr->expr->left->objPtr;
11622 Jim_IncrRefCount(varNamePtr);
11624 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11625 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11626 goto testcond;
11629 /* --- OPTIMIZED FOR --- */
11630 while (retval == JIM_OK) {
11631 /* === Check condition === */
11632 /* Note that currentVal is already set here */
11634 /* Immediate or Variable? get the 'stop' value if the latter. */
11635 if (stopVarNamePtr) {
11636 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11637 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11638 goto testcond;
11642 if (currentVal >= stop + cmpOffset) {
11643 break;
11646 /* Eval body */
11647 retval = Jim_EvalObj(interp, argv[4]);
11648 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11649 retval = JIM_OK;
11651 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11653 /* Increment */
11654 if (objPtr == NULL) {
11655 retval = JIM_ERR;
11656 goto out;
11658 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11659 currentVal = ++JimWideValue(objPtr);
11660 Jim_InvalidateStringRep(objPtr);
11662 else {
11663 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11664 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11665 ++currentVal)) != JIM_OK) {
11666 goto evalnext;
11671 goto out;
11673 evalstart:
11674 #endif
11676 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11677 /* Body */
11678 retval = Jim_EvalObj(interp, argv[4]);
11680 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11681 /* increment */
11682 JIM_IF_OPTIM(evalnext:)
11683 retval = Jim_EvalObj(interp, argv[3]);
11684 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11685 /* test */
11686 JIM_IF_OPTIM(testcond:)
11687 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11691 JIM_IF_OPTIM(out:)
11692 if (stopVarNamePtr) {
11693 Jim_DecrRefCount(interp, stopVarNamePtr);
11695 if (varNamePtr) {
11696 Jim_DecrRefCount(interp, varNamePtr);
11699 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11700 Jim_SetEmptyResult(interp);
11701 return JIM_OK;
11704 return retval;
11707 /* [loop] */
11708 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11710 int retval;
11711 jim_wide i;
11712 jim_wide limit;
11713 jim_wide incr = 1;
11714 Jim_Obj *bodyObjPtr;
11716 if (argc != 5 && argc != 6) {
11717 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11718 return JIM_ERR;
11721 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11722 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11723 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11724 return JIM_ERR;
11726 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11728 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11730 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11731 retval = Jim_EvalObj(interp, bodyObjPtr);
11732 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11733 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11735 retval = JIM_OK;
11737 /* Increment */
11738 i += incr;
11740 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11741 if (argv[1]->typePtr != &variableObjType) {
11742 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11743 return JIM_ERR;
11746 JimWideValue(objPtr) = i;
11747 Jim_InvalidateStringRep(objPtr);
11749 /* The following step is required in order to invalidate the
11750 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11751 if (argv[1]->typePtr != &variableObjType) {
11752 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11753 retval = JIM_ERR;
11754 break;
11758 else {
11759 objPtr = Jim_NewIntObj(interp, i);
11760 retval = Jim_SetVariable(interp, argv[1], objPtr);
11761 if (retval != JIM_OK) {
11762 Jim_FreeNewObj(interp, objPtr);
11768 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11769 Jim_SetEmptyResult(interp);
11770 return JIM_OK;
11772 return retval;
11775 /* List iterators make it easy to iterate over a list.
11776 * At some point iterators will be expanded to support generators.
11778 typedef struct {
11779 Jim_Obj *objPtr;
11780 int idx;
11781 } Jim_ListIter;
11784 * Initialise the iterator at the start of the list.
11786 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11788 iter->objPtr = objPtr;
11789 iter->idx = 0;
11793 * Returns the next object from the list, or NULL on end-of-list.
11795 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11797 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11798 return NULL;
11800 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11804 * Returns 1 if end-of-list has been reached.
11806 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11808 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11811 /* foreach + lmap implementation. */
11812 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11814 int result = JIM_OK;
11815 int i, numargs;
11816 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11817 Jim_ListIter *iters;
11818 Jim_Obj *script;
11819 Jim_Obj *resultObj;
11821 if (argc < 4 || argc % 2 != 0) {
11822 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11823 return JIM_ERR;
11825 script = argv[argc - 1]; /* Last argument is a script */
11826 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11828 if (numargs == 2) {
11829 iters = twoiters;
11831 else {
11832 iters = Jim_Alloc(numargs * sizeof(*iters));
11834 for (i = 0; i < numargs; i++) {
11835 JimListIterInit(&iters[i], argv[i + 1]);
11836 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11837 result = JIM_ERR;
11840 if (result != JIM_OK) {
11841 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11842 return result;
11845 if (doMap) {
11846 resultObj = Jim_NewListObj(interp, NULL, 0);
11848 else {
11849 resultObj = interp->emptyObj;
11851 Jim_IncrRefCount(resultObj);
11853 while (1) {
11854 /* Have we expired all lists? */
11855 for (i = 0; i < numargs; i += 2) {
11856 if (!JimListIterDone(interp, &iters[i + 1])) {
11857 break;
11860 if (i == numargs) {
11861 /* All done */
11862 break;
11865 /* For each list */
11866 for (i = 0; i < numargs; i += 2) {
11867 Jim_Obj *varName;
11869 /* foreach var */
11870 JimListIterInit(&iters[i], argv[i + 1]);
11871 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11872 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11873 if (!valObj) {
11874 /* Ran out, so store the empty string */
11875 valObj = interp->emptyObj;
11877 /* Avoid shimmering */
11878 Jim_IncrRefCount(valObj);
11879 result = Jim_SetVariable(interp, varName, valObj);
11880 Jim_DecrRefCount(interp, valObj);
11881 if (result != JIM_OK) {
11882 goto err;
11886 switch (result = Jim_EvalObj(interp, script)) {
11887 case JIM_OK:
11888 if (doMap) {
11889 Jim_ListAppendElement(interp, resultObj, interp->result);
11891 break;
11892 case JIM_CONTINUE:
11893 break;
11894 case JIM_BREAK:
11895 goto out;
11896 default:
11897 goto err;
11900 out:
11901 result = JIM_OK;
11902 Jim_SetResult(interp, resultObj);
11903 err:
11904 Jim_DecrRefCount(interp, resultObj);
11905 if (numargs > 2) {
11906 Jim_Free(iters);
11908 return result;
11911 /* [foreach] */
11912 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11914 return JimForeachMapHelper(interp, argc, argv, 0);
11917 /* [lmap] */
11918 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11920 return JimForeachMapHelper(interp, argc, argv, 1);
11923 /* [lassign] */
11924 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11926 int result = JIM_ERR;
11927 int i;
11928 Jim_ListIter iter;
11929 Jim_Obj *resultObj;
11931 if (argc < 2) {
11932 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11933 return JIM_ERR;
11936 JimListIterInit(&iter, argv[1]);
11938 for (i = 2; i < argc; i++) {
11939 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11940 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11941 if (result != JIM_OK) {
11942 return result;
11946 resultObj = Jim_NewListObj(interp, NULL, 0);
11947 while (!JimListIterDone(interp, &iter)) {
11948 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
11951 Jim_SetResult(interp, resultObj);
11953 return JIM_OK;
11956 /* [if] */
11957 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11959 int boolean, retval, current = 1, falsebody = 0;
11961 if (argc >= 3) {
11962 while (1) {
11963 /* Far not enough arguments given! */
11964 if (current >= argc)
11965 goto err;
11966 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
11967 != JIM_OK)
11968 return retval;
11969 /* There lacks something, isn't it? */
11970 if (current >= argc)
11971 goto err;
11972 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
11973 current++;
11974 /* Tsk tsk, no then-clause? */
11975 if (current >= argc)
11976 goto err;
11977 if (boolean)
11978 return Jim_EvalObj(interp, argv[current]);
11979 /* Ok: no else-clause follows */
11980 if (++current >= argc) {
11981 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
11982 return JIM_OK;
11984 falsebody = current++;
11985 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
11986 /* IIICKS - else-clause isn't last cmd? */
11987 if (current != argc - 1)
11988 goto err;
11989 return Jim_EvalObj(interp, argv[current]);
11991 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
11992 /* Ok: elseif follows meaning all the stuff
11993 * again (how boring...) */
11994 continue;
11995 /* OOPS - else-clause is not last cmd? */
11996 else if (falsebody != argc - 1)
11997 goto err;
11998 return Jim_EvalObj(interp, argv[falsebody]);
12000 return JIM_OK;
12002 err:
12003 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12004 return JIM_ERR;
12008 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12009 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12010 Jim_Obj *stringObj, int nocase)
12012 Jim_Obj *parms[4];
12013 int argc = 0;
12014 long eq;
12015 int rc;
12017 parms[argc++] = commandObj;
12018 if (nocase) {
12019 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12021 parms[argc++] = patternObj;
12022 parms[argc++] = stringObj;
12024 rc = Jim_EvalObjVector(interp, argc, parms);
12026 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12027 eq = -rc;
12030 return eq;
12033 enum
12034 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12036 /* [switch] */
12037 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12039 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12040 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12041 Jim_Obj *script = 0;
12043 if (argc < 3) {
12044 wrongnumargs:
12045 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12046 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12047 return JIM_ERR;
12049 for (opt = 1; opt < argc; ++opt) {
12050 const char *option = Jim_String(argv[opt]);
12052 if (*option != '-')
12053 break;
12054 else if (strncmp(option, "--", 2) == 0) {
12055 ++opt;
12056 break;
12058 else if (strncmp(option, "-exact", 2) == 0)
12059 matchOpt = SWITCH_EXACT;
12060 else if (strncmp(option, "-glob", 2) == 0)
12061 matchOpt = SWITCH_GLOB;
12062 else if (strncmp(option, "-regexp", 2) == 0)
12063 matchOpt = SWITCH_RE;
12064 else if (strncmp(option, "-command", 2) == 0) {
12065 matchOpt = SWITCH_CMD;
12066 if ((argc - opt) < 2)
12067 goto wrongnumargs;
12068 command = argv[++opt];
12070 else {
12071 Jim_SetResultFormatted(interp,
12072 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12073 argv[opt]);
12074 return JIM_ERR;
12076 if ((argc - opt) < 2)
12077 goto wrongnumargs;
12079 strObj = argv[opt++];
12080 patCount = argc - opt;
12081 if (patCount == 1) {
12082 Jim_Obj **vector;
12084 JimListGetElements(interp, argv[opt], &patCount, &vector);
12085 caseList = vector;
12087 else
12088 caseList = &argv[opt];
12089 if (patCount == 0 || patCount % 2 != 0)
12090 goto wrongnumargs;
12091 for (i = 0; script == 0 && i < patCount; i += 2) {
12092 Jim_Obj *patObj = caseList[i];
12094 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12095 || i < (patCount - 2)) {
12096 switch (matchOpt) {
12097 case SWITCH_EXACT:
12098 if (Jim_StringEqObj(strObj, patObj))
12099 script = caseList[i + 1];
12100 break;
12101 case SWITCH_GLOB:
12102 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12103 script = caseList[i + 1];
12104 break;
12105 case SWITCH_RE:
12106 command = Jim_NewStringObj(interp, "regexp", -1);
12107 /* Fall thru intentionally */
12108 case SWITCH_CMD:{
12109 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12111 /* After the execution of a command we need to
12112 * make sure to reconvert the object into a list
12113 * again. Only for the single-list style [switch]. */
12114 if (argc - opt == 1) {
12115 Jim_Obj **vector;
12117 JimListGetElements(interp, argv[opt], &patCount, &vector);
12118 caseList = vector;
12120 /* command is here already decref'd */
12121 if (rc < 0) {
12122 return -rc;
12124 if (rc)
12125 script = caseList[i + 1];
12126 break;
12130 else {
12131 script = caseList[i + 1];
12134 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12135 script = caseList[i + 1];
12136 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12137 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12138 return JIM_ERR;
12140 Jim_SetEmptyResult(interp);
12141 if (script) {
12142 return Jim_EvalObj(interp, script);
12144 return JIM_OK;
12147 /* [list] */
12148 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12150 Jim_Obj *listObjPtr;
12152 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12153 Jim_SetResult(interp, listObjPtr);
12154 return JIM_OK;
12157 /* [lindex] */
12158 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12160 Jim_Obj *objPtr, *listObjPtr;
12161 int i;
12162 int idx;
12164 if (argc < 2) {
12165 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12166 return JIM_ERR;
12168 objPtr = argv[1];
12169 Jim_IncrRefCount(objPtr);
12170 for (i = 2; i < argc; i++) {
12171 listObjPtr = objPtr;
12172 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12173 Jim_DecrRefCount(interp, listObjPtr);
12174 return JIM_ERR;
12176 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12177 /* Returns an empty object if the index
12178 * is out of range. */
12179 Jim_DecrRefCount(interp, listObjPtr);
12180 Jim_SetEmptyResult(interp);
12181 return JIM_OK;
12183 Jim_IncrRefCount(objPtr);
12184 Jim_DecrRefCount(interp, listObjPtr);
12186 Jim_SetResult(interp, objPtr);
12187 Jim_DecrRefCount(interp, objPtr);
12188 return JIM_OK;
12191 /* [llength] */
12192 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12194 if (argc != 2) {
12195 Jim_WrongNumArgs(interp, 1, argv, "list");
12196 return JIM_ERR;
12198 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12199 return JIM_OK;
12202 /* [lsearch] */
12203 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12205 static const char * const options[] = {
12206 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12207 NULL
12209 enum
12210 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12211 OPT_COMMAND };
12212 int i;
12213 int opt_bool = 0;
12214 int opt_not = 0;
12215 int opt_nocase = 0;
12216 int opt_all = 0;
12217 int opt_inline = 0;
12218 int opt_match = OPT_EXACT;
12219 int listlen;
12220 int rc = JIM_OK;
12221 Jim_Obj *listObjPtr = NULL;
12222 Jim_Obj *commandObj = NULL;
12224 if (argc < 3) {
12225 wrongargs:
12226 Jim_WrongNumArgs(interp, 1, argv,
12227 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12228 return JIM_ERR;
12231 for (i = 1; i < argc - 2; i++) {
12232 int option;
12234 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12235 return JIM_ERR;
12237 switch (option) {
12238 case OPT_BOOL:
12239 opt_bool = 1;
12240 opt_inline = 0;
12241 break;
12242 case OPT_NOT:
12243 opt_not = 1;
12244 break;
12245 case OPT_NOCASE:
12246 opt_nocase = 1;
12247 break;
12248 case OPT_INLINE:
12249 opt_inline = 1;
12250 opt_bool = 0;
12251 break;
12252 case OPT_ALL:
12253 opt_all = 1;
12254 break;
12255 case OPT_COMMAND:
12256 if (i >= argc - 2) {
12257 goto wrongargs;
12259 commandObj = argv[++i];
12260 /* fallthru */
12261 case OPT_EXACT:
12262 case OPT_GLOB:
12263 case OPT_REGEXP:
12264 opt_match = option;
12265 break;
12269 argv += i;
12271 if (opt_all) {
12272 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12274 if (opt_match == OPT_REGEXP) {
12275 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12277 if (commandObj) {
12278 Jim_IncrRefCount(commandObj);
12281 listlen = Jim_ListLength(interp, argv[0]);
12282 for (i = 0; i < listlen; i++) {
12283 int eq = 0;
12284 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12286 switch (opt_match) {
12287 case OPT_EXACT:
12288 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12289 break;
12291 case OPT_GLOB:
12292 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12293 break;
12295 case OPT_REGEXP:
12296 case OPT_COMMAND:
12297 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12298 if (eq < 0) {
12299 if (listObjPtr) {
12300 Jim_FreeNewObj(interp, listObjPtr);
12302 rc = JIM_ERR;
12303 goto done;
12305 break;
12308 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12309 if (!eq && opt_bool && opt_not && !opt_all) {
12310 continue;
12313 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12314 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12315 Jim_Obj *resultObj;
12317 if (opt_bool) {
12318 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12320 else if (!opt_inline) {
12321 resultObj = Jim_NewIntObj(interp, i);
12323 else {
12324 resultObj = objPtr;
12327 if (opt_all) {
12328 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12330 else {
12331 Jim_SetResult(interp, resultObj);
12332 goto done;
12337 if (opt_all) {
12338 Jim_SetResult(interp, listObjPtr);
12340 else {
12341 /* No match */
12342 if (opt_bool) {
12343 Jim_SetResultBool(interp, opt_not);
12345 else if (!opt_inline) {
12346 Jim_SetResultInt(interp, -1);
12350 done:
12351 if (commandObj) {
12352 Jim_DecrRefCount(interp, commandObj);
12354 return rc;
12357 /* [lappend] */
12358 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12360 Jim_Obj *listObjPtr;
12361 int new_obj = 0;
12362 int i;
12364 if (argc < 2) {
12365 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12366 return JIM_ERR;
12368 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12369 if (!listObjPtr) {
12370 /* Create the list if it does not exist */
12371 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12372 new_obj = 1;
12374 else if (Jim_IsShared(listObjPtr)) {
12375 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12376 new_obj = 1;
12378 for (i = 2; i < argc; i++)
12379 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12380 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12381 if (new_obj)
12382 Jim_FreeNewObj(interp, listObjPtr);
12383 return JIM_ERR;
12385 Jim_SetResult(interp, listObjPtr);
12386 return JIM_OK;
12389 /* [linsert] */
12390 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12392 int idx, len;
12393 Jim_Obj *listPtr;
12395 if (argc < 3) {
12396 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12397 return JIM_ERR;
12399 listPtr = argv[1];
12400 if (Jim_IsShared(listPtr))
12401 listPtr = Jim_DuplicateObj(interp, listPtr);
12402 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12403 goto err;
12404 len = Jim_ListLength(interp, listPtr);
12405 if (idx >= len)
12406 idx = len;
12407 else if (idx < 0)
12408 idx = len + idx + 1;
12409 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12410 Jim_SetResult(interp, listPtr);
12411 return JIM_OK;
12412 err:
12413 if (listPtr != argv[1]) {
12414 Jim_FreeNewObj(interp, listPtr);
12416 return JIM_ERR;
12419 /* [lreplace] */
12420 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12422 int first, last, len, rangeLen;
12423 Jim_Obj *listObj;
12424 Jim_Obj *newListObj;
12426 if (argc < 4) {
12427 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12428 return JIM_ERR;
12430 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12431 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12432 return JIM_ERR;
12435 listObj = argv[1];
12436 len = Jim_ListLength(interp, listObj);
12438 first = JimRelToAbsIndex(len, first);
12439 last = JimRelToAbsIndex(len, last);
12440 JimRelToAbsRange(len, &first, &last, &rangeLen);
12442 /* Now construct a new list which consists of:
12443 * <elements before first> <supplied elements> <elements after last>
12446 /* Check to see if trying to replace past the end of the list */
12447 if (first < len) {
12448 /* OK. Not past the end */
12450 else if (len == 0) {
12451 /* Special for empty list, adjust first to 0 */
12452 first = 0;
12454 else {
12455 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12456 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12457 return JIM_ERR;
12460 /* Add the first set of elements */
12461 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12463 /* Add supplied elements */
12464 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12466 /* Add the remaining elements */
12467 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12469 Jim_SetResult(interp, newListObj);
12470 return JIM_OK;
12473 /* [lset] */
12474 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12476 if (argc < 3) {
12477 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12478 return JIM_ERR;
12480 else if (argc == 3) {
12481 /* With no indexes, simply implements [set] */
12482 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12483 return JIM_ERR;
12484 Jim_SetResult(interp, argv[2]);
12485 return JIM_OK;
12487 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12490 /* [lsort] */
12491 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12493 static const char * const options[] = {
12494 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12496 enum
12497 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12498 Jim_Obj *resObj;
12499 int i;
12500 int retCode;
12501 int shared;
12503 struct lsort_info info;
12505 if (argc < 2) {
12506 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12507 return JIM_ERR;
12510 info.type = JIM_LSORT_ASCII;
12511 info.order = 1;
12512 info.indexed = 0;
12513 info.unique = 0;
12514 info.command = NULL;
12515 info.interp = interp;
12517 for (i = 1; i < (argc - 1); i++) {
12518 int option;
12520 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12521 != JIM_OK)
12522 return JIM_ERR;
12523 switch (option) {
12524 case OPT_ASCII:
12525 info.type = JIM_LSORT_ASCII;
12526 break;
12527 case OPT_NOCASE:
12528 info.type = JIM_LSORT_NOCASE;
12529 break;
12530 case OPT_INTEGER:
12531 info.type = JIM_LSORT_INTEGER;
12532 break;
12533 case OPT_REAL:
12534 info.type = JIM_LSORT_REAL;
12535 break;
12536 case OPT_INCREASING:
12537 info.order = 1;
12538 break;
12539 case OPT_DECREASING:
12540 info.order = -1;
12541 break;
12542 case OPT_UNIQUE:
12543 info.unique = 1;
12544 break;
12545 case OPT_COMMAND:
12546 if (i >= (argc - 2)) {
12547 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12548 return JIM_ERR;
12550 info.type = JIM_LSORT_COMMAND;
12551 info.command = argv[i + 1];
12552 i++;
12553 break;
12554 case OPT_INDEX:
12555 if (i >= (argc - 2)) {
12556 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12557 return JIM_ERR;
12559 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12560 return JIM_ERR;
12562 info.indexed = 1;
12563 i++;
12564 break;
12567 resObj = argv[argc - 1];
12568 if ((shared = Jim_IsShared(resObj)))
12569 resObj = Jim_DuplicateObj(interp, resObj);
12570 retCode = ListSortElements(interp, resObj, &info);
12571 if (retCode == JIM_OK) {
12572 Jim_SetResult(interp, resObj);
12574 else if (shared) {
12575 Jim_FreeNewObj(interp, resObj);
12577 return retCode;
12580 /* [append] */
12581 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12583 Jim_Obj *stringObjPtr;
12584 int i;
12586 if (argc < 2) {
12587 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12588 return JIM_ERR;
12590 if (argc == 2) {
12591 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12592 if (!stringObjPtr)
12593 return JIM_ERR;
12595 else {
12596 int new_obj = 0;
12597 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12598 if (!stringObjPtr) {
12599 /* Create the string if it doesn't exist */
12600 stringObjPtr = Jim_NewEmptyStringObj(interp);
12601 new_obj = 1;
12603 else if (Jim_IsShared(stringObjPtr)) {
12604 new_obj = 1;
12605 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12607 for (i = 2; i < argc; i++) {
12608 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12610 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12611 if (new_obj) {
12612 Jim_FreeNewObj(interp, stringObjPtr);
12614 return JIM_ERR;
12617 Jim_SetResult(interp, stringObjPtr);
12618 return JIM_OK;
12621 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12623 * Returns a zero-refcount list describing the expression at 'node'
12625 static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
12627 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
12629 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, jim_tt_name(node->type), -1));
12630 if (TOKEN_IS_EXPR_OP(node->type)) {
12631 if (node->left) {
12632 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->left));
12634 if (node->right) {
12635 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->right));
12637 if (node->ternary) {
12638 Jim_ListAppendElement(interp, listObjPtr, JimGetExprAsList(interp, node->ternary));
12641 else {
12642 Jim_ListAppendElement(interp, listObjPtr, node->objPtr);
12644 return listObjPtr;
12646 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12648 /* [debug] */
12649 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12651 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12652 static const char * const options[] = {
12653 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12654 "exprbc", "show",
12655 NULL
12657 enum
12659 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12660 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12662 int option;
12664 if (argc < 2) {
12665 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12666 return JIM_ERR;
12668 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12669 return Jim_CheckShowCommands(interp, argv[1], options);
12670 if (option == OPT_REFCOUNT) {
12671 if (argc != 3) {
12672 Jim_WrongNumArgs(interp, 2, argv, "object");
12673 return JIM_ERR;
12675 Jim_SetResultInt(interp, argv[2]->refCount);
12676 return JIM_OK;
12678 else if (option == OPT_OBJCOUNT) {
12679 int freeobj = 0, liveobj = 0;
12680 char buf[256];
12681 Jim_Obj *objPtr;
12683 if (argc != 2) {
12684 Jim_WrongNumArgs(interp, 2, argv, "");
12685 return JIM_ERR;
12687 /* Count the number of free objects. */
12688 objPtr = interp->freeList;
12689 while (objPtr) {
12690 freeobj++;
12691 objPtr = objPtr->nextObjPtr;
12693 /* Count the number of live objects. */
12694 objPtr = interp->liveList;
12695 while (objPtr) {
12696 liveobj++;
12697 objPtr = objPtr->nextObjPtr;
12699 /* Set the result string and return. */
12700 sprintf(buf, "free %d used %d", freeobj, liveobj);
12701 Jim_SetResultString(interp, buf, -1);
12702 return JIM_OK;
12704 else if (option == OPT_OBJECTS) {
12705 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12707 /* Count the number of live objects. */
12708 objPtr = interp->liveList;
12709 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12710 while (objPtr) {
12711 char buf[128];
12712 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12714 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12715 sprintf(buf, "%p", objPtr);
12716 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12717 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12718 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12719 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12720 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12721 objPtr = objPtr->nextObjPtr;
12723 Jim_SetResult(interp, listObjPtr);
12724 return JIM_OK;
12726 else if (option == OPT_INVSTR) {
12727 Jim_Obj *objPtr;
12729 if (argc != 3) {
12730 Jim_WrongNumArgs(interp, 2, argv, "object");
12731 return JIM_ERR;
12733 objPtr = argv[2];
12734 if (objPtr->typePtr != NULL)
12735 Jim_InvalidateStringRep(objPtr);
12736 Jim_SetEmptyResult(interp);
12737 return JIM_OK;
12739 else if (option == OPT_SHOW) {
12740 const char *s;
12741 int len, charlen;
12743 if (argc != 3) {
12744 Jim_WrongNumArgs(interp, 2, argv, "object");
12745 return JIM_ERR;
12747 s = Jim_GetString(argv[2], &len);
12748 #ifdef JIM_UTF8
12749 charlen = utf8_strlen(s, len);
12750 #else
12751 charlen = len;
12752 #endif
12753 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12754 printf("chars (%d): <<%s>>\n", charlen, s);
12755 printf("bytes (%d):", len);
12756 while (len--) {
12757 printf(" %02x", (unsigned char)*s++);
12759 printf("\n");
12760 return JIM_OK;
12762 else if (option == OPT_SCRIPTLEN) {
12763 ScriptObj *script;
12765 if (argc != 3) {
12766 Jim_WrongNumArgs(interp, 2, argv, "script");
12767 return JIM_ERR;
12769 script = JimGetScript(interp, argv[2]);
12770 if (script == NULL)
12771 return JIM_ERR;
12772 Jim_SetResultInt(interp, script->len);
12773 return JIM_OK;
12775 else if (option == OPT_EXPRLEN) {
12776 struct ExprTree *expr;
12778 if (argc != 3) {
12779 Jim_WrongNumArgs(interp, 2, argv, "expression");
12780 return JIM_ERR;
12782 expr = JimGetExpression(interp, argv[2]);
12783 if (expr == NULL)
12784 return JIM_ERR;
12785 Jim_SetResultInt(interp, expr->len);
12786 return JIM_OK;
12788 else if (option == OPT_EXPRBC) {
12789 struct ExprTree *expr;
12791 if (argc != 3) {
12792 Jim_WrongNumArgs(interp, 2, argv, "expression");
12793 return JIM_ERR;
12795 expr = JimGetExpression(interp, argv[2]);
12796 if (expr == NULL)
12797 return JIM_ERR;
12798 Jim_SetResult(interp, JimGetExprAsList(interp, expr->expr));
12799 return JIM_OK;
12801 else {
12802 Jim_SetResultString(interp,
12803 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12804 return JIM_ERR;
12806 /* unreached */
12807 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12808 #if !defined(JIM_DEBUG_COMMAND)
12809 Jim_SetResultString(interp, "unsupported", -1);
12810 return JIM_ERR;
12811 #endif
12814 /* [eval] */
12815 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12817 int rc;
12819 if (argc < 2) {
12820 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
12821 return JIM_ERR;
12824 if (argc == 2) {
12825 rc = Jim_EvalObj(interp, argv[1]);
12827 else {
12828 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12831 if (rc == JIM_ERR) {
12832 /* eval is "interesting", so add a stack frame here */
12833 interp->addStackTrace++;
12835 return rc;
12838 /* [uplevel] */
12839 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12841 if (argc >= 2) {
12842 int retcode;
12843 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12844 const char *str;
12846 /* Save the old callframe pointer */
12847 savedCallFrame = interp->framePtr;
12849 /* Lookup the target frame pointer */
12850 str = Jim_String(argv[1]);
12851 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12852 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12853 argc--;
12854 argv++;
12856 else {
12857 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12859 if (targetCallFrame == NULL) {
12860 return JIM_ERR;
12862 if (argc < 2) {
12863 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12864 return JIM_ERR;
12866 /* Eval the code in the target callframe. */
12867 interp->framePtr = targetCallFrame;
12868 if (argc == 2) {
12869 retcode = Jim_EvalObj(interp, argv[1]);
12871 else {
12872 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12874 interp->framePtr = savedCallFrame;
12875 return retcode;
12877 else {
12878 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12879 return JIM_ERR;
12883 /* [expr] */
12884 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12886 int retcode;
12888 if (argc == 2) {
12889 retcode = Jim_EvalExpression(interp, argv[1]);
12891 else if (argc > 2) {
12892 Jim_Obj *objPtr;
12894 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12895 Jim_IncrRefCount(objPtr);
12896 retcode = Jim_EvalExpression(interp, objPtr);
12897 Jim_DecrRefCount(interp, objPtr);
12899 else {
12900 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12901 return JIM_ERR;
12903 if (retcode != JIM_OK)
12904 return retcode;
12905 return JIM_OK;
12908 /* [break] */
12909 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12911 if (argc != 1) {
12912 Jim_WrongNumArgs(interp, 1, argv, "");
12913 return JIM_ERR;
12915 return JIM_BREAK;
12918 /* [continue] */
12919 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12921 if (argc != 1) {
12922 Jim_WrongNumArgs(interp, 1, argv, "");
12923 return JIM_ERR;
12925 return JIM_CONTINUE;
12928 /* [return] */
12929 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12931 int i;
12932 Jim_Obj *stackTraceObj = NULL;
12933 Jim_Obj *errorCodeObj = NULL;
12934 int returnCode = JIM_OK;
12935 long level = 1;
12937 for (i = 1; i < argc - 1; i += 2) {
12938 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
12939 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
12940 return JIM_ERR;
12943 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
12944 stackTraceObj = argv[i + 1];
12946 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
12947 errorCodeObj = argv[i + 1];
12949 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
12950 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
12951 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
12952 return JIM_ERR;
12955 else {
12956 break;
12960 if (i != argc - 1 && i != argc) {
12961 Jim_WrongNumArgs(interp, 1, argv,
12962 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
12965 /* If a stack trace is supplied and code is error, set the stack trace */
12966 if (stackTraceObj && returnCode == JIM_ERR) {
12967 JimSetStackTrace(interp, stackTraceObj);
12969 /* If an error code list is supplied, set the global $errorCode */
12970 if (errorCodeObj && returnCode == JIM_ERR) {
12971 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
12973 interp->returnCode = returnCode;
12974 interp->returnLevel = level;
12976 if (i == argc - 1) {
12977 Jim_SetResult(interp, argv[i]);
12979 return JIM_RETURN;
12982 /* [tailcall] */
12983 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12985 if (interp->framePtr->level == 0) {
12986 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
12987 return JIM_ERR;
12989 else if (argc >= 2) {
12990 /* Need to resolve the tailcall command in the current context */
12991 Jim_CallFrame *cf = interp->framePtr->parent;
12993 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
12994 if (cmdPtr == NULL) {
12995 return JIM_ERR;
12998 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13000 /* And stash this pre-resolved command */
13001 JimIncrCmdRefCount(cmdPtr);
13002 cf->tailcallCmd = cmdPtr;
13004 /* And stash the command list */
13005 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13007 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13008 Jim_IncrRefCount(cf->tailcallObj);
13010 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13011 return JIM_EVAL;
13013 return JIM_OK;
13016 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13018 Jim_Obj *cmdList;
13019 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13021 /* prefixListObj is a list to which the args need to be appended */
13022 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13023 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13025 return JimEvalObjList(interp, cmdList);
13028 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13030 Jim_Obj *prefixListObj = privData;
13031 Jim_DecrRefCount(interp, prefixListObj);
13034 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13036 Jim_Obj *prefixListObj;
13037 const char *newname;
13039 if (argc < 3) {
13040 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13041 return JIM_ERR;
13044 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13045 Jim_IncrRefCount(prefixListObj);
13046 newname = Jim_String(argv[1]);
13047 if (newname[0] == ':' && newname[1] == ':') {
13048 while (*++newname == ':') {
13052 Jim_SetResult(interp, argv[1]);
13054 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13057 /* [proc] */
13058 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13060 Jim_Cmd *cmd;
13062 if (argc != 4 && argc != 5) {
13063 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13064 return JIM_ERR;
13067 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13068 return JIM_ERR;
13071 if (argc == 4) {
13072 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13074 else {
13075 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13078 if (cmd) {
13079 /* Add the new command */
13080 Jim_Obj *qualifiedCmdNameObj;
13081 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13083 JimCreateCommand(interp, cmdname, cmd);
13085 /* Calculate and set the namespace for this proc */
13086 JimUpdateProcNamespace(interp, cmd, cmdname);
13088 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13090 /* Unlike Tcl, set the name of the proc as the result */
13091 Jim_SetResult(interp, argv[1]);
13092 return JIM_OK;
13094 return JIM_ERR;
13097 /* [local] */
13098 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13100 int retcode;
13102 if (argc < 2) {
13103 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13104 return JIM_ERR;
13107 /* Evaluate the arguments with 'local' in force */
13108 interp->local++;
13109 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13110 interp->local--;
13113 /* If OK, and the result is a proc, add it to the list of local procs */
13114 if (retcode == 0) {
13115 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13117 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13118 return JIM_ERR;
13120 if (interp->framePtr->localCommands == NULL) {
13121 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13122 Jim_InitStack(interp->framePtr->localCommands);
13124 Jim_IncrRefCount(cmdNameObj);
13125 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13128 return retcode;
13131 /* [upcall] */
13132 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13134 if (argc < 2) {
13135 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13136 return JIM_ERR;
13138 else {
13139 int retcode;
13141 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13142 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13143 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13144 return JIM_ERR;
13146 /* OK. Mark this command as being in an upcall */
13147 cmdPtr->u.proc.upcall++;
13148 JimIncrCmdRefCount(cmdPtr);
13150 /* Invoke the command as normal */
13151 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13153 /* No longer in an upcall */
13154 cmdPtr->u.proc.upcall--;
13155 JimDecrCmdRefCount(interp, cmdPtr);
13157 return retcode;
13161 /* [apply] */
13162 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13164 if (argc < 2) {
13165 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13166 return JIM_ERR;
13168 else {
13169 int ret;
13170 Jim_Cmd *cmd;
13171 Jim_Obj *argListObjPtr;
13172 Jim_Obj *bodyObjPtr;
13173 Jim_Obj *nsObj = NULL;
13174 Jim_Obj **nargv;
13176 int len = Jim_ListLength(interp, argv[1]);
13177 if (len != 2 && len != 3) {
13178 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13179 return JIM_ERR;
13182 if (len == 3) {
13183 #ifdef jim_ext_namespace
13184 /* Need to canonicalise the given namespace. */
13185 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13186 #else
13187 Jim_SetResultString(interp, "namespaces not enabled", -1);
13188 return JIM_ERR;
13189 #endif
13191 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13192 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13194 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13196 if (cmd) {
13197 /* Create a new argv array with a dummy argv[0], for error messages */
13198 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13199 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13200 Jim_IncrRefCount(nargv[0]);
13201 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13202 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13203 Jim_DecrRefCount(interp, nargv[0]);
13204 Jim_Free(nargv);
13206 JimDecrCmdRefCount(interp, cmd);
13207 return ret;
13209 return JIM_ERR;
13214 /* [concat] */
13215 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13217 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13218 return JIM_OK;
13221 /* [upvar] */
13222 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13224 int i;
13225 Jim_CallFrame *targetCallFrame;
13227 /* Lookup the target frame pointer */
13228 if (argc > 3 && (argc % 2 == 0)) {
13229 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13230 argc--;
13231 argv++;
13233 else {
13234 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13236 if (targetCallFrame == NULL) {
13237 return JIM_ERR;
13240 /* Check for arity */
13241 if (argc < 3) {
13242 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13243 return JIM_ERR;
13246 /* Now... for every other/local couple: */
13247 for (i = 1; i < argc; i += 2) {
13248 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13249 return JIM_ERR;
13251 return JIM_OK;
13254 /* [global] */
13255 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13257 int i;
13259 if (argc < 2) {
13260 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13261 return JIM_ERR;
13263 /* Link every var to the toplevel having the same name */
13264 if (interp->framePtr->level == 0)
13265 return JIM_OK; /* global at toplevel... */
13266 for (i = 1; i < argc; i++) {
13267 /* global ::blah does nothing */
13268 const char *name = Jim_String(argv[i]);
13269 if (name[0] != ':' || name[1] != ':') {
13270 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13271 return JIM_ERR;
13274 return JIM_OK;
13277 /* does the [string map] operation. On error NULL is returned,
13278 * otherwise a new string object with the result, having refcount = 0,
13279 * is returned. */
13280 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13281 Jim_Obj *objPtr, int nocase)
13283 int numMaps;
13284 const char *str, *noMatchStart = NULL;
13285 int strLen, i;
13286 Jim_Obj *resultObjPtr;
13288 numMaps = Jim_ListLength(interp, mapListObjPtr);
13289 if (numMaps % 2) {
13290 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13291 return NULL;
13294 str = Jim_String(objPtr);
13295 strLen = Jim_Utf8Length(interp, objPtr);
13297 /* Map it */
13298 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13299 while (strLen) {
13300 for (i = 0; i < numMaps; i += 2) {
13301 Jim_Obj *eachObjPtr;
13302 const char *k;
13303 int kl;
13305 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13306 k = Jim_String(eachObjPtr);
13307 kl = Jim_Utf8Length(interp, eachObjPtr);
13309 if (strLen >= kl && kl) {
13310 int rc;
13311 rc = JimStringCompareLen(str, k, kl, nocase);
13312 if (rc == 0) {
13313 if (noMatchStart) {
13314 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13315 noMatchStart = NULL;
13317 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13318 str += utf8_index(str, kl);
13319 strLen -= kl;
13320 break;
13324 if (i == numMaps) { /* no match */
13325 int c;
13326 if (noMatchStart == NULL)
13327 noMatchStart = str;
13328 str += utf8_tounicode(str, &c);
13329 strLen--;
13332 if (noMatchStart) {
13333 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13335 return resultObjPtr;
13338 /* [string] */
13339 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13341 int len;
13342 int opt_case = 1;
13343 int option;
13344 static const char * const options[] = {
13345 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13346 "map", "repeat", "reverse", "index", "first", "last", "cat",
13347 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13349 enum
13351 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13352 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13353 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13355 static const char * const nocase_options[] = {
13356 "-nocase", NULL
13358 static const char * const nocase_length_options[] = {
13359 "-nocase", "-length", NULL
13362 if (argc < 2) {
13363 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13364 return JIM_ERR;
13366 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13367 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13368 return Jim_CheckShowCommands(interp, argv[1], options);
13370 switch (option) {
13371 case OPT_LENGTH:
13372 case OPT_BYTELENGTH:
13373 if (argc != 3) {
13374 Jim_WrongNumArgs(interp, 2, argv, "string");
13375 return JIM_ERR;
13377 if (option == OPT_LENGTH) {
13378 len = Jim_Utf8Length(interp, argv[2]);
13380 else {
13381 len = Jim_Length(argv[2]);
13383 Jim_SetResultInt(interp, len);
13384 return JIM_OK;
13386 case OPT_CAT:{
13387 Jim_Obj *objPtr;
13388 if (argc == 3) {
13389 /* optimise the one-arg case */
13390 objPtr = argv[2];
13392 else {
13393 int i;
13395 objPtr = Jim_NewStringObj(interp, "", 0);
13397 for (i = 2; i < argc; i++) {
13398 Jim_AppendObj(interp, objPtr, argv[i]);
13401 Jim_SetResult(interp, objPtr);
13402 return JIM_OK;
13405 case OPT_COMPARE:
13406 case OPT_EQUAL:
13408 /* n is the number of remaining option args */
13409 long opt_length = -1;
13410 int n = argc - 4;
13411 int i = 2;
13412 while (n > 0) {
13413 int subopt;
13414 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13415 JIM_ENUM_ABBREV) != JIM_OK) {
13416 badcompareargs:
13417 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13418 return JIM_ERR;
13420 if (subopt == 0) {
13421 /* -nocase */
13422 opt_case = 0;
13423 n--;
13425 else {
13426 /* -length */
13427 if (n < 2) {
13428 goto badcompareargs;
13430 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13431 return JIM_ERR;
13433 n -= 2;
13436 if (n) {
13437 goto badcompareargs;
13439 argv += argc - 2;
13440 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13441 /* Fast version - [string equal], case sensitive, no length */
13442 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13444 else {
13445 if (opt_length >= 0) {
13446 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13448 else {
13449 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13451 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13453 return JIM_OK;
13456 case OPT_MATCH:
13457 if (argc != 4 &&
13458 (argc != 5 ||
13459 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13460 JIM_ENUM_ABBREV) != JIM_OK)) {
13461 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13462 return JIM_ERR;
13464 if (opt_case == 0) {
13465 argv++;
13467 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13468 return JIM_OK;
13470 case OPT_MAP:{
13471 Jim_Obj *objPtr;
13473 if (argc != 4 &&
13474 (argc != 5 ||
13475 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13476 JIM_ENUM_ABBREV) != JIM_OK)) {
13477 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13478 return JIM_ERR;
13481 if (opt_case == 0) {
13482 argv++;
13484 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13485 if (objPtr == NULL) {
13486 return JIM_ERR;
13488 Jim_SetResult(interp, objPtr);
13489 return JIM_OK;
13492 case OPT_RANGE:
13493 case OPT_BYTERANGE:{
13494 Jim_Obj *objPtr;
13496 if (argc != 5) {
13497 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13498 return JIM_ERR;
13500 if (option == OPT_RANGE) {
13501 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13503 else
13505 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13508 if (objPtr == NULL) {
13509 return JIM_ERR;
13511 Jim_SetResult(interp, objPtr);
13512 return JIM_OK;
13515 case OPT_REPLACE:{
13516 Jim_Obj *objPtr;
13518 if (argc != 5 && argc != 6) {
13519 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13520 return JIM_ERR;
13522 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13523 if (objPtr == NULL) {
13524 return JIM_ERR;
13526 Jim_SetResult(interp, objPtr);
13527 return JIM_OK;
13531 case OPT_REPEAT:{
13532 Jim_Obj *objPtr;
13533 jim_wide count;
13535 if (argc != 4) {
13536 Jim_WrongNumArgs(interp, 2, argv, "string count");
13537 return JIM_ERR;
13539 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13540 return JIM_ERR;
13542 objPtr = Jim_NewStringObj(interp, "", 0);
13543 if (count > 0) {
13544 while (count--) {
13545 Jim_AppendObj(interp, objPtr, argv[2]);
13548 Jim_SetResult(interp, objPtr);
13549 return JIM_OK;
13552 case OPT_REVERSE:{
13553 char *buf, *p;
13554 const char *str;
13555 int i;
13557 if (argc != 3) {
13558 Jim_WrongNumArgs(interp, 2, argv, "string");
13559 return JIM_ERR;
13562 str = Jim_GetString(argv[2], &len);
13563 buf = Jim_Alloc(len + 1);
13564 p = buf + len;
13565 *p = 0;
13566 for (i = 0; i < len; ) {
13567 int c;
13568 int l = utf8_tounicode(str, &c);
13569 memcpy(p - l, str, l);
13570 p -= l;
13571 i += l;
13572 str += l;
13574 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13575 return JIM_OK;
13578 case OPT_INDEX:{
13579 int idx;
13580 const char *str;
13582 if (argc != 4) {
13583 Jim_WrongNumArgs(interp, 2, argv, "string index");
13584 return JIM_ERR;
13586 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13587 return JIM_ERR;
13589 str = Jim_String(argv[2]);
13590 len = Jim_Utf8Length(interp, argv[2]);
13591 if (idx != INT_MIN && idx != INT_MAX) {
13592 idx = JimRelToAbsIndex(len, idx);
13594 if (idx < 0 || idx >= len || str == NULL) {
13595 Jim_SetResultString(interp, "", 0);
13597 else if (len == Jim_Length(argv[2])) {
13598 /* ASCII optimisation */
13599 Jim_SetResultString(interp, str + idx, 1);
13601 else {
13602 int c;
13603 int i = utf8_index(str, idx);
13604 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13606 return JIM_OK;
13609 case OPT_FIRST:
13610 case OPT_LAST:{
13611 int idx = 0, l1, l2;
13612 const char *s1, *s2;
13614 if (argc != 4 && argc != 5) {
13615 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13616 return JIM_ERR;
13618 s1 = Jim_String(argv[2]);
13619 s2 = Jim_String(argv[3]);
13620 l1 = Jim_Utf8Length(interp, argv[2]);
13621 l2 = Jim_Utf8Length(interp, argv[3]);
13622 if (argc == 5) {
13623 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13624 return JIM_ERR;
13626 idx = JimRelToAbsIndex(l2, idx);
13628 else if (option == OPT_LAST) {
13629 idx = l2;
13631 if (option == OPT_FIRST) {
13632 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13634 else {
13635 #ifdef JIM_UTF8
13636 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13637 #else
13638 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13639 #endif
13641 return JIM_OK;
13644 case OPT_TRIM:
13645 case OPT_TRIMLEFT:
13646 case OPT_TRIMRIGHT:{
13647 Jim_Obj *trimchars;
13649 if (argc != 3 && argc != 4) {
13650 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13651 return JIM_ERR;
13653 trimchars = (argc == 4 ? argv[3] : NULL);
13654 if (option == OPT_TRIM) {
13655 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13657 else if (option == OPT_TRIMLEFT) {
13658 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13660 else if (option == OPT_TRIMRIGHT) {
13661 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13663 return JIM_OK;
13666 case OPT_TOLOWER:
13667 case OPT_TOUPPER:
13668 case OPT_TOTITLE:
13669 if (argc != 3) {
13670 Jim_WrongNumArgs(interp, 2, argv, "string");
13671 return JIM_ERR;
13673 if (option == OPT_TOLOWER) {
13674 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13676 else if (option == OPT_TOUPPER) {
13677 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13679 else {
13680 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13682 return JIM_OK;
13684 case OPT_IS:
13685 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13686 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13688 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13689 return JIM_ERR;
13691 return JIM_OK;
13694 /* [time] */
13695 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13697 long i, count = 1;
13698 jim_wide start, elapsed;
13699 char buf[60];
13700 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13702 if (argc < 2) {
13703 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13704 return JIM_ERR;
13706 if (argc == 3) {
13707 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13708 return JIM_ERR;
13710 if (count < 0)
13711 return JIM_OK;
13712 i = count;
13713 start = JimClock();
13714 while (i-- > 0) {
13715 int retval;
13717 retval = Jim_EvalObj(interp, argv[1]);
13718 if (retval != JIM_OK) {
13719 return retval;
13722 elapsed = JimClock() - start;
13723 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13724 Jim_SetResultString(interp, buf, -1);
13725 return JIM_OK;
13728 /* [exit] */
13729 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13731 long exitCode = 0;
13733 if (argc > 2) {
13734 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13735 return JIM_ERR;
13737 if (argc == 2) {
13738 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13739 return JIM_ERR;
13741 interp->exitCode = exitCode;
13742 return JIM_EXIT;
13745 /* [catch] */
13746 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13748 int exitCode = 0;
13749 int i;
13750 int sig = 0;
13752 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13753 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13754 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13756 /* Reset the error code before catch.
13757 * Note that this is not strictly correct.
13759 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13761 for (i = 1; i < argc - 1; i++) {
13762 const char *arg = Jim_String(argv[i]);
13763 jim_wide option;
13764 int ignore;
13766 /* It's a pity we can't use Jim_GetEnum here :-( */
13767 if (strcmp(arg, "--") == 0) {
13768 i++;
13769 break;
13771 if (*arg != '-') {
13772 break;
13775 if (strncmp(arg, "-no", 3) == 0) {
13776 arg += 3;
13777 ignore = 1;
13779 else {
13780 arg++;
13781 ignore = 0;
13784 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13785 option = -1;
13787 if (option < 0) {
13788 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13790 if (option < 0) {
13791 goto wrongargs;
13794 if (ignore) {
13795 ignore_mask |= ((jim_wide)1 << option);
13797 else {
13798 ignore_mask &= (~((jim_wide)1 << option));
13802 argc -= i;
13803 if (argc < 1 || argc > 3) {
13804 wrongargs:
13805 Jim_WrongNumArgs(interp, 1, argv,
13806 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13807 return JIM_ERR;
13809 argv += i;
13811 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13812 sig++;
13815 interp->signal_level += sig;
13816 if (Jim_CheckSignal(interp)) {
13817 /* If a signal is set, don't even try to execute the body */
13818 exitCode = JIM_SIGNAL;
13820 else {
13821 exitCode = Jim_EvalObj(interp, argv[0]);
13822 /* Don't want any caught error included in a later stack trace */
13823 interp->errorFlag = 0;
13825 interp->signal_level -= sig;
13827 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13828 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13829 /* Not caught, pass it up */
13830 return exitCode;
13833 if (sig && exitCode == JIM_SIGNAL) {
13834 /* Catch the signal at this level */
13835 if (interp->signal_set_result) {
13836 interp->signal_set_result(interp, interp->sigmask);
13838 else {
13839 Jim_SetResultInt(interp, interp->sigmask);
13841 interp->sigmask = 0;
13844 if (argc >= 2) {
13845 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13846 return JIM_ERR;
13848 if (argc == 3) {
13849 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13851 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13852 Jim_ListAppendElement(interp, optListObj,
13853 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13854 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13855 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13856 if (exitCode == JIM_ERR) {
13857 Jim_Obj *errorCode;
13858 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13859 -1));
13860 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13862 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13863 if (errorCode) {
13864 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13865 Jim_ListAppendElement(interp, optListObj, errorCode);
13868 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13869 return JIM_ERR;
13873 Jim_SetResultInt(interp, exitCode);
13874 return JIM_OK;
13877 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
13879 /* [ref] */
13880 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13882 if (argc != 3 && argc != 4) {
13883 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13884 return JIM_ERR;
13886 if (argc == 3) {
13887 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13889 else {
13890 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13892 return JIM_OK;
13895 /* [getref] */
13896 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13898 Jim_Reference *refPtr;
13900 if (argc != 2) {
13901 Jim_WrongNumArgs(interp, 1, argv, "reference");
13902 return JIM_ERR;
13904 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13905 return JIM_ERR;
13906 Jim_SetResult(interp, refPtr->objPtr);
13907 return JIM_OK;
13910 /* [setref] */
13911 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13913 Jim_Reference *refPtr;
13915 if (argc != 3) {
13916 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13917 return JIM_ERR;
13919 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13920 return JIM_ERR;
13921 Jim_IncrRefCount(argv[2]);
13922 Jim_DecrRefCount(interp, refPtr->objPtr);
13923 refPtr->objPtr = argv[2];
13924 Jim_SetResult(interp, argv[2]);
13925 return JIM_OK;
13928 /* [collect] */
13929 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13931 if (argc != 1) {
13932 Jim_WrongNumArgs(interp, 1, argv, "");
13933 return JIM_ERR;
13935 Jim_SetResultInt(interp, Jim_Collect(interp));
13937 /* Free all the freed objects. */
13938 while (interp->freeList) {
13939 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13940 Jim_Free(interp->freeList);
13941 interp->freeList = nextObjPtr;
13944 return JIM_OK;
13947 /* [finalize] reference ?newValue? */
13948 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13950 if (argc != 2 && argc != 3) {
13951 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
13952 return JIM_ERR;
13954 if (argc == 2) {
13955 Jim_Obj *cmdNamePtr;
13957 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
13958 return JIM_ERR;
13959 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
13960 Jim_SetResult(interp, cmdNamePtr);
13962 else {
13963 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
13964 return JIM_ERR;
13965 Jim_SetResult(interp, argv[2]);
13967 return JIM_OK;
13970 /* [info references] */
13971 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13973 Jim_Obj *listObjPtr;
13974 Jim_HashTableIterator htiter;
13975 Jim_HashEntry *he;
13977 listObjPtr = Jim_NewListObj(interp, NULL, 0);
13979 JimInitHashTableIterator(&interp->references, &htiter);
13980 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
13981 char buf[JIM_REFERENCE_SPACE + 1];
13982 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
13983 const unsigned long *refId = he->key;
13985 JimFormatReference(buf, refPtr, *refId);
13986 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
13988 Jim_SetResult(interp, listObjPtr);
13989 return JIM_OK;
13991 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
13993 /* [rename] */
13994 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13996 if (argc != 3) {
13997 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
13998 return JIM_ERR;
14001 if (JimValidName(interp, "new procedure", argv[2])) {
14002 return JIM_ERR;
14005 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14008 #define JIM_DICTMATCH_KEYS 0x0001
14009 #define JIM_DICTMATCH_VALUES 0x002
14012 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14013 * return_types should be either or both
14015 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14017 Jim_HashEntry *he;
14018 Jim_Obj *listObjPtr;
14019 Jim_HashTableIterator htiter;
14021 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14022 return JIM_ERR;
14025 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14027 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14028 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14029 if (patternObj) {
14030 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14031 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14032 /* no match */
14033 continue;
14036 if (return_types & JIM_DICTMATCH_KEYS) {
14037 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14039 if (return_types & JIM_DICTMATCH_VALUES) {
14040 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14044 Jim_SetResult(interp, listObjPtr);
14045 return JIM_OK;
14048 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14050 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14051 return -1;
14053 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14057 * Must be called with at least one object.
14058 * Returns the new dictionary, or NULL on error.
14060 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14062 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14063 int i;
14065 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14067 /* Note that we don't optimise the trivial case of a single argument */
14069 for (i = 0; i < objc; i++) {
14070 Jim_HashTable *ht;
14071 Jim_HashTableIterator htiter;
14072 Jim_HashEntry *he;
14074 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14075 Jim_FreeNewObj(interp, objPtr);
14076 return NULL;
14078 ht = objv[i]->internalRep.ptr;
14079 JimInitHashTableIterator(ht, &htiter);
14080 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14081 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14084 return objPtr;
14087 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14089 Jim_HashTable *ht;
14090 unsigned int i;
14091 char buffer[100];
14092 int sum = 0;
14093 int nonzero_count = 0;
14094 Jim_Obj *output;
14095 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14097 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14098 return JIM_ERR;
14101 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14103 /* Note that this uses internal knowledge of the hash table */
14104 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14105 output = Jim_NewStringObj(interp, buffer, -1);
14107 for (i = 0; i < ht->size; i++) {
14108 Jim_HashEntry *he = ht->table[i];
14109 int entries = 0;
14110 while (he) {
14111 entries++;
14112 he = he->next;
14114 if (entries > 9) {
14115 bucket_counts[10]++;
14117 else {
14118 bucket_counts[entries]++;
14120 if (entries) {
14121 sum += entries;
14122 nonzero_count++;
14125 for (i = 0; i < 10; i++) {
14126 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14127 Jim_AppendString(interp, output, buffer, -1);
14129 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14130 Jim_AppendString(interp, output, buffer, -1);
14131 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14132 Jim_AppendString(interp, output, buffer, -1);
14133 Jim_SetResult(interp, output);
14134 return JIM_OK;
14137 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14139 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14141 Jim_AppendString(interp, prefixObj, " ", 1);
14142 Jim_AppendString(interp, prefixObj, subcmd, -1);
14144 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14148 * Implements the [dict with] command
14150 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14152 int i;
14153 Jim_Obj *objPtr;
14154 Jim_Obj *dictObj;
14155 Jim_Obj **dictValues;
14156 int len;
14157 int ret = JIM_OK;
14159 /* Open up the appropriate level of the dictionary */
14160 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14161 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14162 return JIM_ERR;
14164 /* Set the local variables */
14165 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14166 return JIM_ERR;
14168 for (i = 0; i < len; i += 2) {
14169 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14170 Jim_Free(dictValues);
14171 return JIM_ERR;
14175 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14176 if (Jim_Length(scriptObj)) {
14177 ret = Jim_EvalObj(interp, scriptObj);
14179 /* Now if the dictionary still exists, update it based on the local variables */
14180 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14181 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14182 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14183 for (i = 0; i < keyc; i++) {
14184 newkeyv[i] = keyv[i];
14187 for (i = 0; i < len; i += 2) {
14188 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14189 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14190 newkeyv[keyc] = dictValues[i];
14191 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14193 Jim_Free(newkeyv);
14197 Jim_Free(dictValues);
14199 return ret;
14202 /* [dict] */
14203 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14205 Jim_Obj *objPtr;
14206 int types = JIM_DICTMATCH_KEYS;
14207 int option;
14208 static const char * const options[] = {
14209 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14210 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14211 "replace", "update", NULL
14213 enum
14215 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14216 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14217 OPT_REPLACE, OPT_UPDATE,
14220 if (argc < 2) {
14221 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14222 return JIM_ERR;
14225 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14226 return Jim_CheckShowCommands(interp, argv[1], options);
14229 switch (option) {
14230 case OPT_GET:
14231 if (argc < 3) {
14232 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14233 return JIM_ERR;
14235 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14236 JIM_ERRMSG) != JIM_OK) {
14237 return JIM_ERR;
14239 Jim_SetResult(interp, objPtr);
14240 return JIM_OK;
14242 case OPT_SET:
14243 if (argc < 5) {
14244 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14245 return JIM_ERR;
14247 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14249 case OPT_EXISTS:
14250 if (argc < 4) {
14251 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14252 return JIM_ERR;
14254 else {
14255 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14256 if (rc < 0) {
14257 return JIM_ERR;
14259 Jim_SetResultBool(interp, rc == JIM_OK);
14260 return JIM_OK;
14263 case OPT_UNSET:
14264 if (argc < 4) {
14265 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14266 return JIM_ERR;
14268 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14269 return JIM_ERR;
14271 return JIM_OK;
14273 case OPT_VALUES:
14274 types = JIM_DICTMATCH_VALUES;
14275 /* fallthru */
14276 case OPT_KEYS:
14277 if (argc != 3 && argc != 4) {
14278 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14279 return JIM_ERR;
14281 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14283 case OPT_SIZE:
14284 if (argc != 3) {
14285 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14286 return JIM_ERR;
14288 else if (Jim_DictSize(interp, argv[2]) < 0) {
14289 return JIM_ERR;
14291 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14292 return JIM_OK;
14294 case OPT_MERGE:
14295 if (argc == 2) {
14296 return JIM_OK;
14298 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14299 if (objPtr == NULL) {
14300 return JIM_ERR;
14302 Jim_SetResult(interp, objPtr);
14303 return JIM_OK;
14305 case OPT_UPDATE:
14306 if (argc < 6 || argc % 2) {
14307 /* Better error message */
14308 argc = 2;
14310 break;
14312 case OPT_CREATE:
14313 if (argc % 2) {
14314 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14315 return JIM_ERR;
14317 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14318 Jim_SetResult(interp, objPtr);
14319 return JIM_OK;
14321 case OPT_INFO:
14322 if (argc != 3) {
14323 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14324 return JIM_ERR;
14326 return Jim_DictInfo(interp, argv[2]);
14328 case OPT_WITH:
14329 if (argc < 4) {
14330 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14331 return JIM_ERR;
14333 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14335 /* Handle command as an ensemble */
14336 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14339 /* [subst] */
14340 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14342 static const char * const options[] = {
14343 "-nobackslashes", "-nocommands", "-novariables", NULL
14345 enum
14346 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14347 int i;
14348 int flags = JIM_SUBST_FLAG;
14349 Jim_Obj *objPtr;
14351 if (argc < 2) {
14352 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14353 return JIM_ERR;
14355 for (i = 1; i < (argc - 1); i++) {
14356 int option;
14358 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14359 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14360 return JIM_ERR;
14362 switch (option) {
14363 case OPT_NOBACKSLASHES:
14364 flags |= JIM_SUBST_NOESC;
14365 break;
14366 case OPT_NOCOMMANDS:
14367 flags |= JIM_SUBST_NOCMD;
14368 break;
14369 case OPT_NOVARIABLES:
14370 flags |= JIM_SUBST_NOVAR;
14371 break;
14374 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14375 return JIM_ERR;
14377 Jim_SetResult(interp, objPtr);
14378 return JIM_OK;
14381 /* [info] */
14382 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14384 int cmd;
14385 Jim_Obj *objPtr;
14386 int mode = 0;
14388 static const char * const commands[] = {
14389 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14390 "vars", "version", "patchlevel", "complete", "args", "hostname",
14391 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14392 "references", "alias", NULL
14394 enum
14395 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14396 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14397 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14398 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14401 #ifdef jim_ext_namespace
14402 int nons = 0;
14404 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14405 /* This is for internal use only */
14406 argc--;
14407 argv++;
14408 nons = 1;
14410 #endif
14412 if (argc < 2) {
14413 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14414 return JIM_ERR;
14416 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14417 return Jim_CheckShowCommands(interp, argv[1], commands);
14420 /* Test for the most common commands first, just in case it makes a difference */
14421 switch (cmd) {
14422 case INFO_EXISTS:
14423 if (argc != 3) {
14424 Jim_WrongNumArgs(interp, 2, argv, "varName");
14425 return JIM_ERR;
14427 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14428 break;
14430 case INFO_ALIAS:{
14431 Jim_Cmd *cmdPtr;
14433 if (argc != 3) {
14434 Jim_WrongNumArgs(interp, 2, argv, "command");
14435 return JIM_ERR;
14437 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14438 return JIM_ERR;
14440 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14441 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14442 return JIM_ERR;
14444 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14445 return JIM_OK;
14448 case INFO_CHANNELS:
14449 mode++; /* JIM_CMDLIST_CHANNELS */
14450 #ifndef jim_ext_aio
14451 Jim_SetResultString(interp, "aio not enabled", -1);
14452 return JIM_ERR;
14453 #endif
14454 /* fall through */
14455 case INFO_PROCS:
14456 mode++; /* JIM_CMDLIST_PROCS */
14457 /* fall through */
14458 case INFO_COMMANDS:
14459 /* mode 0 => JIM_CMDLIST_COMMANDS */
14460 if (argc != 2 && argc != 3) {
14461 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14462 return JIM_ERR;
14464 #ifdef jim_ext_namespace
14465 if (!nons) {
14466 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14467 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14470 #endif
14471 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14472 break;
14474 case INFO_VARS:
14475 mode++; /* JIM_VARLIST_VARS */
14476 /* fall through */
14477 case INFO_LOCALS:
14478 mode++; /* JIM_VARLIST_LOCALS */
14479 /* fall through */
14480 case INFO_GLOBALS:
14481 /* mode 0 => JIM_VARLIST_GLOBALS */
14482 if (argc != 2 && argc != 3) {
14483 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14484 return JIM_ERR;
14486 #ifdef jim_ext_namespace
14487 if (!nons) {
14488 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14489 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14492 #endif
14493 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14494 break;
14496 case INFO_SCRIPT:
14497 if (argc != 2) {
14498 Jim_WrongNumArgs(interp, 2, argv, "");
14499 return JIM_ERR;
14501 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14502 break;
14504 case INFO_SOURCE:{
14505 jim_wide line;
14506 Jim_Obj *resObjPtr;
14507 Jim_Obj *fileNameObj;
14509 if (argc != 3 && argc != 5) {
14510 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14511 return JIM_ERR;
14513 if (argc == 5) {
14514 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14515 return JIM_ERR;
14517 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14518 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14520 else {
14521 if (argv[2]->typePtr == &sourceObjType) {
14522 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14523 line = argv[2]->internalRep.sourceValue.lineNumber;
14525 else if (argv[2]->typePtr == &scriptObjType) {
14526 ScriptObj *script = JimGetScript(interp, argv[2]);
14527 fileNameObj = script->fileNameObj;
14528 line = script->firstline;
14530 else {
14531 fileNameObj = interp->emptyObj;
14532 line = 1;
14534 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14535 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14536 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14538 Jim_SetResult(interp, resObjPtr);
14539 break;
14542 case INFO_STACKTRACE:
14543 Jim_SetResult(interp, interp->stackTrace);
14544 break;
14546 case INFO_LEVEL:
14547 case INFO_FRAME:
14548 switch (argc) {
14549 case 2:
14550 Jim_SetResultInt(interp, interp->framePtr->level);
14551 break;
14553 case 3:
14554 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14555 return JIM_ERR;
14557 Jim_SetResult(interp, objPtr);
14558 break;
14560 default:
14561 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14562 return JIM_ERR;
14564 break;
14566 case INFO_BODY:
14567 case INFO_STATICS:
14568 case INFO_ARGS:{
14569 Jim_Cmd *cmdPtr;
14571 if (argc != 3) {
14572 Jim_WrongNumArgs(interp, 2, argv, "procname");
14573 return JIM_ERR;
14575 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14576 return JIM_ERR;
14578 if (!cmdPtr->isproc) {
14579 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14580 return JIM_ERR;
14582 switch (cmd) {
14583 case INFO_BODY:
14584 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14585 break;
14586 case INFO_ARGS:
14587 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14588 break;
14589 case INFO_STATICS:
14590 if (cmdPtr->u.proc.staticVars) {
14591 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14592 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14594 break;
14596 break;
14599 case INFO_VERSION:
14600 case INFO_PATCHLEVEL:{
14601 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14603 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14604 Jim_SetResultString(interp, buf, -1);
14605 break;
14608 case INFO_COMPLETE:
14609 if (argc != 3 && argc != 4) {
14610 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14611 return JIM_ERR;
14613 else {
14614 char missing;
14616 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14617 if (missing != ' ' && argc == 4) {
14618 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14621 break;
14623 case INFO_HOSTNAME:
14624 /* Redirect to os.gethostname if it exists */
14625 return Jim_Eval(interp, "os.gethostname");
14627 case INFO_NAMEOFEXECUTABLE:
14628 /* Redirect to Tcl proc */
14629 return Jim_Eval(interp, "{info nameofexecutable}");
14631 case INFO_RETURNCODES:
14632 if (argc == 2) {
14633 int i;
14634 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14636 for (i = 0; jimReturnCodes[i]; i++) {
14637 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14638 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14639 jimReturnCodes[i], -1));
14642 Jim_SetResult(interp, listObjPtr);
14644 else if (argc == 3) {
14645 long code;
14646 const char *name;
14648 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14649 return JIM_ERR;
14651 name = Jim_ReturnCode(code);
14652 if (*name == '?') {
14653 Jim_SetResultInt(interp, code);
14655 else {
14656 Jim_SetResultString(interp, name, -1);
14659 else {
14660 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14661 return JIM_ERR;
14663 break;
14664 case INFO_REFERENCES:
14665 #ifdef JIM_REFERENCES
14666 return JimInfoReferences(interp, argc, argv);
14667 #else
14668 Jim_SetResultString(interp, "not supported", -1);
14669 return JIM_ERR;
14670 #endif
14672 return JIM_OK;
14675 /* [exists] */
14676 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14678 Jim_Obj *objPtr;
14679 int result = 0;
14681 static const char * const options[] = {
14682 "-command", "-proc", "-alias", "-var", NULL
14684 enum
14686 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14688 int option;
14690 if (argc == 2) {
14691 option = OPT_VAR;
14692 objPtr = argv[1];
14694 else if (argc == 3) {
14695 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14696 return JIM_ERR;
14698 objPtr = argv[2];
14700 else {
14701 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14702 return JIM_ERR;
14705 if (option == OPT_VAR) {
14706 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14708 else {
14709 /* Now different kinds of commands */
14710 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14712 if (cmd) {
14713 switch (option) {
14714 case OPT_COMMAND:
14715 result = 1;
14716 break;
14718 case OPT_ALIAS:
14719 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14720 break;
14722 case OPT_PROC:
14723 result = cmd->isproc;
14724 break;
14728 Jim_SetResultBool(interp, result);
14729 return JIM_OK;
14732 /* [split] */
14733 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14735 const char *str, *splitChars, *noMatchStart;
14736 int splitLen, strLen;
14737 Jim_Obj *resObjPtr;
14738 int c;
14739 int len;
14741 if (argc != 2 && argc != 3) {
14742 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14743 return JIM_ERR;
14746 str = Jim_GetString(argv[1], &len);
14747 if (len == 0) {
14748 return JIM_OK;
14750 strLen = Jim_Utf8Length(interp, argv[1]);
14752 /* Init */
14753 if (argc == 2) {
14754 splitChars = " \n\t\r";
14755 splitLen = 4;
14757 else {
14758 splitChars = Jim_String(argv[2]);
14759 splitLen = Jim_Utf8Length(interp, argv[2]);
14762 noMatchStart = str;
14763 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14765 /* Split */
14766 if (splitLen) {
14767 Jim_Obj *objPtr;
14768 while (strLen--) {
14769 const char *sc = splitChars;
14770 int scLen = splitLen;
14771 int sl = utf8_tounicode(str, &c);
14772 while (scLen--) {
14773 int pc;
14774 sc += utf8_tounicode(sc, &pc);
14775 if (c == pc) {
14776 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14777 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14778 noMatchStart = str + sl;
14779 break;
14782 str += sl;
14784 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14785 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14787 else {
14788 /* This handles the special case of splitchars eq {}
14789 * Optimise by sharing common (ASCII) characters
14791 Jim_Obj **commonObj = NULL;
14792 #define NUM_COMMON (128 - 9)
14793 while (strLen--) {
14794 int n = utf8_tounicode(str, &c);
14795 #ifdef JIM_OPTIMIZATION
14796 if (c >= 9 && c < 128) {
14797 /* Common ASCII char. Note that 9 is the tab character */
14798 c -= 9;
14799 if (!commonObj) {
14800 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14801 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14803 if (!commonObj[c]) {
14804 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14806 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14807 str++;
14808 continue;
14810 #endif
14811 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14812 str += n;
14814 Jim_Free(commonObj);
14817 Jim_SetResult(interp, resObjPtr);
14818 return JIM_OK;
14821 /* [join] */
14822 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14824 const char *joinStr;
14825 int joinStrLen;
14827 if (argc != 2 && argc != 3) {
14828 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14829 return JIM_ERR;
14831 /* Init */
14832 if (argc == 2) {
14833 joinStr = " ";
14834 joinStrLen = 1;
14836 else {
14837 joinStr = Jim_GetString(argv[2], &joinStrLen);
14839 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14840 return JIM_OK;
14843 /* [format] */
14844 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14846 Jim_Obj *objPtr;
14848 if (argc < 2) {
14849 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14850 return JIM_ERR;
14852 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14853 if (objPtr == NULL)
14854 return JIM_ERR;
14855 Jim_SetResult(interp, objPtr);
14856 return JIM_OK;
14859 /* [scan] */
14860 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14862 Jim_Obj *listPtr, **outVec;
14863 int outc, i;
14865 if (argc < 3) {
14866 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14867 return JIM_ERR;
14869 if (argv[2]->typePtr != &scanFmtStringObjType)
14870 SetScanFmtFromAny(interp, argv[2]);
14871 if (FormatGetError(argv[2]) != 0) {
14872 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14873 return JIM_ERR;
14875 if (argc > 3) {
14876 int maxPos = FormatGetMaxPos(argv[2]);
14877 int count = FormatGetCnvCount(argv[2]);
14879 if (maxPos > argc - 3) {
14880 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14881 return JIM_ERR;
14883 else if (count > argc - 3) {
14884 Jim_SetResultString(interp, "different numbers of variable names and "
14885 "field specifiers", -1);
14886 return JIM_ERR;
14888 else if (count < argc - 3) {
14889 Jim_SetResultString(interp, "variable is not assigned by any "
14890 "conversion specifiers", -1);
14891 return JIM_ERR;
14894 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14895 if (listPtr == 0)
14896 return JIM_ERR;
14897 if (argc > 3) {
14898 int rc = JIM_OK;
14899 int count = 0;
14901 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14902 int len = Jim_ListLength(interp, listPtr);
14904 if (len != 0) {
14905 JimListGetElements(interp, listPtr, &outc, &outVec);
14906 for (i = 0; i < outc; ++i) {
14907 if (Jim_Length(outVec[i]) > 0) {
14908 ++count;
14909 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14910 rc = JIM_ERR;
14915 Jim_FreeNewObj(interp, listPtr);
14917 else {
14918 count = -1;
14920 if (rc == JIM_OK) {
14921 Jim_SetResultInt(interp, count);
14923 return rc;
14925 else {
14926 if (listPtr == (Jim_Obj *)EOF) {
14927 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14928 return JIM_OK;
14930 Jim_SetResult(interp, listPtr);
14932 return JIM_OK;
14935 /* [error] */
14936 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14938 if (argc != 2 && argc != 3) {
14939 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14940 return JIM_ERR;
14942 Jim_SetResult(interp, argv[1]);
14943 if (argc == 3) {
14944 JimSetStackTrace(interp, argv[2]);
14945 return JIM_ERR;
14947 interp->addStackTrace++;
14948 return JIM_ERR;
14951 /* [lrange] */
14952 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14954 Jim_Obj *objPtr;
14956 if (argc != 4) {
14957 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14958 return JIM_ERR;
14960 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14961 return JIM_ERR;
14962 Jim_SetResult(interp, objPtr);
14963 return JIM_OK;
14966 /* [lrepeat] */
14967 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14969 Jim_Obj *objPtr;
14970 long count;
14972 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14973 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14974 return JIM_ERR;
14977 if (count == 0 || argc == 2) {
14978 return JIM_OK;
14981 argc -= 2;
14982 argv += 2;
14984 objPtr = Jim_NewListObj(interp, argv, argc);
14985 while (--count) {
14986 ListInsertElements(objPtr, -1, argc, argv);
14989 Jim_SetResult(interp, objPtr);
14990 return JIM_OK;
14993 char **Jim_GetEnviron(void)
14995 #if defined(HAVE__NSGETENVIRON)
14996 return *_NSGetEnviron();
14997 #else
14998 #if !defined(NO_ENVIRON_EXTERN)
14999 extern char **environ;
15000 #endif
15002 return environ;
15003 #endif
15006 void Jim_SetEnviron(char **env)
15008 #if defined(HAVE__NSGETENVIRON)
15009 *_NSGetEnviron() = env;
15010 #else
15011 #if !defined(NO_ENVIRON_EXTERN)
15012 extern char **environ;
15013 #endif
15015 environ = env;
15016 #endif
15019 /* [env] */
15020 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15022 const char *key;
15023 const char *val;
15025 if (argc == 1) {
15026 char **e = Jim_GetEnviron();
15028 int i;
15029 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15031 for (i = 0; e[i]; i++) {
15032 const char *equals = strchr(e[i], '=');
15034 if (equals) {
15035 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15036 equals - e[i]));
15037 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15041 Jim_SetResult(interp, listObjPtr);
15042 return JIM_OK;
15045 if (argc < 2) {
15046 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15047 return JIM_ERR;
15049 key = Jim_String(argv[1]);
15050 val = getenv(key);
15051 if (val == NULL) {
15052 if (argc < 3) {
15053 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15054 return JIM_ERR;
15056 val = Jim_String(argv[2]);
15058 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15059 return JIM_OK;
15062 /* [source] */
15063 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15065 int retval;
15067 if (argc != 2) {
15068 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15069 return JIM_ERR;
15071 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15072 if (retval == JIM_RETURN)
15073 return JIM_OK;
15074 return retval;
15077 /* [lreverse] */
15078 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15080 Jim_Obj *revObjPtr, **ele;
15081 int len;
15083 if (argc != 2) {
15084 Jim_WrongNumArgs(interp, 1, argv, "list");
15085 return JIM_ERR;
15087 JimListGetElements(interp, argv[1], &len, &ele);
15088 len--;
15089 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15090 while (len >= 0)
15091 ListAppendElement(revObjPtr, ele[len--]);
15092 Jim_SetResult(interp, revObjPtr);
15093 return JIM_OK;
15096 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15098 jim_wide len;
15100 if (step == 0)
15101 return -1;
15102 if (start == end)
15103 return 0;
15104 else if (step > 0 && start > end)
15105 return -1;
15106 else if (step < 0 && end > start)
15107 return -1;
15108 len = end - start;
15109 if (len < 0)
15110 len = -len; /* abs(len) */
15111 if (step < 0)
15112 step = -step; /* abs(step) */
15113 len = 1 + ((len - 1) / step);
15114 /* We can truncate safely to INT_MAX, the range command
15115 * will always return an error for a such long range
15116 * because Tcl lists can't be so long. */
15117 if (len > INT_MAX)
15118 len = INT_MAX;
15119 return (int)((len < 0) ? -1 : len);
15122 /* [range] */
15123 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15125 jim_wide start = 0, end, step = 1;
15126 int len, i;
15127 Jim_Obj *objPtr;
15129 if (argc < 2 || argc > 4) {
15130 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15131 return JIM_ERR;
15133 if (argc == 2) {
15134 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15135 return JIM_ERR;
15137 else {
15138 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15139 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15140 return JIM_ERR;
15141 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15142 return JIM_ERR;
15144 if ((len = JimRangeLen(start, end, step)) == -1) {
15145 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15146 return JIM_ERR;
15148 objPtr = Jim_NewListObj(interp, NULL, 0);
15149 for (i = 0; i < len; i++)
15150 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15151 Jim_SetResult(interp, objPtr);
15152 return JIM_OK;
15155 /* [rand] */
15156 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15158 jim_wide min = 0, max = 0, len, maxMul;
15160 if (argc < 1 || argc > 3) {
15161 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15162 return JIM_ERR;
15164 if (argc == 1) {
15165 max = JIM_WIDE_MAX;
15166 } else if (argc == 2) {
15167 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15168 return JIM_ERR;
15169 } else if (argc == 3) {
15170 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15171 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15172 return JIM_ERR;
15174 len = max-min;
15175 if (len < 0) {
15176 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15177 return JIM_ERR;
15179 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15180 while (1) {
15181 jim_wide r;
15183 JimRandomBytes(interp, &r, sizeof(jim_wide));
15184 if (r < 0 || r >= maxMul) continue;
15185 r = (len == 0) ? 0 : r%len;
15186 Jim_SetResultInt(interp, min+r);
15187 return JIM_OK;
15191 static const struct {
15192 const char *name;
15193 Jim_CmdProc *cmdProc;
15194 } Jim_CoreCommandsTable[] = {
15195 {"alias", Jim_AliasCoreCommand},
15196 {"set", Jim_SetCoreCommand},
15197 {"unset", Jim_UnsetCoreCommand},
15198 {"puts", Jim_PutsCoreCommand},
15199 {"+", Jim_AddCoreCommand},
15200 {"*", Jim_MulCoreCommand},
15201 {"-", Jim_SubCoreCommand},
15202 {"/", Jim_DivCoreCommand},
15203 {"incr", Jim_IncrCoreCommand},
15204 {"while", Jim_WhileCoreCommand},
15205 {"loop", Jim_LoopCoreCommand},
15206 {"for", Jim_ForCoreCommand},
15207 {"foreach", Jim_ForeachCoreCommand},
15208 {"lmap", Jim_LmapCoreCommand},
15209 {"lassign", Jim_LassignCoreCommand},
15210 {"if", Jim_IfCoreCommand},
15211 {"switch", Jim_SwitchCoreCommand},
15212 {"list", Jim_ListCoreCommand},
15213 {"lindex", Jim_LindexCoreCommand},
15214 {"lset", Jim_LsetCoreCommand},
15215 {"lsearch", Jim_LsearchCoreCommand},
15216 {"llength", Jim_LlengthCoreCommand},
15217 {"lappend", Jim_LappendCoreCommand},
15218 {"linsert", Jim_LinsertCoreCommand},
15219 {"lreplace", Jim_LreplaceCoreCommand},
15220 {"lsort", Jim_LsortCoreCommand},
15221 {"append", Jim_AppendCoreCommand},
15222 {"debug", Jim_DebugCoreCommand},
15223 {"eval", Jim_EvalCoreCommand},
15224 {"uplevel", Jim_UplevelCoreCommand},
15225 {"expr", Jim_ExprCoreCommand},
15226 {"break", Jim_BreakCoreCommand},
15227 {"continue", Jim_ContinueCoreCommand},
15228 {"proc", Jim_ProcCoreCommand},
15229 {"concat", Jim_ConcatCoreCommand},
15230 {"return", Jim_ReturnCoreCommand},
15231 {"upvar", Jim_UpvarCoreCommand},
15232 {"global", Jim_GlobalCoreCommand},
15233 {"string", Jim_StringCoreCommand},
15234 {"time", Jim_TimeCoreCommand},
15235 {"exit", Jim_ExitCoreCommand},
15236 {"catch", Jim_CatchCoreCommand},
15237 #ifdef JIM_REFERENCES
15238 {"ref", Jim_RefCoreCommand},
15239 {"getref", Jim_GetrefCoreCommand},
15240 {"setref", Jim_SetrefCoreCommand},
15241 {"finalize", Jim_FinalizeCoreCommand},
15242 {"collect", Jim_CollectCoreCommand},
15243 #endif
15244 {"rename", Jim_RenameCoreCommand},
15245 {"dict", Jim_DictCoreCommand},
15246 {"subst", Jim_SubstCoreCommand},
15247 {"info", Jim_InfoCoreCommand},
15248 {"exists", Jim_ExistsCoreCommand},
15249 {"split", Jim_SplitCoreCommand},
15250 {"join", Jim_JoinCoreCommand},
15251 {"format", Jim_FormatCoreCommand},
15252 {"scan", Jim_ScanCoreCommand},
15253 {"error", Jim_ErrorCoreCommand},
15254 {"lrange", Jim_LrangeCoreCommand},
15255 {"lrepeat", Jim_LrepeatCoreCommand},
15256 {"env", Jim_EnvCoreCommand},
15257 {"source", Jim_SourceCoreCommand},
15258 {"lreverse", Jim_LreverseCoreCommand},
15259 {"range", Jim_RangeCoreCommand},
15260 {"rand", Jim_RandCoreCommand},
15261 {"tailcall", Jim_TailcallCoreCommand},
15262 {"local", Jim_LocalCoreCommand},
15263 {"upcall", Jim_UpcallCoreCommand},
15264 {"apply", Jim_ApplyCoreCommand},
15265 {NULL, NULL},
15268 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15270 int i = 0;
15272 while (Jim_CoreCommandsTable[i].name != NULL) {
15273 Jim_CreateCommand(interp,
15274 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15275 i++;
15279 /* -----------------------------------------------------------------------------
15280 * Interactive prompt
15281 * ---------------------------------------------------------------------------*/
15282 void Jim_MakeErrorMessage(Jim_Interp *interp)
15284 Jim_Obj *argv[2];
15286 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15287 argv[1] = interp->result;
15289 Jim_EvalObjVector(interp, 2, argv);
15293 * Given a null terminated array of strings, returns an allocated, sorted
15294 * copy of the array.
15296 static char **JimSortStringTable(const char *const *tablePtr)
15298 int count;
15299 char **tablePtrSorted;
15301 /* Find the size of the table */
15302 for (count = 0; tablePtr[count]; count++) {
15305 /* Allocate one extra for the terminating NULL pointer */
15306 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15307 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15308 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15309 tablePtrSorted[count] = NULL;
15311 return tablePtrSorted;
15314 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15315 const char *prefix, const char *const *tablePtr, const char *name)
15317 char **tablePtrSorted;
15318 int i;
15320 if (name == NULL) {
15321 name = "option";
15324 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15325 tablePtrSorted = JimSortStringTable(tablePtr);
15326 for (i = 0; tablePtrSorted[i]; i++) {
15327 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15328 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15330 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15331 if (tablePtrSorted[i + 1]) {
15332 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15335 Jim_Free(tablePtrSorted);
15340 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15341 * and returns JIM_OK.
15343 * Otherwise returns JIM_ERR.
15345 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15347 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15348 int i;
15349 char **tablePtrSorted = JimSortStringTable(tablePtr);
15350 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15351 for (i = 0; tablePtrSorted[i]; i++) {
15352 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15354 Jim_Free(tablePtrSorted);
15355 return JIM_OK;
15357 return JIM_ERR;
15360 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15361 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15363 const char *bad = "bad ";
15364 const char *const *entryPtr = NULL;
15365 int i;
15366 int match = -1;
15367 int arglen;
15368 const char *arg = Jim_GetString(objPtr, &arglen);
15370 *indexPtr = -1;
15372 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15373 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15374 /* Found an exact match */
15375 *indexPtr = i;
15376 return JIM_OK;
15378 if (flags & JIM_ENUM_ABBREV) {
15379 /* Accept an unambiguous abbreviation.
15380 * Note that '-' doesnt' consitute a valid abbreviation
15382 if (strncmp(arg, *entryPtr, arglen) == 0) {
15383 if (*arg == '-' && arglen == 1) {
15384 break;
15386 if (match >= 0) {
15387 bad = "ambiguous ";
15388 goto ambiguous;
15390 match = i;
15395 /* If we had an unambiguous partial match */
15396 if (match >= 0) {
15397 *indexPtr = match;
15398 return JIM_OK;
15401 ambiguous:
15402 if (flags & JIM_ERRMSG) {
15403 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15405 return JIM_ERR;
15408 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15410 int i;
15412 for (i = 0; i < (int)len; i++) {
15413 if (array[i] && strcmp(array[i], name) == 0) {
15414 return i;
15417 return -1;
15420 int Jim_IsDict(Jim_Obj *objPtr)
15422 return objPtr->typePtr == &dictObjType;
15425 int Jim_IsList(Jim_Obj *objPtr)
15427 return objPtr->typePtr == &listObjType;
15431 * Very simple printf-like formatting, designed for error messages.
15433 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15434 * The resulting string is created and set as the result.
15436 * Each '%s' should correspond to a regular string parameter.
15437 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15438 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15440 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15442 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15444 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15446 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15448 /* Initial space needed */
15449 int len = strlen(format);
15450 int extra = 0;
15451 int n = 0;
15452 const char *params[5];
15453 int nobjparam = 0;
15454 Jim_Obj *objparam[5];
15455 char *buf;
15456 va_list args;
15457 int i;
15459 va_start(args, format);
15461 for (i = 0; i < len && n < 5; i++) {
15462 int l;
15464 if (strncmp(format + i, "%s", 2) == 0) {
15465 params[n] = va_arg(args, char *);
15467 l = strlen(params[n]);
15469 else if (strncmp(format + i, "%#s", 3) == 0) {
15470 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15472 params[n] = Jim_GetString(objPtr, &l);
15473 objparam[nobjparam++] = objPtr;
15474 Jim_IncrRefCount(objPtr);
15476 else {
15477 if (format[i] == '%') {
15478 i++;
15480 continue;
15482 n++;
15483 extra += l;
15486 len += extra;
15487 buf = Jim_Alloc(len + 1);
15488 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15490 va_end(args);
15492 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15494 for (i = 0; i < nobjparam; i++) {
15495 Jim_DecrRefCount(interp, objparam[i]);
15499 /* stubs */
15500 #ifndef jim_ext_package
15501 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15503 return JIM_OK;
15505 #endif
15506 #ifndef jim_ext_aio
15507 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15509 Jim_SetResultString(interp, "aio not enabled", -1);
15510 return NULL;
15512 #endif
15516 * Local Variables: ***
15517 * c-basic-offset: 4 ***
15518 * tab-width: 4 ***
15519 * End: ***