optimisation: Reuse ExprBool in Jim_GetBoolFromExpr()
[jimtcl.git] / jim.c
blob18217b707e985535992c9a01c3ddaa50c01a2ea1
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);
2311 static const Jim_ObjType dictSubstObjType = {
2312 "dict-substitution",
2313 FreeDictSubstInternalRep,
2314 NULL,
2315 NULL,
2316 JIM_TYPE_NONE,
2319 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2320 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2322 static const Jim_ObjType interpolatedObjType = {
2323 "interpolated",
2324 FreeInterpolatedInternalRep,
2325 DupInterpolatedInternalRep,
2326 NULL,
2327 JIM_TYPE_NONE,
2330 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2332 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2335 static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2337 /* Copy the interal rep */
2338 dupPtr->internalRep = srcPtr->internalRep;
2339 /* Need to increment the key ref count */
2340 Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr);
2343 /* -----------------------------------------------------------------------------
2344 * String Object
2345 * ---------------------------------------------------------------------------*/
2346 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2347 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2349 static const Jim_ObjType stringObjType = {
2350 "string",
2351 NULL,
2352 DupStringInternalRep,
2353 NULL,
2354 JIM_TYPE_REFERENCES,
2357 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2359 JIM_NOTUSED(interp);
2361 /* This is a bit subtle: the only caller of this function
2362 * should be Jim_DuplicateObj(), that will copy the
2363 * string representaion. After the copy, the duplicated
2364 * object will not have more room in the buffer than
2365 * srcPtr->length bytes. So we just set it to length. */
2366 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2367 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2370 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2372 if (objPtr->typePtr != &stringObjType) {
2373 /* Get a fresh string representation. */
2374 if (objPtr->bytes == NULL) {
2375 /* Invalid string repr. Generate it. */
2376 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2377 objPtr->typePtr->updateStringProc(objPtr);
2379 /* Free any other internal representation. */
2380 Jim_FreeIntRep(interp, objPtr);
2381 /* Set it as string, i.e. just set the maxLength field. */
2382 objPtr->typePtr = &stringObjType;
2383 objPtr->internalRep.strValue.maxLength = objPtr->length;
2384 /* Don't know the utf-8 length yet */
2385 objPtr->internalRep.strValue.charLength = -1;
2387 return JIM_OK;
2391 * Returns the length of the object string in chars, not bytes.
2393 * These may be different for a utf-8 string.
2395 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2397 #ifdef JIM_UTF8
2398 SetStringFromAny(interp, objPtr);
2400 if (objPtr->internalRep.strValue.charLength < 0) {
2401 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2403 return objPtr->internalRep.strValue.charLength;
2404 #else
2405 return Jim_Length(objPtr);
2406 #endif
2409 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2410 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2412 Jim_Obj *objPtr = Jim_NewObj(interp);
2414 /* Need to find out how many bytes the string requires */
2415 if (len == -1)
2416 len = strlen(s);
2417 /* Alloc/Set the string rep. */
2418 if (len == 0) {
2419 objPtr->bytes = JimEmptyStringRep;
2421 else {
2422 objPtr->bytes = Jim_Alloc(len + 1);
2423 memcpy(objPtr->bytes, s, len);
2424 objPtr->bytes[len] = '\0';
2426 objPtr->length = len;
2428 /* No typePtr field for the vanilla string object. */
2429 objPtr->typePtr = NULL;
2430 return objPtr;
2433 /* charlen is in characters -- see also Jim_NewStringObj() */
2434 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2436 #ifdef JIM_UTF8
2437 /* Need to find out how many bytes the string requires */
2438 int bytelen = utf8_index(s, charlen);
2440 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2442 /* Remember the utf8 length, so set the type */
2443 objPtr->typePtr = &stringObjType;
2444 objPtr->internalRep.strValue.maxLength = bytelen;
2445 objPtr->internalRep.strValue.charLength = charlen;
2447 return objPtr;
2448 #else
2449 return Jim_NewStringObj(interp, s, charlen);
2450 #endif
2453 /* This version does not try to duplicate the 's' pointer, but
2454 * use it directly. */
2455 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2457 Jim_Obj *objPtr = Jim_NewObj(interp);
2459 objPtr->bytes = s;
2460 objPtr->length = (len == -1) ? strlen(s) : len;
2461 objPtr->typePtr = NULL;
2462 return objPtr;
2465 /* Low-level string append. Use it only against unshared objects
2466 * of type "string". */
2467 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2469 int needlen;
2471 if (len == -1)
2472 len = strlen(str);
2473 needlen = objPtr->length + len;
2474 if (objPtr->internalRep.strValue.maxLength < needlen ||
2475 objPtr->internalRep.strValue.maxLength == 0) {
2476 needlen *= 2;
2477 /* Inefficient to malloc() for less than 8 bytes */
2478 if (needlen < 7) {
2479 needlen = 7;
2481 if (objPtr->bytes == JimEmptyStringRep) {
2482 objPtr->bytes = Jim_Alloc(needlen + 1);
2484 else {
2485 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2487 objPtr->internalRep.strValue.maxLength = needlen;
2489 memcpy(objPtr->bytes + objPtr->length, str, len);
2490 objPtr->bytes[objPtr->length + len] = '\0';
2492 if (objPtr->internalRep.strValue.charLength >= 0) {
2493 /* Update the utf-8 char length */
2494 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2496 objPtr->length += len;
2499 /* Higher level API to append strings to objects.
2500 * Object must not be unshared for each of these.
2502 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2504 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2505 SetStringFromAny(interp, objPtr);
2506 StringAppendString(objPtr, str, len);
2509 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2511 int len;
2512 const char *str = Jim_GetString(appendObjPtr, &len);
2513 Jim_AppendString(interp, objPtr, str, len);
2516 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2518 va_list ap;
2520 SetStringFromAny(interp, objPtr);
2521 va_start(ap, objPtr);
2522 while (1) {
2523 const char *s = va_arg(ap, const char *);
2525 if (s == NULL)
2526 break;
2527 Jim_AppendString(interp, objPtr, s, -1);
2529 va_end(ap);
2532 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2534 if (aObjPtr == bObjPtr) {
2535 return 1;
2537 else {
2538 int Alen, Blen;
2539 const char *sA = Jim_GetString(aObjPtr, &Alen);
2540 const char *sB = Jim_GetString(bObjPtr, &Blen);
2542 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2547 * Note. Does not support embedded nulls in either the pattern or the object.
2549 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2551 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2555 * Note: does not support embedded nulls for the nocase option.
2557 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2559 int l1, l2;
2560 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2561 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2563 if (nocase) {
2564 /* Do a character compare for nocase */
2565 return JimStringCompareLen(s1, s2, -1, nocase);
2567 return JimStringCompare(s1, l1, s2, l2);
2571 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2573 * Note: does not support embedded nulls
2575 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2577 const char *s1 = Jim_String(firstObjPtr);
2578 const char *s2 = Jim_String(secondObjPtr);
2580 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2583 /* Convert a range, as returned by Jim_GetRange(), into
2584 * an absolute index into an object of the specified length.
2585 * This function may return negative values, or values
2586 * greater than or equal to the length of the list if the index
2587 * is out of range. */
2588 static int JimRelToAbsIndex(int len, int idx)
2590 if (idx < 0)
2591 return len + idx;
2592 return idx;
2595 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2596 * into a form suitable for implementation of commands like [string range] and [lrange].
2598 * The resulting range is guaranteed to address valid elements of
2599 * the structure.
2601 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2603 int rangeLen;
2605 if (*firstPtr > *lastPtr) {
2606 rangeLen = 0;
2608 else {
2609 rangeLen = *lastPtr - *firstPtr + 1;
2610 if (rangeLen) {
2611 if (*firstPtr < 0) {
2612 rangeLen += *firstPtr;
2613 *firstPtr = 0;
2615 if (*lastPtr >= len) {
2616 rangeLen -= (*lastPtr - (len - 1));
2617 *lastPtr = len - 1;
2621 if (rangeLen < 0)
2622 rangeLen = 0;
2624 *rangeLenPtr = rangeLen;
2627 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2628 int len, int *first, int *last, int *range)
2630 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2631 return JIM_ERR;
2633 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2634 return JIM_ERR;
2636 *first = JimRelToAbsIndex(len, *first);
2637 *last = JimRelToAbsIndex(len, *last);
2638 JimRelToAbsRange(len, first, last, range);
2639 return JIM_OK;
2642 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2643 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2645 int first, last;
2646 const char *str;
2647 int rangeLen;
2648 int bytelen;
2650 str = Jim_GetString(strObjPtr, &bytelen);
2652 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2653 return NULL;
2656 if (first == 0 && rangeLen == bytelen) {
2657 return strObjPtr;
2659 return Jim_NewStringObj(interp, str + first, rangeLen);
2662 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2663 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2665 #ifdef JIM_UTF8
2666 int first, last;
2667 const char *str;
2668 int len, rangeLen;
2669 int bytelen;
2671 str = Jim_GetString(strObjPtr, &bytelen);
2672 len = Jim_Utf8Length(interp, strObjPtr);
2674 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2675 return NULL;
2678 if (first == 0 && rangeLen == len) {
2679 return strObjPtr;
2681 if (len == bytelen) {
2682 /* ASCII optimisation */
2683 return Jim_NewStringObj(interp, str + first, rangeLen);
2685 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2686 #else
2687 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2688 #endif
2691 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2692 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2694 int first, last;
2695 const char *str;
2696 int len, rangeLen;
2697 Jim_Obj *objPtr;
2699 len = Jim_Utf8Length(interp, strObjPtr);
2701 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2702 return NULL;
2705 if (last < first) {
2706 return strObjPtr;
2709 str = Jim_String(strObjPtr);
2711 /* Before part */
2712 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2714 /* Replacement */
2715 if (newStrObj) {
2716 Jim_AppendObj(interp, objPtr, newStrObj);
2719 /* After part */
2720 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2722 return objPtr;
2726 * Note: does not support embedded nulls.
2728 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2730 while (*str) {
2731 int c;
2732 str += utf8_tounicode(str, &c);
2733 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2735 *dest = 0;
2739 * Note: does not support embedded nulls.
2741 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2743 char *buf;
2744 int len;
2745 const char *str;
2747 SetStringFromAny(interp, strObjPtr);
2749 str = Jim_GetString(strObjPtr, &len);
2751 #ifdef JIM_UTF8
2752 /* Case mapping can change the utf-8 length of the string.
2753 * But at worst it will be by one extra byte per char
2755 len *= 2;
2756 #endif
2757 buf = Jim_Alloc(len + 1);
2758 JimStrCopyUpperLower(buf, str, 0);
2759 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2763 * Note: does not support embedded nulls.
2765 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2767 char *buf;
2768 const char *str;
2769 int len;
2771 if (strObjPtr->typePtr != &stringObjType) {
2772 SetStringFromAny(interp, strObjPtr);
2775 str = Jim_GetString(strObjPtr, &len);
2777 #ifdef JIM_UTF8
2778 /* Case mapping can change the utf-8 length of the string.
2779 * But at worst it will be by one extra byte per char
2781 len *= 2;
2782 #endif
2783 buf = Jim_Alloc(len + 1);
2784 JimStrCopyUpperLower(buf, str, 1);
2785 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2789 * Note: does not support embedded nulls.
2791 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2793 char *buf, *p;
2794 int len;
2795 int c;
2796 const char *str;
2798 str = Jim_GetString(strObjPtr, &len);
2799 if (len == 0) {
2800 return strObjPtr;
2802 #ifdef JIM_UTF8
2803 /* Case mapping can change the utf-8 length of the string.
2804 * But at worst it will be by one extra byte per char
2806 len *= 2;
2807 #endif
2808 buf = p = Jim_Alloc(len + 1);
2810 str += utf8_tounicode(str, &c);
2811 p += utf8_getchars(p, utf8_title(c));
2813 JimStrCopyUpperLower(p, str, 0);
2815 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2818 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2819 * for unicode character 'c'.
2820 * Returns the position if found or NULL if not
2822 static const char *utf8_memchr(const char *str, int len, int c)
2824 #ifdef JIM_UTF8
2825 while (len) {
2826 int sc;
2827 int n = utf8_tounicode(str, &sc);
2828 if (sc == c) {
2829 return str;
2831 str += n;
2832 len -= n;
2834 return NULL;
2835 #else
2836 return memchr(str, c, len);
2837 #endif
2841 * Searches for the first non-trim char in string (str, len)
2843 * If none is found, returns just past the last char.
2845 * Lengths are in bytes.
2847 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2849 while (len) {
2850 int c;
2851 int n = utf8_tounicode(str, &c);
2853 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2854 /* Not a trim char, so stop */
2855 break;
2857 str += n;
2858 len -= n;
2860 return str;
2864 * Searches backwards for a non-trim char in string (str, len).
2866 * Returns a pointer to just after the non-trim char, or NULL if not found.
2868 * Lengths are in bytes.
2870 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2872 str += len;
2874 while (len) {
2875 int c;
2876 int n = utf8_prev_len(str, len);
2878 len -= n;
2879 str -= n;
2881 n = utf8_tounicode(str, &c);
2883 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2884 return str + n;
2888 return NULL;
2891 static const char default_trim_chars[] = " \t\n\r";
2892 /* sizeof() here includes the null byte */
2893 static int default_trim_chars_len = sizeof(default_trim_chars);
2895 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2897 int len;
2898 const char *str = Jim_GetString(strObjPtr, &len);
2899 const char *trimchars = default_trim_chars;
2900 int trimcharslen = default_trim_chars_len;
2901 const char *newstr;
2903 if (trimcharsObjPtr) {
2904 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2907 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2908 if (newstr == str) {
2909 return strObjPtr;
2912 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2915 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2917 int len;
2918 const char *trimchars = default_trim_chars;
2919 int trimcharslen = default_trim_chars_len;
2920 const char *nontrim;
2922 if (trimcharsObjPtr) {
2923 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2926 SetStringFromAny(interp, strObjPtr);
2928 len = Jim_Length(strObjPtr);
2929 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2931 if (nontrim == NULL) {
2932 /* All trim, so return a zero-length string */
2933 return Jim_NewEmptyStringObj(interp);
2935 if (nontrim == strObjPtr->bytes + len) {
2936 /* All non-trim, so return the original object */
2937 return strObjPtr;
2940 if (Jim_IsShared(strObjPtr)) {
2941 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2943 else {
2944 /* Can modify this string in place */
2945 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2946 strObjPtr->length = (nontrim - strObjPtr->bytes);
2949 return strObjPtr;
2952 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2954 /* First trim left. */
2955 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2957 /* Now trim right */
2958 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2960 /* Note: refCount check is needed since objPtr may be emptyObj */
2961 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2962 /* We don't want this object to be leaked */
2963 Jim_FreeNewObj(interp, objPtr);
2966 return strObjPtr;
2969 /* Some platforms don't have isascii - need a non-macro version */
2970 #ifdef HAVE_ISASCII
2971 #define jim_isascii isascii
2972 #else
2973 static int jim_isascii(int c)
2975 return !(c & ~0x7f);
2977 #endif
2979 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2981 static const char * const strclassnames[] = {
2982 "integer", "alpha", "alnum", "ascii", "digit",
2983 "double", "lower", "upper", "space", "xdigit",
2984 "control", "print", "graph", "punct", "boolean",
2985 NULL
2987 enum {
2988 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2989 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2990 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN,
2992 int strclass;
2993 int len;
2994 int i;
2995 const char *str;
2996 int (*isclassfunc)(int c) = NULL;
2998 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2999 return JIM_ERR;
3002 str = Jim_GetString(strObjPtr, &len);
3003 if (len == 0) {
3004 Jim_SetResultBool(interp, !strict);
3005 return JIM_OK;
3008 switch (strclass) {
3009 case STR_IS_INTEGER:
3011 jim_wide w;
3012 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3013 return JIM_OK;
3016 case STR_IS_DOUBLE:
3018 double d;
3019 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3020 return JIM_OK;
3023 case STR_IS_BOOLEAN:
3025 int b;
3026 Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK);
3027 return JIM_OK;
3030 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3031 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3032 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3033 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3034 case STR_IS_LOWER: isclassfunc = islower; break;
3035 case STR_IS_UPPER: isclassfunc = isupper; break;
3036 case STR_IS_SPACE: isclassfunc = isspace; break;
3037 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3038 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3039 case STR_IS_PRINT: isclassfunc = isprint; break;
3040 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3041 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3042 default:
3043 return JIM_ERR;
3046 for (i = 0; i < len; i++) {
3047 if (!isclassfunc(UCHAR(str[i]))) {
3048 Jim_SetResultBool(interp, 0);
3049 return JIM_OK;
3052 Jim_SetResultBool(interp, 1);
3053 return JIM_OK;
3056 /* -----------------------------------------------------------------------------
3057 * Compared String Object
3058 * ---------------------------------------------------------------------------*/
3060 /* This is strange object that allows comparison of a C literal string
3061 * with a Jim object in a very short time if the same comparison is done
3062 * multiple times. For example every time the [if] command is executed,
3063 * Jim has to check if a given argument is "else".
3064 * If the code has no errors, this comparison is true most of the time,
3065 * so we can cache the pointer of the string of the last matching
3066 * comparison inside the object. Because most C compilers perform literal sharing,
3067 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3068 * this works pretty well even if comparisons are at different places
3069 * inside the C code. */
3071 static const Jim_ObjType comparedStringObjType = {
3072 "compared-string",
3073 NULL,
3074 NULL,
3075 NULL,
3076 JIM_TYPE_REFERENCES,
3079 /* The only way this object is exposed to the API is via the following
3080 * function. Returns true if the string and the object string repr.
3081 * are the same, otherwise zero is returned.
3083 * Note: this isn't binary safe, but it hardly needs to be.*/
3084 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3086 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3087 return 1;
3089 else {
3090 const char *objStr = Jim_String(objPtr);
3092 if (strcmp(str, objStr) != 0)
3093 return 0;
3095 if (objPtr->typePtr != &comparedStringObjType) {
3096 Jim_FreeIntRep(interp, objPtr);
3097 objPtr->typePtr = &comparedStringObjType;
3099 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3100 return 1;
3104 static int qsortCompareStringPointers(const void *a, const void *b)
3106 char *const *sa = (char *const *)a;
3107 char *const *sb = (char *const *)b;
3109 return strcmp(*sa, *sb);
3113 /* -----------------------------------------------------------------------------
3114 * Source Object
3116 * This object is just a string from the language point of view, but
3117 * the internal representation contains the filename and line number
3118 * where this token was read. This information is used by
3119 * Jim_EvalObj() if the object passed happens to be of type "source".
3121 * This allows propagation of the information about line numbers and file
3122 * names and gives error messages with absolute line numbers.
3124 * Note that this object uses the internal representation of the Jim_Object,
3125 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3127 * Also the object will be converted to something else if the given
3128 * token it represents in the source file is not something to be
3129 * evaluated (not a script), and will be specialized in some other way,
3130 * so the time overhead is also almost zero.
3131 * ---------------------------------------------------------------------------*/
3133 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3134 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3136 static const Jim_ObjType sourceObjType = {
3137 "source",
3138 FreeSourceInternalRep,
3139 DupSourceInternalRep,
3140 NULL,
3141 JIM_TYPE_REFERENCES,
3144 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3146 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3149 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3151 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3152 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3155 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3156 Jim_Obj *fileNameObj, int lineNumber)
3158 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3159 JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object"));
3160 Jim_IncrRefCount(fileNameObj);
3161 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3162 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3163 objPtr->typePtr = &sourceObjType;
3166 /* -----------------------------------------------------------------------------
3167 * ScriptLine Object
3169 * This object is used only in the Script internal represenation.
3170 * For each line of the script, it holds the number of tokens on the line
3171 * and the source line number.
3173 static const Jim_ObjType scriptLineObjType = {
3174 "scriptline",
3175 NULL,
3176 NULL,
3177 NULL,
3178 JIM_NONE,
3181 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3183 Jim_Obj *objPtr;
3185 #ifdef DEBUG_SHOW_SCRIPT
3186 char buf[100];
3187 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3188 objPtr = Jim_NewStringObj(interp, buf, -1);
3189 #else
3190 objPtr = Jim_NewEmptyStringObj(interp);
3191 #endif
3192 objPtr->typePtr = &scriptLineObjType;
3193 objPtr->internalRep.scriptLineValue.argc = argc;
3194 objPtr->internalRep.scriptLineValue.line = line;
3196 return objPtr;
3199 /* -----------------------------------------------------------------------------
3200 * Script Object
3202 * This object holds the parsed internal representation of a script.
3203 * This representation is help within an allocated ScriptObj (see below)
3205 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3206 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3208 static const Jim_ObjType scriptObjType = {
3209 "script",
3210 FreeScriptInternalRep,
3211 DupScriptInternalRep,
3212 NULL,
3213 JIM_TYPE_REFERENCES,
3216 /* Each token of a script is represented by a ScriptToken.
3217 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3218 * can be specialized by commands operating on it.
3220 typedef struct ScriptToken
3222 Jim_Obj *objPtr;
3223 int type;
3224 } ScriptToken;
3226 /* This is the script object internal representation. An array of
3227 * ScriptToken structures, including a pre-computed representation of the
3228 * command length and arguments.
3230 * For example the script:
3232 * puts hello
3233 * set $i $x$y [foo]BAR
3235 * will produce a ScriptObj with the following ScriptToken's:
3237 * LIN 2
3238 * ESC puts
3239 * ESC hello
3240 * LIN 4
3241 * ESC set
3242 * VAR i
3243 * WRD 2
3244 * VAR x
3245 * VAR y
3246 * WRD 2
3247 * CMD foo
3248 * ESC BAR
3250 * "puts hello" has two args (LIN 2), composed of single tokens.
3251 * (Note that the WRD token is omitted for the common case of a single token.)
3253 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3254 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3256 * The precomputation of the command structure makes Jim_Eval() faster,
3257 * and simpler because there aren't dynamic lengths / allocations.
3259 * -- {expand}/{*} handling --
3261 * Expand is handled in a special way.
3263 * If a "word" begins with {*}, the word token count is -ve.
3265 * For example the command:
3267 * list {*}{a b}
3269 * Will produce the following cmdstruct array:
3271 * LIN 2
3272 * ESC list
3273 * WRD -1
3274 * STR a b
3276 * Note that the 'LIN' token also contains the source information for the
3277 * first word of the line for error reporting purposes
3279 * -- the substFlags field of the structure --
3281 * The scriptObj structure is used to represent both "script" objects
3282 * and "subst" objects. In the second case, there are no LIN and WRD
3283 * tokens. Instead SEP and EOL tokens are added as-is.
3284 * In addition, the field 'substFlags' is used to represent the flags used to turn
3285 * the string into the internal representation.
3286 * If these flags do not match what the application requires,
3287 * the scriptObj is created again. For example the script:
3289 * subst -nocommands $string
3290 * subst -novariables $string
3292 * Will (re)create the internal representation of the $string object
3293 * two times.
3295 typedef struct ScriptObj
3297 ScriptToken *token; /* Tokens array. */
3298 Jim_Obj *fileNameObj; /* Filename */
3299 int len; /* Length of token[] */
3300 int substFlags; /* flags used for the compilation of "subst" objects */
3301 int inUse; /* Used to share a ScriptObj. Currently
3302 only used by Jim_EvalObj() as protection against
3303 shimmering of the currently evaluated object. */
3304 int firstline; /* Line number of the first line */
3305 int linenr; /* Error line number, if any */
3306 int missing; /* Missing char if script failed to parse, (or space or backslash if OK) */
3307 } ScriptObj;
3309 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
3310 static int JimParseCheckMissing(Jim_Interp *interp, int ch);
3311 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr);
3313 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3315 int i;
3316 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3318 if (--script->inUse != 0)
3319 return;
3320 for (i = 0; i < script->len; i++) {
3321 Jim_DecrRefCount(interp, script->token[i].objPtr);
3323 Jim_Free(script->token);
3324 Jim_DecrRefCount(interp, script->fileNameObj);
3325 Jim_Free(script);
3328 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3330 JIM_NOTUSED(interp);
3331 JIM_NOTUSED(srcPtr);
3333 /* Just return a simple string. We don't try to preserve the source info
3334 * since in practice scripts are never duplicated
3336 dupPtr->typePtr = NULL;
3339 /* A simple parse token.
3340 * As the script is parsed, the created tokens point into the script string rep.
3342 typedef struct
3344 const char *token; /* Pointer to the start of the token */
3345 int len; /* Length of this token */
3346 int type; /* Token type */
3347 int line; /* Line number */
3348 } ParseToken;
3350 /* A list of parsed tokens representing a script.
3351 * Tokens are added to this list as the script is parsed.
3352 * It grows as needed.
3354 typedef struct
3356 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3357 ParseToken *list; /* Array of tokens */
3358 int size; /* Current size of the list */
3359 int count; /* Number of entries used */
3360 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3361 } ParseTokenList;
3363 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3365 tokenlist->list = tokenlist->static_list;
3366 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3367 tokenlist->count = 0;
3370 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3372 if (tokenlist->list != tokenlist->static_list) {
3373 Jim_Free(tokenlist->list);
3378 * Adds the new token to the tokenlist.
3379 * The token has the given length, type and line number.
3380 * The token list is resized as necessary.
3382 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3383 int line)
3385 ParseToken *t;
3387 if (tokenlist->count == tokenlist->size) {
3388 /* Resize the list */
3389 tokenlist->size *= 2;
3390 if (tokenlist->list != tokenlist->static_list) {
3391 tokenlist->list =
3392 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3394 else {
3395 /* The list needs to become allocated */
3396 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3397 memcpy(tokenlist->list, tokenlist->static_list,
3398 tokenlist->count * sizeof(*tokenlist->list));
3401 t = &tokenlist->list[tokenlist->count++];
3402 t->token = token;
3403 t->len = len;
3404 t->type = type;
3405 t->line = line;
3408 /* Counts the number of adjoining non-separator tokens.
3410 * Returns -ve if the first token is the expansion
3411 * operator (in which case the count doesn't include
3412 * that token).
3414 static int JimCountWordTokens(ParseToken *t)
3416 int expand = 1;
3417 int count = 0;
3419 /* Is the first word {*} or {expand}? */
3420 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3421 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3422 /* Create an expand token */
3423 expand = -1;
3424 t++;
3428 /* Now count non-separator words */
3429 while (!TOKEN_IS_SEP(t->type)) {
3430 t++;
3431 count++;
3434 return count * expand;
3438 * Create a script/subst object from the given token.
3440 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3442 Jim_Obj *objPtr;
3444 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3445 /* Convert backlash escapes. The result will never be longer than the original */
3446 int len = t->len;
3447 char *str = Jim_Alloc(len + 1);
3448 len = JimEscape(str, t->token, len);
3449 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3451 else {
3452 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3453 * with a single space.
3455 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3457 return objPtr;
3461 * Takes a tokenlist and creates the allocated list of script tokens
3462 * in script->token, of length script->len.
3464 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3465 * as required.
3467 * Also sets script->line to the line number of the first token
3469 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3470 ParseTokenList *tokenlist)
3472 int i;
3473 struct ScriptToken *token;
3474 /* Number of tokens so far for the current command */
3475 int lineargs = 0;
3476 /* This is the first token for the current command */
3477 ScriptToken *linefirst;
3478 int count;
3479 int linenr;
3481 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3482 printf("==== Tokens ====\n");
3483 for (i = 0; i < tokenlist->count; i++) {
3484 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3485 tokenlist->list[i].len, tokenlist->list[i].token);
3487 #endif
3489 /* May need up to one extra script token for each EOL in the worst case */
3490 count = tokenlist->count;
3491 for (i = 0; i < tokenlist->count; i++) {
3492 if (tokenlist->list[i].type == JIM_TT_EOL) {
3493 count++;
3496 linenr = script->firstline = tokenlist->list[0].line;
3498 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3500 /* This is the first token for the current command */
3501 linefirst = token++;
3503 for (i = 0; i < tokenlist->count; ) {
3504 /* Look ahead to find out how many tokens make up the next word */
3505 int wordtokens;
3507 /* Skip any leading separators */
3508 while (tokenlist->list[i].type == JIM_TT_SEP) {
3509 i++;
3512 wordtokens = JimCountWordTokens(tokenlist->list + i);
3514 if (wordtokens == 0) {
3515 /* None, so at end of line */
3516 if (lineargs) {
3517 linefirst->type = JIM_TT_LINE;
3518 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3519 Jim_IncrRefCount(linefirst->objPtr);
3521 /* Reset for new line */
3522 lineargs = 0;
3523 linefirst = token++;
3525 i++;
3526 continue;
3528 else if (wordtokens != 1) {
3529 /* More than 1, or {*}, so insert a WORD token */
3530 token->type = JIM_TT_WORD;
3531 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3532 Jim_IncrRefCount(token->objPtr);
3533 token++;
3534 if (wordtokens < 0) {
3535 /* Skip the expand token */
3536 i++;
3537 wordtokens = -wordtokens - 1;
3538 lineargs--;
3542 if (lineargs == 0) {
3543 /* First real token on the line, so record the line number */
3544 linenr = tokenlist->list[i].line;
3546 lineargs++;
3548 /* Add each non-separator word token to the line */
3549 while (wordtokens--) {
3550 const ParseToken *t = &tokenlist->list[i++];
3552 token->type = t->type;
3553 token->objPtr = JimMakeScriptObj(interp, t);
3554 Jim_IncrRefCount(token->objPtr);
3556 /* Every object is initially a string of type 'source', but the
3557 * internal type may be specialized during execution of the
3558 * script. */
3559 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3560 token++;
3564 if (lineargs == 0) {
3565 token--;
3568 script->len = token - script->token;
3570 JimPanic((script->len >= count, "allocated script array is too short"));
3572 #ifdef DEBUG_SHOW_SCRIPT
3573 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3574 for (i = 0; i < script->len; i++) {
3575 const ScriptToken *t = &script->token[i];
3576 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3578 #endif
3582 /* Parses the given string object to determine if it represents a complete script.
3584 * This is useful for interactive shells implementation, for [info complete].
3586 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
3587 * '{' on scripts incomplete missing one or more '}' to be balanced.
3588 * '[' on scripts incomplete missing one or more ']' to be balanced.
3589 * '"' on scripts incomplete missing a '"' char.
3590 * '\\' on scripts with a trailing backslash.
3592 * If the script is complete, 1 is returned, otherwise 0.
3594 int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr)
3596 ScriptObj *script = JimGetScript(interp, scriptObj);
3597 if (stateCharPtr) {
3598 *stateCharPtr = script->missing;
3600 return (script->missing == ' ');
3604 * Sets an appropriate error message for a missing script/expression terminator.
3606 * Returns JIM_ERR if 'ch' represents an unmatched/missing character.
3608 * Note that a trailing backslash is not considered to be an error.
3610 static int JimParseCheckMissing(Jim_Interp *interp, int ch)
3612 const char *msg;
3614 switch (ch) {
3615 case '\\':
3616 case ' ':
3617 return JIM_OK;
3619 case '[':
3620 msg = "unmatched \"[\"";
3621 break;
3622 case '{':
3623 msg = "missing close-brace";
3624 break;
3625 case '"':
3626 default:
3627 msg = "missing quote";
3628 break;
3631 Jim_SetResultString(interp, msg, -1);
3632 return JIM_ERR;
3636 * Similar to ScriptObjAddTokens(), but for subst objects.
3638 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3639 ParseTokenList *tokenlist)
3641 int i;
3642 struct ScriptToken *token;
3644 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3646 for (i = 0; i < tokenlist->count; i++) {
3647 const ParseToken *t = &tokenlist->list[i];
3649 /* Create a token for 't' */
3650 token->type = t->type;
3651 token->objPtr = JimMakeScriptObj(interp, t);
3652 Jim_IncrRefCount(token->objPtr);
3653 token++;
3656 script->len = i;
3659 /* This method takes the string representation of an object
3660 * as a Tcl script, and generates the pre-parsed internal representation
3661 * of the script.
3663 * On parse error, sets an error message and returns JIM_ERR
3664 * (Note: the object is still converted to a script, even if an error occurs)
3666 static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
3668 int scriptTextLen;
3669 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3670 struct JimParserCtx parser;
3671 struct ScriptObj *script;
3672 ParseTokenList tokenlist;
3673 int line = 1;
3675 /* Try to get information about filename / line number */
3676 if (objPtr->typePtr == &sourceObjType) {
3677 line = objPtr->internalRep.sourceValue.lineNumber;
3680 /* Initially parse the script into tokens (in tokenlist) */
3681 ScriptTokenListInit(&tokenlist);
3683 JimParserInit(&parser, scriptText, scriptTextLen, line);
3684 while (!parser.eof) {
3685 JimParseScript(&parser);
3686 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3687 parser.tline);
3690 /* Add a final EOF token */
3691 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3693 /* Create the "real" script tokens from the parsed tokens */
3694 script = Jim_Alloc(sizeof(*script));
3695 memset(script, 0, sizeof(*script));
3696 script->inUse = 1;
3697 if (objPtr->typePtr == &sourceObjType) {
3698 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3700 else {
3701 script->fileNameObj = interp->emptyObj;
3703 Jim_IncrRefCount(script->fileNameObj);
3704 script->missing = parser.missing.ch;
3705 script->linenr = parser.missing.line;
3707 ScriptObjAddTokens(interp, script, &tokenlist);
3709 /* No longer need the token list */
3710 ScriptTokenListFree(&tokenlist);
3712 /* Free the old internal rep and set the new one. */
3713 Jim_FreeIntRep(interp, objPtr);
3714 Jim_SetIntRepPtr(objPtr, script);
3715 objPtr->typePtr = &scriptObjType;
3718 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script);
3721 * Returns the parsed script.
3722 * Note that if there is any possibility that the script is not valid,
3723 * call JimScriptValid() to check
3725 static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3727 if (objPtr == interp->emptyObj) {
3728 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3729 objPtr = interp->nullScriptObj;
3732 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3733 JimSetScriptFromAny(interp, objPtr);
3736 return (ScriptObj *)Jim_GetIntRepPtr(objPtr);
3740 * Returns 1 if the script is valid (parsed ok), otherwise returns 0
3741 * and leaves an error message in the interp result.
3744 static int JimScriptValid(Jim_Interp *interp, ScriptObj *script)
3746 if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) {
3747 JimAddErrorToStack(interp, script);
3748 return 0;
3750 return 1;
3754 /* -----------------------------------------------------------------------------
3755 * Commands
3756 * ---------------------------------------------------------------------------*/
3757 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3759 cmdPtr->inUse++;
3762 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3764 if (--cmdPtr->inUse == 0) {
3765 if (cmdPtr->isproc) {
3766 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3767 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3768 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3769 if (cmdPtr->u.proc.staticVars) {
3770 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3771 Jim_Free(cmdPtr->u.proc.staticVars);
3774 else {
3775 /* native (C) */
3776 if (cmdPtr->u.native.delProc) {
3777 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3780 if (cmdPtr->prevCmd) {
3781 /* Delete any pushed command too */
3782 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3784 Jim_Free(cmdPtr);
3788 /* Variables HashTable Type.
3790 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3793 /* Variables HashTable Type.
3795 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3796 static void JimVariablesHTValDestructor(void *interp, void *val)
3798 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3799 Jim_Free(val);
3802 static const Jim_HashTableType JimVariablesHashTableType = {
3803 JimStringCopyHTHashFunction, /* hash function */
3804 JimStringCopyHTDup, /* key dup */
3805 NULL, /* val dup */
3806 JimStringCopyHTKeyCompare, /* key compare */
3807 JimStringCopyHTKeyDestructor, /* key destructor */
3808 JimVariablesHTValDestructor /* val destructor */
3811 /* Commands HashTable Type.
3813 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3815 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3817 JimDecrCmdRefCount(interp, val);
3820 static const Jim_HashTableType JimCommandsHashTableType = {
3821 JimStringCopyHTHashFunction, /* hash function */
3822 JimStringCopyHTDup, /* key dup */
3823 NULL, /* val dup */
3824 JimStringCopyHTKeyCompare, /* key compare */
3825 JimStringCopyHTKeyDestructor, /* key destructor */
3826 JimCommandsHT_ValDestructor /* val destructor */
3829 /* ------------------------- Commands related functions --------------------- */
3831 #ifdef jim_ext_namespace
3833 * Returns the "unscoped" version of the given namespace.
3834 * That is, the fully qualified name without the leading ::
3835 * The returned value is either nsObj, or an object with a zero ref count.
3837 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3839 const char *name = Jim_String(nsObj);
3840 if (name[0] == ':' && name[1] == ':') {
3841 /* This command is being defined in the global namespace */
3842 while (*++name == ':') {
3844 nsObj = Jim_NewStringObj(interp, name, -1);
3846 else if (Jim_Length(interp->framePtr->nsObj)) {
3847 /* This command is being defined in a non-global namespace */
3848 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3849 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3851 return nsObj;
3854 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3856 Jim_Obj *resultObj;
3858 const char *name = Jim_String(nameObjPtr);
3859 if (name[0] == ':' && name[1] == ':') {
3860 return nameObjPtr;
3862 Jim_IncrRefCount(nameObjPtr);
3863 resultObj = Jim_NewStringObj(interp, "::", -1);
3864 Jim_AppendObj(interp, resultObj, nameObjPtr);
3865 Jim_DecrRefCount(interp, nameObjPtr);
3867 return resultObj;
3871 * An efficient version of JimQualifyNameObj() where the name is
3872 * available (and needed) as a 'const char *'.
3873 * Avoids creating an object if not necessary.
3874 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3876 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3878 Jim_Obj *objPtr = interp->emptyObj;
3880 if (name[0] == ':' && name[1] == ':') {
3881 /* This command is being defined in the global namespace */
3882 while (*++name == ':') {
3885 else if (Jim_Length(interp->framePtr->nsObj)) {
3886 /* This command is being defined in a non-global namespace */
3887 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3888 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3889 name = Jim_String(objPtr);
3891 Jim_IncrRefCount(objPtr);
3892 *objPtrPtr = objPtr;
3893 return name;
3896 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3898 #else
3899 /* We can be more efficient in the no-namespace case */
3900 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3901 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3903 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3905 return nameObjPtr;
3907 #endif
3909 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3911 /* It may already exist, so we try to delete the old one.
3912 * Note that reference count means that it won't be deleted yet if
3913 * it exists in the call stack.
3915 * BUT, if 'local' is in force, instead of deleting the existing
3916 * proc, we stash a reference to the old proc here.
3918 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3919 if (he) {
3920 /* There was an old cmd with the same name,
3921 * so this requires a 'proc epoch' update. */
3923 /* If a procedure with the same name didn't exist there is no need
3924 * to increment the 'proc epoch' because creation of a new procedure
3925 * can never affect existing cached commands. We don't do
3926 * negative caching. */
3927 Jim_InterpIncrProcEpoch(interp);
3930 if (he && interp->local) {
3931 /* Push this command over the top of the previous one */
3932 cmd->prevCmd = Jim_GetHashEntryVal(he);
3933 Jim_SetHashVal(&interp->commands, he, cmd);
3935 else {
3936 if (he) {
3937 /* Replace the existing command */
3938 Jim_DeleteHashEntry(&interp->commands, name);
3941 Jim_AddHashEntry(&interp->commands, name, cmd);
3943 return JIM_OK;
3947 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3948 Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc)
3950 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3952 /* Store the new details for this command */
3953 memset(cmdPtr, 0, sizeof(*cmdPtr));
3954 cmdPtr->inUse = 1;
3955 cmdPtr->u.native.delProc = delProc;
3956 cmdPtr->u.native.cmdProc = cmdProc;
3957 cmdPtr->u.native.privData = privData;
3959 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3961 return JIM_OK;
3964 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3966 int len, i;
3968 len = Jim_ListLength(interp, staticsListObjPtr);
3969 if (len == 0) {
3970 return JIM_OK;
3973 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3974 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3975 for (i = 0; i < len; i++) {
3976 Jim_Obj *objPtr, *initObjPtr, *nameObjPtr;
3977 Jim_Var *varPtr;
3978 int subLen;
3980 objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i);
3981 /* Check if it's composed of two elements. */
3982 subLen = Jim_ListLength(interp, objPtr);
3983 if (subLen == 1 || subLen == 2) {
3984 /* Try to get the variable value from the current
3985 * environment. */
3986 nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0);
3987 if (subLen == 1) {
3988 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3989 if (initObjPtr == NULL) {
3990 Jim_SetResultFormatted(interp,
3991 "variable for initialization of static \"%#s\" not found in the local context",
3992 nameObjPtr);
3993 return JIM_ERR;
3996 else {
3997 initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3999 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
4000 return JIM_ERR;
4003 varPtr = Jim_Alloc(sizeof(*varPtr));
4004 varPtr->objPtr = initObjPtr;
4005 Jim_IncrRefCount(initObjPtr);
4006 varPtr->linkFramePtr = NULL;
4007 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
4008 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
4009 Jim_SetResultFormatted(interp,
4010 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4011 Jim_DecrRefCount(interp, initObjPtr);
4012 Jim_Free(varPtr);
4013 return JIM_ERR;
4016 else {
4017 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
4018 objPtr);
4019 return JIM_ERR;
4022 return JIM_OK;
4025 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
4027 #ifdef jim_ext_namespace
4028 if (cmdPtr->isproc) {
4029 /* XXX: Really need JimNamespaceSplit() */
4030 const char *pt = strrchr(cmdname, ':');
4031 if (pt && pt != cmdname && pt[-1] == ':') {
4032 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4033 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
4034 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4036 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
4037 /* This commands shadows a global command, so a proc epoch update is required */
4038 Jim_InterpIncrProcEpoch(interp);
4042 #endif
4045 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
4046 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
4048 Jim_Cmd *cmdPtr;
4049 int argListLen;
4050 int i;
4052 argListLen = Jim_ListLength(interp, argListObjPtr);
4054 /* Allocate space for both the command pointer and the arg list */
4055 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
4056 memset(cmdPtr, 0, sizeof(*cmdPtr));
4057 cmdPtr->inUse = 1;
4058 cmdPtr->isproc = 1;
4059 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
4060 cmdPtr->u.proc.argListLen = argListLen;
4061 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
4062 cmdPtr->u.proc.argsPos = -1;
4063 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
4064 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
4065 Jim_IncrRefCount(argListObjPtr);
4066 Jim_IncrRefCount(bodyObjPtr);
4067 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4069 /* Create the statics hash table. */
4070 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
4071 goto err;
4074 /* Parse the args out into arglist, validating as we go */
4075 /* Examine the argument list for default parameters and 'args' */
4076 for (i = 0; i < argListLen; i++) {
4077 Jim_Obj *argPtr;
4078 Jim_Obj *nameObjPtr;
4079 Jim_Obj *defaultObjPtr;
4080 int len;
4082 /* Examine a parameter */
4083 argPtr = Jim_ListGetIndex(interp, argListObjPtr, i);
4084 len = Jim_ListLength(interp, argPtr);
4085 if (len == 0) {
4086 Jim_SetResultString(interp, "argument with no name", -1);
4087 err:
4088 JimDecrCmdRefCount(interp, cmdPtr);
4089 return NULL;
4091 if (len > 2) {
4092 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4093 goto err;
4096 if (len == 2) {
4097 /* Optional parameter */
4098 nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0);
4099 defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1);
4101 else {
4102 /* Required parameter */
4103 nameObjPtr = argPtr;
4104 defaultObjPtr = NULL;
4108 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4109 if (cmdPtr->u.proc.argsPos >= 0) {
4110 Jim_SetResultString(interp, "'args' specified more than once", -1);
4111 goto err;
4113 cmdPtr->u.proc.argsPos = i;
4115 else {
4116 if (len == 2) {
4117 cmdPtr->u.proc.optArity++;
4119 else {
4120 cmdPtr->u.proc.reqArity++;
4124 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4125 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4128 return cmdPtr;
4131 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4133 int ret = JIM_OK;
4134 Jim_Obj *qualifiedNameObj;
4135 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4137 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4138 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4139 ret = JIM_ERR;
4141 else {
4142 Jim_InterpIncrProcEpoch(interp);
4145 JimFreeQualifiedName(interp, qualifiedNameObj);
4147 return ret;
4150 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4152 int ret = JIM_ERR;
4153 Jim_HashEntry *he;
4154 Jim_Cmd *cmdPtr;
4155 Jim_Obj *qualifiedOldNameObj;
4156 Jim_Obj *qualifiedNewNameObj;
4157 const char *fqold;
4158 const char *fqnew;
4160 if (newName[0] == 0) {
4161 return Jim_DeleteCommand(interp, oldName);
4164 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4165 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4167 /* Does it exist? */
4168 he = Jim_FindHashEntry(&interp->commands, fqold);
4169 if (he == NULL) {
4170 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4172 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4173 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4175 else {
4176 /* Add the new name first */
4177 cmdPtr = Jim_GetHashEntryVal(he);
4178 JimIncrCmdRefCount(cmdPtr);
4179 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4180 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4182 /* Now remove the old name */
4183 Jim_DeleteHashEntry(&interp->commands, fqold);
4185 /* Increment the epoch */
4186 Jim_InterpIncrProcEpoch(interp);
4188 ret = JIM_OK;
4191 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4192 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4194 return ret;
4197 /* -----------------------------------------------------------------------------
4198 * Command object
4199 * ---------------------------------------------------------------------------*/
4201 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4203 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4206 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4208 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4209 dupPtr->typePtr = srcPtr->typePtr;
4210 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4213 static const Jim_ObjType commandObjType = {
4214 "command",
4215 FreeCommandInternalRep,
4216 DupCommandInternalRep,
4217 NULL,
4218 JIM_TYPE_REFERENCES,
4221 /* This function returns the command structure for the command name
4222 * stored in objPtr. It tries to specialize the objPtr to contain
4223 * a cached info instead to perform the lookup into the hash table
4224 * every time. The information cached may not be uptodate, in such
4225 * a case the lookup is performed and the cache updated.
4227 * Respects the 'upcall' setting
4229 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4231 Jim_Cmd *cmd;
4233 /* In order to be valid, the proc epoch must match and
4234 * the lookup must have occurred in the same namespace
4236 if (objPtr->typePtr != &commandObjType ||
4237 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4238 #ifdef jim_ext_namespace
4239 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4240 #endif
4242 /* Not cached or out of date, so lookup */
4244 /* Do we need to try the local namespace? */
4245 const char *name = Jim_String(objPtr);
4246 Jim_HashEntry *he;
4248 if (name[0] == ':' && name[1] == ':') {
4249 while (*++name == ':') {
4252 #ifdef jim_ext_namespace
4253 else if (Jim_Length(interp->framePtr->nsObj)) {
4254 /* This command is being defined in a non-global namespace */
4255 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4256 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4257 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4258 Jim_FreeNewObj(interp, nameObj);
4259 if (he) {
4260 goto found;
4263 #endif
4265 /* Lookup in the global namespace */
4266 he = Jim_FindHashEntry(&interp->commands, name);
4267 if (he == NULL) {
4268 if (flags & JIM_ERRMSG) {
4269 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4271 return NULL;
4273 #ifdef jim_ext_namespace
4274 found:
4275 #endif
4276 cmd = Jim_GetHashEntryVal(he);
4278 /* Free the old internal repr and set the new one. */
4279 Jim_FreeIntRep(interp, objPtr);
4280 objPtr->typePtr = &commandObjType;
4281 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4282 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4283 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4284 Jim_IncrRefCount(interp->framePtr->nsObj);
4286 else {
4287 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4289 while (cmd->u.proc.upcall) {
4290 cmd = cmd->prevCmd;
4292 return cmd;
4295 /* -----------------------------------------------------------------------------
4296 * Variables
4297 * ---------------------------------------------------------------------------*/
4299 /* -----------------------------------------------------------------------------
4300 * Variable object
4301 * ---------------------------------------------------------------------------*/
4303 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4305 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4307 static const Jim_ObjType variableObjType = {
4308 "variable",
4309 NULL,
4310 NULL,
4311 NULL,
4312 JIM_TYPE_REFERENCES,
4316 * Check that the name does not contain embedded nulls.
4318 * Variable and procedure names are manipulated as null terminated strings, so
4319 * don't allow names with embedded nulls.
4321 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4323 /* Variable names and proc names can't contain embedded nulls */
4324 if (nameObjPtr->typePtr != &variableObjType) {
4325 int len;
4326 const char *str = Jim_GetString(nameObjPtr, &len);
4327 if (memchr(str, '\0', len)) {
4328 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4329 return JIM_ERR;
4332 return JIM_OK;
4335 /* This method should be called only by the variable API.
4336 * It returns JIM_OK on success (variable already exists),
4337 * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not
4338 * a variable name, but syntax glue for [dict] i.e. the last
4339 * character is ')' */
4340 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4342 const char *varName;
4343 Jim_CallFrame *framePtr;
4344 Jim_HashEntry *he;
4345 int global;
4346 int len;
4348 /* Check if the object is already an uptodate variable */
4349 if (objPtr->typePtr == &variableObjType) {
4350 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4351 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4352 /* nothing to do */
4353 return JIM_OK;
4355 /* Need to re-resolve the variable in the updated callframe */
4357 else if (objPtr->typePtr == &dictSubstObjType) {
4358 return JIM_DICT_SUGAR;
4360 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4361 return JIM_ERR;
4365 varName = Jim_GetString(objPtr, &len);
4367 /* Make sure it's not syntax glue to get/set dict. */
4368 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4369 return JIM_DICT_SUGAR;
4372 if (varName[0] == ':' && varName[1] == ':') {
4373 while (*++varName == ':') {
4375 global = 1;
4376 framePtr = interp->topFramePtr;
4378 else {
4379 global = 0;
4380 framePtr = interp->framePtr;
4383 /* Resolve this name in the variables hash table */
4384 he = Jim_FindHashEntry(&framePtr->vars, varName);
4385 if (he == NULL) {
4386 if (!global && framePtr->staticVars) {
4387 /* Try with static vars. */
4388 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4390 if (he == NULL) {
4391 return JIM_ERR;
4395 /* Free the old internal repr and set the new one. */
4396 Jim_FreeIntRep(interp, objPtr);
4397 objPtr->typePtr = &variableObjType;
4398 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4399 objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
4400 objPtr->internalRep.varValue.global = global;
4401 return JIM_OK;
4404 /* -------------------- Variables related functions ------------------------- */
4405 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4406 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4408 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4410 const char *name;
4411 Jim_CallFrame *framePtr;
4412 int global;
4414 /* New variable to create */
4415 Jim_Var *var = Jim_Alloc(sizeof(*var));
4417 var->objPtr = valObjPtr;
4418 Jim_IncrRefCount(valObjPtr);
4419 var->linkFramePtr = NULL;
4421 name = Jim_String(nameObjPtr);
4422 if (name[0] == ':' && name[1] == ':') {
4423 while (*++name == ':') {
4425 framePtr = interp->topFramePtr;
4426 global = 1;
4428 else {
4429 framePtr = interp->framePtr;
4430 global = 0;
4433 /* Insert the new variable */
4434 Jim_AddHashEntry(&framePtr->vars, name, var);
4436 /* Make the object int rep a variable */
4437 Jim_FreeIntRep(interp, nameObjPtr);
4438 nameObjPtr->typePtr = &variableObjType;
4439 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4440 nameObjPtr->internalRep.varValue.varPtr = var;
4441 nameObjPtr->internalRep.varValue.global = global;
4443 return var;
4446 /* For now that's dummy. Variables lookup should be optimized
4447 * in many ways, with caching of lookups, and possibly with
4448 * a table of pre-allocated vars in every CallFrame for local vars.
4449 * All the caching should also have an 'epoch' mechanism similar
4450 * to the one used by Tcl for procedures lookup caching. */
4452 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4454 int err;
4455 Jim_Var *var;
4457 switch (SetVariableFromAny(interp, nameObjPtr)) {
4458 case JIM_DICT_SUGAR:
4459 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4461 case JIM_ERR:
4462 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4463 return JIM_ERR;
4465 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4466 break;
4468 case JIM_OK:
4469 var = nameObjPtr->internalRep.varValue.varPtr;
4470 if (var->linkFramePtr == NULL) {
4471 Jim_IncrRefCount(valObjPtr);
4472 Jim_DecrRefCount(interp, var->objPtr);
4473 var->objPtr = valObjPtr;
4475 else { /* Else handle the link */
4476 Jim_CallFrame *savedCallFrame;
4478 savedCallFrame = interp->framePtr;
4479 interp->framePtr = var->linkFramePtr;
4480 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4481 interp->framePtr = savedCallFrame;
4482 if (err != JIM_OK)
4483 return err;
4486 return JIM_OK;
4489 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4491 Jim_Obj *nameObjPtr;
4492 int result;
4494 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4495 Jim_IncrRefCount(nameObjPtr);
4496 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4497 Jim_DecrRefCount(interp, nameObjPtr);
4498 return result;
4501 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4503 Jim_CallFrame *savedFramePtr;
4504 int result;
4506 savedFramePtr = interp->framePtr;
4507 interp->framePtr = interp->topFramePtr;
4508 result = Jim_SetVariableStr(interp, name, objPtr);
4509 interp->framePtr = savedFramePtr;
4510 return result;
4513 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4515 Jim_Obj *nameObjPtr, *valObjPtr;
4516 int result;
4518 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4519 valObjPtr = Jim_NewStringObj(interp, val, -1);
4520 Jim_IncrRefCount(nameObjPtr);
4521 Jim_IncrRefCount(valObjPtr);
4522 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4523 Jim_DecrRefCount(interp, nameObjPtr);
4524 Jim_DecrRefCount(interp, valObjPtr);
4525 return result;
4528 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4529 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4531 const char *varName;
4532 const char *targetName;
4533 Jim_CallFrame *framePtr;
4534 Jim_Var *varPtr;
4536 /* Check for an existing variable or link */
4537 switch (SetVariableFromAny(interp, nameObjPtr)) {
4538 case JIM_DICT_SUGAR:
4539 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4540 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4541 return JIM_ERR;
4543 case JIM_OK:
4544 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4546 if (varPtr->linkFramePtr == NULL) {
4547 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4548 return JIM_ERR;
4551 /* It exists, but is a link, so first delete the link */
4552 varPtr->linkFramePtr = NULL;
4553 break;
4556 /* Resolve the call frames for both variables */
4557 /* XXX: SetVariableFromAny() already did this! */
4558 varName = Jim_String(nameObjPtr);
4560 if (varName[0] == ':' && varName[1] == ':') {
4561 while (*++varName == ':') {
4563 /* Linking a global var does nothing */
4564 framePtr = interp->topFramePtr;
4566 else {
4567 framePtr = interp->framePtr;
4570 targetName = Jim_String(targetNameObjPtr);
4571 if (targetName[0] == ':' && targetName[1] == ':') {
4572 while (*++targetName == ':') {
4574 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4575 targetCallFrame = interp->topFramePtr;
4577 Jim_IncrRefCount(targetNameObjPtr);
4579 if (framePtr->level < targetCallFrame->level) {
4580 Jim_SetResultFormatted(interp,
4581 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4582 nameObjPtr);
4583 Jim_DecrRefCount(interp, targetNameObjPtr);
4584 return JIM_ERR;
4587 /* Check for cycles. */
4588 if (framePtr == targetCallFrame) {
4589 Jim_Obj *objPtr = targetNameObjPtr;
4591 /* Cycles are only possible with 'uplevel 0' */
4592 while (1) {
4593 if (strcmp(Jim_String(objPtr), varName) == 0) {
4594 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4595 Jim_DecrRefCount(interp, targetNameObjPtr);
4596 return JIM_ERR;
4598 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4599 break;
4600 varPtr = objPtr->internalRep.varValue.varPtr;
4601 if (varPtr->linkFramePtr != targetCallFrame)
4602 break;
4603 objPtr = varPtr->objPtr;
4607 /* Perform the binding */
4608 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4609 /* We are now sure 'nameObjPtr' type is variableObjType */
4610 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4611 Jim_DecrRefCount(interp, targetNameObjPtr);
4612 return JIM_OK;
4615 /* Return the Jim_Obj pointer associated with a variable name,
4616 * or NULL if the variable was not found in the current context.
4617 * The same optimization discussed in the comment to the
4618 * 'SetVariable' function should apply here.
4620 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4621 * in a dictionary which is shared, the array variable value is duplicated first.
4622 * This allows the array element to be updated (e.g. append, lappend) without
4623 * affecting other references to the dictionary.
4625 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4627 switch (SetVariableFromAny(interp, nameObjPtr)) {
4628 case JIM_OK:{
4629 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4631 if (varPtr->linkFramePtr == NULL) {
4632 return varPtr->objPtr;
4634 else {
4635 Jim_Obj *objPtr;
4637 /* The variable is a link? Resolve it. */
4638 Jim_CallFrame *savedCallFrame = interp->framePtr;
4640 interp->framePtr = varPtr->linkFramePtr;
4641 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4642 interp->framePtr = savedCallFrame;
4643 if (objPtr) {
4644 return objPtr;
4646 /* Error, so fall through to the error message */
4649 break;
4651 case JIM_DICT_SUGAR:
4652 /* [dict] syntax sugar. */
4653 return JimDictSugarGet(interp, nameObjPtr, flags);
4655 if (flags & JIM_ERRMSG) {
4656 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4658 return NULL;
4661 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4663 Jim_CallFrame *savedFramePtr;
4664 Jim_Obj *objPtr;
4666 savedFramePtr = interp->framePtr;
4667 interp->framePtr = interp->topFramePtr;
4668 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4669 interp->framePtr = savedFramePtr;
4671 return objPtr;
4674 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4676 Jim_Obj *nameObjPtr, *varObjPtr;
4678 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4679 Jim_IncrRefCount(nameObjPtr);
4680 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4681 Jim_DecrRefCount(interp, nameObjPtr);
4682 return varObjPtr;
4685 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4687 Jim_CallFrame *savedFramePtr;
4688 Jim_Obj *objPtr;
4690 savedFramePtr = interp->framePtr;
4691 interp->framePtr = interp->topFramePtr;
4692 objPtr = Jim_GetVariableStr(interp, name, flags);
4693 interp->framePtr = savedFramePtr;
4695 return objPtr;
4698 /* Unset a variable.
4699 * Note: On success unset invalidates all the variable objects created
4700 * in the current call frame incrementing. */
4701 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4703 Jim_Var *varPtr;
4704 int retval;
4705 Jim_CallFrame *framePtr;
4707 retval = SetVariableFromAny(interp, nameObjPtr);
4708 if (retval == JIM_DICT_SUGAR) {
4709 /* [dict] syntax sugar. */
4710 return JimDictSugarSet(interp, nameObjPtr, NULL);
4712 else if (retval == JIM_OK) {
4713 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4715 /* If it's a link call UnsetVariable recursively */
4716 if (varPtr->linkFramePtr) {
4717 framePtr = interp->framePtr;
4718 interp->framePtr = varPtr->linkFramePtr;
4719 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4720 interp->framePtr = framePtr;
4722 else {
4723 const char *name = Jim_String(nameObjPtr);
4724 if (nameObjPtr->internalRep.varValue.global) {
4725 name += 2;
4726 framePtr = interp->topFramePtr;
4728 else {
4729 framePtr = interp->framePtr;
4732 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4733 if (retval == JIM_OK) {
4734 /* Change the callframe id, invalidating var lookup caching */
4735 framePtr->id = interp->callFrameEpoch++;
4739 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4740 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4742 return retval;
4745 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4747 /* Given a variable name for [dict] operation syntax sugar,
4748 * this function returns two objects, the first with the name
4749 * of the variable to set, and the second with the respective key.
4750 * For example "foo(bar)" will return objects with string repr. of
4751 * "foo" and "bar".
4753 * The returned objects have refcount = 1. The function can't fail. */
4754 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4755 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4757 const char *str, *p;
4758 int len, keyLen;
4759 Jim_Obj *varObjPtr, *keyObjPtr;
4761 str = Jim_GetString(objPtr, &len);
4763 p = strchr(str, '(');
4764 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4766 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4768 p++;
4769 keyLen = (str + len) - p;
4770 if (str[len - 1] == ')') {
4771 keyLen--;
4774 /* Create the objects with the variable name and key. */
4775 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4777 Jim_IncrRefCount(varObjPtr);
4778 Jim_IncrRefCount(keyObjPtr);
4779 *varPtrPtr = varObjPtr;
4780 *keyPtrPtr = keyObjPtr;
4783 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4784 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4785 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4787 int err;
4789 SetDictSubstFromAny(interp, objPtr);
4791 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4792 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4794 if (err == JIM_OK) {
4795 /* Don't keep an extra ref to the result */
4796 Jim_SetEmptyResult(interp);
4798 else {
4799 if (!valObjPtr) {
4800 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4801 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4802 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4803 objPtr);
4804 return err;
4807 /* Make the error more informative and Tcl-compatible */
4808 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4809 (valObjPtr ? "set" : "unset"), objPtr);
4811 return err;
4815 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4817 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4818 * and stored back to the variable before expansion.
4820 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4821 Jim_Obj *keyObjPtr, int flags)
4823 Jim_Obj *dictObjPtr;
4824 Jim_Obj *resObjPtr = NULL;
4825 int ret;
4827 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4828 if (!dictObjPtr) {
4829 return NULL;
4832 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4833 if (ret != JIM_OK) {
4834 Jim_SetResultFormatted(interp,
4835 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4836 ret < 0 ? "variable isn't" : "no such element in");
4838 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4839 /* Update the variable to have an unshared copy */
4840 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4843 return resObjPtr;
4846 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4847 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4849 SetDictSubstFromAny(interp, objPtr);
4851 return JimDictExpandArrayVariable(interp,
4852 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4853 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4856 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4858 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4860 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4861 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4864 /* Note: The object *must* be in dict-sugar format */
4865 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4867 if (objPtr->typePtr != &dictSubstObjType) {
4868 Jim_Obj *varObjPtr, *keyObjPtr;
4870 if (objPtr->typePtr == &interpolatedObjType) {
4871 /* An interpolated object in dict-sugar form */
4873 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4874 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4876 Jim_IncrRefCount(varObjPtr);
4877 Jim_IncrRefCount(keyObjPtr);
4879 else {
4880 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4883 Jim_FreeIntRep(interp, objPtr);
4884 objPtr->typePtr = &dictSubstObjType;
4885 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4886 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4890 /* This function is used to expand [dict get] sugar in the form
4891 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4892 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4893 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4894 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4895 * the [dict]ionary contained in variable VARNAME. */
4896 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4898 Jim_Obj *resObjPtr = NULL;
4899 Jim_Obj *substKeyObjPtr = NULL;
4901 SetDictSubstFromAny(interp, objPtr);
4903 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4904 &substKeyObjPtr, JIM_NONE)
4905 != JIM_OK) {
4906 return NULL;
4908 Jim_IncrRefCount(substKeyObjPtr);
4909 resObjPtr =
4910 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4911 substKeyObjPtr, 0);
4912 Jim_DecrRefCount(interp, substKeyObjPtr);
4914 return resObjPtr;
4917 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4919 Jim_Obj *resultObjPtr;
4921 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4922 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4923 resultObjPtr->refCount--;
4924 return resultObjPtr;
4926 return NULL;
4929 /* -----------------------------------------------------------------------------
4930 * CallFrame
4931 * ---------------------------------------------------------------------------*/
4933 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4935 Jim_CallFrame *cf;
4937 if (interp->freeFramesList) {
4938 cf = interp->freeFramesList;
4939 interp->freeFramesList = cf->next;
4941 cf->argv = NULL;
4942 cf->argc = 0;
4943 cf->procArgsObjPtr = NULL;
4944 cf->procBodyObjPtr = NULL;
4945 cf->next = NULL;
4946 cf->staticVars = NULL;
4947 cf->localCommands = NULL;
4948 cf->tailcallObj = NULL;
4949 cf->tailcallCmd = NULL;
4951 else {
4952 cf = Jim_Alloc(sizeof(*cf));
4953 memset(cf, 0, sizeof(*cf));
4955 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4958 cf->id = interp->callFrameEpoch++;
4959 cf->parent = parent;
4960 cf->level = parent ? parent->level + 1 : 0;
4961 cf->nsObj = nsObj;
4962 Jim_IncrRefCount(nsObj);
4964 return cf;
4967 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4969 /* Delete any local procs */
4970 if (localCommands) {
4971 Jim_Obj *cmdNameObj;
4973 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4974 Jim_HashEntry *he;
4975 Jim_Obj *fqObjName;
4976 Jim_HashTable *ht = &interp->commands;
4978 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4980 he = Jim_FindHashEntry(ht, fqname);
4982 if (he) {
4983 Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4984 if (cmd->prevCmd) {
4985 Jim_Cmd *prevCmd = cmd->prevCmd;
4986 cmd->prevCmd = NULL;
4988 /* Delete the old command */
4989 JimDecrCmdRefCount(interp, cmd);
4991 /* And restore the original */
4992 Jim_SetHashVal(ht, he, prevCmd);
4994 else {
4995 Jim_DeleteHashEntry(ht, fqname);
4997 Jim_InterpIncrProcEpoch(interp);
4999 Jim_DecrRefCount(interp, cmdNameObj);
5000 JimFreeQualifiedName(interp, fqObjName);
5002 Jim_FreeStack(localCommands);
5003 Jim_Free(localCommands);
5005 return JIM_OK;
5009 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
5010 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
5011 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
5013 JimDeleteLocalProcs(interp, cf->localCommands);
5015 if (cf->procArgsObjPtr)
5016 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
5017 if (cf->procBodyObjPtr)
5018 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
5019 Jim_DecrRefCount(interp, cf->nsObj);
5020 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
5021 Jim_FreeHashTable(&cf->vars);
5022 else {
5023 int i;
5024 Jim_HashEntry **table = cf->vars.table, *he;
5026 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5027 he = table[i];
5028 while (he != NULL) {
5029 Jim_HashEntry *nextEntry = he->next;
5030 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5032 Jim_DecrRefCount(interp, varPtr->objPtr);
5033 Jim_Free(Jim_GetHashEntryKey(he));
5034 Jim_Free(varPtr);
5035 Jim_Free(he);
5036 table[i] = NULL;
5037 he = nextEntry;
5040 cf->vars.used = 0;
5042 cf->next = interp->freeFramesList;
5043 interp->freeFramesList = cf;
5047 /* -----------------------------------------------------------------------------
5048 * References
5049 * ---------------------------------------------------------------------------*/
5050 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
5052 /* References HashTable Type.
5054 * Keys are unsigned long integers, dynamically allocated for now but in the
5055 * future it's worth to cache this 4 bytes objects. Values are pointers
5056 * to Jim_References. */
5057 static void JimReferencesHTValDestructor(void *interp, void *val)
5059 Jim_Reference *refPtr = (void *)val;
5061 Jim_DecrRefCount(interp, refPtr->objPtr);
5062 if (refPtr->finalizerCmdNamePtr != NULL) {
5063 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5065 Jim_Free(val);
5068 static unsigned int JimReferencesHTHashFunction(const void *key)
5070 /* Only the least significant bits are used. */
5071 const unsigned long *widePtr = key;
5072 unsigned int intValue = (unsigned int)*widePtr;
5074 return Jim_IntHashFunction(intValue);
5077 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5079 void *copy = Jim_Alloc(sizeof(unsigned long));
5081 JIM_NOTUSED(privdata);
5083 memcpy(copy, key, sizeof(unsigned long));
5084 return copy;
5087 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5089 JIM_NOTUSED(privdata);
5091 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5094 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5096 JIM_NOTUSED(privdata);
5098 Jim_Free(key);
5101 static const Jim_HashTableType JimReferencesHashTableType = {
5102 JimReferencesHTHashFunction, /* hash function */
5103 JimReferencesHTKeyDup, /* key dup */
5104 NULL, /* val dup */
5105 JimReferencesHTKeyCompare, /* key compare */
5106 JimReferencesHTKeyDestructor, /* key destructor */
5107 JimReferencesHTValDestructor /* val destructor */
5110 /* -----------------------------------------------------------------------------
5111 * Reference object type and References API
5112 * ---------------------------------------------------------------------------*/
5114 /* The string representation of references has two features in order
5115 * to make the GC faster. The first is that every reference starts
5116 * with a non common character '<', in order to make the string matching
5117 * faster. The second is that the reference string rep is 42 characters
5118 * in length, this means that it is not necessary to check any object with a string
5119 * repr < 42, and usually there aren't many of these objects. */
5121 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5123 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5125 const char *fmt = "<reference.<%s>.%020lu>";
5127 sprintf(buf, fmt, refPtr->tag, id);
5128 return JIM_REFERENCE_SPACE;
5131 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5133 static const Jim_ObjType referenceObjType = {
5134 "reference",
5135 NULL,
5136 NULL,
5137 UpdateStringOfReference,
5138 JIM_TYPE_REFERENCES,
5141 static void UpdateStringOfReference(struct Jim_Obj *objPtr)
5143 char buf[JIM_REFERENCE_SPACE + 1];
5145 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5146 JimSetStringBytes(objPtr, buf);
5149 /* returns true if 'c' is a valid reference tag character.
5150 * i.e. inside the range [_a-zA-Z0-9] */
5151 static int isrefchar(int c)
5153 return (c == '_' || isalnum(c));
5156 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5158 unsigned long value;
5159 int i, len;
5160 const char *str, *start, *end;
5161 char refId[21];
5162 Jim_Reference *refPtr;
5163 Jim_HashEntry *he;
5164 char *endptr;
5166 /* Get the string representation */
5167 str = Jim_GetString(objPtr, &len);
5168 /* Check if it looks like a reference */
5169 if (len < JIM_REFERENCE_SPACE)
5170 goto badformat;
5171 /* Trim spaces */
5172 start = str;
5173 end = str + len - 1;
5174 while (*start == ' ')
5175 start++;
5176 while (*end == ' ' && end > start)
5177 end--;
5178 if (end - start + 1 != JIM_REFERENCE_SPACE)
5179 goto badformat;
5180 /* <reference.<1234567>.%020> */
5181 if (memcmp(start, "<reference.<", 12) != 0)
5182 goto badformat;
5183 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5184 goto badformat;
5185 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5186 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5187 if (!isrefchar(start[12 + i]))
5188 goto badformat;
5190 /* Extract info from the reference. */
5191 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5192 refId[20] = '\0';
5193 /* Try to convert the ID into an unsigned long */
5194 value = strtoul(refId, &endptr, 10);
5195 if (JimCheckConversion(refId, endptr) != JIM_OK)
5196 goto badformat;
5197 /* Check if the reference really exists! */
5198 he = Jim_FindHashEntry(&interp->references, &value);
5199 if (he == NULL) {
5200 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5201 return JIM_ERR;
5203 refPtr = Jim_GetHashEntryVal(he);
5204 /* Free the old internal repr and set the new one. */
5205 Jim_FreeIntRep(interp, objPtr);
5206 objPtr->typePtr = &referenceObjType;
5207 objPtr->internalRep.refValue.id = value;
5208 objPtr->internalRep.refValue.refPtr = refPtr;
5209 return JIM_OK;
5211 badformat:
5212 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5213 return JIM_ERR;
5216 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5217 * as finalizer command (or NULL if there is no finalizer).
5218 * The returned reference object has refcount = 0. */
5219 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5221 struct Jim_Reference *refPtr;
5222 unsigned long id;
5223 Jim_Obj *refObjPtr;
5224 const char *tag;
5225 int tagLen, i;
5227 /* Perform the Garbage Collection if needed. */
5228 Jim_CollectIfNeeded(interp);
5230 refPtr = Jim_Alloc(sizeof(*refPtr));
5231 refPtr->objPtr = objPtr;
5232 Jim_IncrRefCount(objPtr);
5233 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5234 if (cmdNamePtr)
5235 Jim_IncrRefCount(cmdNamePtr);
5236 id = interp->referenceNextId++;
5237 Jim_AddHashEntry(&interp->references, &id, refPtr);
5238 refObjPtr = Jim_NewObj(interp);
5239 refObjPtr->typePtr = &referenceObjType;
5240 refObjPtr->bytes = NULL;
5241 refObjPtr->internalRep.refValue.id = id;
5242 refObjPtr->internalRep.refValue.refPtr = refPtr;
5243 interp->referenceNextId++;
5244 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5245 * that does not pass the 'isrefchar' test is replaced with '_' */
5246 tag = Jim_GetString(tagPtr, &tagLen);
5247 if (tagLen > JIM_REFERENCE_TAGLEN)
5248 tagLen = JIM_REFERENCE_TAGLEN;
5249 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5250 if (i < tagLen && isrefchar(tag[i]))
5251 refPtr->tag[i] = tag[i];
5252 else
5253 refPtr->tag[i] = '_';
5255 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5256 return refObjPtr;
5259 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5261 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5262 return NULL;
5263 return objPtr->internalRep.refValue.refPtr;
5266 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5268 Jim_Reference *refPtr;
5270 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5271 return JIM_ERR;
5272 Jim_IncrRefCount(cmdNamePtr);
5273 if (refPtr->finalizerCmdNamePtr)
5274 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5275 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5276 return JIM_OK;
5279 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5281 Jim_Reference *refPtr;
5283 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5284 return JIM_ERR;
5285 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5286 return JIM_OK;
5289 /* -----------------------------------------------------------------------------
5290 * References Garbage Collection
5291 * ---------------------------------------------------------------------------*/
5293 /* This the hash table type for the "MARK" phase of the GC */
5294 static const Jim_HashTableType JimRefMarkHashTableType = {
5295 JimReferencesHTHashFunction, /* hash function */
5296 JimReferencesHTKeyDup, /* key dup */
5297 NULL, /* val dup */
5298 JimReferencesHTKeyCompare, /* key compare */
5299 JimReferencesHTKeyDestructor, /* key destructor */
5300 NULL /* val destructor */
5303 /* Performs the garbage collection. */
5304 int Jim_Collect(Jim_Interp *interp)
5306 int collected = 0;
5307 Jim_HashTable marks;
5308 Jim_HashTableIterator htiter;
5309 Jim_HashEntry *he;
5310 Jim_Obj *objPtr;
5312 /* Avoid recursive calls */
5313 if (interp->lastCollectId == -1) {
5314 /* Jim_Collect() already running. Return just now. */
5315 return 0;
5317 interp->lastCollectId = -1;
5319 /* Mark all the references found into the 'mark' hash table.
5320 * The references are searched in every live object that
5321 * is of a type that can contain references. */
5322 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5323 objPtr = interp->liveList;
5324 while (objPtr) {
5325 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5326 const char *str, *p;
5327 int len;
5329 /* If the object is of type reference, to get the
5330 * Id is simple... */
5331 if (objPtr->typePtr == &referenceObjType) {
5332 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5333 #ifdef JIM_DEBUG_GC
5334 printf("MARK (reference): %d refcount: %d\n",
5335 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5336 #endif
5337 objPtr = objPtr->nextObjPtr;
5338 continue;
5340 /* Get the string repr of the object we want
5341 * to scan for references. */
5342 p = str = Jim_GetString(objPtr, &len);
5343 /* Skip objects too little to contain references. */
5344 if (len < JIM_REFERENCE_SPACE) {
5345 objPtr = objPtr->nextObjPtr;
5346 continue;
5348 /* Extract references from the object string repr. */
5349 while (1) {
5350 int i;
5351 unsigned long id;
5353 if ((p = strstr(p, "<reference.<")) == NULL)
5354 break;
5355 /* Check if it's a valid reference. */
5356 if (len - (p - str) < JIM_REFERENCE_SPACE)
5357 break;
5358 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5359 break;
5360 for (i = 21; i <= 40; i++)
5361 if (!isdigit(UCHAR(p[i])))
5362 break;
5363 /* Get the ID */
5364 id = strtoul(p + 21, NULL, 10);
5366 /* Ok, a reference for the given ID
5367 * was found. Mark it. */
5368 Jim_AddHashEntry(&marks, &id, NULL);
5369 #ifdef JIM_DEBUG_GC
5370 printf("MARK: %d\n", (int)id);
5371 #endif
5372 p += JIM_REFERENCE_SPACE;
5375 objPtr = objPtr->nextObjPtr;
5378 /* Run the references hash table to destroy every reference that
5379 * is not referenced outside (not present in the mark HT). */
5380 JimInitHashTableIterator(&interp->references, &htiter);
5381 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5382 const unsigned long *refId;
5383 Jim_Reference *refPtr;
5385 refId = he->key;
5386 /* Check if in the mark phase we encountered
5387 * this reference. */
5388 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5389 #ifdef JIM_DEBUG_GC
5390 printf("COLLECTING %d\n", (int)*refId);
5391 #endif
5392 collected++;
5393 /* Drop the reference, but call the
5394 * finalizer first if registered. */
5395 refPtr = Jim_GetHashEntryVal(he);
5396 if (refPtr->finalizerCmdNamePtr) {
5397 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5398 Jim_Obj *objv[3], *oldResult;
5400 JimFormatReference(refstr, refPtr, *refId);
5402 objv[0] = refPtr->finalizerCmdNamePtr;
5403 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5404 objv[2] = refPtr->objPtr;
5406 /* Drop the reference itself */
5407 /* Avoid the finaliser being freed here */
5408 Jim_IncrRefCount(objv[0]);
5409 /* Don't remove the reference from the hash table just yet
5410 * since that will free refPtr, and hence refPtr->objPtr
5413 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5414 oldResult = interp->result;
5415 Jim_IncrRefCount(oldResult);
5416 Jim_EvalObjVector(interp, 3, objv);
5417 Jim_SetResult(interp, oldResult);
5418 Jim_DecrRefCount(interp, oldResult);
5420 Jim_DecrRefCount(interp, objv[0]);
5422 Jim_DeleteHashEntry(&interp->references, refId);
5425 Jim_FreeHashTable(&marks);
5426 interp->lastCollectId = interp->referenceNextId;
5427 interp->lastCollectTime = time(NULL);
5428 return collected;
5431 #define JIM_COLLECT_ID_PERIOD 5000
5432 #define JIM_COLLECT_TIME_PERIOD 300
5434 void Jim_CollectIfNeeded(Jim_Interp *interp)
5436 unsigned long elapsedId;
5437 int elapsedTime;
5439 elapsedId = interp->referenceNextId - interp->lastCollectId;
5440 elapsedTime = time(NULL) - interp->lastCollectTime;
5443 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5444 Jim_Collect(interp);
5447 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
5449 int Jim_IsBigEndian(void)
5451 union {
5452 unsigned short s;
5453 unsigned char c[2];
5454 } uval = {0x0102};
5456 return uval.c[0] == 1;
5459 /* -----------------------------------------------------------------------------
5460 * Interpreter related functions
5461 * ---------------------------------------------------------------------------*/
5463 Jim_Interp *Jim_CreateInterp(void)
5465 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5467 memset(i, 0, sizeof(*i));
5469 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5470 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5471 i->lastCollectTime = time(NULL);
5473 /* Note that we can create objects only after the
5474 * interpreter liveList and freeList pointers are
5475 * initialized to NULL. */
5476 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5477 #ifdef JIM_REFERENCES
5478 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5479 #endif
5480 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5481 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5482 i->emptyObj = Jim_NewEmptyStringObj(i);
5483 i->trueObj = Jim_NewIntObj(i, 1);
5484 i->falseObj = Jim_NewIntObj(i, 0);
5485 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5486 i->errorFileNameObj = i->emptyObj;
5487 i->result = i->emptyObj;
5488 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5489 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5490 i->errorProc = i->emptyObj;
5491 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5492 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5493 Jim_IncrRefCount(i->emptyObj);
5494 Jim_IncrRefCount(i->errorFileNameObj);
5495 Jim_IncrRefCount(i->result);
5496 Jim_IncrRefCount(i->stackTrace);
5497 Jim_IncrRefCount(i->unknown);
5498 Jim_IncrRefCount(i->currentScriptObj);
5499 Jim_IncrRefCount(i->nullScriptObj);
5500 Jim_IncrRefCount(i->errorProc);
5501 Jim_IncrRefCount(i->trueObj);
5502 Jim_IncrRefCount(i->falseObj);
5504 /* Initialize key variables every interpreter should contain */
5505 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5506 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5508 Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim");
5509 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5510 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5511 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5512 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5513 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5514 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5515 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5517 return i;
5520 void Jim_FreeInterp(Jim_Interp *i)
5522 Jim_CallFrame *cf, *cfx;
5524 Jim_Obj *objPtr, *nextObjPtr;
5526 /* Free the active call frames list - must be done before i->commands is destroyed */
5527 for (cf = i->framePtr; cf; cf = cfx) {
5528 cfx = cf->parent;
5529 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5532 Jim_DecrRefCount(i, i->emptyObj);
5533 Jim_DecrRefCount(i, i->trueObj);
5534 Jim_DecrRefCount(i, i->falseObj);
5535 Jim_DecrRefCount(i, i->result);
5536 Jim_DecrRefCount(i, i->stackTrace);
5537 Jim_DecrRefCount(i, i->errorProc);
5538 Jim_DecrRefCount(i, i->unknown);
5539 Jim_DecrRefCount(i, i->errorFileNameObj);
5540 Jim_DecrRefCount(i, i->currentScriptObj);
5541 Jim_DecrRefCount(i, i->nullScriptObj);
5542 Jim_FreeHashTable(&i->commands);
5543 #ifdef JIM_REFERENCES
5544 Jim_FreeHashTable(&i->references);
5545 #endif
5546 Jim_FreeHashTable(&i->packages);
5547 Jim_Free(i->prngState);
5548 Jim_FreeHashTable(&i->assocData);
5550 /* Check that the live object list is empty, otherwise
5551 * there is a memory leak. */
5552 #ifdef JIM_MAINTAINER
5553 if (i->liveList != NULL) {
5554 objPtr = i->liveList;
5556 printf("\n-------------------------------------\n");
5557 printf("Objects still in the free list:\n");
5558 while (objPtr) {
5559 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5561 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5562 printf("%p (%d) %-10s: '%.20s...'\n",
5563 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5565 else {
5566 printf("%p (%d) %-10s: '%s'\n",
5567 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5569 if (objPtr->typePtr == &sourceObjType) {
5570 printf("FILE %s LINE %d\n",
5571 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5572 objPtr->internalRep.sourceValue.lineNumber);
5574 objPtr = objPtr->nextObjPtr;
5576 printf("-------------------------------------\n\n");
5577 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5579 #endif
5581 /* Free all the freed objects. */
5582 objPtr = i->freeList;
5583 while (objPtr) {
5584 nextObjPtr = objPtr->nextObjPtr;
5585 Jim_Free(objPtr);
5586 objPtr = nextObjPtr;
5589 /* Free the free call frames list */
5590 for (cf = i->freeFramesList; cf; cf = cfx) {
5591 cfx = cf->next;
5592 if (cf->vars.table)
5593 Jim_FreeHashTable(&cf->vars);
5594 Jim_Free(cf);
5597 /* Free the interpreter structure. */
5598 Jim_Free(i);
5601 /* Returns the call frame relative to the level represented by
5602 * levelObjPtr. If levelObjPtr == NULL, the level is assumed to be '1'.
5604 * This function accepts the 'level' argument in the form
5605 * of the commands [uplevel] and [upvar].
5607 * Returns NULL on error.
5609 * Note: for a function accepting a relative integer as level suitable
5610 * for implementation of [info level ?level?], see JimGetCallFrameByInteger()
5612 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5614 long level;
5615 const char *str;
5616 Jim_CallFrame *framePtr;
5618 if (levelObjPtr) {
5619 str = Jim_String(levelObjPtr);
5620 if (str[0] == '#') {
5621 char *endptr;
5623 level = jim_strtol(str + 1, &endptr);
5624 if (str[1] == '\0' || endptr[0] != '\0') {
5625 level = -1;
5628 else {
5629 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5630 level = -1;
5632 else {
5633 /* Convert from a relative to an absolute level */
5634 level = interp->framePtr->level - level;
5638 else {
5639 str = "1"; /* Needed to format the error message. */
5640 level = interp->framePtr->level - 1;
5643 if (level == 0) {
5644 return interp->topFramePtr;
5646 if (level > 0) {
5647 /* Lookup */
5648 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5649 if (framePtr->level == level) {
5650 return framePtr;
5655 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5656 return NULL;
5659 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5660 * as a relative integer like in the [info level ?level?] command.
5662 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5664 long level;
5665 Jim_CallFrame *framePtr;
5667 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5668 if (level <= 0) {
5669 /* Convert from a relative to an absolute level */
5670 level = interp->framePtr->level + level;
5673 if (level == 0) {
5674 return interp->topFramePtr;
5677 /* Lookup */
5678 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5679 if (framePtr->level == level) {
5680 return framePtr;
5685 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5686 return NULL;
5689 static void JimResetStackTrace(Jim_Interp *interp)
5691 Jim_DecrRefCount(interp, interp->stackTrace);
5692 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5693 Jim_IncrRefCount(interp->stackTrace);
5696 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5698 int len;
5700 /* Increment reference first in case these are the same object */
5701 Jim_IncrRefCount(stackTraceObj);
5702 Jim_DecrRefCount(interp, interp->stackTrace);
5703 interp->stackTrace = stackTraceObj;
5704 interp->errorFlag = 1;
5706 /* This is a bit ugly.
5707 * If the filename of the last entry of the stack trace is empty,
5708 * the next stack level should be added.
5710 len = Jim_ListLength(interp, interp->stackTrace);
5711 if (len >= 3) {
5712 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5713 interp->addStackTrace = 1;
5718 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5719 Jim_Obj *fileNameObj, int linenr)
5721 if (strcmp(procname, "unknown") == 0) {
5722 procname = "";
5724 if (!*procname && !Jim_Length(fileNameObj)) {
5725 /* No useful info here */
5726 return;
5729 if (Jim_IsShared(interp->stackTrace)) {
5730 Jim_DecrRefCount(interp, interp->stackTrace);
5731 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5732 Jim_IncrRefCount(interp->stackTrace);
5735 /* If we have no procname but the previous element did, merge with that frame */
5736 if (!*procname && Jim_Length(fileNameObj)) {
5737 /* Just a filename. Check the previous entry */
5738 int len = Jim_ListLength(interp, interp->stackTrace);
5740 if (len >= 3) {
5741 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5742 if (Jim_Length(objPtr)) {
5743 /* Yes, the previous level had procname */
5744 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5745 if (Jim_Length(objPtr) == 0) {
5746 /* But no filename, so merge the new info with that frame */
5747 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5748 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5749 return;
5755 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5756 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5757 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5760 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5761 void *data)
5763 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5765 assocEntryPtr->delProc = delProc;
5766 assocEntryPtr->data = data;
5767 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5770 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5772 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5774 if (entryPtr != NULL) {
5775 AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr);
5776 return assocEntryPtr->data;
5778 return NULL;
5781 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5783 return Jim_DeleteHashEntry(&interp->assocData, key);
5786 int Jim_GetExitCode(Jim_Interp *interp)
5788 return interp->exitCode;
5791 /* -----------------------------------------------------------------------------
5792 * Integer object
5793 * ---------------------------------------------------------------------------*/
5794 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5795 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5797 static const Jim_ObjType intObjType = {
5798 "int",
5799 NULL,
5800 NULL,
5801 UpdateStringOfInt,
5802 JIM_TYPE_NONE,
5805 /* A coerced double is closer to an int than a double.
5806 * It is an int value temporarily masquerading as a double value.
5807 * i.e. it has the same string value as an int and Jim_GetWide()
5808 * succeeds, but also Jim_GetDouble() returns the value directly.
5810 static const Jim_ObjType coercedDoubleObjType = {
5811 "coerced-double",
5812 NULL,
5813 NULL,
5814 UpdateStringOfInt,
5815 JIM_TYPE_NONE,
5819 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5821 char buf[JIM_INTEGER_SPACE + 1];
5822 jim_wide wideValue = JimWideValue(objPtr);
5823 int pos = 0;
5825 if (wideValue == 0) {
5826 buf[pos++] = '0';
5828 else {
5829 char tmp[JIM_INTEGER_SPACE];
5830 int num = 0;
5831 int i;
5833 if (wideValue < 0) {
5834 buf[pos++] = '-';
5835 i = wideValue % 10;
5836 /* C89 is implementation defined as to whether (-106 % 10) is -6 or 4,
5837 * whereas C99 is always -6
5838 * coverity[dead_error_line]
5840 tmp[num++] = (i > 0) ? (10 - i) : -i;
5841 wideValue /= -10;
5844 while (wideValue) {
5845 tmp[num++] = wideValue % 10;
5846 wideValue /= 10;
5849 for (i = 0; i < num; i++) {
5850 buf[pos++] = '0' + tmp[num - i - 1];
5853 buf[pos] = 0;
5855 JimSetStringBytes(objPtr, buf);
5858 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5860 jim_wide wideValue;
5861 const char *str;
5863 if (objPtr->typePtr == &coercedDoubleObjType) {
5864 /* Simple switch */
5865 objPtr->typePtr = &intObjType;
5866 return JIM_OK;
5869 /* Get the string representation */
5870 str = Jim_String(objPtr);
5871 /* Try to convert into a jim_wide */
5872 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5873 if (flags & JIM_ERRMSG) {
5874 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5876 return JIM_ERR;
5878 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5879 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5880 return JIM_ERR;
5882 /* Free the old internal repr and set the new one. */
5883 Jim_FreeIntRep(interp, objPtr);
5884 objPtr->typePtr = &intObjType;
5885 objPtr->internalRep.wideValue = wideValue;
5886 return JIM_OK;
5889 #ifdef JIM_OPTIMIZATION
5890 static int JimIsWide(Jim_Obj *objPtr)
5892 return objPtr->typePtr == &intObjType;
5894 #endif
5896 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5898 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5899 return JIM_ERR;
5900 *widePtr = JimWideValue(objPtr);
5901 return JIM_OK;
5904 /* Get a wide but does not set an error if the format is bad. */
5905 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5907 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5908 return JIM_ERR;
5909 *widePtr = JimWideValue(objPtr);
5910 return JIM_OK;
5913 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5915 jim_wide wideValue;
5916 int retval;
5918 retval = Jim_GetWide(interp, objPtr, &wideValue);
5919 if (retval == JIM_OK) {
5920 *longPtr = (long)wideValue;
5921 return JIM_OK;
5923 return JIM_ERR;
5926 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5928 Jim_Obj *objPtr;
5930 objPtr = Jim_NewObj(interp);
5931 objPtr->typePtr = &intObjType;
5932 objPtr->bytes = NULL;
5933 objPtr->internalRep.wideValue = wideValue;
5934 return objPtr;
5937 /* -----------------------------------------------------------------------------
5938 * Double object
5939 * ---------------------------------------------------------------------------*/
5940 #define JIM_DOUBLE_SPACE 30
5942 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5943 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5945 static const Jim_ObjType doubleObjType = {
5946 "double",
5947 NULL,
5948 NULL,
5949 UpdateStringOfDouble,
5950 JIM_TYPE_NONE,
5953 #ifndef HAVE_ISNAN
5954 #undef isnan
5955 #define isnan(X) ((X) != (X))
5956 #endif
5957 #ifndef HAVE_ISINF
5958 #undef isinf
5959 #define isinf(X) (1.0 / (X) == 0.0)
5960 #endif
5962 static void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5964 double value = objPtr->internalRep.doubleValue;
5966 if (isnan(value)) {
5967 JimSetStringBytes(objPtr, "NaN");
5968 return;
5970 if (isinf(value)) {
5971 if (value < 0) {
5972 JimSetStringBytes(objPtr, "-Inf");
5974 else {
5975 JimSetStringBytes(objPtr, "Inf");
5977 return;
5980 char buf[JIM_DOUBLE_SPACE + 1];
5981 int i;
5982 int len = sprintf(buf, "%.12g", value);
5984 /* Add a final ".0" if necessary */
5985 for (i = 0; i < len; i++) {
5986 if (buf[i] == '.' || buf[i] == 'e') {
5987 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5988 /* If 'buf' ends in e-0nn or e+0nn, remove
5989 * the 0 after the + or - and reduce the length by 1
5991 char *e = strchr(buf, 'e');
5992 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5993 /* Move it up */
5994 e += 2;
5995 memmove(e, e + 1, len - (e - buf));
5997 #endif
5998 break;
6001 if (buf[i] == '\0') {
6002 buf[i++] = '.';
6003 buf[i++] = '0';
6004 buf[i] = '\0';
6006 JimSetStringBytes(objPtr, buf);
6010 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
6012 double doubleValue;
6013 jim_wide wideValue;
6014 const char *str;
6016 /* Preserve the string representation.
6017 * Needed so we can convert back to int without loss
6019 str = Jim_String(objPtr);
6021 #ifdef HAVE_LONG_LONG
6022 /* Assume a 53 bit mantissa */
6023 #define MIN_INT_IN_DOUBLE -(1LL << 53)
6024 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
6026 if (objPtr->typePtr == &intObjType
6027 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
6028 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
6030 /* Direct conversion to coerced double */
6031 objPtr->typePtr = &coercedDoubleObjType;
6032 return JIM_OK;
6034 else
6035 #endif
6036 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
6037 /* Managed to convert to an int, so we can use this as a cooerced double */
6038 Jim_FreeIntRep(interp, objPtr);
6039 objPtr->typePtr = &coercedDoubleObjType;
6040 objPtr->internalRep.wideValue = wideValue;
6041 return JIM_OK;
6043 else {
6044 /* Try to convert into a double */
6045 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
6046 Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr);
6047 return JIM_ERR;
6049 /* Free the old internal repr and set the new one. */
6050 Jim_FreeIntRep(interp, objPtr);
6052 objPtr->typePtr = &doubleObjType;
6053 objPtr->internalRep.doubleValue = doubleValue;
6054 return JIM_OK;
6057 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
6059 if (objPtr->typePtr == &coercedDoubleObjType) {
6060 *doublePtr = JimWideValue(objPtr);
6061 return JIM_OK;
6063 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
6064 return JIM_ERR;
6066 if (objPtr->typePtr == &coercedDoubleObjType) {
6067 *doublePtr = JimWideValue(objPtr);
6069 else {
6070 *doublePtr = objPtr->internalRep.doubleValue;
6072 return JIM_OK;
6075 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
6077 Jim_Obj *objPtr;
6079 objPtr = Jim_NewObj(interp);
6080 objPtr->typePtr = &doubleObjType;
6081 objPtr->bytes = NULL;
6082 objPtr->internalRep.doubleValue = doubleValue;
6083 return objPtr;
6086 /* -----------------------------------------------------------------------------
6087 * Boolean conversion
6088 * ---------------------------------------------------------------------------*/
6089 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
6091 int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr)
6093 if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
6094 return JIM_ERR;
6095 *booleanPtr = (int) JimWideValue(objPtr);
6096 return JIM_OK;
6099 static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
6101 static const char * const falses[] = {
6102 "0", "false", "no", "off", NULL
6104 static const char * const trues[] = {
6105 "1", "true", "yes", "on", NULL
6108 int boolean;
6110 int index;
6111 if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6112 boolean = 0;
6113 } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6114 boolean = 1;
6115 } else {
6116 if (flags & JIM_ERRMSG) {
6117 Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6119 return JIM_ERR;
6122 /* Free the old internal repr and set the new one. */
6123 Jim_FreeIntRep(interp, objPtr);
6124 objPtr->typePtr = &intObjType;
6125 objPtr->internalRep.wideValue = boolean;
6126 return JIM_OK;
6129 /* -----------------------------------------------------------------------------
6130 * List object
6131 * ---------------------------------------------------------------------------*/
6132 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6133 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6134 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6135 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6136 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6137 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6139 /* Note that while the elements of the list may contain references,
6140 * the list object itself can't. This basically means that the
6141 * list object string representation as a whole can't contain references
6142 * that are not presents in the single elements. */
6143 static const Jim_ObjType listObjType = {
6144 "list",
6145 FreeListInternalRep,
6146 DupListInternalRep,
6147 UpdateStringOfList,
6148 JIM_TYPE_NONE,
6151 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6153 int i;
6155 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6156 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6158 Jim_Free(objPtr->internalRep.listValue.ele);
6161 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6163 int i;
6165 JIM_NOTUSED(interp);
6167 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6168 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6169 dupPtr->internalRep.listValue.ele =
6170 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6171 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6172 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6173 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6174 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6176 dupPtr->typePtr = &listObjType;
6179 /* The following function checks if a given string can be encoded
6180 * into a list element without any kind of quoting, surrounded by braces,
6181 * or using escapes to quote. */
6182 #define JIM_ELESTR_SIMPLE 0
6183 #define JIM_ELESTR_BRACE 1
6184 #define JIM_ELESTR_QUOTE 2
6185 static unsigned char ListElementQuotingType(const char *s, int len)
6187 int i, level, blevel, trySimple = 1;
6189 /* Try with the SIMPLE case */
6190 if (len == 0)
6191 return JIM_ELESTR_BRACE;
6192 if (s[0] == '"' || s[0] == '{') {
6193 trySimple = 0;
6194 goto testbrace;
6196 for (i = 0; i < len; i++) {
6197 switch (s[i]) {
6198 case ' ':
6199 case '$':
6200 case '"':
6201 case '[':
6202 case ']':
6203 case ';':
6204 case '\\':
6205 case '\r':
6206 case '\n':
6207 case '\t':
6208 case '\f':
6209 case '\v':
6210 trySimple = 0;
6211 /* fall through */
6212 case '{':
6213 case '}':
6214 goto testbrace;
6217 return JIM_ELESTR_SIMPLE;
6219 testbrace:
6220 /* Test if it's possible to do with braces */
6221 if (s[len - 1] == '\\')
6222 return JIM_ELESTR_QUOTE;
6223 level = 0;
6224 blevel = 0;
6225 for (i = 0; i < len; i++) {
6226 switch (s[i]) {
6227 case '{':
6228 level++;
6229 break;
6230 case '}':
6231 level--;
6232 if (level < 0)
6233 return JIM_ELESTR_QUOTE;
6234 break;
6235 case '[':
6236 blevel++;
6237 break;
6238 case ']':
6239 blevel--;
6240 break;
6241 case '\\':
6242 if (s[i + 1] == '\n')
6243 return JIM_ELESTR_QUOTE;
6244 else if (s[i + 1] != '\0')
6245 i++;
6246 break;
6249 if (blevel < 0) {
6250 return JIM_ELESTR_QUOTE;
6253 if (level == 0) {
6254 if (!trySimple)
6255 return JIM_ELESTR_BRACE;
6256 for (i = 0; i < len; i++) {
6257 switch (s[i]) {
6258 case ' ':
6259 case '$':
6260 case '"':
6261 case '[':
6262 case ']':
6263 case ';':
6264 case '\\':
6265 case '\r':
6266 case '\n':
6267 case '\t':
6268 case '\f':
6269 case '\v':
6270 return JIM_ELESTR_BRACE;
6271 break;
6274 return JIM_ELESTR_SIMPLE;
6276 return JIM_ELESTR_QUOTE;
6279 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6280 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6281 * scenario.
6282 * Returns the length of the result.
6284 static int BackslashQuoteString(const char *s, int len, char *q)
6286 char *p = q;
6288 while (len--) {
6289 switch (*s) {
6290 case ' ':
6291 case '$':
6292 case '"':
6293 case '[':
6294 case ']':
6295 case '{':
6296 case '}':
6297 case ';':
6298 case '\\':
6299 *p++ = '\\';
6300 *p++ = *s++;
6301 break;
6302 case '\n':
6303 *p++ = '\\';
6304 *p++ = 'n';
6305 s++;
6306 break;
6307 case '\r':
6308 *p++ = '\\';
6309 *p++ = 'r';
6310 s++;
6311 break;
6312 case '\t':
6313 *p++ = '\\';
6314 *p++ = 't';
6315 s++;
6316 break;
6317 case '\f':
6318 *p++ = '\\';
6319 *p++ = 'f';
6320 s++;
6321 break;
6322 case '\v':
6323 *p++ = '\\';
6324 *p++ = 'v';
6325 s++;
6326 break;
6327 default:
6328 *p++ = *s++;
6329 break;
6332 *p = '\0';
6334 return p - q;
6337 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6339 #define STATIC_QUOTING_LEN 32
6340 int i, bufLen, realLength;
6341 const char *strRep;
6342 char *p;
6343 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6345 /* Estimate the space needed. */
6346 if (objc > STATIC_QUOTING_LEN) {
6347 quotingType = Jim_Alloc(objc);
6349 else {
6350 quotingType = staticQuoting;
6352 bufLen = 0;
6353 for (i = 0; i < objc; i++) {
6354 int len;
6356 strRep = Jim_GetString(objv[i], &len);
6357 quotingType[i] = ListElementQuotingType(strRep, len);
6358 switch (quotingType[i]) {
6359 case JIM_ELESTR_SIMPLE:
6360 if (i != 0 || strRep[0] != '#') {
6361 bufLen += len;
6362 break;
6364 /* Special case '#' on first element needs braces */
6365 quotingType[i] = JIM_ELESTR_BRACE;
6366 /* fall through */
6367 case JIM_ELESTR_BRACE:
6368 bufLen += len + 2;
6369 break;
6370 case JIM_ELESTR_QUOTE:
6371 bufLen += len * 2;
6372 break;
6374 bufLen++; /* elements separator. */
6376 bufLen++;
6378 /* Generate the string rep. */
6379 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6380 realLength = 0;
6381 for (i = 0; i < objc; i++) {
6382 int len, qlen;
6384 strRep = Jim_GetString(objv[i], &len);
6386 switch (quotingType[i]) {
6387 case JIM_ELESTR_SIMPLE:
6388 memcpy(p, strRep, len);
6389 p += len;
6390 realLength += len;
6391 break;
6392 case JIM_ELESTR_BRACE:
6393 *p++ = '{';
6394 memcpy(p, strRep, len);
6395 p += len;
6396 *p++ = '}';
6397 realLength += len + 2;
6398 break;
6399 case JIM_ELESTR_QUOTE:
6400 if (i == 0 && strRep[0] == '#') {
6401 *p++ = '\\';
6402 realLength++;
6404 qlen = BackslashQuoteString(strRep, len, p);
6405 p += qlen;
6406 realLength += qlen;
6407 break;
6409 /* Add a separating space */
6410 if (i + 1 != objc) {
6411 *p++ = ' ';
6412 realLength++;
6415 *p = '\0'; /* nul term. */
6416 objPtr->length = realLength;
6418 if (quotingType != staticQuoting) {
6419 Jim_Free(quotingType);
6423 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6425 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6428 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6430 struct JimParserCtx parser;
6431 const char *str;
6432 int strLen;
6433 Jim_Obj *fileNameObj;
6434 int linenr;
6436 if (objPtr->typePtr == &listObjType) {
6437 return JIM_OK;
6440 /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6441 * it also preserves any source location of the dict elements
6442 * which can be very useful
6444 if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6445 Jim_Obj **listObjPtrPtr;
6446 int len;
6447 int i;
6449 listObjPtrPtr = JimDictPairs(objPtr, &len);
6450 for (i = 0; i < len; i++) {
6451 Jim_IncrRefCount(listObjPtrPtr[i]);
6454 /* Now just switch the internal rep */
6455 Jim_FreeIntRep(interp, objPtr);
6456 objPtr->typePtr = &listObjType;
6457 objPtr->internalRep.listValue.len = len;
6458 objPtr->internalRep.listValue.maxLen = len;
6459 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6461 return JIM_OK;
6464 /* Try to preserve information about filename / line number */
6465 if (objPtr->typePtr == &sourceObjType) {
6466 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6467 linenr = objPtr->internalRep.sourceValue.lineNumber;
6469 else {
6470 fileNameObj = interp->emptyObj;
6471 linenr = 1;
6473 Jim_IncrRefCount(fileNameObj);
6475 /* Get the string representation */
6476 str = Jim_GetString(objPtr, &strLen);
6478 /* Free the old internal repr just now and initialize the
6479 * new one just now. The string->list conversion can't fail. */
6480 Jim_FreeIntRep(interp, objPtr);
6481 objPtr->typePtr = &listObjType;
6482 objPtr->internalRep.listValue.len = 0;
6483 objPtr->internalRep.listValue.maxLen = 0;
6484 objPtr->internalRep.listValue.ele = NULL;
6486 /* Convert into a list */
6487 if (strLen) {
6488 JimParserInit(&parser, str, strLen, linenr);
6489 while (!parser.eof) {
6490 Jim_Obj *elementPtr;
6492 JimParseList(&parser);
6493 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6494 continue;
6495 elementPtr = JimParserGetTokenObj(interp, &parser);
6496 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6497 ListAppendElement(objPtr, elementPtr);
6500 Jim_DecrRefCount(interp, fileNameObj);
6501 return JIM_OK;
6504 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6506 Jim_Obj *objPtr;
6508 objPtr = Jim_NewObj(interp);
6509 objPtr->typePtr = &listObjType;
6510 objPtr->bytes = NULL;
6511 objPtr->internalRep.listValue.ele = NULL;
6512 objPtr->internalRep.listValue.len = 0;
6513 objPtr->internalRep.listValue.maxLen = 0;
6515 if (len) {
6516 ListInsertElements(objPtr, 0, len, elements);
6519 return objPtr;
6522 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6523 * length of the vector. Note that the user of this function should make
6524 * sure that the list object can't shimmer while the vector returned
6525 * is in use, this vector is the one stored inside the internal representation
6526 * of the list object. This function is not exported, extensions should
6527 * always access to the List object elements using Jim_ListIndex(). */
6528 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6529 Jim_Obj ***listVec)
6531 *listLen = Jim_ListLength(interp, listObj);
6532 *listVec = listObj->internalRep.listValue.ele;
6535 /* Sorting uses ints, but commands may return wide */
6536 static int JimSign(jim_wide w)
6538 if (w == 0) {
6539 return 0;
6541 else if (w < 0) {
6542 return -1;
6544 return 1;
6547 /* ListSortElements type values */
6548 struct lsort_info {
6549 jmp_buf jmpbuf;
6550 Jim_Obj *command;
6551 Jim_Interp *interp;
6552 enum {
6553 JIM_LSORT_ASCII,
6554 JIM_LSORT_NOCASE,
6555 JIM_LSORT_INTEGER,
6556 JIM_LSORT_REAL,
6557 JIM_LSORT_COMMAND
6558 } type;
6559 int order;
6560 int index;
6561 int indexed;
6562 int unique;
6563 int (*subfn)(Jim_Obj **, Jim_Obj **);
6566 static struct lsort_info *sort_info;
6568 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6570 Jim_Obj *lObj, *rObj;
6572 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6573 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6574 longjmp(sort_info->jmpbuf, JIM_ERR);
6576 return sort_info->subfn(&lObj, &rObj);
6579 /* Sort the internal rep of a list. */
6580 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6582 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6585 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6587 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6590 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6592 jim_wide lhs = 0, rhs = 0;
6594 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6595 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6596 longjmp(sort_info->jmpbuf, JIM_ERR);
6599 return JimSign(lhs - rhs) * sort_info->order;
6602 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6604 double lhs = 0, rhs = 0;
6606 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6607 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6608 longjmp(sort_info->jmpbuf, JIM_ERR);
6610 if (lhs == rhs) {
6611 return 0;
6613 if (lhs > rhs) {
6614 return sort_info->order;
6616 return -sort_info->order;
6619 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6621 Jim_Obj *compare_script;
6622 int rc;
6624 jim_wide ret = 0;
6626 /* This must be a valid list */
6627 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6628 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6629 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6631 rc = Jim_EvalObj(sort_info->interp, compare_script);
6633 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6634 longjmp(sort_info->jmpbuf, rc);
6637 return JimSign(ret) * sort_info->order;
6640 /* Remove duplicate elements from the (sorted) list in-place, according to the
6641 * comparison function, comp.
6643 * Note that the last unique value is kept, not the first
6645 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6647 int src;
6648 int dst = 0;
6649 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6651 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6652 if (comp(&ele[dst], &ele[src]) == 0) {
6653 /* Match, so replace the dest with the current source */
6654 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6656 else {
6657 /* No match, so keep the current source and move to the next destination */
6658 dst++;
6660 ele[dst] = ele[src];
6663 /* At end of list, keep the final element unless all elements were kept */
6664 dst++;
6665 if (dst < listObjPtr->internalRep.listValue.len) {
6666 ele[dst] = ele[src];
6669 /* Set the new length */
6670 listObjPtr->internalRep.listValue.len = dst;
6673 /* Sort a list *in place*. MUST be called with a non-shared list. */
6674 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6676 struct lsort_info *prev_info;
6678 typedef int (qsort_comparator) (const void *, const void *);
6679 int (*fn) (Jim_Obj **, Jim_Obj **);
6680 Jim_Obj **vector;
6681 int len;
6682 int rc;
6684 JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object"));
6685 SetListFromAny(interp, listObjPtr);
6687 /* Allow lsort to be called reentrantly */
6688 prev_info = sort_info;
6689 sort_info = info;
6691 vector = listObjPtr->internalRep.listValue.ele;
6692 len = listObjPtr->internalRep.listValue.len;
6693 switch (info->type) {
6694 case JIM_LSORT_ASCII:
6695 fn = ListSortString;
6696 break;
6697 case JIM_LSORT_NOCASE:
6698 fn = ListSortStringNoCase;
6699 break;
6700 case JIM_LSORT_INTEGER:
6701 fn = ListSortInteger;
6702 break;
6703 case JIM_LSORT_REAL:
6704 fn = ListSortReal;
6705 break;
6706 case JIM_LSORT_COMMAND:
6707 fn = ListSortCommand;
6708 break;
6709 default:
6710 fn = NULL; /* avoid warning */
6711 JimPanic((1, "ListSort called with invalid sort type"));
6712 return -1; /* Should not be run but keeps static analysers happy */
6715 if (info->indexed) {
6716 /* Need to interpose a "list index" function */
6717 info->subfn = fn;
6718 fn = ListSortIndexHelper;
6721 if ((rc = setjmp(info->jmpbuf)) == 0) {
6722 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6724 if (info->unique && len > 1) {
6725 ListRemoveDuplicates(listObjPtr, fn);
6728 Jim_InvalidateStringRep(listObjPtr);
6730 sort_info = prev_info;
6732 return rc;
6735 /* This is the low-level function to insert elements into a list.
6736 * The higher-level Jim_ListInsertElements() performs shared object
6737 * check and invalidates the string repr. This version is used
6738 * in the internals of the List Object and is not exported.
6740 * NOTE: this function can be called only against objects
6741 * with internal type of List.
6743 * An insertion point (idx) of -1 means end-of-list.
6745 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6747 int currentLen = listPtr->internalRep.listValue.len;
6748 int requiredLen = currentLen + elemc;
6749 int i;
6750 Jim_Obj **point;
6752 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6753 if (requiredLen < 2) {
6754 /* Don't do allocations of under 4 pointers. */
6755 requiredLen = 4;
6757 else {
6758 requiredLen *= 2;
6761 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6762 sizeof(Jim_Obj *) * requiredLen);
6764 listPtr->internalRep.listValue.maxLen = requiredLen;
6766 if (idx < 0) {
6767 idx = currentLen;
6769 point = listPtr->internalRep.listValue.ele + idx;
6770 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6771 for (i = 0; i < elemc; ++i) {
6772 point[i] = elemVec[i];
6773 Jim_IncrRefCount(point[i]);
6775 listPtr->internalRep.listValue.len += elemc;
6778 /* Convenience call to ListInsertElements() to append a single element.
6780 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6782 ListInsertElements(listPtr, -1, 1, &objPtr);
6785 /* Appends every element of appendListPtr into listPtr.
6786 * Both have to be of the list type.
6787 * Convenience call to ListInsertElements()
6789 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6791 ListInsertElements(listPtr, -1,
6792 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6795 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6797 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6798 SetListFromAny(interp, listPtr);
6799 Jim_InvalidateStringRep(listPtr);
6800 ListAppendElement(listPtr, objPtr);
6803 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6805 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6806 SetListFromAny(interp, listPtr);
6807 SetListFromAny(interp, appendListPtr);
6808 Jim_InvalidateStringRep(listPtr);
6809 ListAppendList(listPtr, appendListPtr);
6812 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6814 SetListFromAny(interp, objPtr);
6815 return objPtr->internalRep.listValue.len;
6818 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6819 int objc, Jim_Obj *const *objVec)
6821 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6822 SetListFromAny(interp, listPtr);
6823 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6824 idx = listPtr->internalRep.listValue.len;
6825 else if (idx < 0)
6826 idx = 0;
6827 Jim_InvalidateStringRep(listPtr);
6828 ListInsertElements(listPtr, idx, objc, objVec);
6831 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6833 SetListFromAny(interp, listPtr);
6834 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6835 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6836 return NULL;
6838 if (idx < 0)
6839 idx = listPtr->internalRep.listValue.len + idx;
6840 return listPtr->internalRep.listValue.ele[idx];
6843 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6845 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6846 if (*objPtrPtr == NULL) {
6847 if (flags & JIM_ERRMSG) {
6848 Jim_SetResultString(interp, "list index out of range", -1);
6850 return JIM_ERR;
6852 return JIM_OK;
6855 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6856 Jim_Obj *newObjPtr, int flags)
6858 SetListFromAny(interp, listPtr);
6859 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6860 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6861 if (flags & JIM_ERRMSG) {
6862 Jim_SetResultString(interp, "list index out of range", -1);
6864 return JIM_ERR;
6866 if (idx < 0)
6867 idx = listPtr->internalRep.listValue.len + idx;
6868 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6869 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6870 Jim_IncrRefCount(newObjPtr);
6871 return JIM_OK;
6874 /* Modify the list stored in the variable named 'varNamePtr'
6875 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6876 * with the new element 'newObjptr'. (implements the [lset] command) */
6877 int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6878 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6880 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6881 int shared, i, idx;
6883 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6884 if (objPtr == NULL)
6885 return JIM_ERR;
6886 if ((shared = Jim_IsShared(objPtr)))
6887 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6888 for (i = 0; i < indexc - 1; i++) {
6889 listObjPtr = objPtr;
6890 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6891 goto err;
6892 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6893 goto err;
6895 if (Jim_IsShared(objPtr)) {
6896 objPtr = Jim_DuplicateObj(interp, objPtr);
6897 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6899 Jim_InvalidateStringRep(listObjPtr);
6901 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6902 goto err;
6903 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6904 goto err;
6905 Jim_InvalidateStringRep(objPtr);
6906 Jim_InvalidateStringRep(varObjPtr);
6907 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6908 goto err;
6909 Jim_SetResult(interp, varObjPtr);
6910 return JIM_OK;
6911 err:
6912 if (shared) {
6913 Jim_FreeNewObj(interp, varObjPtr);
6915 return JIM_ERR;
6918 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6920 int i;
6921 int listLen = Jim_ListLength(interp, listObjPtr);
6922 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6924 for (i = 0; i < listLen; ) {
6925 Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i));
6926 if (++i != listLen) {
6927 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6930 return resObjPtr;
6933 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6935 int i;
6937 /* If all the objects in objv are lists,
6938 * it's possible to return a list as result, that's the
6939 * concatenation of all the lists. */
6940 for (i = 0; i < objc; i++) {
6941 if (!Jim_IsList(objv[i]))
6942 break;
6944 if (i == objc) {
6945 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6947 for (i = 0; i < objc; i++)
6948 ListAppendList(objPtr, objv[i]);
6949 return objPtr;
6951 else {
6952 /* Else... we have to glue strings together */
6953 int len = 0, objLen;
6954 char *bytes, *p;
6956 /* Compute the length */
6957 for (i = 0; i < objc; i++) {
6958 len += Jim_Length(objv[i]);
6960 if (objc)
6961 len += objc - 1;
6962 /* Create the string rep, and a string object holding it. */
6963 p = bytes = Jim_Alloc(len + 1);
6964 for (i = 0; i < objc; i++) {
6965 const char *s = Jim_GetString(objv[i], &objLen);
6967 /* Remove leading space */
6968 while (objLen && isspace(UCHAR(*s))) {
6969 s++;
6970 objLen--;
6971 len--;
6973 /* And trailing space */
6974 while (objLen && isspace(UCHAR(s[objLen - 1]))) {
6975 /* Handle trailing backslash-space case */
6976 if (objLen > 1 && s[objLen - 2] == '\\') {
6977 break;
6979 objLen--;
6980 len--;
6982 memcpy(p, s, objLen);
6983 p += objLen;
6984 if (i + 1 != objc) {
6985 if (objLen)
6986 *p++ = ' ';
6987 else {
6988 /* Drop the space calculated for this
6989 * element that is instead null. */
6990 len--;
6994 *p = '\0';
6995 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6999 /* Returns a list composed of the elements in the specified range.
7000 * first and start are directly accepted as Jim_Objects and
7001 * processed for the end?-index? case. */
7002 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
7003 Jim_Obj *lastObjPtr)
7005 int first, last;
7006 int len, rangeLen;
7008 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
7009 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
7010 return NULL;
7011 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
7012 first = JimRelToAbsIndex(len, first);
7013 last = JimRelToAbsIndex(len, last);
7014 JimRelToAbsRange(len, &first, &last, &rangeLen);
7015 if (first == 0 && last == len) {
7016 return listObjPtr;
7018 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
7021 /* -----------------------------------------------------------------------------
7022 * Dict object
7023 * ---------------------------------------------------------------------------*/
7024 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
7025 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
7026 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7027 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7029 /* Dict HashTable Type.
7031 * Keys and Values are Jim objects. */
7033 static unsigned int JimObjectHTHashFunction(const void *key)
7035 int len;
7036 const char *str = Jim_GetString((Jim_Obj *)key, &len);
7037 return Jim_GenHashFunction((const unsigned char *)str, len);
7040 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
7042 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
7045 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
7047 Jim_IncrRefCount((Jim_Obj *)val);
7048 return (void *)val;
7051 static void JimObjectHTKeyValDestructor(void *interp, void *val)
7053 Jim_DecrRefCount(interp, (Jim_Obj *)val);
7056 static const Jim_HashTableType JimDictHashTableType = {
7057 JimObjectHTHashFunction, /* hash function */
7058 JimObjectHTKeyValDup, /* key dup */
7059 JimObjectHTKeyValDup, /* val dup */
7060 JimObjectHTKeyCompare, /* key compare */
7061 JimObjectHTKeyValDestructor, /* key destructor */
7062 JimObjectHTKeyValDestructor /* val destructor */
7065 /* Note that while the elements of the dict may contain references,
7066 * the list object itself can't. This basically means that the
7067 * dict object string representation as a whole can't contain references
7068 * that are not presents in the single elements. */
7069 static const Jim_ObjType dictObjType = {
7070 "dict",
7071 FreeDictInternalRep,
7072 DupDictInternalRep,
7073 UpdateStringOfDict,
7074 JIM_TYPE_NONE,
7077 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
7079 JIM_NOTUSED(interp);
7081 Jim_FreeHashTable(objPtr->internalRep.ptr);
7082 Jim_Free(objPtr->internalRep.ptr);
7085 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
7087 Jim_HashTable *ht, *dupHt;
7088 Jim_HashTableIterator htiter;
7089 Jim_HashEntry *he;
7091 /* Create a new hash table */
7092 ht = srcPtr->internalRep.ptr;
7093 dupHt = Jim_Alloc(sizeof(*dupHt));
7094 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7095 if (ht->size != 0)
7096 Jim_ExpandHashTable(dupHt, ht->size);
7097 /* Copy every element from the source to the dup hash table */
7098 JimInitHashTableIterator(ht, &htiter);
7099 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7100 Jim_AddHashEntry(dupHt, he->key, he->u.val);
7103 dupPtr->internalRep.ptr = dupHt;
7104 dupPtr->typePtr = &dictObjType;
7107 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
7109 Jim_HashTable *ht;
7110 Jim_HashTableIterator htiter;
7111 Jim_HashEntry *he;
7112 Jim_Obj **objv;
7113 int i;
7115 ht = dictPtr->internalRep.ptr;
7117 /* Turn the hash table into a flat vector of Jim_Objects. */
7118 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7119 JimInitHashTableIterator(ht, &htiter);
7120 i = 0;
7121 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7122 objv[i++] = Jim_GetHashEntryKey(he);
7123 objv[i++] = Jim_GetHashEntryVal(he);
7125 *len = i;
7126 return objv;
7129 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7131 /* Turn the hash table into a flat vector of Jim_Objects. */
7132 int len;
7133 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7135 /* And now generate the string rep as a list */
7136 JimMakeListStringRep(objPtr, objv, len);
7138 Jim_Free(objv);
7141 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7143 int listlen;
7145 if (objPtr->typePtr == &dictObjType) {
7146 return JIM_OK;
7149 if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7150 /* A shared list, so get the string representation now to avoid
7151 * changing the order in case of fast conversion to dict.
7153 Jim_String(objPtr);
7156 /* For simplicity, convert a non-list object to a list and then to a dict */
7157 listlen = Jim_ListLength(interp, objPtr);
7158 if (listlen % 2) {
7159 Jim_SetResultString(interp, "missing value to go with key", -1);
7160 return JIM_ERR;
7162 else {
7163 /* Converting from a list to a dict can't fail */
7164 Jim_HashTable *ht;
7165 int i;
7167 ht = Jim_Alloc(sizeof(*ht));
7168 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7170 for (i = 0; i < listlen; i += 2) {
7171 Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7172 Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7174 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7177 Jim_FreeIntRep(interp, objPtr);
7178 objPtr->typePtr = &dictObjType;
7179 objPtr->internalRep.ptr = ht;
7181 return JIM_OK;
7185 /* Dict object API */
7187 /* Add an element to a dict. objPtr must be of the "dict" type.
7188 * The higher-level exported function is Jim_DictAddElement().
7189 * If an element with the specified key already exists, the value
7190 * associated is replaced with the new one.
7192 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7193 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7194 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7196 Jim_HashTable *ht = objPtr->internalRep.ptr;
7198 if (valueObjPtr == NULL) { /* unset */
7199 return Jim_DeleteHashEntry(ht, keyObjPtr);
7201 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7202 return JIM_OK;
7205 /* Add an element, higher-level interface for DictAddElement().
7206 * If valueObjPtr == NULL, the key is removed if it exists. */
7207 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7208 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7210 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7211 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7212 return JIM_ERR;
7214 Jim_InvalidateStringRep(objPtr);
7215 return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7218 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7220 Jim_Obj *objPtr;
7221 int i;
7223 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7225 objPtr = Jim_NewObj(interp);
7226 objPtr->typePtr = &dictObjType;
7227 objPtr->bytes = NULL;
7228 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7229 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7230 for (i = 0; i < len; i += 2)
7231 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7232 return objPtr;
7235 /* Return the value associated to the specified dict key
7236 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7238 * Sets *objPtrPtr to non-NULL only upon success.
7240 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7241 Jim_Obj **objPtrPtr, int flags)
7243 Jim_HashEntry *he;
7244 Jim_HashTable *ht;
7246 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7247 return -1;
7249 ht = dictPtr->internalRep.ptr;
7250 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7251 if (flags & JIM_ERRMSG) {
7252 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7254 return JIM_ERR;
7256 else {
7257 *objPtrPtr = Jim_GetHashEntryVal(he);
7258 return JIM_OK;
7262 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7263 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7265 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7266 return JIM_ERR;
7268 *objPtrPtr = JimDictPairs(dictPtr, len);
7270 return JIM_OK;
7274 /* Return the value associated to the specified dict keys */
7275 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7276 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7278 int i;
7280 if (keyc == 0) {
7281 *objPtrPtr = dictPtr;
7282 return JIM_OK;
7285 for (i = 0; i < keyc; i++) {
7286 Jim_Obj *objPtr;
7288 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7289 if (rc != JIM_OK) {
7290 return rc;
7292 dictPtr = objPtr;
7294 *objPtrPtr = dictPtr;
7295 return JIM_OK;
7298 /* Modify the dict stored into the variable named 'varNamePtr'
7299 * setting the element specified by the 'keyc' keys objects in 'keyv',
7300 * with the new value of the element 'newObjPtr'.
7302 * If newObjPtr == NULL the operation is to remove the given key
7303 * from the dictionary.
7305 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7306 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7308 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7309 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7311 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7312 int shared, i;
7314 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7315 if (objPtr == NULL) {
7316 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7317 /* Cannot remove a key from non existing var */
7318 return JIM_ERR;
7320 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7321 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7322 Jim_FreeNewObj(interp, varObjPtr);
7323 return JIM_ERR;
7326 if ((shared = Jim_IsShared(objPtr)))
7327 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7328 for (i = 0; i < keyc; i++) {
7329 dictObjPtr = objPtr;
7331 /* Check if it's a valid dictionary */
7332 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7333 goto err;
7336 if (i == keyc - 1) {
7337 /* Last key: Note that error on unset with missing last key is OK */
7338 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7339 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7340 goto err;
7343 break;
7346 /* Check if the given key exists. */
7347 Jim_InvalidateStringRep(dictObjPtr);
7348 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7349 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7350 /* This key exists at the current level.
7351 * Make sure it's not shared!. */
7352 if (Jim_IsShared(objPtr)) {
7353 objPtr = Jim_DuplicateObj(interp, objPtr);
7354 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7357 else {
7358 /* Key not found. If it's an [unset] operation
7359 * this is an error. Only the last key may not
7360 * exist. */
7361 if (newObjPtr == NULL) {
7362 goto err;
7364 /* Otherwise set an empty dictionary
7365 * as key's value. */
7366 objPtr = Jim_NewDictObj(interp, NULL, 0);
7367 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7370 /* XXX: Is this necessary? */
7371 Jim_InvalidateStringRep(objPtr);
7372 Jim_InvalidateStringRep(varObjPtr);
7373 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7374 goto err;
7376 Jim_SetResult(interp, varObjPtr);
7377 return JIM_OK;
7378 err:
7379 if (shared) {
7380 Jim_FreeNewObj(interp, varObjPtr);
7382 return JIM_ERR;
7385 /* -----------------------------------------------------------------------------
7386 * Index object
7387 * ---------------------------------------------------------------------------*/
7388 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7389 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7391 static const Jim_ObjType indexObjType = {
7392 "index",
7393 NULL,
7394 NULL,
7395 UpdateStringOfIndex,
7396 JIM_TYPE_NONE,
7399 static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7401 if (objPtr->internalRep.intValue == -1) {
7402 JimSetStringBytes(objPtr, "end");
7404 else {
7405 char buf[JIM_INTEGER_SPACE + 1];
7406 if (objPtr->internalRep.intValue >= 0) {
7407 sprintf(buf, "%d", objPtr->internalRep.intValue);
7409 else {
7410 /* Must be <= -2 */
7411 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7413 JimSetStringBytes(objPtr, buf);
7417 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7419 int idx, end = 0;
7420 const char *str;
7421 char *endptr;
7423 /* Get the string representation */
7424 str = Jim_String(objPtr);
7426 /* Try to convert into an index */
7427 if (strncmp(str, "end", 3) == 0) {
7428 end = 1;
7429 str += 3;
7430 idx = 0;
7432 else {
7433 idx = jim_strtol(str, &endptr);
7435 if (endptr == str) {
7436 goto badindex;
7438 str = endptr;
7441 /* Now str may include or +<num> or -<num> */
7442 if (*str == '+' || *str == '-') {
7443 int sign = (*str == '+' ? 1 : -1);
7445 idx += sign * jim_strtol(++str, &endptr);
7446 if (str == endptr || *endptr) {
7447 goto badindex;
7449 str = endptr;
7451 /* The only thing left should be spaces */
7452 while (isspace(UCHAR(*str))) {
7453 str++;
7455 if (*str) {
7456 goto badindex;
7458 if (end) {
7459 if (idx > 0) {
7460 idx = INT_MAX;
7462 else {
7463 /* end-1 is repesented as -2 */
7464 idx--;
7467 else if (idx < 0) {
7468 idx = -INT_MAX;
7471 /* Free the old internal repr and set the new one. */
7472 Jim_FreeIntRep(interp, objPtr);
7473 objPtr->typePtr = &indexObjType;
7474 objPtr->internalRep.intValue = idx;
7475 return JIM_OK;
7477 badindex:
7478 Jim_SetResultFormatted(interp,
7479 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7480 return JIM_ERR;
7483 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7485 /* Avoid shimmering if the object is an integer. */
7486 if (objPtr->typePtr == &intObjType) {
7487 jim_wide val = JimWideValue(objPtr);
7489 if (val < 0)
7490 *indexPtr = -INT_MAX;
7491 else if (val > INT_MAX)
7492 *indexPtr = INT_MAX;
7493 else
7494 *indexPtr = (int)val;
7495 return JIM_OK;
7497 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7498 return JIM_ERR;
7499 *indexPtr = objPtr->internalRep.intValue;
7500 return JIM_OK;
7503 /* -----------------------------------------------------------------------------
7504 * Return Code Object.
7505 * ---------------------------------------------------------------------------*/
7507 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7508 static const char * const jimReturnCodes[] = {
7509 "ok",
7510 "error",
7511 "return",
7512 "break",
7513 "continue",
7514 "signal",
7515 "exit",
7516 "eval",
7517 NULL
7520 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1)
7522 static const Jim_ObjType returnCodeObjType = {
7523 "return-code",
7524 NULL,
7525 NULL,
7526 NULL,
7527 JIM_TYPE_NONE,
7530 /* Converts a (standard) return code to a string. Returns "?" for
7531 * non-standard return codes.
7533 const char *Jim_ReturnCode(int code)
7535 if (code < 0 || code >= (int)jimReturnCodesSize) {
7536 return "?";
7538 else {
7539 return jimReturnCodes[code];
7543 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7545 int returnCode;
7546 jim_wide wideValue;
7548 /* Try to convert into an integer */
7549 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7550 returnCode = (int)wideValue;
7551 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7552 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7553 return JIM_ERR;
7555 /* Free the old internal repr and set the new one. */
7556 Jim_FreeIntRep(interp, objPtr);
7557 objPtr->typePtr = &returnCodeObjType;
7558 objPtr->internalRep.intValue = returnCode;
7559 return JIM_OK;
7562 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7564 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7565 return JIM_ERR;
7566 *intPtr = objPtr->internalRep.intValue;
7567 return JIM_OK;
7570 /* -----------------------------------------------------------------------------
7571 * Expression Parsing
7572 * ---------------------------------------------------------------------------*/
7573 static int JimParseExprOperator(struct JimParserCtx *pc);
7574 static int JimParseExprNumber(struct JimParserCtx *pc);
7575 static int JimParseExprIrrational(struct JimParserCtx *pc);
7576 static int JimParseExprBoolean(struct JimParserCtx *pc);
7578 /* Exrp's Stack machine operators opcodes. */
7580 /* Binary operators (numbers) */
7581 enum
7583 /* Continues on from the JIM_TT_ space */
7584 /* Operations */
7585 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7586 JIM_EXPROP_DIV,
7587 JIM_EXPROP_MOD,
7588 JIM_EXPROP_SUB,
7589 JIM_EXPROP_ADD,
7590 JIM_EXPROP_LSHIFT,
7591 JIM_EXPROP_RSHIFT,
7592 JIM_EXPROP_ROTL,
7593 JIM_EXPROP_ROTR,
7594 JIM_EXPROP_LT,
7595 JIM_EXPROP_GT,
7596 JIM_EXPROP_LTE,
7597 JIM_EXPROP_GTE,
7598 JIM_EXPROP_NUMEQ,
7599 JIM_EXPROP_NUMNE,
7600 JIM_EXPROP_BITAND, /* 35 */
7601 JIM_EXPROP_BITXOR,
7602 JIM_EXPROP_BITOR,
7604 /* Note must keep these together */
7605 JIM_EXPROP_LOGICAND, /* 38 */
7606 JIM_EXPROP_LOGICAND_LEFT,
7607 JIM_EXPROP_LOGICAND_RIGHT,
7609 /* and these */
7610 JIM_EXPROP_LOGICOR, /* 41 */
7611 JIM_EXPROP_LOGICOR_LEFT,
7612 JIM_EXPROP_LOGICOR_RIGHT,
7614 /* and these */
7615 /* Ternary operators */
7616 JIM_EXPROP_TERNARY, /* 44 */
7617 JIM_EXPROP_TERNARY_LEFT,
7618 JIM_EXPROP_TERNARY_RIGHT,
7620 /* and these */
7621 JIM_EXPROP_COLON, /* 47 */
7622 JIM_EXPROP_COLON_LEFT,
7623 JIM_EXPROP_COLON_RIGHT,
7625 JIM_EXPROP_POW, /* 50 */
7627 /* Binary operators (strings) */
7628 JIM_EXPROP_STREQ, /* 51 */
7629 JIM_EXPROP_STRNE,
7630 JIM_EXPROP_STRIN,
7631 JIM_EXPROP_STRNI,
7633 /* Unary operators (numbers) */
7634 JIM_EXPROP_NOT, /* 55 */
7635 JIM_EXPROP_BITNOT,
7636 JIM_EXPROP_UNARYMINUS,
7637 JIM_EXPROP_UNARYPLUS,
7639 /* Functions */
7640 JIM_EXPROP_FUNC_FIRST, /* 59 */
7641 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
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 struct JimExprState
7673 Jim_Obj **stack;
7674 int stacklen;
7675 int opcode;
7676 int skip;
7679 /* Operators table */
7680 typedef struct Jim_ExprOperator
7682 const char *name;
7683 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7684 unsigned char precedence;
7685 unsigned char arity;
7686 unsigned char lazy;
7687 unsigned char namelen;
7688 } Jim_ExprOperator;
7690 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7692 Jim_IncrRefCount(obj);
7693 e->stack[e->stacklen++] = obj;
7696 static Jim_Obj *ExprPop(struct JimExprState *e)
7698 JimPanic((e->stacklen <= 0, "expr stack underflow"));
7699 return e->stack[--e->stacklen];
7702 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7704 int intresult = 1;
7705 int rc = JIM_OK;
7706 Jim_Obj *A = ExprPop(e);
7707 double dA, dC = 0;
7708 jim_wide wA, wC = 0;
7710 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7711 switch (e->opcode) {
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 (e->opcode) {
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 ExprPush(e, Jim_NewIntObj(interp, wC));
7773 else {
7774 ExprPush(e, 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 JimExprState *e)
7793 Jim_Obj *A = ExprPop(e);
7794 jim_wide wA;
7796 int rc = Jim_GetWide(interp, A, &wA);
7797 if (rc == JIM_OK) {
7798 switch (e->opcode) {
7799 case JIM_EXPROP_BITNOT:
7800 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7801 break;
7802 case JIM_EXPROP_FUNC_SRAND:
7803 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7804 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7805 break;
7806 default:
7807 abort();
7811 Jim_DecrRefCount(interp, A);
7813 return rc;
7816 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7818 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7820 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7822 return JIM_OK;
7825 #ifdef JIM_MATH_FUNCTIONS
7826 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7828 int rc;
7829 Jim_Obj *A = ExprPop(e);
7830 double dA, dC;
7832 rc = Jim_GetDouble(interp, A, &dA);
7833 if (rc == JIM_OK) {
7834 switch (e->opcode) {
7835 case JIM_EXPROP_FUNC_SIN:
7836 dC = sin(dA);
7837 break;
7838 case JIM_EXPROP_FUNC_COS:
7839 dC = cos(dA);
7840 break;
7841 case JIM_EXPROP_FUNC_TAN:
7842 dC = tan(dA);
7843 break;
7844 case JIM_EXPROP_FUNC_ASIN:
7845 dC = asin(dA);
7846 break;
7847 case JIM_EXPROP_FUNC_ACOS:
7848 dC = acos(dA);
7849 break;
7850 case JIM_EXPROP_FUNC_ATAN:
7851 dC = atan(dA);
7852 break;
7853 case JIM_EXPROP_FUNC_SINH:
7854 dC = sinh(dA);
7855 break;
7856 case JIM_EXPROP_FUNC_COSH:
7857 dC = cosh(dA);
7858 break;
7859 case JIM_EXPROP_FUNC_TANH:
7860 dC = tanh(dA);
7861 break;
7862 case JIM_EXPROP_FUNC_CEIL:
7863 dC = ceil(dA);
7864 break;
7865 case JIM_EXPROP_FUNC_FLOOR:
7866 dC = floor(dA);
7867 break;
7868 case JIM_EXPROP_FUNC_EXP:
7869 dC = exp(dA);
7870 break;
7871 case JIM_EXPROP_FUNC_LOG:
7872 dC = log(dA);
7873 break;
7874 case JIM_EXPROP_FUNC_LOG10:
7875 dC = log10(dA);
7876 break;
7877 case JIM_EXPROP_FUNC_SQRT:
7878 dC = sqrt(dA);
7879 break;
7880 default:
7881 abort();
7883 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7886 Jim_DecrRefCount(interp, A);
7888 return rc;
7890 #endif
7892 /* A binary operation on two ints */
7893 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7895 Jim_Obj *B = ExprPop(e);
7896 Jim_Obj *A = ExprPop(e);
7897 jim_wide wA, wB;
7898 int rc = JIM_ERR;
7900 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7901 jim_wide wC;
7903 rc = JIM_OK;
7905 switch (e->opcode) {
7906 case JIM_EXPROP_LSHIFT:
7907 wC = wA << wB;
7908 break;
7909 case JIM_EXPROP_RSHIFT:
7910 wC = wA >> wB;
7911 break;
7912 case JIM_EXPROP_BITAND:
7913 wC = wA & wB;
7914 break;
7915 case JIM_EXPROP_BITXOR:
7916 wC = wA ^ wB;
7917 break;
7918 case JIM_EXPROP_BITOR:
7919 wC = wA | wB;
7920 break;
7921 case JIM_EXPROP_MOD:
7922 if (wB == 0) {
7923 wC = 0;
7924 Jim_SetResultString(interp, "Division by zero", -1);
7925 rc = JIM_ERR;
7927 else {
7929 * From Tcl 8.x
7931 * This code is tricky: C doesn't guarantee much
7932 * about the quotient or remainder, but Tcl does.
7933 * The remainder always has the same sign as the
7934 * divisor and a smaller absolute value.
7936 int negative = 0;
7938 if (wB < 0) {
7939 wB = -wB;
7940 wA = -wA;
7941 negative = 1;
7943 wC = wA % wB;
7944 if (wC < 0) {
7945 wC += wB;
7947 if (negative) {
7948 wC = -wC;
7951 break;
7952 case JIM_EXPROP_ROTL:
7953 case JIM_EXPROP_ROTR:{
7954 /* uint32_t would be better. But not everyone has inttypes.h? */
7955 unsigned long uA = (unsigned long)wA;
7956 unsigned long uB = (unsigned long)wB;
7957 const unsigned int S = sizeof(unsigned long) * 8;
7959 /* Shift left by the word size or more is undefined. */
7960 uB %= S;
7962 if (e->opcode == JIM_EXPROP_ROTR) {
7963 uB = S - uB;
7965 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7966 break;
7968 default:
7969 abort();
7971 ExprPush(e, Jim_NewIntObj(interp, wC));
7975 Jim_DecrRefCount(interp, A);
7976 Jim_DecrRefCount(interp, B);
7978 return rc;
7982 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7983 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7985 int rc = JIM_OK;
7986 double dA, dB, dC = 0;
7987 jim_wide wA, wB, wC = 0;
7989 Jim_Obj *B = ExprPop(e);
7990 Jim_Obj *A = ExprPop(e);
7992 if ((A->typePtr != &doubleObjType || A->bytes) &&
7993 (B->typePtr != &doubleObjType || B->bytes) &&
7994 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7996 /* Both are ints */
7998 switch (e->opcode) {
7999 case JIM_EXPROP_POW:
8000 case JIM_EXPROP_FUNC_POW:
8001 if (wA == 0 && wB < 0) {
8002 Jim_SetResultString(interp, "exponentiation of zero by negative power", -1);
8003 rc = JIM_ERR;
8004 goto done;
8006 wC = JimPowWide(wA, wB);
8007 goto intresult;
8008 case JIM_EXPROP_ADD:
8009 wC = wA + wB;
8010 goto intresult;
8011 case JIM_EXPROP_SUB:
8012 wC = wA - wB;
8013 goto intresult;
8014 case JIM_EXPROP_MUL:
8015 wC = wA * wB;
8016 goto intresult;
8017 case JIM_EXPROP_DIV:
8018 if (wB == 0) {
8019 Jim_SetResultString(interp, "Division by zero", -1);
8020 rc = JIM_ERR;
8021 goto done;
8023 else {
8025 * From Tcl 8.x
8027 * This code is tricky: C doesn't guarantee much
8028 * about the quotient or remainder, but Tcl does.
8029 * The remainder always has the same sign as the
8030 * divisor and a smaller absolute value.
8032 if (wB < 0) {
8033 wB = -wB;
8034 wA = -wA;
8036 wC = wA / wB;
8037 if (wA % wB < 0) {
8038 wC--;
8040 goto intresult;
8042 case JIM_EXPROP_LT:
8043 wC = wA < wB;
8044 goto intresult;
8045 case JIM_EXPROP_GT:
8046 wC = wA > wB;
8047 goto intresult;
8048 case JIM_EXPROP_LTE:
8049 wC = wA <= wB;
8050 goto intresult;
8051 case JIM_EXPROP_GTE:
8052 wC = wA >= wB;
8053 goto intresult;
8054 case JIM_EXPROP_NUMEQ:
8055 wC = wA == wB;
8056 goto intresult;
8057 case JIM_EXPROP_NUMNE:
8058 wC = wA != wB;
8059 goto intresult;
8062 if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
8063 switch (e->opcode) {
8064 #ifndef JIM_MATH_FUNCTIONS
8065 case JIM_EXPROP_POW:
8066 case JIM_EXPROP_FUNC_POW:
8067 case JIM_EXPROP_FUNC_ATAN2:
8068 case JIM_EXPROP_FUNC_HYPOT:
8069 case JIM_EXPROP_FUNC_FMOD:
8070 Jim_SetResultString(interp, "unsupported", -1);
8071 rc = JIM_ERR;
8072 goto done;
8073 #else
8074 case JIM_EXPROP_POW:
8075 case JIM_EXPROP_FUNC_POW:
8076 dC = pow(dA, dB);
8077 goto doubleresult;
8078 case JIM_EXPROP_FUNC_ATAN2:
8079 dC = atan2(dA, dB);
8080 goto doubleresult;
8081 case JIM_EXPROP_FUNC_HYPOT:
8082 dC = hypot(dA, dB);
8083 goto doubleresult;
8084 case JIM_EXPROP_FUNC_FMOD:
8085 dC = fmod(dA, dB);
8086 goto doubleresult;
8087 #endif
8088 case JIM_EXPROP_ADD:
8089 dC = dA + dB;
8090 goto doubleresult;
8091 case JIM_EXPROP_SUB:
8092 dC = dA - dB;
8093 goto doubleresult;
8094 case JIM_EXPROP_MUL:
8095 dC = dA * dB;
8096 goto doubleresult;
8097 case JIM_EXPROP_DIV:
8098 if (dB == 0) {
8099 #ifdef INFINITY
8100 dC = dA < 0 ? -INFINITY : INFINITY;
8101 #else
8102 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
8103 #endif
8105 else {
8106 dC = dA / dB;
8108 goto doubleresult;
8109 case JIM_EXPROP_LT:
8110 wC = dA < dB;
8111 goto intresult;
8112 case JIM_EXPROP_GT:
8113 wC = dA > dB;
8114 goto intresult;
8115 case JIM_EXPROP_LTE:
8116 wC = dA <= dB;
8117 goto intresult;
8118 case JIM_EXPROP_GTE:
8119 wC = dA >= dB;
8120 goto intresult;
8121 case JIM_EXPROP_NUMEQ:
8122 wC = dA == dB;
8123 goto intresult;
8124 case JIM_EXPROP_NUMNE:
8125 wC = dA != dB;
8126 goto intresult;
8129 else {
8130 /* Handle the string case */
8132 /* XXX: Could optimise the eq/ne case by checking lengths */
8133 int i = Jim_StringCompareObj(interp, A, B, 0);
8135 switch (e->opcode) {
8136 case JIM_EXPROP_LT:
8137 wC = i < 0;
8138 goto intresult;
8139 case JIM_EXPROP_GT:
8140 wC = i > 0;
8141 goto intresult;
8142 case JIM_EXPROP_LTE:
8143 wC = i <= 0;
8144 goto intresult;
8145 case JIM_EXPROP_GTE:
8146 wC = i >= 0;
8147 goto intresult;
8148 case JIM_EXPROP_NUMEQ:
8149 wC = i == 0;
8150 goto intresult;
8151 case JIM_EXPROP_NUMNE:
8152 wC = i != 0;
8153 goto intresult;
8156 /* If we get here, it is an error */
8157 rc = JIM_ERR;
8158 done:
8159 Jim_DecrRefCount(interp, A);
8160 Jim_DecrRefCount(interp, B);
8161 return rc;
8162 intresult:
8163 ExprPush(e, Jim_NewIntObj(interp, wC));
8164 goto done;
8165 doubleresult:
8166 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8167 goto done;
8170 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8172 int listlen;
8173 int i;
8175 listlen = Jim_ListLength(interp, listObjPtr);
8176 for (i = 0; i < listlen; i++) {
8177 if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) {
8178 return 1;
8181 return 0;
8184 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8186 Jim_Obj *B = ExprPop(e);
8187 Jim_Obj *A = ExprPop(e);
8189 jim_wide wC;
8191 switch (e->opcode) {
8192 case JIM_EXPROP_STREQ:
8193 case JIM_EXPROP_STRNE:
8194 wC = Jim_StringEqObj(A, B);
8195 if (e->opcode == JIM_EXPROP_STRNE) {
8196 wC = !wC;
8198 break;
8199 case JIM_EXPROP_STRIN:
8200 wC = JimSearchList(interp, B, A);
8201 break;
8202 case JIM_EXPROP_STRNI:
8203 wC = !JimSearchList(interp, B, A);
8204 break;
8205 default:
8206 abort();
8208 ExprPush(e, Jim_NewIntObj(interp, wC));
8210 Jim_DecrRefCount(interp, A);
8211 Jim_DecrRefCount(interp, B);
8213 return JIM_OK;
8216 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8218 long l;
8219 double d;
8220 int b;
8222 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8223 return l != 0;
8225 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8226 return d != 0;
8228 if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) {
8229 return b != 0;
8231 return -1;
8234 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8236 Jim_Obj *skip = ExprPop(e);
8237 Jim_Obj *A = ExprPop(e);
8238 int rc = JIM_OK;
8240 switch (ExprBool(interp, A)) {
8241 case 0:
8242 /* false, so skip RHS opcodes with a 0 result */
8243 e->skip = JimWideValue(skip);
8244 ExprPush(e, Jim_NewIntObj(interp, 0));
8245 break;
8247 case 1:
8248 /* true so continue */
8249 break;
8251 case -1:
8252 /* Invalid */
8253 rc = JIM_ERR;
8255 Jim_DecrRefCount(interp, A);
8256 Jim_DecrRefCount(interp, skip);
8258 return rc;
8261 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8263 Jim_Obj *skip = ExprPop(e);
8264 Jim_Obj *A = ExprPop(e);
8265 int rc = JIM_OK;
8267 switch (ExprBool(interp, A)) {
8268 case 0:
8269 /* false, so do nothing */
8270 break;
8272 case 1:
8273 /* true so skip RHS opcodes with a 1 result */
8274 e->skip = JimWideValue(skip);
8275 ExprPush(e, Jim_NewIntObj(interp, 1));
8276 break;
8278 case -1:
8279 /* Invalid */
8280 rc = JIM_ERR;
8281 break;
8283 Jim_DecrRefCount(interp, A);
8284 Jim_DecrRefCount(interp, skip);
8286 return rc;
8289 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8291 Jim_Obj *A = ExprPop(e);
8292 int rc = JIM_OK;
8294 switch (ExprBool(interp, A)) {
8295 case 0:
8296 ExprPush(e, Jim_NewIntObj(interp, 0));
8297 break;
8299 case 1:
8300 ExprPush(e, Jim_NewIntObj(interp, 1));
8301 break;
8303 case -1:
8304 /* Invalid */
8305 rc = JIM_ERR;
8306 break;
8308 Jim_DecrRefCount(interp, A);
8310 return rc;
8313 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8315 Jim_Obj *skip = ExprPop(e);
8316 Jim_Obj *A = ExprPop(e);
8317 int rc = JIM_OK;
8319 /* Repush A */
8320 ExprPush(e, A);
8322 switch (ExprBool(interp, A)) {
8323 case 0:
8324 /* false, skip RHS opcodes */
8325 e->skip = JimWideValue(skip);
8326 /* Push a dummy value */
8327 ExprPush(e, Jim_NewIntObj(interp, 0));
8328 break;
8330 case 1:
8331 /* true so do nothing */
8332 break;
8334 case -1:
8335 /* Invalid */
8336 rc = JIM_ERR;
8337 break;
8339 Jim_DecrRefCount(interp, A);
8340 Jim_DecrRefCount(interp, skip);
8342 return rc;
8345 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8347 Jim_Obj *skip = ExprPop(e);
8348 Jim_Obj *B = ExprPop(e);
8349 Jim_Obj *A = ExprPop(e);
8351 /* No need to check for A as non-boolean */
8352 if (ExprBool(interp, A)) {
8353 /* true, so skip RHS opcodes */
8354 e->skip = JimWideValue(skip);
8355 /* Repush B as the answer */
8356 ExprPush(e, B);
8359 Jim_DecrRefCount(interp, skip);
8360 Jim_DecrRefCount(interp, A);
8361 Jim_DecrRefCount(interp, B);
8362 return JIM_OK;
8365 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8367 return JIM_OK;
8370 enum
8372 LAZY_NONE,
8373 LAZY_OP,
8374 LAZY_LEFT,
8375 LAZY_RIGHT,
8376 RIGHT_ASSOC, /* reuse this field for right associativity too */
8379 /* name - precedence - arity - opcode
8381 * This array *must* be kept in sync with the JIM_EXPROP enum.
8383 * The following macros pre-compute the string length at compile time.
8385 #define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1}
8386 #define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, LAZY_NONE)
8388 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8389 OPRINIT("*", 110, 2, JimExprOpBin),
8390 OPRINIT("/", 110, 2, JimExprOpBin),
8391 OPRINIT("%", 110, 2, JimExprOpIntBin),
8393 OPRINIT("-", 100, 2, JimExprOpBin),
8394 OPRINIT("+", 100, 2, JimExprOpBin),
8396 OPRINIT("<<", 90, 2, JimExprOpIntBin),
8397 OPRINIT(">>", 90, 2, JimExprOpIntBin),
8399 OPRINIT("<<<", 90, 2, JimExprOpIntBin),
8400 OPRINIT(">>>", 90, 2, JimExprOpIntBin),
8402 OPRINIT("<", 80, 2, JimExprOpBin),
8403 OPRINIT(">", 80, 2, JimExprOpBin),
8404 OPRINIT("<=", 80, 2, JimExprOpBin),
8405 OPRINIT(">=", 80, 2, JimExprOpBin),
8407 OPRINIT("==", 70, 2, JimExprOpBin),
8408 OPRINIT("!=", 70, 2, JimExprOpBin),
8410 OPRINIT("&", 50, 2, JimExprOpIntBin),
8411 OPRINIT("^", 49, 2, JimExprOpIntBin),
8412 OPRINIT("|", 48, 2, JimExprOpIntBin),
8414 OPRINIT_ATTR("&&", 10, 2, NULL, LAZY_OP),
8415 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8416 OPRINIT_ATTR(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8418 OPRINIT_ATTR("||", 9, 2, NULL, LAZY_OP),
8419 OPRINIT_ATTR(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8420 OPRINIT_ATTR(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8422 OPRINIT_ATTR("?", 5, 2, JimExprOpNull, LAZY_OP),
8423 OPRINIT_ATTR(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8424 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8426 OPRINIT_ATTR(":", 5, 2, JimExprOpNull, LAZY_OP),
8427 OPRINIT_ATTR(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8428 OPRINIT_ATTR(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8430 /* Precedence is higher than * and / but lower than ! and ~, and right-associative */
8431 OPRINIT_ATTR("**", 120, 2, JimExprOpBin, RIGHT_ASSOC),
8433 OPRINIT("eq", 60, 2, JimExprOpStrBin),
8434 OPRINIT("ne", 60, 2, JimExprOpStrBin),
8436 OPRINIT("in", 55, 2, JimExprOpStrBin),
8437 OPRINIT("ni", 55, 2, JimExprOpStrBin),
8439 OPRINIT("!", 150, 1, JimExprOpNumUnary),
8440 OPRINIT("~", 150, 1, JimExprOpIntUnary),
8441 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8442 OPRINIT(NULL, 150, 1, JimExprOpNumUnary),
8446 OPRINIT("int", 200, 1, JimExprOpNumUnary),
8447 OPRINIT("wide", 200, 1, JimExprOpNumUnary),
8448 OPRINIT("abs", 200, 1, JimExprOpNumUnary),
8449 OPRINIT("double", 200, 1, JimExprOpNumUnary),
8450 OPRINIT("round", 200, 1, JimExprOpNumUnary),
8451 OPRINIT("rand", 200, 0, JimExprOpNone),
8452 OPRINIT("srand", 200, 1, JimExprOpIntUnary),
8454 #ifdef JIM_MATH_FUNCTIONS
8455 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary),
8456 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary),
8457 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary),
8458 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary),
8459 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary),
8460 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary),
8461 OPRINIT("atan2", 200, 2, JimExprOpBin),
8462 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary),
8463 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary),
8464 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary),
8465 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary),
8466 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary),
8467 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary),
8468 OPRINIT("log", 200, 1, JimExprOpDoubleUnary),
8469 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary),
8470 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary),
8471 OPRINIT("pow", 200, 2, JimExprOpBin),
8472 OPRINIT("hypot", 200, 2, JimExprOpBin),
8473 OPRINIT("fmod", 200, 2, JimExprOpBin),
8474 #endif
8476 #undef OPRINIT
8477 #undef OPRINIT_LAZY
8479 #define JIM_EXPR_OPERATORS_NUM \
8480 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8482 static int JimParseExpression(struct JimParserCtx *pc)
8484 /* Discard spaces and quoted newline */
8485 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8486 if (*pc->p == '\n') {
8487 pc->linenr++;
8489 pc->p++;
8490 pc->len--;
8493 /* Common case */
8494 pc->tline = pc->linenr;
8495 pc->tstart = pc->p;
8497 if (pc->len == 0) {
8498 pc->tend = pc->p;
8499 pc->tt = JIM_TT_EOL;
8500 pc->eof = 1;
8501 return JIM_OK;
8503 switch (*(pc->p)) {
8504 case '(':
8505 pc->tt = JIM_TT_SUBEXPR_START;
8506 goto singlechar;
8507 case ')':
8508 pc->tt = JIM_TT_SUBEXPR_END;
8509 goto singlechar;
8510 case ',':
8511 pc->tt = JIM_TT_SUBEXPR_COMMA;
8512 singlechar:
8513 pc->tend = pc->p;
8514 pc->p++;
8515 pc->len--;
8516 break;
8517 case '[':
8518 return JimParseCmd(pc);
8519 case '$':
8520 if (JimParseVar(pc) == JIM_ERR)
8521 return JimParseExprOperator(pc);
8522 else {
8523 /* Don't allow expr sugar in expressions */
8524 if (pc->tt == JIM_TT_EXPRSUGAR) {
8525 return JIM_ERR;
8527 return JIM_OK;
8529 break;
8530 case '0':
8531 case '1':
8532 case '2':
8533 case '3':
8534 case '4':
8535 case '5':
8536 case '6':
8537 case '7':
8538 case '8':
8539 case '9':
8540 case '.':
8541 return JimParseExprNumber(pc);
8542 case '"':
8543 return JimParseQuote(pc);
8544 case '{':
8545 return JimParseBrace(pc);
8547 case 'N':
8548 case 'I':
8549 case 'n':
8550 case 'i':
8551 if (JimParseExprIrrational(pc) == JIM_ERR)
8552 if (JimParseExprBoolean(pc) == JIM_ERR)
8553 return JimParseExprOperator(pc);
8554 break;
8555 case 't':
8556 case 'f':
8557 case 'o':
8558 case 'y':
8559 if (JimParseExprBoolean(pc) == JIM_ERR)
8560 return JimParseExprOperator(pc);
8561 break;
8562 default:
8563 return JimParseExprOperator(pc);
8564 break;
8566 return JIM_OK;
8569 static int JimParseExprNumber(struct JimParserCtx *pc)
8571 char *end;
8573 /* Assume an integer for now */
8574 pc->tt = JIM_TT_EXPR_INT;
8576 jim_strtoull(pc->p, (char **)&pc->p);
8577 /* Tried as an integer, but perhaps it parses as a double */
8578 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8579 /* Some stupid compilers insist they are cleverer that
8580 * we are. Even a (void) cast doesn't prevent this warning!
8582 if (strtod(pc->tstart, &end)) { /* nothing */ }
8583 if (end == pc->tstart)
8584 return JIM_ERR;
8585 if (end > pc->p) {
8586 /* Yes, double captured more chars */
8587 pc->tt = JIM_TT_EXPR_DOUBLE;
8588 pc->p = end;
8591 pc->tend = pc->p - 1;
8592 pc->len -= (pc->p - pc->tstart);
8593 return JIM_OK;
8596 static int JimParseExprIrrational(struct JimParserCtx *pc)
8598 const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8599 int i;
8601 for (i = 0; irrationals[i]; i++) {
8602 const char *irr = irrationals[i];
8604 if (strncmp(irr, pc->p, 3) == 0) {
8605 pc->p += 3;
8606 pc->len -= 3;
8607 pc->tend = pc->p - 1;
8608 pc->tt = JIM_TT_EXPR_DOUBLE;
8609 return JIM_OK;
8612 return JIM_ERR;
8615 static int JimParseExprBoolean(struct JimParserCtx *pc)
8617 const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8618 const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8619 int i;
8621 for (i = 0; booleans[i]; i++) {
8622 const char *boolean = booleans[i];
8623 int length = lengths[i];
8625 if (strncmp(boolean, pc->p, length) == 0) {
8626 pc->p += length;
8627 pc->len -= length;
8628 pc->tend = pc->p - 1;
8629 pc->tt = JIM_TT_EXPR_BOOLEAN;
8630 return JIM_OK;
8633 return JIM_ERR;
8636 static int JimParseExprOperator(struct JimParserCtx *pc)
8638 int i;
8639 int bestIdx = -1, bestLen = 0;
8641 /* Try to get the longest match. */
8642 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8643 const char * const opname = Jim_ExprOperators[i].name;
8644 const int oplen = Jim_ExprOperators[i].namelen;
8646 if (opname == NULL || opname[0] != pc->p[0]) {
8647 continue;
8650 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8651 bestIdx = i + JIM_TT_EXPR_OP;
8652 bestLen = oplen;
8655 if (bestIdx == -1) {
8656 return JIM_ERR;
8659 /* Validate paretheses around function arguments */
8660 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8661 const char *p = pc->p + bestLen;
8662 int len = pc->len - bestLen;
8664 while (len && isspace(UCHAR(*p))) {
8665 len--;
8666 p++;
8668 if (*p != '(') {
8669 return JIM_ERR;
8672 pc->tend = pc->p + bestLen - 1;
8673 pc->p += bestLen;
8674 pc->len -= bestLen;
8676 pc->tt = bestIdx;
8677 return JIM_OK;
8680 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8682 static Jim_ExprOperator dummy_op;
8683 if (opcode < JIM_TT_EXPR_OP) {
8684 return &dummy_op;
8686 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8689 const char *jim_tt_name(int type)
8691 static const char * const tt_names[JIM_TT_EXPR_OP] =
8692 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8693 "DBL", "BOO", "$()" };
8694 if (type < JIM_TT_EXPR_OP) {
8695 return tt_names[type];
8697 else if (type == JIM_EXPROP_UNARYMINUS) {
8698 return "-VE";
8700 else if (type == JIM_EXPROP_UNARYPLUS) {
8701 return "+VE";
8703 else {
8704 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8705 static char buf[20];
8707 if (op->name) {
8708 return op->name;
8710 sprintf(buf, "(%d)", type);
8711 return buf;
8715 /* -----------------------------------------------------------------------------
8716 * Expression Object
8717 * ---------------------------------------------------------------------------*/
8718 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8719 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8720 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8722 static const Jim_ObjType exprObjType = {
8723 "expression",
8724 FreeExprInternalRep,
8725 DupExprInternalRep,
8726 NULL,
8727 JIM_TYPE_REFERENCES,
8730 /* Expr bytecode structure */
8731 typedef struct ExprByteCode
8733 ScriptToken *token; /* Tokens array. */
8734 int len; /* Length as number of tokens. */
8735 int inUse; /* Used for sharing. */
8736 } ExprByteCode;
8738 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8740 int i;
8742 for (i = 0; i < expr->len; i++) {
8743 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8745 Jim_Free(expr->token);
8746 Jim_Free(expr);
8749 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8751 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8753 if (expr) {
8754 if (--expr->inUse != 0) {
8755 return;
8758 ExprFreeByteCode(interp, expr);
8762 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8764 JIM_NOTUSED(interp);
8765 JIM_NOTUSED(srcPtr);
8767 /* Just returns an simple string. */
8768 dupPtr->typePtr = NULL;
8771 /* Check if an expr program looks correct
8772 * Sets an error result on invalid
8774 static int ExprCheckCorrectness(Jim_Interp *interp, Jim_Obj *exprObjPtr, ExprByteCode * expr)
8776 int i;
8777 int stacklen = 0;
8778 int ternary = 0;
8779 int lasttt = JIM_TT_NONE;
8780 const char *errmsg;
8782 /* Try to check if there are stack underflows,
8783 * and make sure at the end of the program there is
8784 * a single result on the stack. */
8785 for (i = 0; i < expr->len; i++) {
8786 ScriptToken *t = &expr->token[i];
8787 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8788 lasttt = t->type;
8790 stacklen -= op->arity;
8792 if (stacklen < 0) {
8793 break;
8795 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8796 ternary++;
8798 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8799 if (--ternary < 0) {
8800 /* got : without preceding ? */
8801 stacklen = 1;
8802 break;
8806 /* All operations and operands add one to the stack */
8807 stacklen++;
8809 if (stacklen == 1 && ternary == 0) {
8810 return JIM_OK;
8813 if (stacklen <= 0) {
8814 /* Too few args */
8815 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8816 errmsg = "too few arguments for math function";
8817 Jim_SetResultString(interp, "too few arguments for math function", -1);
8818 } else {
8819 errmsg = "premature end of expression";
8822 else if (stacklen > 1) {
8823 if (lasttt >= JIM_EXPROP_FUNC_FIRST) {
8824 errmsg = "too many arguments for math function";
8825 } else {
8826 errmsg = "extra tokens at end of expression";
8829 else {
8830 errmsg = "invalid ternary expression";
8832 Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": %s", exprObjPtr, errmsg);
8833 return JIM_ERR;
8836 /* This procedure converts every occurrence of || and && opereators
8837 * in lazy unary versions.
8839 * a b || is converted into:
8841 * a <offset> |L b |R
8843 * a b && is converted into:
8845 * a <offset> &L b &R
8847 * "|L" checks if 'a' is true:
8848 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8849 * the opcode just after |R.
8850 * 2) if it is false does nothing.
8851 * "|R" checks if 'b' is true:
8852 * 1) if it is true pushes 1, otherwise pushes 0.
8854 * "&L" checks if 'a' is true:
8855 * 1) if it is true does nothing.
8856 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8857 * the opcode just after &R
8858 * "&R" checks if 'a' is true:
8859 * if it is true pushes 1, otherwise pushes 0.
8861 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8863 int i;
8865 int leftindex, arity, offset;
8867 /* Search for the end of the first operator */
8868 leftindex = expr->len - 1;
8870 arity = 1;
8871 while (arity) {
8872 if (leftindex < 0) {
8873 return JIM_ERR;
8875 ScriptToken *tt = &expr->token[leftindex];
8877 if (tt->type >= JIM_TT_EXPR_OP) {
8878 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8880 arity--;
8881 leftindex--;
8883 leftindex++;
8885 /* Move them up */
8886 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8887 sizeof(*expr->token) * (expr->len - leftindex));
8888 expr->len += 2;
8889 offset = (expr->len - leftindex) - 1;
8891 /* Now we rely on the fact that the left and right version have opcodes
8892 * 1 and 2 after the main opcode respectively
8894 expr->token[leftindex + 1].type = t->type + 1;
8895 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8897 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8898 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8900 /* Now add the 'R' operator */
8901 expr->token[expr->len].objPtr = interp->emptyObj;
8902 expr->token[expr->len].type = t->type + 2;
8903 expr->len++;
8905 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8906 for (i = leftindex - 1; i > 0; i--) {
8907 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8908 if (op->lazy == LAZY_LEFT) {
8909 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8910 JimWideValue(expr->token[i - 1].objPtr) += 2;
8914 return JIM_OK;
8917 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8919 struct ScriptToken *token = &expr->token[expr->len];
8920 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8922 if (op->lazy == LAZY_OP) {
8923 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8924 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8925 return JIM_ERR;
8928 else {
8929 token->objPtr = interp->emptyObj;
8930 token->type = t->type;
8931 expr->len++;
8933 return JIM_OK;
8937 * Returns the index of the COLON_LEFT to the left of 'right_index'
8938 * taking into account nesting.
8940 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8942 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8944 int ternary_count = 1;
8946 right_index--;
8948 while (right_index > 1) {
8949 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8950 ternary_count--;
8952 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8953 ternary_count++;
8955 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8956 return right_index;
8958 right_index--;
8961 /*notreached*/
8962 return -1;
8966 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8968 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8969 * Otherwise returns 0.
8971 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8973 int i = right_index - 1;
8974 int ternary_count = 1;
8976 while (i > 1) {
8977 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8978 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8979 *prev_right_index = i - 2;
8980 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8981 return 1;
8984 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8985 if (ternary_count == 0) {
8986 return 0;
8988 ternary_count++;
8990 i--;
8992 return 0;
8996 * ExprTernaryReorderExpression description
8997 * ========================================
8999 * ?: is right-to-left associative which doesn't work with the stack-based
9000 * expression engine. The fix is to reorder the bytecode.
9002 * The expression:
9004 * expr 1?2:0?3:4
9006 * Has initial bytecode:
9008 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
9009 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
9011 * The fix involves simulating this expression instead:
9013 * expr 1?2:(0?3:4)
9015 * With the following bytecode:
9017 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
9018 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
9020 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
9021 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
9022 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
9023 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
9025 * ExprTernaryReorderExpression works thus as follows :
9026 * - start from the end of the stack
9027 * - while walking towards the beginning of the stack
9028 * if token=JIM_EXPROP_COLON_RIGHT then
9029 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
9030 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
9031 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
9032 * if all found then
9033 * perform the rotation
9034 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
9035 * end if
9036 * end if
9038 * Note: care has to be taken for nested ternary constructs!!!
9040 static int ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
9042 int i;
9044 for (i = expr->len - 1; i > 1; i--) {
9045 int prev_right_index;
9046 int prev_left_index;
9047 int j;
9048 ScriptToken tmp;
9050 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
9051 continue;
9054 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
9055 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
9056 continue;
9058 if (prev_left_index < 0) {
9059 return -1;
9063 ** rotate tokens down
9065 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
9066 ** | | |
9067 ** | V V
9068 ** | [...] : ...
9069 ** | | |
9070 ** | V V
9071 ** | [...] : ...
9072 ** | | |
9073 ** | V V
9074 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
9076 tmp = expr->token[prev_right_index];
9077 for (j = prev_right_index; j < i; j++) {
9078 expr->token[j] = expr->token[j + 1];
9080 expr->token[i] = tmp;
9082 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
9084 * This is 'colon left increment' = i - prev_right_index
9086 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
9087 * [prev_left_index-1] : skip_count
9090 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
9092 /* Adjust for i-- in the loop */
9093 i++;
9095 return 0;
9098 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj)
9100 Jim_Stack stack;
9101 ExprByteCode *expr;
9102 int ok = 1;
9103 int i;
9104 int prevtt = JIM_TT_NONE;
9105 int have_ternary = 0;
9107 /* -1 for EOL */
9108 int count = tokenlist->count - 1;
9110 expr = Jim_Alloc(sizeof(*expr));
9111 expr->inUse = 1;
9112 expr->len = 0;
9114 Jim_InitStack(&stack);
9116 /* Need extra bytecodes for lazy operators.
9117 * Also check for the ternary operator
9119 for (i = 0; i < tokenlist->count; i++) {
9120 ParseToken *t = &tokenlist->list[i];
9121 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
9123 if (op->lazy == LAZY_OP) {
9124 count += 2;
9125 /* Ternary is a lazy op but also needs reordering */
9126 if (t->type == JIM_EXPROP_TERNARY) {
9127 have_ternary = 1;
9132 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
9134 for (i = 0; i < tokenlist->count && ok; i++) {
9135 ParseToken *t = &tokenlist->list[i];
9137 /* Next token will be stored here */
9138 struct ScriptToken *token = &expr->token[expr->len];
9140 if (t->type == JIM_TT_EOL) {
9141 break;
9144 if (TOKEN_IS_EXPR_OP(t->type)) {
9145 const struct Jim_ExprOperator *op;
9146 ParseToken *tt;
9148 /* Convert -/+ to unary minus or unary plus if necessary */
9149 if (prevtt == JIM_TT_NONE || prevtt == JIM_TT_SUBEXPR_START || prevtt == JIM_TT_SUBEXPR_COMMA || prevtt >= JIM_TT_EXPR_OP) {
9150 if (t->type == JIM_EXPROP_SUB) {
9151 t->type = JIM_EXPROP_UNARYMINUS;
9153 else if (t->type == JIM_EXPROP_ADD) {
9154 t->type = JIM_EXPROP_UNARYPLUS;
9158 op = JimExprOperatorInfoByOpcode(t->type);
9160 /* Handle precedence */
9161 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9162 const struct Jim_ExprOperator *tt_op =
9163 JimExprOperatorInfoByOpcode(tt->type);
9165 /* Note that right-to-left associativity of ?: operator is handled later.
9168 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9169 /* Don't reduce if right associative with equal precedence? */
9170 if (tt_op->precedence == op->precedence && tt_op->lazy == RIGHT_ASSOC) {
9171 break;
9173 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9174 ok = 0;
9175 goto err;
9177 Jim_StackPop(&stack);
9179 else {
9180 break;
9183 Jim_StackPush(&stack, t);
9185 else if (t->type == JIM_TT_SUBEXPR_START) {
9186 Jim_StackPush(&stack, t);
9188 else if (t->type == JIM_TT_SUBEXPR_END || t->type == JIM_TT_SUBEXPR_COMMA) {
9189 /* Reduce the expression back to the previous ( or , */
9190 ok = 0;
9191 while (Jim_StackLen(&stack)) {
9192 ParseToken *tt = Jim_StackPop(&stack);
9194 if (tt->type == JIM_TT_SUBEXPR_START || tt->type == JIM_TT_SUBEXPR_COMMA) {
9195 if (t->type == JIM_TT_SUBEXPR_COMMA) {
9196 /* Need to push back the previous START or COMMA in the case of comma */
9197 Jim_StackPush(&stack, tt);
9199 ok = 1;
9200 break;
9202 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9203 goto err;
9206 if (!ok) {
9207 Jim_SetResultFormatted(interp, "Unexpected close parenthesis in expression: \"%#s\"", exprObjPtr);
9208 goto err;
9211 else {
9212 Jim_Obj *objPtr = NULL;
9214 /* This is a simple non-operator term, so create and push the appropriate object */
9215 token->type = t->type;
9217 /* Two consecutive terms without an operator is invalid */
9218 if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) {
9219 Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", exprObjPtr);
9220 ok = 0;
9221 goto err;
9224 /* Immediately create a double or int object? */
9225 if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) {
9226 char *endptr;
9227 if (t->type == JIM_TT_EXPR_INT) {
9228 objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
9230 else {
9231 objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
9233 if (endptr != t->token + t->len) {
9234 /* Conversion failed, so just store it as a string */
9235 Jim_FreeNewObj(interp, objPtr);
9236 objPtr = NULL;
9240 if (objPtr) {
9241 token->objPtr = objPtr;
9243 else {
9244 /* Everything else is stored a simple string term */
9245 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
9246 if (t->type == JIM_TT_CMD) {
9247 /* Only commands need source info */
9248 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
9251 expr->len++;
9253 prevtt = t->type;
9256 /* Reduce any remaining subexpr */
9257 while (Jim_StackLen(&stack)) {
9258 ParseToken *tt = Jim_StackPop(&stack);
9260 if (tt->type == JIM_TT_SUBEXPR_START) {
9261 ok = 0;
9262 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9263 goto err;
9265 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9266 ok = 0;
9267 goto err;
9271 if (have_ternary) {
9272 if (ExprTernaryReorderExpression(interp, expr) != 0) {
9273 ok = 0;
9274 Jim_SetResultString(interp, "Invalid ternary expression", -1);
9278 err:
9279 /* Free the stack used for the compilation. */
9280 Jim_FreeStack(&stack);
9282 for (i = 0; i < expr->len; i++) {
9283 Jim_IncrRefCount(expr->token[i].objPtr);
9286 if (!ok) {
9287 ExprFreeByteCode(interp, expr);
9288 return NULL;
9291 return expr;
9295 /* This method takes the string representation of an expression
9296 * and generates a program for the Expr's stack-based VM. */
9297 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9299 int exprTextLen;
9300 const char *exprText;
9301 struct JimParserCtx parser;
9302 struct ExprByteCode *expr;
9303 ParseTokenList tokenlist;
9304 int line;
9305 Jim_Obj *fileNameObj;
9306 int rc = JIM_ERR;
9308 /* Try to get information about filename / line number */
9309 if (objPtr->typePtr == &sourceObjType) {
9310 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9311 line = objPtr->internalRep.sourceValue.lineNumber;
9313 else {
9314 fileNameObj = interp->emptyObj;
9315 line = 1;
9317 Jim_IncrRefCount(fileNameObj);
9319 exprText = Jim_GetString(objPtr, &exprTextLen);
9321 /* Initially tokenise the expression into tokenlist */
9322 ScriptTokenListInit(&tokenlist);
9324 JimParserInit(&parser, exprText, exprTextLen, line);
9325 while (!parser.eof) {
9326 if (JimParseExpression(&parser) != JIM_OK) {
9327 ScriptTokenListFree(&tokenlist);
9328 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9329 expr = NULL;
9330 goto err;
9333 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9334 parser.tline);
9337 #ifdef DEBUG_SHOW_EXPR_TOKENS
9339 int i;
9340 printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj));
9341 for (i = 0; i < tokenlist.count; i++) {
9342 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9343 tokenlist.list[i].len, tokenlist.list[i].token);
9346 #endif
9348 if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) {
9349 ScriptTokenListFree(&tokenlist);
9350 Jim_DecrRefCount(interp, fileNameObj);
9351 return JIM_ERR;
9354 /* Now create the expression bytecode from the tokenlist */
9355 expr = ExprCreateByteCode(interp, &tokenlist, objPtr, fileNameObj);
9357 /* No longer need the token list */
9358 ScriptTokenListFree(&tokenlist);
9360 if (!expr) {
9361 goto err;
9364 #ifdef DEBUG_SHOW_EXPR
9366 int i;
9368 printf("==== Expr ====\n");
9369 for (i = 0; i < expr->len; i++) {
9370 ScriptToken *t = &expr->token[i];
9372 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9375 #endif
9377 /* Check program correctness. */
9378 if (ExprCheckCorrectness(interp, objPtr, expr) != JIM_OK) {
9379 /* ExprCheckCorrectness set an error in this case */
9380 ExprFreeByteCode(interp, expr);
9381 expr = NULL;
9382 goto err;
9385 rc = JIM_OK;
9387 err:
9388 /* Free the old internal rep and set the new one. */
9389 Jim_DecrRefCount(interp, fileNameObj);
9390 Jim_FreeIntRep(interp, objPtr);
9391 Jim_SetIntRepPtr(objPtr, expr);
9392 objPtr->typePtr = &exprObjType;
9393 return rc;
9396 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9398 if (objPtr->typePtr != &exprObjType) {
9399 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9400 return NULL;
9403 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9406 #ifdef JIM_OPTIMIZATION
9407 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9409 if (token->type == JIM_TT_EXPR_INT)
9410 return token->objPtr;
9411 else if (token->type == JIM_TT_VAR)
9412 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9413 else if (token->type == JIM_TT_DICTSUGAR)
9414 return JimExpandDictSugar(interp, token->objPtr);
9415 else
9416 return NULL;
9418 #endif
9420 /* -----------------------------------------------------------------------------
9421 * Expressions evaluation.
9422 * Jim uses a specialized stack-based virtual machine for expressions,
9423 * that takes advantage of the fact that expr's operators
9424 * can't be redefined.
9426 * Jim_EvalExpression() uses the bytecode compiled by
9427 * SetExprFromAny() method of the "expression" object.
9429 * On success a Tcl Object containing the result of the evaluation
9430 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9431 * returned.
9432 * On error the function returns a retcode != to JIM_OK and set a suitable
9433 * error on the interp.
9434 * ---------------------------------------------------------------------------*/
9435 #define JIM_EE_STATICSTACK_LEN 10
9437 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9439 ExprByteCode *expr;
9440 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9441 int i;
9442 int retcode = JIM_OK;
9443 struct JimExprState e;
9445 expr = JimGetExpression(interp, exprObjPtr);
9446 if (!expr) {
9447 return JIM_ERR; /* error in expression. */
9450 #ifdef JIM_OPTIMIZATION
9451 /* Check for one of the following common expressions used by while/for
9453 * CONST
9454 * $a
9455 * !$a
9456 * $a < CONST, $a < $b
9457 * $a <= CONST, $a <= $b
9458 * $a > CONST, $a > $b
9459 * $a >= CONST, $a >= $b
9460 * $a != CONST, $a != $b
9461 * $a == CONST, $a == $b
9464 Jim_Obj *objPtr;
9466 /* STEP 1 -- Check if there are the conditions to run the specialized
9467 * version of while */
9469 switch (expr->len) {
9470 case 1:
9471 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9472 if (objPtr) {
9473 Jim_IncrRefCount(objPtr);
9474 *exprResultPtrPtr = objPtr;
9475 return JIM_OK;
9477 break;
9479 case 2:
9480 if (expr->token[1].type == JIM_EXPROP_NOT) {
9481 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9483 if (objPtr && JimIsWide(objPtr)) {
9484 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9485 Jim_IncrRefCount(*exprResultPtrPtr);
9486 return JIM_OK;
9489 break;
9491 case 3:
9492 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9493 if (objPtr && JimIsWide(objPtr)) {
9494 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9495 if (objPtr2 && JimIsWide(objPtr2)) {
9496 jim_wide wideValueA = JimWideValue(objPtr);
9497 jim_wide wideValueB = JimWideValue(objPtr2);
9498 int cmpRes;
9499 switch (expr->token[2].type) {
9500 case JIM_EXPROP_LT:
9501 cmpRes = wideValueA < wideValueB;
9502 break;
9503 case JIM_EXPROP_LTE:
9504 cmpRes = wideValueA <= wideValueB;
9505 break;
9506 case JIM_EXPROP_GT:
9507 cmpRes = wideValueA > wideValueB;
9508 break;
9509 case JIM_EXPROP_GTE:
9510 cmpRes = wideValueA >= wideValueB;
9511 break;
9512 case JIM_EXPROP_NUMEQ:
9513 cmpRes = wideValueA == wideValueB;
9514 break;
9515 case JIM_EXPROP_NUMNE:
9516 cmpRes = wideValueA != wideValueB;
9517 break;
9518 default:
9519 goto noopt;
9521 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9522 Jim_IncrRefCount(*exprResultPtrPtr);
9523 return JIM_OK;
9526 break;
9529 noopt:
9530 #endif
9532 /* In order to avoid that the internal repr gets freed due to
9533 * shimmering of the exprObjPtr's object, we make the internal rep
9534 * shared. */
9535 expr->inUse++;
9537 /* The stack-based expr VM itself */
9539 /* Stack allocation. Expr programs have the feature that
9540 * a program of length N can't require a stack longer than
9541 * N. */
9542 if (expr->len > JIM_EE_STATICSTACK_LEN)
9543 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9544 else
9545 e.stack = staticStack;
9547 e.stacklen = 0;
9549 /* Execute every instruction */
9550 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9551 Jim_Obj *objPtr;
9553 switch (expr->token[i].type) {
9554 case JIM_TT_EXPR_INT:
9555 case JIM_TT_EXPR_DOUBLE:
9556 case JIM_TT_EXPR_BOOLEAN:
9557 case JIM_TT_STR:
9558 ExprPush(&e, expr->token[i].objPtr);
9559 break;
9561 case JIM_TT_VAR:
9562 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9563 if (objPtr) {
9564 ExprPush(&e, objPtr);
9566 else {
9567 retcode = JIM_ERR;
9569 break;
9571 case JIM_TT_DICTSUGAR:
9572 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9573 if (objPtr) {
9574 ExprPush(&e, objPtr);
9576 else {
9577 retcode = JIM_ERR;
9579 break;
9581 case JIM_TT_ESC:
9582 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9583 if (retcode == JIM_OK) {
9584 ExprPush(&e, objPtr);
9586 break;
9588 case JIM_TT_CMD:
9589 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9590 if (retcode == JIM_OK) {
9591 ExprPush(&e, Jim_GetResult(interp));
9593 break;
9595 default:{
9596 /* Find and execute the operation */
9597 e.skip = 0;
9598 e.opcode = expr->token[i].type;
9600 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9601 /* Skip some opcodes if necessary */
9602 i += e.skip;
9603 continue;
9608 expr->inUse--;
9610 if (retcode == JIM_OK) {
9611 *exprResultPtrPtr = ExprPop(&e);
9613 else {
9614 for (i = 0; i < e.stacklen; i++) {
9615 Jim_DecrRefCount(interp, e.stack[i]);
9618 if (e.stack != staticStack) {
9619 Jim_Free(e.stack);
9621 return retcode;
9624 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9626 Jim_Obj *exprResultPtr;
9627 int retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9629 if (retcode == JIM_OK) {
9630 switch (ExprBool(interp, exprResultPtr)) {
9631 case 0:
9632 *boolPtr = 0;
9633 break;
9635 case 1:
9636 *boolPtr = 1;
9637 break;
9639 case -1:
9640 retcode = JIM_ERR;
9641 break;
9643 Jim_DecrRefCount(interp, exprResultPtr);
9645 return retcode;
9648 /* -----------------------------------------------------------------------------
9649 * ScanFormat String Object
9650 * ---------------------------------------------------------------------------*/
9652 /* This Jim_Obj will held a parsed representation of a format string passed to
9653 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9654 * to be parsed in its entirely first and then, if correct, can be used for
9655 * scanning. To avoid endless re-parsing, the parsed representation will be
9656 * stored in an internal representation and re-used for performance reason. */
9658 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9659 * scanformat string. This part will later be used to extract information
9660 * out from the string to be parsed by Jim_ScanString */
9662 typedef struct ScanFmtPartDescr
9664 char *arg; /* Specification of a CHARSET conversion */
9665 char *prefix; /* Prefix to be scanned literally before conversion */
9666 size_t width; /* Maximal width of input to be converted */
9667 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9668 char type; /* Type of conversion (e.g. c, d, f) */
9669 char modifier; /* Modify type (e.g. l - long, h - short */
9670 } ScanFmtPartDescr;
9672 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9673 * string parsed and separated in part descriptions. Furthermore it contains
9674 * the original string representation of the scanformat string to allow for
9675 * fast update of the Jim_Obj's string representation part.
9677 * As an add-on the internal object representation adds some scratch pad area
9678 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9679 * memory for purpose of string scanning.
9681 * The error member points to a static allocated string in case of a mal-
9682 * formed scanformat string or it contains '0' (NULL) in case of a valid
9683 * parse representation.
9685 * The whole memory of the internal representation is allocated as a single
9686 * area of memory that will be internally separated. So freeing and duplicating
9687 * of such an object is cheap */
9689 typedef struct ScanFmtStringObj
9691 jim_wide size; /* Size of internal repr in bytes */
9692 char *stringRep; /* Original string representation */
9693 size_t count; /* Number of ScanFmtPartDescr contained */
9694 size_t convCount; /* Number of conversions that will assign */
9695 size_t maxPos; /* Max position index if XPG3 is used */
9696 const char *error; /* Ptr to error text (NULL if no error */
9697 char *scratch; /* Some scratch pad used by Jim_ScanString */
9698 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9699 } ScanFmtStringObj;
9702 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9703 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9704 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9706 static const Jim_ObjType scanFmtStringObjType = {
9707 "scanformatstring",
9708 FreeScanFmtInternalRep,
9709 DupScanFmtInternalRep,
9710 UpdateStringOfScanFmt,
9711 JIM_TYPE_NONE,
9714 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9716 JIM_NOTUSED(interp);
9717 Jim_Free((char *)objPtr->internalRep.ptr);
9718 objPtr->internalRep.ptr = 0;
9721 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9723 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9724 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9726 JIM_NOTUSED(interp);
9727 memcpy(newVec, srcPtr->internalRep.ptr, size);
9728 dupPtr->internalRep.ptr = newVec;
9729 dupPtr->typePtr = &scanFmtStringObjType;
9732 static void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9734 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9737 /* SetScanFmtFromAny will parse a given string and create the internal
9738 * representation of the format specification. In case of an error
9739 * the error data member of the internal representation will be set
9740 * to an descriptive error text and the function will be left with
9741 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9742 * specification */
9744 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9746 ScanFmtStringObj *fmtObj;
9747 char *buffer;
9748 int maxCount, i, approxSize, lastPos = -1;
9749 const char *fmt = Jim_String(objPtr);
9750 int maxFmtLen = Jim_Length(objPtr);
9751 const char *fmtEnd = fmt + maxFmtLen;
9752 int curr;
9754 Jim_FreeIntRep(interp, objPtr);
9755 /* Count how many conversions could take place maximally */
9756 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9757 if (fmt[i] == '%')
9758 ++maxCount;
9759 /* Calculate an approximation of the memory necessary */
9760 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9761 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9762 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9763 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9764 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9765 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9766 +1; /* safety byte */
9767 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9768 memset(fmtObj, 0, approxSize);
9769 fmtObj->size = approxSize;
9770 fmtObj->maxPos = 0;
9771 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9772 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9773 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9774 buffer = fmtObj->stringRep + maxFmtLen + 1;
9775 objPtr->internalRep.ptr = fmtObj;
9776 objPtr->typePtr = &scanFmtStringObjType;
9777 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9778 int width = 0, skip;
9779 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9781 fmtObj->count++;
9782 descr->width = 0; /* Assume width unspecified */
9783 /* Overread and store any "literal" prefix */
9784 if (*fmt != '%' || fmt[1] == '%') {
9785 descr->type = 0;
9786 descr->prefix = &buffer[i];
9787 for (; fmt < fmtEnd; ++fmt) {
9788 if (*fmt == '%') {
9789 if (fmt[1] != '%')
9790 break;
9791 ++fmt;
9793 buffer[i++] = *fmt;
9795 buffer[i++] = 0;
9797 /* Skip the conversion introducing '%' sign */
9798 ++fmt;
9799 /* End reached due to non-conversion literal only? */
9800 if (fmt >= fmtEnd)
9801 goto done;
9802 descr->pos = 0; /* Assume "natural" positioning */
9803 if (*fmt == '*') {
9804 descr->pos = -1; /* Okay, conversion will not be assigned */
9805 ++fmt;
9807 else
9808 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9809 /* Check if next token is a number (could be width or pos */
9810 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9811 fmt += skip;
9812 /* Was the number a XPG3 position specifier? */
9813 if (descr->pos != -1 && *fmt == '$') {
9814 int prev;
9816 ++fmt;
9817 descr->pos = width;
9818 width = 0;
9819 /* Look if "natural" postioning and XPG3 one was mixed */
9820 if ((lastPos == 0 && descr->pos > 0)
9821 || (lastPos > 0 && descr->pos == 0)) {
9822 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9823 return JIM_ERR;
9825 /* Look if this position was already used */
9826 for (prev = 0; prev < curr; ++prev) {
9827 if (fmtObj->descr[prev].pos == -1)
9828 continue;
9829 if (fmtObj->descr[prev].pos == descr->pos) {
9830 fmtObj->error =
9831 "variable is assigned by multiple \"%n$\" conversion specifiers";
9832 return JIM_ERR;
9835 /* Try to find a width after the XPG3 specifier */
9836 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9837 descr->width = width;
9838 fmt += skip;
9840 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9841 fmtObj->maxPos = descr->pos;
9843 else {
9844 /* Number was not a XPG3, so it has to be a width */
9845 descr->width = width;
9848 /* If positioning mode was undetermined yet, fix this */
9849 if (lastPos == -1)
9850 lastPos = descr->pos;
9851 /* Handle CHARSET conversion type ... */
9852 if (*fmt == '[') {
9853 int swapped = 1, beg = i, end, j;
9855 descr->type = '[';
9856 descr->arg = &buffer[i];
9857 ++fmt;
9858 if (*fmt == '^')
9859 buffer[i++] = *fmt++;
9860 if (*fmt == ']')
9861 buffer[i++] = *fmt++;
9862 while (*fmt && *fmt != ']')
9863 buffer[i++] = *fmt++;
9864 if (*fmt != ']') {
9865 fmtObj->error = "unmatched [ in format string";
9866 return JIM_ERR;
9868 end = i;
9869 buffer[i++] = 0;
9870 /* In case a range fence was given "backwards", swap it */
9871 while (swapped) {
9872 swapped = 0;
9873 for (j = beg + 1; j < end - 1; ++j) {
9874 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9875 char tmp = buffer[j - 1];
9877 buffer[j - 1] = buffer[j + 1];
9878 buffer[j + 1] = tmp;
9879 swapped = 1;
9884 else {
9885 /* Remember any valid modifier if given */
9886 if (fmt < fmtEnd && strchr("hlL", *fmt))
9887 descr->modifier = tolower((int)*fmt++);
9889 if (fmt >= fmtEnd) {
9890 fmtObj->error = "missing scan conversion character";
9891 return JIM_ERR;
9894 descr->type = *fmt;
9895 if (strchr("efgcsndoxui", *fmt) == 0) {
9896 fmtObj->error = "bad scan conversion character";
9897 return JIM_ERR;
9899 else if (*fmt == 'c' && descr->width != 0) {
9900 fmtObj->error = "field width may not be specified in %c " "conversion";
9901 return JIM_ERR;
9903 else if (*fmt == 'u' && descr->modifier == 'l') {
9904 fmtObj->error = "unsigned wide not supported";
9905 return JIM_ERR;
9908 curr++;
9910 done:
9911 return JIM_OK;
9914 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9916 #define FormatGetCnvCount(_fo_) \
9917 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9918 #define FormatGetMaxPos(_fo_) \
9919 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9920 #define FormatGetError(_fo_) \
9921 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9923 /* JimScanAString is used to scan an unspecified string that ends with
9924 * next WS, or a string that is specified via a charset.
9927 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9929 char *buffer = Jim_StrDup(str);
9930 char *p = buffer;
9932 while (*str) {
9933 int c;
9934 int n;
9936 if (!sdescr && isspace(UCHAR(*str)))
9937 break; /* EOS via WS if unspecified */
9939 n = utf8_tounicode(str, &c);
9940 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9941 break;
9942 while (n--)
9943 *p++ = *str++;
9945 *p = 0;
9946 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9949 /* ScanOneEntry will scan one entry out of the string passed as argument.
9950 * It use the sscanf() function for this task. After extracting and
9951 * converting of the value, the count of scanned characters will be
9952 * returned of -1 in case of no conversion tool place and string was
9953 * already scanned thru */
9955 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9956 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9958 const char *tok;
9959 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9960 size_t scanned = 0;
9961 size_t anchor = pos;
9962 int i;
9963 Jim_Obj *tmpObj = NULL;
9965 /* First pessimistically assume, we will not scan anything :-) */
9966 *valObjPtr = 0;
9967 if (descr->prefix) {
9968 /* There was a prefix given before the conversion, skip it and adjust
9969 * the string-to-be-parsed accordingly */
9970 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9971 /* If prefix require, skip WS */
9972 if (isspace(UCHAR(descr->prefix[i])))
9973 while (pos < strLen && isspace(UCHAR(str[pos])))
9974 ++pos;
9975 else if (descr->prefix[i] != str[pos])
9976 break; /* Prefix do not match here, leave the loop */
9977 else
9978 ++pos; /* Prefix matched so far, next round */
9980 if (pos >= strLen) {
9981 return -1; /* All of str consumed: EOF condition */
9983 else if (descr->prefix[i] != 0)
9984 return 0; /* Not whole prefix consumed, no conversion possible */
9986 /* For all but following conversion, skip leading WS */
9987 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9988 while (isspace(UCHAR(str[pos])))
9989 ++pos;
9990 /* Determine how much skipped/scanned so far */
9991 scanned = pos - anchor;
9993 /* %c is a special, simple case. no width */
9994 if (descr->type == 'n') {
9995 /* Return pseudo conversion means: how much scanned so far? */
9996 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9998 else if (pos >= strLen) {
9999 /* Cannot scan anything, as str is totally consumed */
10000 return -1;
10002 else if (descr->type == 'c') {
10003 int c;
10004 scanned += utf8_tounicode(&str[pos], &c);
10005 *valObjPtr = Jim_NewIntObj(interp, c);
10006 return scanned;
10008 else {
10009 /* Processing of conversions follows ... */
10010 if (descr->width > 0) {
10011 /* Do not try to scan as fas as possible but only the given width.
10012 * To ensure this, we copy the part that should be scanned. */
10013 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
10014 size_t tLen = descr->width > sLen ? sLen : descr->width;
10016 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
10017 tok = tmpObj->bytes;
10019 else {
10020 /* As no width was given, simply refer to the original string */
10021 tok = &str[pos];
10023 switch (descr->type) {
10024 case 'd':
10025 case 'o':
10026 case 'x':
10027 case 'u':
10028 case 'i':{
10029 char *endp; /* Position where the number finished */
10030 jim_wide w;
10032 int base = descr->type == 'o' ? 8
10033 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
10035 /* Try to scan a number with the given base */
10036 if (base == 0) {
10037 w = jim_strtoull(tok, &endp);
10039 else {
10040 w = strtoull(tok, &endp, base);
10043 if (endp != tok) {
10044 /* There was some number sucessfully scanned! */
10045 *valObjPtr = Jim_NewIntObj(interp, w);
10047 /* Adjust the number-of-chars scanned so far */
10048 scanned += endp - tok;
10050 else {
10051 /* Nothing was scanned. We have to determine if this
10052 * happened due to e.g. prefix mismatch or input str
10053 * exhausted */
10054 scanned = *tok ? 0 : -1;
10056 break;
10058 case 's':
10059 case '[':{
10060 *valObjPtr = JimScanAString(interp, descr->arg, tok);
10061 scanned += Jim_Length(*valObjPtr);
10062 break;
10064 case 'e':
10065 case 'f':
10066 case 'g':{
10067 char *endp;
10068 double value = strtod(tok, &endp);
10070 if (endp != tok) {
10071 /* There was some number sucessfully scanned! */
10072 *valObjPtr = Jim_NewDoubleObj(interp, value);
10073 /* Adjust the number-of-chars scanned so far */
10074 scanned += endp - tok;
10076 else {
10077 /* Nothing was scanned. We have to determine if this
10078 * happened due to e.g. prefix mismatch or input str
10079 * exhausted */
10080 scanned = *tok ? 0 : -1;
10082 break;
10085 /* If a substring was allocated (due to pre-defined width) do not
10086 * forget to free it */
10087 if (tmpObj) {
10088 Jim_FreeNewObj(interp, tmpObj);
10091 return scanned;
10094 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
10095 * string and returns all converted (and not ignored) values in a list back
10096 * to the caller. If an error occured, a NULL pointer will be returned */
10098 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
10100 size_t i, pos;
10101 int scanned = 1;
10102 const char *str = Jim_String(strObjPtr);
10103 int strLen = Jim_Utf8Length(interp, strObjPtr);
10104 Jim_Obj *resultList = 0;
10105 Jim_Obj **resultVec = 0;
10106 int resultc;
10107 Jim_Obj *emptyStr = 0;
10108 ScanFmtStringObj *fmtObj;
10110 /* This should never happen. The format object should already be of the correct type */
10111 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
10113 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
10114 /* Check if format specification was valid */
10115 if (fmtObj->error != 0) {
10116 if (flags & JIM_ERRMSG)
10117 Jim_SetResultString(interp, fmtObj->error, -1);
10118 return 0;
10120 /* Allocate a new "shared" empty string for all unassigned conversions */
10121 emptyStr = Jim_NewEmptyStringObj(interp);
10122 Jim_IncrRefCount(emptyStr);
10123 /* Create a list and fill it with empty strings up to max specified XPG3 */
10124 resultList = Jim_NewListObj(interp, NULL, 0);
10125 if (fmtObj->maxPos > 0) {
10126 for (i = 0; i < fmtObj->maxPos; ++i)
10127 Jim_ListAppendElement(interp, resultList, emptyStr);
10128 JimListGetElements(interp, resultList, &resultc, &resultVec);
10130 /* Now handle every partial format description */
10131 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
10132 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
10133 Jim_Obj *value = 0;
10135 /* Only last type may be "literal" w/o conversion - skip it! */
10136 if (descr->type == 0)
10137 continue;
10138 /* As long as any conversion could be done, we will proceed */
10139 if (scanned > 0)
10140 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
10141 /* In case our first try results in EOF, we will leave */
10142 if (scanned == -1 && i == 0)
10143 goto eof;
10144 /* Advance next pos-to-be-scanned for the amount scanned already */
10145 pos += scanned;
10147 /* value == 0 means no conversion took place so take empty string */
10148 if (value == 0)
10149 value = Jim_NewEmptyStringObj(interp);
10150 /* If value is a non-assignable one, skip it */
10151 if (descr->pos == -1) {
10152 Jim_FreeNewObj(interp, value);
10154 else if (descr->pos == 0)
10155 /* Otherwise append it to the result list if no XPG3 was given */
10156 Jim_ListAppendElement(interp, resultList, value);
10157 else if (resultVec[descr->pos - 1] == emptyStr) {
10158 /* But due to given XPG3, put the value into the corr. slot */
10159 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
10160 Jim_IncrRefCount(value);
10161 resultVec[descr->pos - 1] = value;
10163 else {
10164 /* Otherwise, the slot was already used - free obj and ERROR */
10165 Jim_FreeNewObj(interp, value);
10166 goto err;
10169 Jim_DecrRefCount(interp, emptyStr);
10170 return resultList;
10171 eof:
10172 Jim_DecrRefCount(interp, emptyStr);
10173 Jim_FreeNewObj(interp, resultList);
10174 return (Jim_Obj *)EOF;
10175 err:
10176 Jim_DecrRefCount(interp, emptyStr);
10177 Jim_FreeNewObj(interp, resultList);
10178 return 0;
10181 /* -----------------------------------------------------------------------------
10182 * Pseudo Random Number Generation
10183 * ---------------------------------------------------------------------------*/
10184 /* Initialize the sbox with the numbers from 0 to 255 */
10185 static void JimPrngInit(Jim_Interp *interp)
10187 #define PRNG_SEED_SIZE 256
10188 int i;
10189 unsigned int *seed;
10190 time_t t = time(NULL);
10192 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
10194 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
10195 for (i = 0; i < PRNG_SEED_SIZE; i++) {
10196 seed[i] = (rand() ^ t ^ clock());
10198 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
10199 Jim_Free(seed);
10202 /* Generates N bytes of random data */
10203 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
10205 Jim_PrngState *prng;
10206 unsigned char *destByte = (unsigned char *)dest;
10207 unsigned int si, sj, x;
10209 /* initialization, only needed the first time */
10210 if (interp->prngState == NULL)
10211 JimPrngInit(interp);
10212 prng = interp->prngState;
10213 /* generates 'len' bytes of pseudo-random numbers */
10214 for (x = 0; x < len; x++) {
10215 prng->i = (prng->i + 1) & 0xff;
10216 si = prng->sbox[prng->i];
10217 prng->j = (prng->j + si) & 0xff;
10218 sj = prng->sbox[prng->j];
10219 prng->sbox[prng->i] = sj;
10220 prng->sbox[prng->j] = si;
10221 *destByte++ = prng->sbox[(si + sj) & 0xff];
10225 /* Re-seed the generator with user-provided bytes */
10226 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10228 int i;
10229 Jim_PrngState *prng;
10231 /* initialization, only needed the first time */
10232 if (interp->prngState == NULL)
10233 JimPrngInit(interp);
10234 prng = interp->prngState;
10236 /* Set the sbox[i] with i */
10237 for (i = 0; i < 256; i++)
10238 prng->sbox[i] = i;
10239 /* Now use the seed to perform a random permutation of the sbox */
10240 for (i = 0; i < seedLen; i++) {
10241 unsigned char t;
10243 t = prng->sbox[i & 0xFF];
10244 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10245 prng->sbox[seed[i]] = t;
10247 prng->i = prng->j = 0;
10249 /* discard at least the first 256 bytes of stream.
10250 * borrow the seed buffer for this
10252 for (i = 0; i < 256; i += seedLen) {
10253 JimRandomBytes(interp, seed, seedLen);
10257 /* [incr] */
10258 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10260 jim_wide wideValue, increment = 1;
10261 Jim_Obj *intObjPtr;
10263 if (argc != 2 && argc != 3) {
10264 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10265 return JIM_ERR;
10267 if (argc == 3) {
10268 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10269 return JIM_ERR;
10271 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10272 if (!intObjPtr) {
10273 /* Set missing variable to 0 */
10274 wideValue = 0;
10276 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10277 return JIM_ERR;
10279 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10280 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10281 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10282 Jim_FreeNewObj(interp, intObjPtr);
10283 return JIM_ERR;
10286 else {
10287 /* Can do it the quick way */
10288 Jim_InvalidateStringRep(intObjPtr);
10289 JimWideValue(intObjPtr) = wideValue + increment;
10291 /* The following step is required in order to invalidate the
10292 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10293 if (argv[1]->typePtr != &variableObjType) {
10294 /* Note that this can't fail since GetVariable already succeeded */
10295 Jim_SetVariable(interp, argv[1], intObjPtr);
10298 Jim_SetResult(interp, intObjPtr);
10299 return JIM_OK;
10303 /* -----------------------------------------------------------------------------
10304 * Eval
10305 * ---------------------------------------------------------------------------*/
10306 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10307 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10309 /* Handle calls to the [unknown] command */
10310 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10312 int retcode;
10314 /* If JimUnknown() is recursively called too many times...
10315 * done here
10317 if (interp->unknown_called > 50) {
10318 return JIM_ERR;
10321 /* The object interp->unknown just contains
10322 * the "unknown" string, it is used in order to
10323 * avoid to lookup the unknown command every time
10324 * but instead to cache the result. */
10326 /* If the [unknown] command does not exist ... */
10327 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10328 return JIM_ERR;
10330 interp->unknown_called++;
10331 /* XXX: Are we losing fileNameObj and linenr? */
10332 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10333 interp->unknown_called--;
10335 return retcode;
10338 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10340 int retcode;
10341 Jim_Cmd *cmdPtr;
10343 #if 0
10344 printf("invoke");
10345 int j;
10346 for (j = 0; j < objc; j++) {
10347 printf(" '%s'", Jim_String(objv[j]));
10349 printf("\n");
10350 #endif
10352 if (interp->framePtr->tailcallCmd) {
10353 /* Special tailcall command was pre-resolved */
10354 cmdPtr = interp->framePtr->tailcallCmd;
10355 interp->framePtr->tailcallCmd = NULL;
10357 else {
10358 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10359 if (cmdPtr == NULL) {
10360 return JimUnknown(interp, objc, objv);
10362 JimIncrCmdRefCount(cmdPtr);
10365 if (interp->evalDepth == interp->maxEvalDepth) {
10366 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10367 retcode = JIM_ERR;
10368 goto out;
10370 interp->evalDepth++;
10372 /* Call it -- Make sure result is an empty object. */
10373 Jim_SetEmptyResult(interp);
10374 if (cmdPtr->isproc) {
10375 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10377 else {
10378 interp->cmdPrivData = cmdPtr->u.native.privData;
10379 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10381 interp->evalDepth--;
10383 out:
10384 JimDecrCmdRefCount(interp, cmdPtr);
10386 return retcode;
10389 /* Eval the object vector 'objv' composed of 'objc' elements.
10390 * Every element is used as single argument.
10391 * Jim_EvalObj() will call this function every time its object
10392 * argument is of "list" type, with no string representation.
10394 * This is possible because the string representation of a
10395 * list object generated by the UpdateStringOfList is made
10396 * in a way that ensures that every list element is a different
10397 * command argument. */
10398 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10400 int i, retcode;
10402 /* Incr refcount of arguments. */
10403 for (i = 0; i < objc; i++)
10404 Jim_IncrRefCount(objv[i]);
10406 retcode = JimInvokeCommand(interp, objc, objv);
10408 /* Decr refcount of arguments and return the retcode */
10409 for (i = 0; i < objc; i++)
10410 Jim_DecrRefCount(interp, objv[i]);
10412 return retcode;
10416 * Invokes 'prefix' as a command with the objv array as arguments.
10418 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10420 int ret;
10421 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10423 nargv[0] = prefix;
10424 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10425 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10426 Jim_Free(nargv);
10427 return ret;
10430 static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script)
10432 if (!interp->errorFlag) {
10433 /* This is the first error, so save the file/line information and reset the stack */
10434 interp->errorFlag = 1;
10435 Jim_IncrRefCount(script->fileNameObj);
10436 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10437 interp->errorFileNameObj = script->fileNameObj;
10438 interp->errorLine = script->linenr;
10440 JimResetStackTrace(interp);
10441 /* Always add a level where the error first occurs */
10442 interp->addStackTrace++;
10445 /* Now if this is an "interesting" level, add it to the stack trace */
10446 if (interp->addStackTrace > 0) {
10447 /* Add the stack info for the current level */
10449 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10451 /* Note: if we didn't have a filename for this level,
10452 * don't clear the addStackTrace flag
10453 * so we can pick it up at the next level
10455 if (Jim_Length(script->fileNameObj)) {
10456 interp->addStackTrace = 0;
10459 Jim_DecrRefCount(interp, interp->errorProc);
10460 interp->errorProc = interp->emptyObj;
10461 Jim_IncrRefCount(interp->errorProc);
10465 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10467 Jim_Obj *objPtr;
10469 switch (token->type) {
10470 case JIM_TT_STR:
10471 case JIM_TT_ESC:
10472 objPtr = token->objPtr;
10473 break;
10474 case JIM_TT_VAR:
10475 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10476 break;
10477 case JIM_TT_DICTSUGAR:
10478 objPtr = JimExpandDictSugar(interp, token->objPtr);
10479 break;
10480 case JIM_TT_EXPRSUGAR:
10481 objPtr = JimExpandExprSugar(interp, token->objPtr);
10482 break;
10483 case JIM_TT_CMD:
10484 switch (Jim_EvalObj(interp, token->objPtr)) {
10485 case JIM_OK:
10486 case JIM_RETURN:
10487 objPtr = interp->result;
10488 break;
10489 case JIM_BREAK:
10490 /* Stop substituting */
10491 return JIM_BREAK;
10492 case JIM_CONTINUE:
10493 /* just skip this one */
10494 return JIM_CONTINUE;
10495 default:
10496 return JIM_ERR;
10498 break;
10499 default:
10500 JimPanic((1,
10501 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10502 objPtr = NULL;
10503 break;
10505 if (objPtr) {
10506 *objPtrPtr = objPtr;
10507 return JIM_OK;
10509 return JIM_ERR;
10512 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10513 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10514 * The returned object has refcount = 0.
10516 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10518 int totlen = 0, i;
10519 Jim_Obj **intv;
10520 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10521 Jim_Obj *objPtr;
10522 char *s;
10524 if (tokens <= JIM_EVAL_SINTV_LEN)
10525 intv = sintv;
10526 else
10527 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10529 /* Compute every token forming the argument
10530 * in the intv objects vector. */
10531 for (i = 0; i < tokens; i++) {
10532 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10533 case JIM_OK:
10534 case JIM_RETURN:
10535 break;
10536 case JIM_BREAK:
10537 if (flags & JIM_SUBST_FLAG) {
10538 /* Stop here */
10539 tokens = i;
10540 continue;
10542 /* XXX: Should probably set an error about break outside loop */
10543 /* fall through to error */
10544 case JIM_CONTINUE:
10545 if (flags & JIM_SUBST_FLAG) {
10546 intv[i] = NULL;
10547 continue;
10549 /* XXX: Ditto continue outside loop */
10550 /* fall through to error */
10551 default:
10552 while (i--) {
10553 Jim_DecrRefCount(interp, intv[i]);
10555 if (intv != sintv) {
10556 Jim_Free(intv);
10558 return NULL;
10560 Jim_IncrRefCount(intv[i]);
10561 Jim_String(intv[i]);
10562 totlen += intv[i]->length;
10565 /* Fast path return for a single token */
10566 if (tokens == 1 && intv[0] && intv == sintv) {
10567 /* Reverse the Jim_IncrRefCount() above, but don't free the object */
10568 intv[0]->refCount--;
10569 return intv[0];
10572 /* Concatenate every token in an unique
10573 * object. */
10574 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10576 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10577 && token[2].type == JIM_TT_VAR) {
10578 /* May be able to do fast interpolated object -> dictSubst */
10579 objPtr->typePtr = &interpolatedObjType;
10580 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10581 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10582 Jim_IncrRefCount(intv[2]);
10584 else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) {
10585 /* The first interpolated token is source, so preserve the source info */
10586 JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber);
10590 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10591 objPtr->length = totlen;
10592 for (i = 0; i < tokens; i++) {
10593 if (intv[i]) {
10594 memcpy(s, intv[i]->bytes, intv[i]->length);
10595 s += intv[i]->length;
10596 Jim_DecrRefCount(interp, intv[i]);
10599 objPtr->bytes[totlen] = '\0';
10600 /* Free the intv vector if not static. */
10601 if (intv != sintv) {
10602 Jim_Free(intv);
10605 return objPtr;
10609 /* listPtr *must* be a list.
10610 * The contents of the list is evaluated with the first element as the command and
10611 * the remaining elements as the arguments.
10613 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10615 int retcode = JIM_OK;
10617 JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list."));
10619 if (listPtr->internalRep.listValue.len) {
10620 Jim_IncrRefCount(listPtr);
10621 retcode = JimInvokeCommand(interp,
10622 listPtr->internalRep.listValue.len,
10623 listPtr->internalRep.listValue.ele);
10624 Jim_DecrRefCount(interp, listPtr);
10626 return retcode;
10629 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10631 SetListFromAny(interp, listPtr);
10632 return JimEvalObjList(interp, listPtr);
10635 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10637 int i;
10638 ScriptObj *script;
10639 ScriptToken *token;
10640 int retcode = JIM_OK;
10641 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10642 Jim_Obj *prevScriptObj;
10644 /* If the object is of type "list", with no string rep we can call
10645 * a specialized version of Jim_EvalObj() */
10646 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10647 return JimEvalObjList(interp, scriptObjPtr);
10650 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10651 script = JimGetScript(interp, scriptObjPtr);
10652 if (!JimScriptValid(interp, script)) {
10653 Jim_DecrRefCount(interp, scriptObjPtr);
10654 return JIM_ERR;
10657 /* Reset the interpreter result. This is useful to
10658 * return the empty result in the case of empty program. */
10659 Jim_SetEmptyResult(interp);
10661 token = script->token;
10663 #ifdef JIM_OPTIMIZATION
10664 /* Check for one of the following common scripts used by for, while
10666 * {}
10667 * incr a
10669 if (script->len == 0) {
10670 Jim_DecrRefCount(interp, scriptObjPtr);
10671 return JIM_OK;
10673 if (script->len == 3
10674 && token[1].objPtr->typePtr == &commandObjType
10675 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10676 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10677 && token[2].objPtr->typePtr == &variableObjType) {
10679 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10681 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10682 JimWideValue(objPtr)++;
10683 Jim_InvalidateStringRep(objPtr);
10684 Jim_DecrRefCount(interp, scriptObjPtr);
10685 Jim_SetResult(interp, objPtr);
10686 return JIM_OK;
10689 #endif
10691 /* Now we have to make sure the internal repr will not be
10692 * freed on shimmering.
10694 * Think for example to this:
10696 * set x {llength $x; ... some more code ...}; eval $x
10698 * In order to preserve the internal rep, we increment the
10699 * inUse field of the script internal rep structure. */
10700 script->inUse++;
10702 /* Stash the current script */
10703 prevScriptObj = interp->currentScriptObj;
10704 interp->currentScriptObj = scriptObjPtr;
10706 interp->errorFlag = 0;
10707 argv = sargv;
10709 /* Execute every command sequentially until the end of the script
10710 * or an error occurs.
10712 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10713 int argc;
10714 int j;
10716 /* First token of the line is always JIM_TT_LINE */
10717 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10718 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10720 /* Allocate the arguments vector if required */
10721 if (argc > JIM_EVAL_SARGV_LEN)
10722 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10724 /* Skip the JIM_TT_LINE token */
10725 i++;
10727 /* Populate the arguments objects.
10728 * If an error occurs, retcode will be set and
10729 * 'j' will be set to the number of args expanded
10731 for (j = 0; j < argc; j++) {
10732 long wordtokens = 1;
10733 int expand = 0;
10734 Jim_Obj *wordObjPtr = NULL;
10736 if (token[i].type == JIM_TT_WORD) {
10737 wordtokens = JimWideValue(token[i++].objPtr);
10738 if (wordtokens < 0) {
10739 expand = 1;
10740 wordtokens = -wordtokens;
10744 if (wordtokens == 1) {
10745 /* Fast path if the token does not
10746 * need interpolation */
10748 switch (token[i].type) {
10749 case JIM_TT_ESC:
10750 case JIM_TT_STR:
10751 wordObjPtr = token[i].objPtr;
10752 break;
10753 case JIM_TT_VAR:
10754 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10755 break;
10756 case JIM_TT_EXPRSUGAR:
10757 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10758 break;
10759 case JIM_TT_DICTSUGAR:
10760 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10761 break;
10762 case JIM_TT_CMD:
10763 retcode = Jim_EvalObj(interp, token[i].objPtr);
10764 if (retcode == JIM_OK) {
10765 wordObjPtr = Jim_GetResult(interp);
10767 break;
10768 default:
10769 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10772 else {
10773 /* For interpolation we call a helper
10774 * function to do the work for us. */
10775 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10778 if (!wordObjPtr) {
10779 if (retcode == JIM_OK) {
10780 retcode = JIM_ERR;
10782 break;
10785 Jim_IncrRefCount(wordObjPtr);
10786 i += wordtokens;
10788 if (!expand) {
10789 argv[j] = wordObjPtr;
10791 else {
10792 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10793 int len = Jim_ListLength(interp, wordObjPtr);
10794 int newargc = argc + len - 1;
10795 int k;
10797 if (len > 1) {
10798 if (argv == sargv) {
10799 if (newargc > JIM_EVAL_SARGV_LEN) {
10800 argv = Jim_Alloc(sizeof(*argv) * newargc);
10801 memcpy(argv, sargv, sizeof(*argv) * j);
10804 else {
10805 /* Need to realloc to make room for (len - 1) more entries */
10806 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10810 /* Now copy in the expanded version */
10811 for (k = 0; k < len; k++) {
10812 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10813 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10816 /* The original object reference is no longer needed,
10817 * after the expansion it is no longer present on
10818 * the argument vector, but the single elements are
10819 * in its place. */
10820 Jim_DecrRefCount(interp, wordObjPtr);
10822 /* And update the indexes */
10823 j--;
10824 argc += len - 1;
10828 if (retcode == JIM_OK && argc) {
10829 /* Invoke the command */
10830 retcode = JimInvokeCommand(interp, argc, argv);
10831 /* Check for a signal after each command */
10832 if (Jim_CheckSignal(interp)) {
10833 retcode = JIM_SIGNAL;
10837 /* Finished with the command, so decrement ref counts of each argument */
10838 while (j-- > 0) {
10839 Jim_DecrRefCount(interp, argv[j]);
10842 if (argv != sargv) {
10843 Jim_Free(argv);
10844 argv = sargv;
10848 /* Possibly add to the error stack trace */
10849 if (retcode == JIM_ERR) {
10850 JimAddErrorToStack(interp, script);
10852 /* Propagate the addStackTrace value through 'return -code error' */
10853 else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) {
10854 /* No need to add stack trace */
10855 interp->addStackTrace = 0;
10858 /* Restore the current script */
10859 interp->currentScriptObj = prevScriptObj;
10861 /* Note that we don't have to decrement inUse, because the
10862 * following code transfers our use of the reference again to
10863 * the script object. */
10864 Jim_FreeIntRep(interp, scriptObjPtr);
10865 scriptObjPtr->typePtr = &scriptObjType;
10866 Jim_SetIntRepPtr(scriptObjPtr, script);
10867 Jim_DecrRefCount(interp, scriptObjPtr);
10869 return retcode;
10872 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10874 int retcode;
10875 /* If argObjPtr begins with '&', do an automatic upvar */
10876 const char *varname = Jim_String(argNameObj);
10877 if (*varname == '&') {
10878 /* First check that the target variable exists */
10879 Jim_Obj *objPtr;
10880 Jim_CallFrame *savedCallFrame = interp->framePtr;
10882 interp->framePtr = interp->framePtr->parent;
10883 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10884 interp->framePtr = savedCallFrame;
10885 if (!objPtr) {
10886 return JIM_ERR;
10889 /* It exists, so perform the binding. */
10890 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10891 Jim_IncrRefCount(objPtr);
10892 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10893 Jim_DecrRefCount(interp, objPtr);
10895 else {
10896 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10898 return retcode;
10902 * Sets the interp result to be an error message indicating the required proc args.
10904 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10906 /* Create a nice error message, consistent with Tcl 8.5 */
10907 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10908 int i;
10910 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10911 Jim_AppendString(interp, argmsg, " ", 1);
10913 if (i == cmd->u.proc.argsPos) {
10914 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10915 /* Renamed args */
10916 Jim_AppendString(interp, argmsg, "?", 1);
10917 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10918 Jim_AppendString(interp, argmsg, " ...?", -1);
10920 else {
10921 /* We have plain args */
10922 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10925 else {
10926 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10927 Jim_AppendString(interp, argmsg, "?", 1);
10928 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10929 Jim_AppendString(interp, argmsg, "?", 1);
10931 else {
10932 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10933 if (*arg == '&') {
10934 arg++;
10936 Jim_AppendString(interp, argmsg, arg, -1);
10940 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10943 #ifdef jim_ext_namespace
10945 * [namespace eval]
10947 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10949 Jim_CallFrame *callFramePtr;
10950 int retcode;
10952 /* Create a new callframe */
10953 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10954 callFramePtr->argv = &interp->emptyObj;
10955 callFramePtr->argc = 0;
10956 callFramePtr->procArgsObjPtr = NULL;
10957 callFramePtr->procBodyObjPtr = scriptObj;
10958 callFramePtr->staticVars = NULL;
10959 callFramePtr->fileNameObj = interp->emptyObj;
10960 callFramePtr->line = 0;
10961 Jim_IncrRefCount(scriptObj);
10962 interp->framePtr = callFramePtr;
10964 /* Check if there are too nested calls */
10965 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10966 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10967 retcode = JIM_ERR;
10969 else {
10970 /* Eval the body */
10971 retcode = Jim_EvalObj(interp, scriptObj);
10974 /* Destroy the callframe */
10975 interp->framePtr = interp->framePtr->parent;
10976 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10978 return retcode;
10980 #endif
10982 /* Call a procedure implemented in Tcl.
10983 * It's possible to speed-up a lot this function, currently
10984 * the callframes are not cached, but allocated and
10985 * destroied every time. What is expecially costly is
10986 * to create/destroy the local vars hash table every time.
10988 * This can be fixed just implementing callframes caching
10989 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10990 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10992 Jim_CallFrame *callFramePtr;
10993 int i, d, retcode, optargs;
10994 ScriptObj *script;
10996 /* Check arity */
10997 if (argc - 1 < cmd->u.proc.reqArity ||
10998 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10999 JimSetProcWrongArgs(interp, argv[0], cmd);
11000 return JIM_ERR;
11003 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
11004 /* Optimise for procedure with no body - useful for optional debugging */
11005 return JIM_OK;
11008 /* Check if there are too nested calls */
11009 if (interp->framePtr->level == interp->maxCallFrameDepth) {
11010 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
11011 return JIM_ERR;
11014 /* Create a new callframe */
11015 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
11016 callFramePtr->argv = argv;
11017 callFramePtr->argc = argc;
11018 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
11019 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
11020 callFramePtr->staticVars = cmd->u.proc.staticVars;
11022 /* Remember where we were called from. */
11023 script = JimGetScript(interp, interp->currentScriptObj);
11024 callFramePtr->fileNameObj = script->fileNameObj;
11025 callFramePtr->line = script->linenr;
11027 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
11028 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
11029 interp->framePtr = callFramePtr;
11031 /* How many optional args are available */
11032 optargs = (argc - 1 - cmd->u.proc.reqArity);
11034 /* Step 'i' along the actual args, and step 'd' along the formal args */
11035 i = 1;
11036 for (d = 0; d < cmd->u.proc.argListLen; d++) {
11037 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
11038 if (d == cmd->u.proc.argsPos) {
11039 /* assign $args */
11040 Jim_Obj *listObjPtr;
11041 int argsLen = 0;
11042 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
11043 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
11045 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
11047 /* It is possible to rename args. */
11048 if (cmd->u.proc.arglist[d].defaultObjPtr) {
11049 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
11051 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
11052 if (retcode != JIM_OK) {
11053 goto badargset;
11056 i += argsLen;
11057 continue;
11060 /* Optional or required? */
11061 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
11062 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
11064 else {
11065 /* Ran out, so use the default */
11066 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
11068 if (retcode != JIM_OK) {
11069 goto badargset;
11073 /* Eval the body */
11074 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
11076 badargset:
11078 /* Free the callframe */
11079 interp->framePtr = interp->framePtr->parent;
11080 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
11082 /* Now chain any tailcalls in the parent frame */
11083 if (interp->framePtr->tailcallObj) {
11084 do {
11085 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
11087 interp->framePtr->tailcallObj = NULL;
11089 if (retcode == JIM_EVAL) {
11090 retcode = Jim_EvalObjList(interp, tailcallObj);
11091 if (retcode == JIM_RETURN) {
11092 /* If the result of the tailcall is 'return', push
11093 * it up to the caller
11095 interp->returnLevel++;
11098 Jim_DecrRefCount(interp, tailcallObj);
11099 } while (interp->framePtr->tailcallObj);
11101 /* If the tailcall chain finished early, may need to manually discard the command */
11102 if (interp->framePtr->tailcallCmd) {
11103 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
11104 interp->framePtr->tailcallCmd = NULL;
11108 /* Handle the JIM_RETURN return code */
11109 if (retcode == JIM_RETURN) {
11110 if (--interp->returnLevel <= 0) {
11111 retcode = interp->returnCode;
11112 interp->returnCode = JIM_OK;
11113 interp->returnLevel = 0;
11116 else if (retcode == JIM_ERR) {
11117 interp->addStackTrace++;
11118 Jim_DecrRefCount(interp, interp->errorProc);
11119 interp->errorProc = argv[0];
11120 Jim_IncrRefCount(interp->errorProc);
11123 return retcode;
11126 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
11128 int retval;
11129 Jim_Obj *scriptObjPtr;
11131 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
11132 Jim_IncrRefCount(scriptObjPtr);
11134 if (filename) {
11135 Jim_Obj *prevScriptObj;
11137 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
11139 prevScriptObj = interp->currentScriptObj;
11140 interp->currentScriptObj = scriptObjPtr;
11142 retval = Jim_EvalObj(interp, scriptObjPtr);
11144 interp->currentScriptObj = prevScriptObj;
11146 else {
11147 retval = Jim_EvalObj(interp, scriptObjPtr);
11149 Jim_DecrRefCount(interp, scriptObjPtr);
11150 return retval;
11153 int Jim_Eval(Jim_Interp *interp, const char *script)
11155 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
11158 /* Execute script in the scope of the global level */
11159 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
11161 int retval;
11162 Jim_CallFrame *savedFramePtr = interp->framePtr;
11164 interp->framePtr = interp->topFramePtr;
11165 retval = Jim_Eval(interp, script);
11166 interp->framePtr = savedFramePtr;
11168 return retval;
11171 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
11173 int retval;
11174 Jim_CallFrame *savedFramePtr = interp->framePtr;
11176 interp->framePtr = interp->topFramePtr;
11177 retval = Jim_EvalFile(interp, filename);
11178 interp->framePtr = savedFramePtr;
11180 return retval;
11183 #include <sys/stat.h>
11185 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
11187 FILE *fp;
11188 char *buf;
11189 Jim_Obj *scriptObjPtr;
11190 Jim_Obj *prevScriptObj;
11191 struct stat sb;
11192 int retcode;
11193 int readlen;
11195 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
11196 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
11197 return JIM_ERR;
11199 if (sb.st_size == 0) {
11200 fclose(fp);
11201 return JIM_OK;
11204 buf = Jim_Alloc(sb.st_size + 1);
11205 readlen = fread(buf, 1, sb.st_size, fp);
11206 if (ferror(fp)) {
11207 fclose(fp);
11208 Jim_Free(buf);
11209 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
11210 return JIM_ERR;
11212 fclose(fp);
11213 buf[readlen] = 0;
11215 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
11216 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
11217 Jim_IncrRefCount(scriptObjPtr);
11219 prevScriptObj = interp->currentScriptObj;
11220 interp->currentScriptObj = scriptObjPtr;
11222 retcode = Jim_EvalObj(interp, scriptObjPtr);
11224 /* Handle the JIM_RETURN return code */
11225 if (retcode == JIM_RETURN) {
11226 if (--interp->returnLevel <= 0) {
11227 retcode = interp->returnCode;
11228 interp->returnCode = JIM_OK;
11229 interp->returnLevel = 0;
11232 if (retcode == JIM_ERR) {
11233 /* EvalFile changes context, so add a stack frame here */
11234 interp->addStackTrace++;
11237 interp->currentScriptObj = prevScriptObj;
11239 Jim_DecrRefCount(interp, scriptObjPtr);
11241 return retcode;
11244 /* -----------------------------------------------------------------------------
11245 * Subst
11246 * ---------------------------------------------------------------------------*/
11247 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11249 pc->tstart = pc->p;
11250 pc->tline = pc->linenr;
11252 if (pc->len == 0) {
11253 pc->tend = pc->p;
11254 pc->tt = JIM_TT_EOL;
11255 pc->eof = 1;
11256 return;
11258 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11259 JimParseCmd(pc);
11260 return;
11262 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11263 if (JimParseVar(pc) == JIM_OK) {
11264 return;
11266 /* Not a var, so treat as a string */
11267 pc->tstart = pc->p;
11268 flags |= JIM_SUBST_NOVAR;
11270 while (pc->len) {
11271 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11272 break;
11274 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11275 break;
11277 if (*pc->p == '\\' && pc->len > 1) {
11278 pc->p++;
11279 pc->len--;
11281 pc->p++;
11282 pc->len--;
11284 pc->tend = pc->p - 1;
11285 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11288 /* The subst object type reuses most of the data structures and functions
11289 * of the script object. Script's data structures are a bit more complex
11290 * for what is needed for [subst]itution tasks, but the reuse helps to
11291 * deal with a single data structure at the cost of some more memory
11292 * usage for substitutions. */
11294 /* This method takes the string representation of an object
11295 * as a Tcl string where to perform [subst]itution, and generates
11296 * the pre-parsed internal representation. */
11297 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11299 int scriptTextLen;
11300 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11301 struct JimParserCtx parser;
11302 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11303 ParseTokenList tokenlist;
11305 /* Initially parse the subst into tokens (in tokenlist) */
11306 ScriptTokenListInit(&tokenlist);
11308 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11309 while (1) {
11310 JimParseSubst(&parser, flags);
11311 if (parser.eof) {
11312 /* Note that subst doesn't need the EOL token */
11313 break;
11315 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11316 parser.tline);
11319 /* Create the "real" subst/script tokens from the initial token list */
11320 script->inUse = 1;
11321 script->substFlags = flags;
11322 script->fileNameObj = interp->emptyObj;
11323 Jim_IncrRefCount(script->fileNameObj);
11324 SubstObjAddTokens(interp, script, &tokenlist);
11326 /* No longer need the token list */
11327 ScriptTokenListFree(&tokenlist);
11329 #ifdef DEBUG_SHOW_SUBST
11331 int i;
11333 printf("==== Subst ====\n");
11334 for (i = 0; i < script->len; i++) {
11335 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11336 Jim_String(script->token[i].objPtr));
11339 #endif
11341 /* Free the old internal rep and set the new one. */
11342 Jim_FreeIntRep(interp, objPtr);
11343 Jim_SetIntRepPtr(objPtr, script);
11344 objPtr->typePtr = &scriptObjType;
11345 return JIM_OK;
11348 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11350 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11351 SetSubstFromAny(interp, objPtr, flags);
11352 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11355 /* Performs commands,variables,blackslashes substitution,
11356 * storing the result object (with refcount 0) into
11357 * resObjPtrPtr. */
11358 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11360 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11362 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11363 /* In order to preserve the internal rep, we increment the
11364 * inUse field of the script internal rep structure. */
11365 script->inUse++;
11367 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11369 script->inUse--;
11370 Jim_DecrRefCount(interp, substObjPtr);
11371 if (*resObjPtrPtr == NULL) {
11372 return JIM_ERR;
11374 return JIM_OK;
11377 /* -----------------------------------------------------------------------------
11378 * Core commands utility functions
11379 * ---------------------------------------------------------------------------*/
11380 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11382 Jim_Obj *objPtr;
11383 Jim_Obj *listObjPtr;
11385 JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0"));
11387 listObjPtr = Jim_NewListObj(interp, argv, argc);
11389 if (*msg) {
11390 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11392 Jim_IncrRefCount(listObjPtr);
11393 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11394 Jim_DecrRefCount(interp, listObjPtr);
11396 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11400 * May add the key and/or value to the list.
11402 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11403 Jim_HashEntry *he, int type);
11405 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11408 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11409 * invoke the callback to add entries to a list.
11410 * Returns the list.
11412 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11413 JimHashtableIteratorCallbackType *callback, int type)
11415 Jim_HashEntry *he;
11416 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11418 /* Check for the non-pattern case. We can do this much more efficiently. */
11419 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11420 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11421 if (he) {
11422 callback(interp, listObjPtr, he, type);
11425 else {
11426 Jim_HashTableIterator htiter;
11427 JimInitHashTableIterator(ht, &htiter);
11428 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11429 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11430 callback(interp, listObjPtr, he, type);
11434 return listObjPtr;
11437 /* Keep these in order */
11438 #define JIM_CMDLIST_COMMANDS 0
11439 #define JIM_CMDLIST_PROCS 1
11440 #define JIM_CMDLIST_CHANNELS 2
11443 * Adds matching command names (procs, channels) to the list.
11445 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11446 Jim_HashEntry *he, int type)
11448 Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11449 Jim_Obj *objPtr;
11451 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11452 /* not a proc */
11453 return;
11456 objPtr = Jim_NewStringObj(interp, he->key, -1);
11457 Jim_IncrRefCount(objPtr);
11459 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11460 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11462 Jim_DecrRefCount(interp, objPtr);
11465 /* type is JIM_CMDLIST_xxx */
11466 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11468 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11471 /* Keep these in order */
11472 #define JIM_VARLIST_GLOBALS 0
11473 #define JIM_VARLIST_LOCALS 1
11474 #define JIM_VARLIST_VARS 2
11476 #define JIM_VARLIST_VALUES 0x1000
11479 * Adds matching variable names to the list.
11481 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11482 Jim_HashEntry *he, int type)
11484 Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11486 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11487 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11488 if (type & JIM_VARLIST_VALUES) {
11489 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11494 /* mode is JIM_VARLIST_xxx */
11495 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11497 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11498 /* For [info locals], if we are at top level an emtpy list
11499 * is returned. I don't agree, but we aim at compatibility (SS) */
11500 return interp->emptyObj;
11502 else {
11503 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11504 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11508 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11509 Jim_Obj **objPtrPtr, int info_level_cmd)
11511 Jim_CallFrame *targetCallFrame;
11513 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11514 if (targetCallFrame == NULL) {
11515 return JIM_ERR;
11517 /* No proc call at toplevel callframe */
11518 if (targetCallFrame == interp->topFramePtr) {
11519 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11520 return JIM_ERR;
11522 if (info_level_cmd) {
11523 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11525 else {
11526 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11528 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11529 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11530 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11531 *objPtrPtr = listObj;
11533 return JIM_OK;
11536 /* -----------------------------------------------------------------------------
11537 * Core commands
11538 * ---------------------------------------------------------------------------*/
11540 /* fake [puts] -- not the real puts, just for debugging. */
11541 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11543 if (argc != 2 && argc != 3) {
11544 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11545 return JIM_ERR;
11547 if (argc == 3) {
11548 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11549 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11550 return JIM_ERR;
11552 else {
11553 fputs(Jim_String(argv[2]), stdout);
11556 else {
11557 puts(Jim_String(argv[1]));
11559 return JIM_OK;
11562 /* Helper for [+] and [*] */
11563 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11565 jim_wide wideValue, res;
11566 double doubleValue, doubleRes;
11567 int i;
11569 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11571 for (i = 1; i < argc; i++) {
11572 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11573 goto trydouble;
11574 if (op == JIM_EXPROP_ADD)
11575 res += wideValue;
11576 else
11577 res *= wideValue;
11579 Jim_SetResultInt(interp, res);
11580 return JIM_OK;
11581 trydouble:
11582 doubleRes = (double)res;
11583 for (; i < argc; i++) {
11584 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11585 return JIM_ERR;
11586 if (op == JIM_EXPROP_ADD)
11587 doubleRes += doubleValue;
11588 else
11589 doubleRes *= doubleValue;
11591 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11592 return JIM_OK;
11595 /* Helper for [-] and [/] */
11596 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11598 jim_wide wideValue, res = 0;
11599 double doubleValue, doubleRes = 0;
11600 int i = 2;
11602 if (argc < 2) {
11603 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11604 return JIM_ERR;
11606 else if (argc == 2) {
11607 /* The arity = 2 case is different. For [- x] returns -x,
11608 * while [/ x] returns 1/x. */
11609 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11610 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11611 return JIM_ERR;
11613 else {
11614 if (op == JIM_EXPROP_SUB)
11615 doubleRes = -doubleValue;
11616 else
11617 doubleRes = 1.0 / doubleValue;
11618 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11619 return JIM_OK;
11622 if (op == JIM_EXPROP_SUB) {
11623 res = -wideValue;
11624 Jim_SetResultInt(interp, res);
11626 else {
11627 doubleRes = 1.0 / wideValue;
11628 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11630 return JIM_OK;
11632 else {
11633 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11634 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11635 != JIM_OK) {
11636 return JIM_ERR;
11638 else {
11639 goto trydouble;
11643 for (i = 2; i < argc; i++) {
11644 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11645 doubleRes = (double)res;
11646 goto trydouble;
11648 if (op == JIM_EXPROP_SUB)
11649 res -= wideValue;
11650 else {
11651 if (wideValue == 0) {
11652 Jim_SetResultString(interp, "Division by zero", -1);
11653 return JIM_ERR;
11655 res /= wideValue;
11658 Jim_SetResultInt(interp, res);
11659 return JIM_OK;
11660 trydouble:
11661 for (; i < argc; i++) {
11662 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11663 return JIM_ERR;
11664 if (op == JIM_EXPROP_SUB)
11665 doubleRes -= doubleValue;
11666 else
11667 doubleRes /= doubleValue;
11669 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11670 return JIM_OK;
11674 /* [+] */
11675 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11677 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11680 /* [*] */
11681 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11683 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11686 /* [-] */
11687 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11689 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11692 /* [/] */
11693 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11695 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11698 /* [set] */
11699 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11701 if (argc != 2 && argc != 3) {
11702 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11703 return JIM_ERR;
11705 if (argc == 2) {
11706 Jim_Obj *objPtr;
11708 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11709 if (!objPtr)
11710 return JIM_ERR;
11711 Jim_SetResult(interp, objPtr);
11712 return JIM_OK;
11714 /* argc == 3 case. */
11715 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11716 return JIM_ERR;
11717 Jim_SetResult(interp, argv[2]);
11718 return JIM_OK;
11721 /* [unset]
11723 * unset ?-nocomplain? ?--? ?varName ...?
11725 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11727 int i = 1;
11728 int complain = 1;
11730 while (i < argc) {
11731 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11732 i++;
11733 break;
11735 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11736 complain = 0;
11737 i++;
11738 continue;
11740 break;
11743 while (i < argc) {
11744 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11745 && complain) {
11746 return JIM_ERR;
11748 i++;
11750 return JIM_OK;
11753 /* [while] */
11754 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11756 if (argc != 3) {
11757 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11758 return JIM_ERR;
11761 /* The general purpose implementation of while starts here */
11762 while (1) {
11763 int boolean, retval;
11765 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11766 return retval;
11767 if (!boolean)
11768 break;
11770 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11771 switch (retval) {
11772 case JIM_BREAK:
11773 goto out;
11774 break;
11775 case JIM_CONTINUE:
11776 continue;
11777 break;
11778 default:
11779 return retval;
11783 out:
11784 Jim_SetEmptyResult(interp);
11785 return JIM_OK;
11788 /* [for] */
11789 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11791 int retval;
11792 int boolean = 1;
11793 Jim_Obj *varNamePtr = NULL;
11794 Jim_Obj *stopVarNamePtr = NULL;
11796 if (argc != 5) {
11797 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11798 return JIM_ERR;
11801 /* Do the initialisation */
11802 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11803 return retval;
11806 /* And do the first test now. Better for optimisation
11807 * if we can do next/test at the bottom of the loop
11809 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11811 /* Ready to do the body as follows:
11812 * while (1) {
11813 * body // check retcode
11814 * next // check retcode
11815 * test // check retcode/test bool
11819 #ifdef JIM_OPTIMIZATION
11820 /* Check if the for is on the form:
11821 * for ... {$i < CONST} {incr i}
11822 * for ... {$i < $j} {incr i}
11824 if (retval == JIM_OK && boolean) {
11825 ScriptObj *incrScript;
11826 ExprByteCode *expr;
11827 jim_wide stop, currentVal;
11828 Jim_Obj *objPtr;
11829 int cmpOffset;
11831 /* Do it only if there aren't shared arguments */
11832 expr = JimGetExpression(interp, argv[2]);
11833 incrScript = JimGetScript(interp, argv[3]);
11835 /* Ensure proper lengths to start */
11836 if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) {
11837 goto evalstart;
11839 /* Ensure proper token types. */
11840 if (incrScript->token[1].type != JIM_TT_ESC ||
11841 expr->token[0].type != JIM_TT_VAR ||
11842 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11843 goto evalstart;
11846 if (expr->token[2].type == JIM_EXPROP_LT) {
11847 cmpOffset = 0;
11849 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11850 cmpOffset = 1;
11852 else {
11853 goto evalstart;
11856 /* Update command must be incr */
11857 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11858 goto evalstart;
11861 /* incr, expression must be about the same variable */
11862 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11863 goto evalstart;
11866 /* Get the stop condition (must be a variable or integer) */
11867 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11868 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11869 goto evalstart;
11872 else {
11873 stopVarNamePtr = expr->token[1].objPtr;
11874 Jim_IncrRefCount(stopVarNamePtr);
11875 /* Keep the compiler happy */
11876 stop = 0;
11879 /* Initialization */
11880 varNamePtr = expr->token[0].objPtr;
11881 Jim_IncrRefCount(varNamePtr);
11883 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11884 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11885 goto testcond;
11888 /* --- OPTIMIZED FOR --- */
11889 while (retval == JIM_OK) {
11890 /* === Check condition === */
11891 /* Note that currentVal is already set here */
11893 /* Immediate or Variable? get the 'stop' value if the latter. */
11894 if (stopVarNamePtr) {
11895 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11896 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11897 goto testcond;
11901 if (currentVal >= stop + cmpOffset) {
11902 break;
11905 /* Eval body */
11906 retval = Jim_EvalObj(interp, argv[4]);
11907 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11908 retval = JIM_OK;
11910 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11912 /* Increment */
11913 if (objPtr == NULL) {
11914 retval = JIM_ERR;
11915 goto out;
11917 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11918 currentVal = ++JimWideValue(objPtr);
11919 Jim_InvalidateStringRep(objPtr);
11921 else {
11922 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11923 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11924 ++currentVal)) != JIM_OK) {
11925 goto evalnext;
11930 goto out;
11932 evalstart:
11933 #endif
11935 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11936 /* Body */
11937 retval = Jim_EvalObj(interp, argv[4]);
11939 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11940 /* increment */
11941 JIM_IF_OPTIM(evalnext:)
11942 retval = Jim_EvalObj(interp, argv[3]);
11943 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11944 /* test */
11945 JIM_IF_OPTIM(testcond:)
11946 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11950 JIM_IF_OPTIM(out:)
11951 if (stopVarNamePtr) {
11952 Jim_DecrRefCount(interp, stopVarNamePtr);
11954 if (varNamePtr) {
11955 Jim_DecrRefCount(interp, varNamePtr);
11958 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11959 Jim_SetEmptyResult(interp);
11960 return JIM_OK;
11963 return retval;
11966 /* [loop] */
11967 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11969 int retval;
11970 jim_wide i;
11971 jim_wide limit;
11972 jim_wide incr = 1;
11973 Jim_Obj *bodyObjPtr;
11975 if (argc != 5 && argc != 6) {
11976 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11977 return JIM_ERR;
11980 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11981 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11982 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11983 return JIM_ERR;
11985 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11987 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11989 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11990 retval = Jim_EvalObj(interp, bodyObjPtr);
11991 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11992 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11994 retval = JIM_OK;
11996 /* Increment */
11997 i += incr;
11999 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
12000 if (argv[1]->typePtr != &variableObjType) {
12001 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
12002 return JIM_ERR;
12005 JimWideValue(objPtr) = i;
12006 Jim_InvalidateStringRep(objPtr);
12008 /* The following step is required in order to invalidate the
12009 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
12010 if (argv[1]->typePtr != &variableObjType) {
12011 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
12012 retval = JIM_ERR;
12013 break;
12017 else {
12018 objPtr = Jim_NewIntObj(interp, i);
12019 retval = Jim_SetVariable(interp, argv[1], objPtr);
12020 if (retval != JIM_OK) {
12021 Jim_FreeNewObj(interp, objPtr);
12027 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
12028 Jim_SetEmptyResult(interp);
12029 return JIM_OK;
12031 return retval;
12034 /* List iterators make it easy to iterate over a list.
12035 * At some point iterators will be expanded to support generators.
12037 typedef struct {
12038 Jim_Obj *objPtr;
12039 int idx;
12040 } Jim_ListIter;
12043 * Initialise the iterator at the start of the list.
12045 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
12047 iter->objPtr = objPtr;
12048 iter->idx = 0;
12052 * Returns the next object from the list, or NULL on end-of-list.
12054 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
12056 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
12057 return NULL;
12059 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
12063 * Returns 1 if end-of-list has been reached.
12065 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
12067 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
12070 /* foreach + lmap implementation. */
12071 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
12073 int result = JIM_OK;
12074 int i, numargs;
12075 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
12076 Jim_ListIter *iters;
12077 Jim_Obj *script;
12078 Jim_Obj *resultObj;
12080 if (argc < 4 || argc % 2 != 0) {
12081 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
12082 return JIM_ERR;
12084 script = argv[argc - 1]; /* Last argument is a script */
12085 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
12087 if (numargs == 2) {
12088 iters = twoiters;
12090 else {
12091 iters = Jim_Alloc(numargs * sizeof(*iters));
12093 for (i = 0; i < numargs; i++) {
12094 JimListIterInit(&iters[i], argv[i + 1]);
12095 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
12096 result = JIM_ERR;
12099 if (result != JIM_OK) {
12100 Jim_SetResultString(interp, "foreach varlist is empty", -1);
12101 return result;
12104 if (doMap) {
12105 resultObj = Jim_NewListObj(interp, NULL, 0);
12107 else {
12108 resultObj = interp->emptyObj;
12110 Jim_IncrRefCount(resultObj);
12112 while (1) {
12113 /* Have we expired all lists? */
12114 for (i = 0; i < numargs; i += 2) {
12115 if (!JimListIterDone(interp, &iters[i + 1])) {
12116 break;
12119 if (i == numargs) {
12120 /* All done */
12121 break;
12124 /* For each list */
12125 for (i = 0; i < numargs; i += 2) {
12126 Jim_Obj *varName;
12128 /* foreach var */
12129 JimListIterInit(&iters[i], argv[i + 1]);
12130 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
12131 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
12132 if (!valObj) {
12133 /* Ran out, so store the empty string */
12134 valObj = interp->emptyObj;
12136 /* Avoid shimmering */
12137 Jim_IncrRefCount(valObj);
12138 result = Jim_SetVariable(interp, varName, valObj);
12139 Jim_DecrRefCount(interp, valObj);
12140 if (result != JIM_OK) {
12141 goto err;
12145 switch (result = Jim_EvalObj(interp, script)) {
12146 case JIM_OK:
12147 if (doMap) {
12148 Jim_ListAppendElement(interp, resultObj, interp->result);
12150 break;
12151 case JIM_CONTINUE:
12152 break;
12153 case JIM_BREAK:
12154 goto out;
12155 default:
12156 goto err;
12159 out:
12160 result = JIM_OK;
12161 Jim_SetResult(interp, resultObj);
12162 err:
12163 Jim_DecrRefCount(interp, resultObj);
12164 if (numargs > 2) {
12165 Jim_Free(iters);
12167 return result;
12170 /* [foreach] */
12171 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12173 return JimForeachMapHelper(interp, argc, argv, 0);
12176 /* [lmap] */
12177 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12179 return JimForeachMapHelper(interp, argc, argv, 1);
12182 /* [lassign] */
12183 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12185 int result = JIM_ERR;
12186 int i;
12187 Jim_ListIter iter;
12188 Jim_Obj *resultObj;
12190 if (argc < 2) {
12191 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
12192 return JIM_ERR;
12195 JimListIterInit(&iter, argv[1]);
12197 for (i = 2; i < argc; i++) {
12198 Jim_Obj *valObj = JimListIterNext(interp, &iter);
12199 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
12200 if (result != JIM_OK) {
12201 return result;
12205 resultObj = Jim_NewListObj(interp, NULL, 0);
12206 while (!JimListIterDone(interp, &iter)) {
12207 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
12210 Jim_SetResult(interp, resultObj);
12212 return JIM_OK;
12215 /* [if] */
12216 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12218 int boolean, retval, current = 1, falsebody = 0;
12220 if (argc >= 3) {
12221 while (1) {
12222 /* Far not enough arguments given! */
12223 if (current >= argc)
12224 goto err;
12225 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12226 != JIM_OK)
12227 return retval;
12228 /* There lacks something, isn't it? */
12229 if (current >= argc)
12230 goto err;
12231 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12232 current++;
12233 /* Tsk tsk, no then-clause? */
12234 if (current >= argc)
12235 goto err;
12236 if (boolean)
12237 return Jim_EvalObj(interp, argv[current]);
12238 /* Ok: no else-clause follows */
12239 if (++current >= argc) {
12240 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12241 return JIM_OK;
12243 falsebody = current++;
12244 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12245 /* IIICKS - else-clause isn't last cmd? */
12246 if (current != argc - 1)
12247 goto err;
12248 return Jim_EvalObj(interp, argv[current]);
12250 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12251 /* Ok: elseif follows meaning all the stuff
12252 * again (how boring...) */
12253 continue;
12254 /* OOPS - else-clause is not last cmd? */
12255 else if (falsebody != argc - 1)
12256 goto err;
12257 return Jim_EvalObj(interp, argv[falsebody]);
12259 return JIM_OK;
12261 err:
12262 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12263 return JIM_ERR;
12267 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12268 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12269 Jim_Obj *stringObj, int nocase)
12271 Jim_Obj *parms[4];
12272 int argc = 0;
12273 long eq;
12274 int rc;
12276 parms[argc++] = commandObj;
12277 if (nocase) {
12278 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12280 parms[argc++] = patternObj;
12281 parms[argc++] = stringObj;
12283 rc = Jim_EvalObjVector(interp, argc, parms);
12285 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12286 eq = -rc;
12289 return eq;
12292 enum
12293 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12295 /* [switch] */
12296 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12298 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12299 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12300 Jim_Obj *script = 0;
12302 if (argc < 3) {
12303 wrongnumargs:
12304 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12305 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12306 return JIM_ERR;
12308 for (opt = 1; opt < argc; ++opt) {
12309 const char *option = Jim_String(argv[opt]);
12311 if (*option != '-')
12312 break;
12313 else if (strncmp(option, "--", 2) == 0) {
12314 ++opt;
12315 break;
12317 else if (strncmp(option, "-exact", 2) == 0)
12318 matchOpt = SWITCH_EXACT;
12319 else if (strncmp(option, "-glob", 2) == 0)
12320 matchOpt = SWITCH_GLOB;
12321 else if (strncmp(option, "-regexp", 2) == 0)
12322 matchOpt = SWITCH_RE;
12323 else if (strncmp(option, "-command", 2) == 0) {
12324 matchOpt = SWITCH_CMD;
12325 if ((argc - opt) < 2)
12326 goto wrongnumargs;
12327 command = argv[++opt];
12329 else {
12330 Jim_SetResultFormatted(interp,
12331 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12332 argv[opt]);
12333 return JIM_ERR;
12335 if ((argc - opt) < 2)
12336 goto wrongnumargs;
12338 strObj = argv[opt++];
12339 patCount = argc - opt;
12340 if (patCount == 1) {
12341 Jim_Obj **vector;
12343 JimListGetElements(interp, argv[opt], &patCount, &vector);
12344 caseList = vector;
12346 else
12347 caseList = &argv[opt];
12348 if (patCount == 0 || patCount % 2 != 0)
12349 goto wrongnumargs;
12350 for (i = 0; script == 0 && i < patCount; i += 2) {
12351 Jim_Obj *patObj = caseList[i];
12353 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12354 || i < (patCount - 2)) {
12355 switch (matchOpt) {
12356 case SWITCH_EXACT:
12357 if (Jim_StringEqObj(strObj, patObj))
12358 script = caseList[i + 1];
12359 break;
12360 case SWITCH_GLOB:
12361 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12362 script = caseList[i + 1];
12363 break;
12364 case SWITCH_RE:
12365 command = Jim_NewStringObj(interp, "regexp", -1);
12366 /* Fall thru intentionally */
12367 case SWITCH_CMD:{
12368 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12370 /* After the execution of a command we need to
12371 * make sure to reconvert the object into a list
12372 * again. Only for the single-list style [switch]. */
12373 if (argc - opt == 1) {
12374 Jim_Obj **vector;
12376 JimListGetElements(interp, argv[opt], &patCount, &vector);
12377 caseList = vector;
12379 /* command is here already decref'd */
12380 if (rc < 0) {
12381 return -rc;
12383 if (rc)
12384 script = caseList[i + 1];
12385 break;
12389 else {
12390 script = caseList[i + 1];
12393 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12394 script = caseList[i + 1];
12395 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12396 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12397 return JIM_ERR;
12399 Jim_SetEmptyResult(interp);
12400 if (script) {
12401 return Jim_EvalObj(interp, script);
12403 return JIM_OK;
12406 /* [list] */
12407 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12409 Jim_Obj *listObjPtr;
12411 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12412 Jim_SetResult(interp, listObjPtr);
12413 return JIM_OK;
12416 /* [lindex] */
12417 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12419 Jim_Obj *objPtr, *listObjPtr;
12420 int i;
12421 int idx;
12423 if (argc < 2) {
12424 Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12425 return JIM_ERR;
12427 objPtr = argv[1];
12428 Jim_IncrRefCount(objPtr);
12429 for (i = 2; i < argc; i++) {
12430 listObjPtr = objPtr;
12431 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12432 Jim_DecrRefCount(interp, listObjPtr);
12433 return JIM_ERR;
12435 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12436 /* Returns an empty object if the index
12437 * is out of range. */
12438 Jim_DecrRefCount(interp, listObjPtr);
12439 Jim_SetEmptyResult(interp);
12440 return JIM_OK;
12442 Jim_IncrRefCount(objPtr);
12443 Jim_DecrRefCount(interp, listObjPtr);
12445 Jim_SetResult(interp, objPtr);
12446 Jim_DecrRefCount(interp, objPtr);
12447 return JIM_OK;
12450 /* [llength] */
12451 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12453 if (argc != 2) {
12454 Jim_WrongNumArgs(interp, 1, argv, "list");
12455 return JIM_ERR;
12457 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12458 return JIM_OK;
12461 /* [lsearch] */
12462 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12464 static const char * const options[] = {
12465 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12466 NULL
12468 enum
12469 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12470 OPT_COMMAND };
12471 int i;
12472 int opt_bool = 0;
12473 int opt_not = 0;
12474 int opt_nocase = 0;
12475 int opt_all = 0;
12476 int opt_inline = 0;
12477 int opt_match = OPT_EXACT;
12478 int listlen;
12479 int rc = JIM_OK;
12480 Jim_Obj *listObjPtr = NULL;
12481 Jim_Obj *commandObj = NULL;
12483 if (argc < 3) {
12484 wrongargs:
12485 Jim_WrongNumArgs(interp, 1, argv,
12486 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12487 return JIM_ERR;
12490 for (i = 1; i < argc - 2; i++) {
12491 int option;
12493 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12494 return JIM_ERR;
12496 switch (option) {
12497 case OPT_BOOL:
12498 opt_bool = 1;
12499 opt_inline = 0;
12500 break;
12501 case OPT_NOT:
12502 opt_not = 1;
12503 break;
12504 case OPT_NOCASE:
12505 opt_nocase = 1;
12506 break;
12507 case OPT_INLINE:
12508 opt_inline = 1;
12509 opt_bool = 0;
12510 break;
12511 case OPT_ALL:
12512 opt_all = 1;
12513 break;
12514 case OPT_COMMAND:
12515 if (i >= argc - 2) {
12516 goto wrongargs;
12518 commandObj = argv[++i];
12519 /* fallthru */
12520 case OPT_EXACT:
12521 case OPT_GLOB:
12522 case OPT_REGEXP:
12523 opt_match = option;
12524 break;
12528 argv += i;
12530 if (opt_all) {
12531 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12533 if (opt_match == OPT_REGEXP) {
12534 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12536 if (commandObj) {
12537 Jim_IncrRefCount(commandObj);
12540 listlen = Jim_ListLength(interp, argv[0]);
12541 for (i = 0; i < listlen; i++) {
12542 int eq = 0;
12543 Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
12545 switch (opt_match) {
12546 case OPT_EXACT:
12547 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12548 break;
12550 case OPT_GLOB:
12551 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12552 break;
12554 case OPT_REGEXP:
12555 case OPT_COMMAND:
12556 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12557 if (eq < 0) {
12558 if (listObjPtr) {
12559 Jim_FreeNewObj(interp, listObjPtr);
12561 rc = JIM_ERR;
12562 goto done;
12564 break;
12567 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12568 if (!eq && opt_bool && opt_not && !opt_all) {
12569 continue;
12572 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12573 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12574 Jim_Obj *resultObj;
12576 if (opt_bool) {
12577 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12579 else if (!opt_inline) {
12580 resultObj = Jim_NewIntObj(interp, i);
12582 else {
12583 resultObj = objPtr;
12586 if (opt_all) {
12587 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12589 else {
12590 Jim_SetResult(interp, resultObj);
12591 goto done;
12596 if (opt_all) {
12597 Jim_SetResult(interp, listObjPtr);
12599 else {
12600 /* No match */
12601 if (opt_bool) {
12602 Jim_SetResultBool(interp, opt_not);
12604 else if (!opt_inline) {
12605 Jim_SetResultInt(interp, -1);
12609 done:
12610 if (commandObj) {
12611 Jim_DecrRefCount(interp, commandObj);
12613 return rc;
12616 /* [lappend] */
12617 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12619 Jim_Obj *listObjPtr;
12620 int new_obj = 0;
12621 int i;
12623 if (argc < 2) {
12624 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12625 return JIM_ERR;
12627 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12628 if (!listObjPtr) {
12629 /* Create the list if it does not exist */
12630 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12631 new_obj = 1;
12633 else if (Jim_IsShared(listObjPtr)) {
12634 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12635 new_obj = 1;
12637 for (i = 2; i < argc; i++)
12638 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12639 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12640 if (new_obj)
12641 Jim_FreeNewObj(interp, listObjPtr);
12642 return JIM_ERR;
12644 Jim_SetResult(interp, listObjPtr);
12645 return JIM_OK;
12648 /* [linsert] */
12649 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12651 int idx, len;
12652 Jim_Obj *listPtr;
12654 if (argc < 3) {
12655 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12656 return JIM_ERR;
12658 listPtr = argv[1];
12659 if (Jim_IsShared(listPtr))
12660 listPtr = Jim_DuplicateObj(interp, listPtr);
12661 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12662 goto err;
12663 len = Jim_ListLength(interp, listPtr);
12664 if (idx >= len)
12665 idx = len;
12666 else if (idx < 0)
12667 idx = len + idx + 1;
12668 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12669 Jim_SetResult(interp, listPtr);
12670 return JIM_OK;
12671 err:
12672 if (listPtr != argv[1]) {
12673 Jim_FreeNewObj(interp, listPtr);
12675 return JIM_ERR;
12678 /* [lreplace] */
12679 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12681 int first, last, len, rangeLen;
12682 Jim_Obj *listObj;
12683 Jim_Obj *newListObj;
12685 if (argc < 4) {
12686 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12687 return JIM_ERR;
12689 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12690 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12691 return JIM_ERR;
12694 listObj = argv[1];
12695 len = Jim_ListLength(interp, listObj);
12697 first = JimRelToAbsIndex(len, first);
12698 last = JimRelToAbsIndex(len, last);
12699 JimRelToAbsRange(len, &first, &last, &rangeLen);
12701 /* Now construct a new list which consists of:
12702 * <elements before first> <supplied elements> <elements after last>
12705 /* Check to see if trying to replace past the end of the list */
12706 if (first < len) {
12707 /* OK. Not past the end */
12709 else if (len == 0) {
12710 /* Special for empty list, adjust first to 0 */
12711 first = 0;
12713 else {
12714 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12715 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12716 return JIM_ERR;
12719 /* Add the first set of elements */
12720 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12722 /* Add supplied elements */
12723 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12725 /* Add the remaining elements */
12726 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12728 Jim_SetResult(interp, newListObj);
12729 return JIM_OK;
12732 /* [lset] */
12733 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12735 if (argc < 3) {
12736 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12737 return JIM_ERR;
12739 else if (argc == 3) {
12740 /* With no indexes, simply implements [set] */
12741 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12742 return JIM_ERR;
12743 Jim_SetResult(interp, argv[2]);
12744 return JIM_OK;
12746 return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]);
12749 /* [lsort] */
12750 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12752 static const char * const options[] = {
12753 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12755 enum
12756 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12757 Jim_Obj *resObj;
12758 int i;
12759 int retCode;
12760 int shared;
12762 struct lsort_info info;
12764 if (argc < 2) {
12765 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12766 return JIM_ERR;
12769 info.type = JIM_LSORT_ASCII;
12770 info.order = 1;
12771 info.indexed = 0;
12772 info.unique = 0;
12773 info.command = NULL;
12774 info.interp = interp;
12776 for (i = 1; i < (argc - 1); i++) {
12777 int option;
12779 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12780 != JIM_OK)
12781 return JIM_ERR;
12782 switch (option) {
12783 case OPT_ASCII:
12784 info.type = JIM_LSORT_ASCII;
12785 break;
12786 case OPT_NOCASE:
12787 info.type = JIM_LSORT_NOCASE;
12788 break;
12789 case OPT_INTEGER:
12790 info.type = JIM_LSORT_INTEGER;
12791 break;
12792 case OPT_REAL:
12793 info.type = JIM_LSORT_REAL;
12794 break;
12795 case OPT_INCREASING:
12796 info.order = 1;
12797 break;
12798 case OPT_DECREASING:
12799 info.order = -1;
12800 break;
12801 case OPT_UNIQUE:
12802 info.unique = 1;
12803 break;
12804 case OPT_COMMAND:
12805 if (i >= (argc - 2)) {
12806 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12807 return JIM_ERR;
12809 info.type = JIM_LSORT_COMMAND;
12810 info.command = argv[i + 1];
12811 i++;
12812 break;
12813 case OPT_INDEX:
12814 if (i >= (argc - 2)) {
12815 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12816 return JIM_ERR;
12818 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12819 return JIM_ERR;
12821 info.indexed = 1;
12822 i++;
12823 break;
12826 resObj = argv[argc - 1];
12827 if ((shared = Jim_IsShared(resObj)))
12828 resObj = Jim_DuplicateObj(interp, resObj);
12829 retCode = ListSortElements(interp, resObj, &info);
12830 if (retCode == JIM_OK) {
12831 Jim_SetResult(interp, resObj);
12833 else if (shared) {
12834 Jim_FreeNewObj(interp, resObj);
12836 return retCode;
12839 /* [append] */
12840 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12842 Jim_Obj *stringObjPtr;
12843 int i;
12845 if (argc < 2) {
12846 Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?");
12847 return JIM_ERR;
12849 if (argc == 2) {
12850 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12851 if (!stringObjPtr)
12852 return JIM_ERR;
12854 else {
12855 int new_obj = 0;
12856 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12857 if (!stringObjPtr) {
12858 /* Create the string if it doesn't exist */
12859 stringObjPtr = Jim_NewEmptyStringObj(interp);
12860 new_obj = 1;
12862 else if (Jim_IsShared(stringObjPtr)) {
12863 new_obj = 1;
12864 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12866 for (i = 2; i < argc; i++) {
12867 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12869 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12870 if (new_obj) {
12871 Jim_FreeNewObj(interp, stringObjPtr);
12873 return JIM_ERR;
12876 Jim_SetResult(interp, stringObjPtr);
12877 return JIM_OK;
12880 /* [debug] */
12881 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12883 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12884 static const char * const options[] = {
12885 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12886 "exprbc", "show",
12887 NULL
12889 enum
12891 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12892 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12894 int option;
12896 if (argc < 2) {
12897 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12898 return JIM_ERR;
12900 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12901 return Jim_CheckShowCommands(interp, argv[1], options);
12902 if (option == OPT_REFCOUNT) {
12903 if (argc != 3) {
12904 Jim_WrongNumArgs(interp, 2, argv, "object");
12905 return JIM_ERR;
12907 Jim_SetResultInt(interp, argv[2]->refCount);
12908 return JIM_OK;
12910 else if (option == OPT_OBJCOUNT) {
12911 int freeobj = 0, liveobj = 0;
12912 char buf[256];
12913 Jim_Obj *objPtr;
12915 if (argc != 2) {
12916 Jim_WrongNumArgs(interp, 2, argv, "");
12917 return JIM_ERR;
12919 /* Count the number of free objects. */
12920 objPtr = interp->freeList;
12921 while (objPtr) {
12922 freeobj++;
12923 objPtr = objPtr->nextObjPtr;
12925 /* Count the number of live objects. */
12926 objPtr = interp->liveList;
12927 while (objPtr) {
12928 liveobj++;
12929 objPtr = objPtr->nextObjPtr;
12931 /* Set the result string and return. */
12932 sprintf(buf, "free %d used %d", freeobj, liveobj);
12933 Jim_SetResultString(interp, buf, -1);
12934 return JIM_OK;
12936 else if (option == OPT_OBJECTS) {
12937 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12939 /* Count the number of live objects. */
12940 objPtr = interp->liveList;
12941 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12942 while (objPtr) {
12943 char buf[128];
12944 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12946 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12947 sprintf(buf, "%p", objPtr);
12948 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12949 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12950 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12951 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12952 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12953 objPtr = objPtr->nextObjPtr;
12955 Jim_SetResult(interp, listObjPtr);
12956 return JIM_OK;
12958 else if (option == OPT_INVSTR) {
12959 Jim_Obj *objPtr;
12961 if (argc != 3) {
12962 Jim_WrongNumArgs(interp, 2, argv, "object");
12963 return JIM_ERR;
12965 objPtr = argv[2];
12966 if (objPtr->typePtr != NULL)
12967 Jim_InvalidateStringRep(objPtr);
12968 Jim_SetEmptyResult(interp);
12969 return JIM_OK;
12971 else if (option == OPT_SHOW) {
12972 const char *s;
12973 int len, charlen;
12975 if (argc != 3) {
12976 Jim_WrongNumArgs(interp, 2, argv, "object");
12977 return JIM_ERR;
12979 s = Jim_GetString(argv[2], &len);
12980 #ifdef JIM_UTF8
12981 charlen = utf8_strlen(s, len);
12982 #else
12983 charlen = len;
12984 #endif
12985 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12986 printf("chars (%d): <<%s>>\n", charlen, s);
12987 printf("bytes (%d):", len);
12988 while (len--) {
12989 printf(" %02x", (unsigned char)*s++);
12991 printf("\n");
12992 return JIM_OK;
12994 else if (option == OPT_SCRIPTLEN) {
12995 ScriptObj *script;
12997 if (argc != 3) {
12998 Jim_WrongNumArgs(interp, 2, argv, "script");
12999 return JIM_ERR;
13001 script = JimGetScript(interp, argv[2]);
13002 if (script == NULL)
13003 return JIM_ERR;
13004 Jim_SetResultInt(interp, script->len);
13005 return JIM_OK;
13007 else if (option == OPT_EXPRLEN) {
13008 ExprByteCode *expr;
13010 if (argc != 3) {
13011 Jim_WrongNumArgs(interp, 2, argv, "expression");
13012 return JIM_ERR;
13014 expr = JimGetExpression(interp, argv[2]);
13015 if (expr == NULL)
13016 return JIM_ERR;
13017 Jim_SetResultInt(interp, expr->len);
13018 return JIM_OK;
13020 else if (option == OPT_EXPRBC) {
13021 Jim_Obj *objPtr;
13022 ExprByteCode *expr;
13023 int i;
13025 if (argc != 3) {
13026 Jim_WrongNumArgs(interp, 2, argv, "expression");
13027 return JIM_ERR;
13029 expr = JimGetExpression(interp, argv[2]);
13030 if (expr == NULL)
13031 return JIM_ERR;
13032 objPtr = Jim_NewListObj(interp, NULL, 0);
13033 for (i = 0; i < expr->len; i++) {
13034 const char *type;
13035 const Jim_ExprOperator *op;
13036 Jim_Obj *obj = expr->token[i].objPtr;
13038 switch (expr->token[i].type) {
13039 case JIM_TT_EXPR_INT:
13040 type = "int";
13041 break;
13042 case JIM_TT_EXPR_DOUBLE:
13043 type = "double";
13044 break;
13045 case JIM_TT_EXPR_BOOLEAN:
13046 type = "boolean";
13047 break;
13048 case JIM_TT_CMD:
13049 type = "command";
13050 break;
13051 case JIM_TT_VAR:
13052 type = "variable";
13053 break;
13054 case JIM_TT_DICTSUGAR:
13055 type = "dictsugar";
13056 break;
13057 case JIM_TT_EXPRSUGAR:
13058 type = "exprsugar";
13059 break;
13060 case JIM_TT_ESC:
13061 type = "subst";
13062 break;
13063 case JIM_TT_STR:
13064 type = "string";
13065 break;
13066 default:
13067 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
13068 if (op == NULL) {
13069 type = "private";
13071 else {
13072 type = "operator";
13074 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
13075 break;
13077 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
13078 Jim_ListAppendElement(interp, objPtr, obj);
13080 Jim_SetResult(interp, objPtr);
13081 return JIM_OK;
13083 else {
13084 Jim_SetResultString(interp,
13085 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
13086 return JIM_ERR;
13088 /* unreached */
13089 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
13090 #if !defined(JIM_DEBUG_COMMAND)
13091 Jim_SetResultString(interp, "unsupported", -1);
13092 return JIM_ERR;
13093 #endif
13096 /* [eval] */
13097 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13099 int rc;
13101 if (argc < 2) {
13102 Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?");
13103 return JIM_ERR;
13106 if (argc == 2) {
13107 rc = Jim_EvalObj(interp, argv[1]);
13109 else {
13110 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13113 if (rc == JIM_ERR) {
13114 /* eval is "interesting", so add a stack frame here */
13115 interp->addStackTrace++;
13117 return rc;
13120 /* [uplevel] */
13121 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13123 if (argc >= 2) {
13124 int retcode;
13125 Jim_CallFrame *savedCallFrame, *targetCallFrame;
13126 const char *str;
13128 /* Save the old callframe pointer */
13129 savedCallFrame = interp->framePtr;
13131 /* Lookup the target frame pointer */
13132 str = Jim_String(argv[1]);
13133 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
13134 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13135 argc--;
13136 argv++;
13138 else {
13139 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13141 if (targetCallFrame == NULL) {
13142 return JIM_ERR;
13144 if (argc < 2) {
13145 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
13146 return JIM_ERR;
13148 /* Eval the code in the target callframe. */
13149 interp->framePtr = targetCallFrame;
13150 if (argc == 2) {
13151 retcode = Jim_EvalObj(interp, argv[1]);
13153 else {
13154 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13156 interp->framePtr = savedCallFrame;
13157 return retcode;
13159 else {
13160 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
13161 return JIM_ERR;
13165 /* [expr] */
13166 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13168 Jim_Obj *exprResultPtr;
13169 int retcode;
13171 if (argc == 2) {
13172 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
13174 else if (argc > 2) {
13175 Jim_Obj *objPtr;
13177 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
13178 Jim_IncrRefCount(objPtr);
13179 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
13180 Jim_DecrRefCount(interp, objPtr);
13182 else {
13183 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
13184 return JIM_ERR;
13186 if (retcode != JIM_OK)
13187 return retcode;
13188 Jim_SetResult(interp, exprResultPtr);
13189 Jim_DecrRefCount(interp, exprResultPtr);
13190 return JIM_OK;
13193 /* [break] */
13194 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13196 if (argc != 1) {
13197 Jim_WrongNumArgs(interp, 1, argv, "");
13198 return JIM_ERR;
13200 return JIM_BREAK;
13203 /* [continue] */
13204 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13206 if (argc != 1) {
13207 Jim_WrongNumArgs(interp, 1, argv, "");
13208 return JIM_ERR;
13210 return JIM_CONTINUE;
13213 /* [return] */
13214 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13216 int i;
13217 Jim_Obj *stackTraceObj = NULL;
13218 Jim_Obj *errorCodeObj = NULL;
13219 int returnCode = JIM_OK;
13220 long level = 1;
13222 for (i = 1; i < argc - 1; i += 2) {
13223 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13224 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13225 return JIM_ERR;
13228 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13229 stackTraceObj = argv[i + 1];
13231 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13232 errorCodeObj = argv[i + 1];
13234 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13235 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13236 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13237 return JIM_ERR;
13240 else {
13241 break;
13245 if (i != argc - 1 && i != argc) {
13246 Jim_WrongNumArgs(interp, 1, argv,
13247 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13250 /* If a stack trace is supplied and code is error, set the stack trace */
13251 if (stackTraceObj && returnCode == JIM_ERR) {
13252 JimSetStackTrace(interp, stackTraceObj);
13254 /* If an error code list is supplied, set the global $errorCode */
13255 if (errorCodeObj && returnCode == JIM_ERR) {
13256 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13258 interp->returnCode = returnCode;
13259 interp->returnLevel = level;
13261 if (i == argc - 1) {
13262 Jim_SetResult(interp, argv[i]);
13264 return JIM_RETURN;
13267 /* [tailcall] */
13268 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13270 if (interp->framePtr->level == 0) {
13271 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13272 return JIM_ERR;
13274 else if (argc >= 2) {
13275 /* Need to resolve the tailcall command in the current context */
13276 Jim_CallFrame *cf = interp->framePtr->parent;
13278 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13279 if (cmdPtr == NULL) {
13280 return JIM_ERR;
13283 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13285 /* And stash this pre-resolved command */
13286 JimIncrCmdRefCount(cmdPtr);
13287 cf->tailcallCmd = cmdPtr;
13289 /* And stash the command list */
13290 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13292 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13293 Jim_IncrRefCount(cf->tailcallObj);
13295 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13296 return JIM_EVAL;
13298 return JIM_OK;
13301 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13303 Jim_Obj *cmdList;
13304 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13306 /* prefixListObj is a list to which the args need to be appended */
13307 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13308 Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1);
13310 return JimEvalObjList(interp, cmdList);
13313 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13315 Jim_Obj *prefixListObj = privData;
13316 Jim_DecrRefCount(interp, prefixListObj);
13319 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13321 Jim_Obj *prefixListObj;
13322 const char *newname;
13324 if (argc < 3) {
13325 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13326 return JIM_ERR;
13329 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13330 Jim_IncrRefCount(prefixListObj);
13331 newname = Jim_String(argv[1]);
13332 if (newname[0] == ':' && newname[1] == ':') {
13333 while (*++newname == ':') {
13337 Jim_SetResult(interp, argv[1]);
13339 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13342 /* [proc] */
13343 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13345 Jim_Cmd *cmd;
13347 if (argc != 4 && argc != 5) {
13348 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13349 return JIM_ERR;
13352 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13353 return JIM_ERR;
13356 if (argc == 4) {
13357 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13359 else {
13360 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13363 if (cmd) {
13364 /* Add the new command */
13365 Jim_Obj *qualifiedCmdNameObj;
13366 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13368 JimCreateCommand(interp, cmdname, cmd);
13370 /* Calculate and set the namespace for this proc */
13371 JimUpdateProcNamespace(interp, cmd, cmdname);
13373 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13375 /* Unlike Tcl, set the name of the proc as the result */
13376 Jim_SetResult(interp, argv[1]);
13377 return JIM_OK;
13379 return JIM_ERR;
13382 /* [local] */
13383 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13385 int retcode;
13387 if (argc < 2) {
13388 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13389 return JIM_ERR;
13392 /* Evaluate the arguments with 'local' in force */
13393 interp->local++;
13394 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13395 interp->local--;
13398 /* If OK, and the result is a proc, add it to the list of local procs */
13399 if (retcode == 0) {
13400 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13402 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13403 return JIM_ERR;
13405 if (interp->framePtr->localCommands == NULL) {
13406 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13407 Jim_InitStack(interp->framePtr->localCommands);
13409 Jim_IncrRefCount(cmdNameObj);
13410 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13413 return retcode;
13416 /* [upcall] */
13417 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13419 if (argc < 2) {
13420 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13421 return JIM_ERR;
13423 else {
13424 int retcode;
13426 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13427 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13428 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13429 return JIM_ERR;
13431 /* OK. Mark this command as being in an upcall */
13432 cmdPtr->u.proc.upcall++;
13433 JimIncrCmdRefCount(cmdPtr);
13435 /* Invoke the command as normal */
13436 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13438 /* No longer in an upcall */
13439 cmdPtr->u.proc.upcall--;
13440 JimDecrCmdRefCount(interp, cmdPtr);
13442 return retcode;
13446 /* [apply] */
13447 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13449 if (argc < 2) {
13450 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13451 return JIM_ERR;
13453 else {
13454 int ret;
13455 Jim_Cmd *cmd;
13456 Jim_Obj *argListObjPtr;
13457 Jim_Obj *bodyObjPtr;
13458 Jim_Obj *nsObj = NULL;
13459 Jim_Obj **nargv;
13461 int len = Jim_ListLength(interp, argv[1]);
13462 if (len != 2 && len != 3) {
13463 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13464 return JIM_ERR;
13467 if (len == 3) {
13468 #ifdef jim_ext_namespace
13469 /* Need to canonicalise the given namespace. */
13470 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13471 #else
13472 Jim_SetResultString(interp, "namespaces not enabled", -1);
13473 return JIM_ERR;
13474 #endif
13476 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13477 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13479 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13481 if (cmd) {
13482 /* Create a new argv array with a dummy argv[0], for error messages */
13483 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13484 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13485 Jim_IncrRefCount(nargv[0]);
13486 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13487 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13488 Jim_DecrRefCount(interp, nargv[0]);
13489 Jim_Free(nargv);
13491 JimDecrCmdRefCount(interp, cmd);
13492 return ret;
13494 return JIM_ERR;
13499 /* [concat] */
13500 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13502 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13503 return JIM_OK;
13506 /* [upvar] */
13507 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13509 int i;
13510 Jim_CallFrame *targetCallFrame;
13512 /* Lookup the target frame pointer */
13513 if (argc > 3 && (argc % 2 == 0)) {
13514 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13515 argc--;
13516 argv++;
13518 else {
13519 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13521 if (targetCallFrame == NULL) {
13522 return JIM_ERR;
13525 /* Check for arity */
13526 if (argc < 3) {
13527 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13528 return JIM_ERR;
13531 /* Now... for every other/local couple: */
13532 for (i = 1; i < argc; i += 2) {
13533 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13534 return JIM_ERR;
13536 return JIM_OK;
13539 /* [global] */
13540 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13542 int i;
13544 if (argc < 2) {
13545 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13546 return JIM_ERR;
13548 /* Link every var to the toplevel having the same name */
13549 if (interp->framePtr->level == 0)
13550 return JIM_OK; /* global at toplevel... */
13551 for (i = 1; i < argc; i++) {
13552 /* global ::blah does nothing */
13553 const char *name = Jim_String(argv[i]);
13554 if (name[0] != ':' || name[1] != ':') {
13555 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13556 return JIM_ERR;
13559 return JIM_OK;
13562 /* does the [string map] operation. On error NULL is returned,
13563 * otherwise a new string object with the result, having refcount = 0,
13564 * is returned. */
13565 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13566 Jim_Obj *objPtr, int nocase)
13568 int numMaps;
13569 const char *str, *noMatchStart = NULL;
13570 int strLen, i;
13571 Jim_Obj *resultObjPtr;
13573 numMaps = Jim_ListLength(interp, mapListObjPtr);
13574 if (numMaps % 2) {
13575 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13576 return NULL;
13579 str = Jim_String(objPtr);
13580 strLen = Jim_Utf8Length(interp, objPtr);
13582 /* Map it */
13583 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13584 while (strLen) {
13585 for (i = 0; i < numMaps; i += 2) {
13586 Jim_Obj *eachObjPtr;
13587 const char *k;
13588 int kl;
13590 eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i);
13591 k = Jim_String(eachObjPtr);
13592 kl = Jim_Utf8Length(interp, eachObjPtr);
13594 if (strLen >= kl && kl) {
13595 int rc;
13596 rc = JimStringCompareLen(str, k, kl, nocase);
13597 if (rc == 0) {
13598 if (noMatchStart) {
13599 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13600 noMatchStart = NULL;
13602 Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1));
13603 str += utf8_index(str, kl);
13604 strLen -= kl;
13605 break;
13609 if (i == numMaps) { /* no match */
13610 int c;
13611 if (noMatchStart == NULL)
13612 noMatchStart = str;
13613 str += utf8_tounicode(str, &c);
13614 strLen--;
13617 if (noMatchStart) {
13618 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13620 return resultObjPtr;
13623 /* [string] */
13624 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13626 int len;
13627 int opt_case = 1;
13628 int option;
13629 static const char * const options[] = {
13630 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13631 "map", "repeat", "reverse", "index", "first", "last", "cat",
13632 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13634 enum
13636 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13637 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT,
13638 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13640 static const char * const nocase_options[] = {
13641 "-nocase", NULL
13643 static const char * const nocase_length_options[] = {
13644 "-nocase", "-length", NULL
13647 if (argc < 2) {
13648 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13649 return JIM_ERR;
13651 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13652 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13653 return Jim_CheckShowCommands(interp, argv[1], options);
13655 switch (option) {
13656 case OPT_LENGTH:
13657 case OPT_BYTELENGTH:
13658 if (argc != 3) {
13659 Jim_WrongNumArgs(interp, 2, argv, "string");
13660 return JIM_ERR;
13662 if (option == OPT_LENGTH) {
13663 len = Jim_Utf8Length(interp, argv[2]);
13665 else {
13666 len = Jim_Length(argv[2]);
13668 Jim_SetResultInt(interp, len);
13669 return JIM_OK;
13671 case OPT_CAT:{
13672 Jim_Obj *objPtr;
13673 if (argc == 3) {
13674 /* optimise the one-arg case */
13675 objPtr = argv[2];
13677 else {
13678 int i;
13680 objPtr = Jim_NewStringObj(interp, "", 0);
13682 for (i = 2; i < argc; i++) {
13683 Jim_AppendObj(interp, objPtr, argv[i]);
13686 Jim_SetResult(interp, objPtr);
13687 return JIM_OK;
13690 case OPT_COMPARE:
13691 case OPT_EQUAL:
13693 /* n is the number of remaining option args */
13694 long opt_length = -1;
13695 int n = argc - 4;
13696 int i = 2;
13697 while (n > 0) {
13698 int subopt;
13699 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13700 JIM_ENUM_ABBREV) != JIM_OK) {
13701 badcompareargs:
13702 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13703 return JIM_ERR;
13705 if (subopt == 0) {
13706 /* -nocase */
13707 opt_case = 0;
13708 n--;
13710 else {
13711 /* -length */
13712 if (n < 2) {
13713 goto badcompareargs;
13715 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13716 return JIM_ERR;
13718 n -= 2;
13721 if (n) {
13722 goto badcompareargs;
13724 argv += argc - 2;
13725 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13726 /* Fast version - [string equal], case sensitive, no length */
13727 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13729 else {
13730 if (opt_length >= 0) {
13731 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13733 else {
13734 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13736 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13738 return JIM_OK;
13741 case OPT_MATCH:
13742 if (argc != 4 &&
13743 (argc != 5 ||
13744 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13745 JIM_ENUM_ABBREV) != JIM_OK)) {
13746 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13747 return JIM_ERR;
13749 if (opt_case == 0) {
13750 argv++;
13752 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13753 return JIM_OK;
13755 case OPT_MAP:{
13756 Jim_Obj *objPtr;
13758 if (argc != 4 &&
13759 (argc != 5 ||
13760 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13761 JIM_ENUM_ABBREV) != JIM_OK)) {
13762 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13763 return JIM_ERR;
13766 if (opt_case == 0) {
13767 argv++;
13769 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13770 if (objPtr == NULL) {
13771 return JIM_ERR;
13773 Jim_SetResult(interp, objPtr);
13774 return JIM_OK;
13777 case OPT_RANGE:
13778 case OPT_BYTERANGE:{
13779 Jim_Obj *objPtr;
13781 if (argc != 5) {
13782 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13783 return JIM_ERR;
13785 if (option == OPT_RANGE) {
13786 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13788 else
13790 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13793 if (objPtr == NULL) {
13794 return JIM_ERR;
13796 Jim_SetResult(interp, objPtr);
13797 return JIM_OK;
13800 case OPT_REPLACE:{
13801 Jim_Obj *objPtr;
13803 if (argc != 5 && argc != 6) {
13804 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13805 return JIM_ERR;
13807 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13808 if (objPtr == NULL) {
13809 return JIM_ERR;
13811 Jim_SetResult(interp, objPtr);
13812 return JIM_OK;
13816 case OPT_REPEAT:{
13817 Jim_Obj *objPtr;
13818 jim_wide count;
13820 if (argc != 4) {
13821 Jim_WrongNumArgs(interp, 2, argv, "string count");
13822 return JIM_ERR;
13824 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13825 return JIM_ERR;
13827 objPtr = Jim_NewStringObj(interp, "", 0);
13828 if (count > 0) {
13829 while (count--) {
13830 Jim_AppendObj(interp, objPtr, argv[2]);
13833 Jim_SetResult(interp, objPtr);
13834 return JIM_OK;
13837 case OPT_REVERSE:{
13838 char *buf, *p;
13839 const char *str;
13840 int i;
13842 if (argc != 3) {
13843 Jim_WrongNumArgs(interp, 2, argv, "string");
13844 return JIM_ERR;
13847 str = Jim_GetString(argv[2], &len);
13848 buf = Jim_Alloc(len + 1);
13849 p = buf + len;
13850 *p = 0;
13851 for (i = 0; i < len; ) {
13852 int c;
13853 int l = utf8_tounicode(str, &c);
13854 memcpy(p - l, str, l);
13855 p -= l;
13856 i += l;
13857 str += l;
13859 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13860 return JIM_OK;
13863 case OPT_INDEX:{
13864 int idx;
13865 const char *str;
13867 if (argc != 4) {
13868 Jim_WrongNumArgs(interp, 2, argv, "string index");
13869 return JIM_ERR;
13871 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13872 return JIM_ERR;
13874 str = Jim_String(argv[2]);
13875 len = Jim_Utf8Length(interp, argv[2]);
13876 if (idx != INT_MIN && idx != INT_MAX) {
13877 idx = JimRelToAbsIndex(len, idx);
13879 if (idx < 0 || idx >= len || str == NULL) {
13880 Jim_SetResultString(interp, "", 0);
13882 else if (len == Jim_Length(argv[2])) {
13883 /* ASCII optimisation */
13884 Jim_SetResultString(interp, str + idx, 1);
13886 else {
13887 int c;
13888 int i = utf8_index(str, idx);
13889 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13891 return JIM_OK;
13894 case OPT_FIRST:
13895 case OPT_LAST:{
13896 int idx = 0, l1, l2;
13897 const char *s1, *s2;
13899 if (argc != 4 && argc != 5) {
13900 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13901 return JIM_ERR;
13903 s1 = Jim_String(argv[2]);
13904 s2 = Jim_String(argv[3]);
13905 l1 = Jim_Utf8Length(interp, argv[2]);
13906 l2 = Jim_Utf8Length(interp, argv[3]);
13907 if (argc == 5) {
13908 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13909 return JIM_ERR;
13911 idx = JimRelToAbsIndex(l2, idx);
13913 else if (option == OPT_LAST) {
13914 idx = l2;
13916 if (option == OPT_FIRST) {
13917 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13919 else {
13920 #ifdef JIM_UTF8
13921 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13922 #else
13923 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13924 #endif
13926 return JIM_OK;
13929 case OPT_TRIM:
13930 case OPT_TRIMLEFT:
13931 case OPT_TRIMRIGHT:{
13932 Jim_Obj *trimchars;
13934 if (argc != 3 && argc != 4) {
13935 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13936 return JIM_ERR;
13938 trimchars = (argc == 4 ? argv[3] : NULL);
13939 if (option == OPT_TRIM) {
13940 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13942 else if (option == OPT_TRIMLEFT) {
13943 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13945 else if (option == OPT_TRIMRIGHT) {
13946 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13948 return JIM_OK;
13951 case OPT_TOLOWER:
13952 case OPT_TOUPPER:
13953 case OPT_TOTITLE:
13954 if (argc != 3) {
13955 Jim_WrongNumArgs(interp, 2, argv, "string");
13956 return JIM_ERR;
13958 if (option == OPT_TOLOWER) {
13959 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13961 else if (option == OPT_TOUPPER) {
13962 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13964 else {
13965 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13967 return JIM_OK;
13969 case OPT_IS:
13970 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13971 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13973 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13974 return JIM_ERR;
13976 return JIM_OK;
13979 /* [time] */
13980 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13982 long i, count = 1;
13983 jim_wide start, elapsed;
13984 char buf[60];
13985 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13987 if (argc < 2) {
13988 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13989 return JIM_ERR;
13991 if (argc == 3) {
13992 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13993 return JIM_ERR;
13995 if (count < 0)
13996 return JIM_OK;
13997 i = count;
13998 start = JimClock();
13999 while (i-- > 0) {
14000 int retval;
14002 retval = Jim_EvalObj(interp, argv[1]);
14003 if (retval != JIM_OK) {
14004 return retval;
14007 elapsed = JimClock() - start;
14008 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
14009 Jim_SetResultString(interp, buf, -1);
14010 return JIM_OK;
14013 /* [exit] */
14014 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14016 long exitCode = 0;
14018 if (argc > 2) {
14019 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
14020 return JIM_ERR;
14022 if (argc == 2) {
14023 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
14024 return JIM_ERR;
14026 interp->exitCode = exitCode;
14027 return JIM_EXIT;
14030 /* [catch] */
14031 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14033 int exitCode = 0;
14034 int i;
14035 int sig = 0;
14037 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
14038 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
14039 static const int max_ignore_code = sizeof(ignore_mask) * 8;
14041 /* Reset the error code before catch.
14042 * Note that this is not strictly correct.
14044 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
14046 for (i = 1; i < argc - 1; i++) {
14047 const char *arg = Jim_String(argv[i]);
14048 jim_wide option;
14049 int ignore;
14051 /* It's a pity we can't use Jim_GetEnum here :-( */
14052 if (strcmp(arg, "--") == 0) {
14053 i++;
14054 break;
14056 if (*arg != '-') {
14057 break;
14060 if (strncmp(arg, "-no", 3) == 0) {
14061 arg += 3;
14062 ignore = 1;
14064 else {
14065 arg++;
14066 ignore = 0;
14069 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
14070 option = -1;
14072 if (option < 0) {
14073 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
14075 if (option < 0) {
14076 goto wrongargs;
14079 if (ignore) {
14080 ignore_mask |= ((jim_wide)1 << option);
14082 else {
14083 ignore_mask &= (~((jim_wide)1 << option));
14087 argc -= i;
14088 if (argc < 1 || argc > 3) {
14089 wrongargs:
14090 Jim_WrongNumArgs(interp, 1, argv,
14091 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
14092 return JIM_ERR;
14094 argv += i;
14096 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
14097 sig++;
14100 interp->signal_level += sig;
14101 if (Jim_CheckSignal(interp)) {
14102 /* If a signal is set, don't even try to execute the body */
14103 exitCode = JIM_SIGNAL;
14105 else {
14106 exitCode = Jim_EvalObj(interp, argv[0]);
14107 /* Don't want any caught error included in a later stack trace */
14108 interp->errorFlag = 0;
14110 interp->signal_level -= sig;
14112 /* Catch or pass through? Only the first 32/64 codes can be passed through */
14113 if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
14114 /* Not caught, pass it up */
14115 return exitCode;
14118 if (sig && exitCode == JIM_SIGNAL) {
14119 /* Catch the signal at this level */
14120 if (interp->signal_set_result) {
14121 interp->signal_set_result(interp, interp->sigmask);
14123 else {
14124 Jim_SetResultInt(interp, interp->sigmask);
14126 interp->sigmask = 0;
14129 if (argc >= 2) {
14130 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
14131 return JIM_ERR;
14133 if (argc == 3) {
14134 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
14136 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
14137 Jim_ListAppendElement(interp, optListObj,
14138 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
14139 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
14140 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
14141 if (exitCode == JIM_ERR) {
14142 Jim_Obj *errorCode;
14143 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
14144 -1));
14145 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
14147 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
14148 if (errorCode) {
14149 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
14150 Jim_ListAppendElement(interp, optListObj, errorCode);
14153 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
14154 return JIM_ERR;
14158 Jim_SetResultInt(interp, exitCode);
14159 return JIM_OK;
14162 #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)
14164 /* [ref] */
14165 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14167 if (argc != 3 && argc != 4) {
14168 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
14169 return JIM_ERR;
14171 if (argc == 3) {
14172 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
14174 else {
14175 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
14177 return JIM_OK;
14180 /* [getref] */
14181 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14183 Jim_Reference *refPtr;
14185 if (argc != 2) {
14186 Jim_WrongNumArgs(interp, 1, argv, "reference");
14187 return JIM_ERR;
14189 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14190 return JIM_ERR;
14191 Jim_SetResult(interp, refPtr->objPtr);
14192 return JIM_OK;
14195 /* [setref] */
14196 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14198 Jim_Reference *refPtr;
14200 if (argc != 3) {
14201 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
14202 return JIM_ERR;
14204 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
14205 return JIM_ERR;
14206 Jim_IncrRefCount(argv[2]);
14207 Jim_DecrRefCount(interp, refPtr->objPtr);
14208 refPtr->objPtr = argv[2];
14209 Jim_SetResult(interp, argv[2]);
14210 return JIM_OK;
14213 /* [collect] */
14214 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14216 if (argc != 1) {
14217 Jim_WrongNumArgs(interp, 1, argv, "");
14218 return JIM_ERR;
14220 Jim_SetResultInt(interp, Jim_Collect(interp));
14222 /* Free all the freed objects. */
14223 while (interp->freeList) {
14224 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
14225 Jim_Free(interp->freeList);
14226 interp->freeList = nextObjPtr;
14229 return JIM_OK;
14232 /* [finalize] reference ?newValue? */
14233 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14235 if (argc != 2 && argc != 3) {
14236 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14237 return JIM_ERR;
14239 if (argc == 2) {
14240 Jim_Obj *cmdNamePtr;
14242 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14243 return JIM_ERR;
14244 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14245 Jim_SetResult(interp, cmdNamePtr);
14247 else {
14248 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14249 return JIM_ERR;
14250 Jim_SetResult(interp, argv[2]);
14252 return JIM_OK;
14255 /* [info references] */
14256 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14258 Jim_Obj *listObjPtr;
14259 Jim_HashTableIterator htiter;
14260 Jim_HashEntry *he;
14262 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14264 JimInitHashTableIterator(&interp->references, &htiter);
14265 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14266 char buf[JIM_REFERENCE_SPACE + 1];
14267 Jim_Reference *refPtr = Jim_GetHashEntryVal(he);
14268 const unsigned long *refId = he->key;
14270 JimFormatReference(buf, refPtr, *refId);
14271 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14273 Jim_SetResult(interp, listObjPtr);
14274 return JIM_OK;
14276 #endif /* JIM_REFERENCES && !JIM_BOOTSTRAP */
14278 /* [rename] */
14279 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14281 if (argc != 3) {
14282 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14283 return JIM_ERR;
14286 if (JimValidName(interp, "new procedure", argv[2])) {
14287 return JIM_ERR;
14290 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14293 #define JIM_DICTMATCH_KEYS 0x0001
14294 #define JIM_DICTMATCH_VALUES 0x002
14297 * match_type must be one of JIM_DICTMATCH_KEYS or JIM_DICTMATCH_VALUES
14298 * return_types should be either or both
14300 int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14302 Jim_HashEntry *he;
14303 Jim_Obj *listObjPtr;
14304 Jim_HashTableIterator htiter;
14306 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14307 return JIM_ERR;
14310 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14312 JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14313 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14314 if (patternObj) {
14315 Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he);
14316 if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
14317 /* no match */
14318 continue;
14321 if (return_types & JIM_DICTMATCH_KEYS) {
14322 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14324 if (return_types & JIM_DICTMATCH_VALUES) {
14325 Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
14329 Jim_SetResult(interp, listObjPtr);
14330 return JIM_OK;
14333 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14335 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14336 return -1;
14338 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14342 * Must be called with at least one object.
14343 * Returns the new dictionary, or NULL on error.
14345 Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
14347 Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0);
14348 int i;
14350 JimPanic((objc == 0, "Jim_DictMerge called with objc=0"));
14352 /* Note that we don't optimise the trivial case of a single argument */
14354 for (i = 0; i < objc; i++) {
14355 Jim_HashTable *ht;
14356 Jim_HashTableIterator htiter;
14357 Jim_HashEntry *he;
14359 if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
14360 Jim_FreeNewObj(interp, objPtr);
14361 return NULL;
14363 ht = objv[i]->internalRep.ptr;
14364 JimInitHashTableIterator(ht, &htiter);
14365 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14366 Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
14369 return objPtr;
14372 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14374 Jim_HashTable *ht;
14375 unsigned int i;
14376 char buffer[100];
14377 int sum = 0;
14378 int nonzero_count = 0;
14379 Jim_Obj *output;
14380 int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
14382 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14383 return JIM_ERR;
14386 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14388 /* Note that this uses internal knowledge of the hash table */
14389 snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
14390 output = Jim_NewStringObj(interp, buffer, -1);
14392 for (i = 0; i < ht->size; i++) {
14393 Jim_HashEntry *he = ht->table[i];
14394 int entries = 0;
14395 while (he) {
14396 entries++;
14397 he = he->next;
14399 if (entries > 9) {
14400 bucket_counts[10]++;
14402 else {
14403 bucket_counts[entries]++;
14405 if (entries) {
14406 sum += entries;
14407 nonzero_count++;
14410 for (i = 0; i < 10; i++) {
14411 snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14412 Jim_AppendString(interp, output, buffer, -1);
14414 snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14415 Jim_AppendString(interp, output, buffer, -1);
14416 snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14417 Jim_AppendString(interp, output, buffer, -1);
14418 Jim_SetResult(interp, output);
14419 return JIM_OK;
14422 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14424 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14426 Jim_AppendString(interp, prefixObj, " ", 1);
14427 Jim_AppendString(interp, prefixObj, subcmd, -1);
14429 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14433 * Implements the [dict with] command
14435 static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj)
14437 int i;
14438 Jim_Obj *objPtr;
14439 Jim_Obj *dictObj;
14440 Jim_Obj **dictValues;
14441 int len;
14442 int ret = JIM_OK;
14444 /* Open up the appropriate level of the dictionary */
14445 dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG);
14446 if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) {
14447 return JIM_ERR;
14449 /* Set the local variables */
14450 if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
14451 return JIM_ERR;
14453 for (i = 0; i < len; i += 2) {
14454 if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14455 Jim_Free(dictValues);
14456 return JIM_ERR;
14460 /* As an optimisation, if the script is empty, no need to evaluate it or update the dict */
14461 if (Jim_Length(scriptObj)) {
14462 ret = Jim_EvalObj(interp, scriptObj);
14464 /* Now if the dictionary still exists, update it based on the local variables */
14465 if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) {
14466 /* We need a copy of keyv with one extra element at the end for Jim_SetDictKeysVector() */
14467 Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1));
14468 for (i = 0; i < keyc; i++) {
14469 newkeyv[i] = keyv[i];
14472 for (i = 0; i < len; i += 2) {
14473 /* This will be NULL if the variable no longer exists, thus deleting the variable */
14474 objPtr = Jim_GetVariable(interp, dictValues[i], 0);
14475 newkeyv[keyc] = dictValues[i];
14476 Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0);
14478 Jim_Free(newkeyv);
14482 Jim_Free(dictValues);
14484 return ret;
14487 /* [dict] */
14488 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14490 Jim_Obj *objPtr;
14491 int types = JIM_DICTMATCH_KEYS;
14492 int option;
14493 static const char * const options[] = {
14494 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14495 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14496 "replace", "update", NULL
14498 enum
14500 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14501 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14502 OPT_REPLACE, OPT_UPDATE,
14505 if (argc < 2) {
14506 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14507 return JIM_ERR;
14510 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14511 return Jim_CheckShowCommands(interp, argv[1], options);
14514 switch (option) {
14515 case OPT_GET:
14516 if (argc < 3) {
14517 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14518 return JIM_ERR;
14520 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14521 JIM_ERRMSG) != JIM_OK) {
14522 return JIM_ERR;
14524 Jim_SetResult(interp, objPtr);
14525 return JIM_OK;
14527 case OPT_SET:
14528 if (argc < 5) {
14529 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14530 return JIM_ERR;
14532 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14534 case OPT_EXISTS:
14535 if (argc < 4) {
14536 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14537 return JIM_ERR;
14539 else {
14540 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14541 if (rc < 0) {
14542 return JIM_ERR;
14544 Jim_SetResultBool(interp, rc == JIM_OK);
14545 return JIM_OK;
14548 case OPT_UNSET:
14549 if (argc < 4) {
14550 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14551 return JIM_ERR;
14553 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14554 return JIM_ERR;
14556 return JIM_OK;
14558 case OPT_VALUES:
14559 types = JIM_DICTMATCH_VALUES;
14560 /* fallthru */
14561 case OPT_KEYS:
14562 if (argc != 3 && argc != 4) {
14563 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14564 return JIM_ERR;
14566 return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types);
14568 case OPT_SIZE:
14569 if (argc != 3) {
14570 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14571 return JIM_ERR;
14573 else if (Jim_DictSize(interp, argv[2]) < 0) {
14574 return JIM_ERR;
14576 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14577 return JIM_OK;
14579 case OPT_MERGE:
14580 if (argc == 2) {
14581 return JIM_OK;
14583 objPtr = Jim_DictMerge(interp, argc - 2, argv + 2);
14584 if (objPtr == NULL) {
14585 return JIM_ERR;
14587 Jim_SetResult(interp, objPtr);
14588 return JIM_OK;
14590 case OPT_UPDATE:
14591 if (argc < 6 || argc % 2) {
14592 /* Better error message */
14593 argc = 2;
14595 break;
14597 case OPT_CREATE:
14598 if (argc % 2) {
14599 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14600 return JIM_ERR;
14602 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14603 Jim_SetResult(interp, objPtr);
14604 return JIM_OK;
14606 case OPT_INFO:
14607 if (argc != 3) {
14608 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14609 return JIM_ERR;
14611 return Jim_DictInfo(interp, argv[2]);
14613 case OPT_WITH:
14614 if (argc < 4) {
14615 Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script");
14616 return JIM_ERR;
14618 return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]);
14620 /* Handle command as an ensemble */
14621 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14624 /* [subst] */
14625 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14627 static const char * const options[] = {
14628 "-nobackslashes", "-nocommands", "-novariables", NULL
14630 enum
14631 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14632 int i;
14633 int flags = JIM_SUBST_FLAG;
14634 Jim_Obj *objPtr;
14636 if (argc < 2) {
14637 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14638 return JIM_ERR;
14640 for (i = 1; i < (argc - 1); i++) {
14641 int option;
14643 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14644 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14645 return JIM_ERR;
14647 switch (option) {
14648 case OPT_NOBACKSLASHES:
14649 flags |= JIM_SUBST_NOESC;
14650 break;
14651 case OPT_NOCOMMANDS:
14652 flags |= JIM_SUBST_NOCMD;
14653 break;
14654 case OPT_NOVARIABLES:
14655 flags |= JIM_SUBST_NOVAR;
14656 break;
14659 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14660 return JIM_ERR;
14662 Jim_SetResult(interp, objPtr);
14663 return JIM_OK;
14666 /* [info] */
14667 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14669 int cmd;
14670 Jim_Obj *objPtr;
14671 int mode = 0;
14673 static const char * const commands[] = {
14674 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14675 "vars", "version", "patchlevel", "complete", "args", "hostname",
14676 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14677 "references", "alias", NULL
14679 enum
14680 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14681 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14682 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14683 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14686 #ifdef jim_ext_namespace
14687 int nons = 0;
14689 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14690 /* This is for internal use only */
14691 argc--;
14692 argv++;
14693 nons = 1;
14695 #endif
14697 if (argc < 2) {
14698 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14699 return JIM_ERR;
14701 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14702 return Jim_CheckShowCommands(interp, argv[1], commands);
14705 /* Test for the most common commands first, just in case it makes a difference */
14706 switch (cmd) {
14707 case INFO_EXISTS:
14708 if (argc != 3) {
14709 Jim_WrongNumArgs(interp, 2, argv, "varName");
14710 return JIM_ERR;
14712 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14713 break;
14715 case INFO_ALIAS:{
14716 Jim_Cmd *cmdPtr;
14718 if (argc != 3) {
14719 Jim_WrongNumArgs(interp, 2, argv, "command");
14720 return JIM_ERR;
14722 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14723 return JIM_ERR;
14725 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14726 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14727 return JIM_ERR;
14729 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14730 return JIM_OK;
14733 case INFO_CHANNELS:
14734 mode++; /* JIM_CMDLIST_CHANNELS */
14735 #ifndef jim_ext_aio
14736 Jim_SetResultString(interp, "aio not enabled", -1);
14737 return JIM_ERR;
14738 #endif
14739 /* fall through */
14740 case INFO_PROCS:
14741 mode++; /* JIM_CMDLIST_PROCS */
14742 /* fall through */
14743 case INFO_COMMANDS:
14744 /* mode 0 => JIM_CMDLIST_COMMANDS */
14745 if (argc != 2 && argc != 3) {
14746 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14747 return JIM_ERR;
14749 #ifdef jim_ext_namespace
14750 if (!nons) {
14751 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14752 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14755 #endif
14756 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14757 break;
14759 case INFO_VARS:
14760 mode++; /* JIM_VARLIST_VARS */
14761 /* fall through */
14762 case INFO_LOCALS:
14763 mode++; /* JIM_VARLIST_LOCALS */
14764 /* fall through */
14765 case INFO_GLOBALS:
14766 /* mode 0 => JIM_VARLIST_GLOBALS */
14767 if (argc != 2 && argc != 3) {
14768 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14769 return JIM_ERR;
14771 #ifdef jim_ext_namespace
14772 if (!nons) {
14773 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14774 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14777 #endif
14778 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14779 break;
14781 case INFO_SCRIPT:
14782 if (argc != 2) {
14783 Jim_WrongNumArgs(interp, 2, argv, "");
14784 return JIM_ERR;
14786 Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj);
14787 break;
14789 case INFO_SOURCE:{
14790 jim_wide line;
14791 Jim_Obj *resObjPtr;
14792 Jim_Obj *fileNameObj;
14794 if (argc != 3 && argc != 5) {
14795 Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
14796 return JIM_ERR;
14798 if (argc == 5) {
14799 if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
14800 return JIM_ERR;
14802 resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
14803 JimSetSourceInfo(interp, resObjPtr, argv[3], line);
14805 else {
14806 if (argv[2]->typePtr == &sourceObjType) {
14807 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14808 line = argv[2]->internalRep.sourceValue.lineNumber;
14810 else if (argv[2]->typePtr == &scriptObjType) {
14811 ScriptObj *script = JimGetScript(interp, argv[2]);
14812 fileNameObj = script->fileNameObj;
14813 line = script->firstline;
14815 else {
14816 fileNameObj = interp->emptyObj;
14817 line = 1;
14819 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14820 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14821 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14823 Jim_SetResult(interp, resObjPtr);
14824 break;
14827 case INFO_STACKTRACE:
14828 Jim_SetResult(interp, interp->stackTrace);
14829 break;
14831 case INFO_LEVEL:
14832 case INFO_FRAME:
14833 switch (argc) {
14834 case 2:
14835 Jim_SetResultInt(interp, interp->framePtr->level);
14836 break;
14838 case 3:
14839 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14840 return JIM_ERR;
14842 Jim_SetResult(interp, objPtr);
14843 break;
14845 default:
14846 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14847 return JIM_ERR;
14849 break;
14851 case INFO_BODY:
14852 case INFO_STATICS:
14853 case INFO_ARGS:{
14854 Jim_Cmd *cmdPtr;
14856 if (argc != 3) {
14857 Jim_WrongNumArgs(interp, 2, argv, "procname");
14858 return JIM_ERR;
14860 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14861 return JIM_ERR;
14863 if (!cmdPtr->isproc) {
14864 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14865 return JIM_ERR;
14867 switch (cmd) {
14868 case INFO_BODY:
14869 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14870 break;
14871 case INFO_ARGS:
14872 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14873 break;
14874 case INFO_STATICS:
14875 if (cmdPtr->u.proc.staticVars) {
14876 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14877 NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES));
14879 break;
14881 break;
14884 case INFO_VERSION:
14885 case INFO_PATCHLEVEL:{
14886 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14888 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14889 Jim_SetResultString(interp, buf, -1);
14890 break;
14893 case INFO_COMPLETE:
14894 if (argc != 3 && argc != 4) {
14895 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14896 return JIM_ERR;
14898 else {
14899 char missing;
14901 Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing));
14902 if (missing != ' ' && argc == 4) {
14903 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14906 break;
14908 case INFO_HOSTNAME:
14909 /* Redirect to os.gethostname if it exists */
14910 return Jim_Eval(interp, "os.gethostname");
14912 case INFO_NAMEOFEXECUTABLE:
14913 /* Redirect to Tcl proc */
14914 return Jim_Eval(interp, "{info nameofexecutable}");
14916 case INFO_RETURNCODES:
14917 if (argc == 2) {
14918 int i;
14919 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14921 for (i = 0; jimReturnCodes[i]; i++) {
14922 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14923 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14924 jimReturnCodes[i], -1));
14927 Jim_SetResult(interp, listObjPtr);
14929 else if (argc == 3) {
14930 long code;
14931 const char *name;
14933 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14934 return JIM_ERR;
14936 name = Jim_ReturnCode(code);
14937 if (*name == '?') {
14938 Jim_SetResultInt(interp, code);
14940 else {
14941 Jim_SetResultString(interp, name, -1);
14944 else {
14945 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14946 return JIM_ERR;
14948 break;
14949 case INFO_REFERENCES:
14950 #ifdef JIM_REFERENCES
14951 return JimInfoReferences(interp, argc, argv);
14952 #else
14953 Jim_SetResultString(interp, "not supported", -1);
14954 return JIM_ERR;
14955 #endif
14957 return JIM_OK;
14960 /* [exists] */
14961 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14963 Jim_Obj *objPtr;
14964 int result = 0;
14966 static const char * const options[] = {
14967 "-command", "-proc", "-alias", "-var", NULL
14969 enum
14971 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14973 int option;
14975 if (argc == 2) {
14976 option = OPT_VAR;
14977 objPtr = argv[1];
14979 else if (argc == 3) {
14980 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14981 return JIM_ERR;
14983 objPtr = argv[2];
14985 else {
14986 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14987 return JIM_ERR;
14990 if (option == OPT_VAR) {
14991 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14993 else {
14994 /* Now different kinds of commands */
14995 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14997 if (cmd) {
14998 switch (option) {
14999 case OPT_COMMAND:
15000 result = 1;
15001 break;
15003 case OPT_ALIAS:
15004 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
15005 break;
15007 case OPT_PROC:
15008 result = cmd->isproc;
15009 break;
15013 Jim_SetResultBool(interp, result);
15014 return JIM_OK;
15017 /* [split] */
15018 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15020 const char *str, *splitChars, *noMatchStart;
15021 int splitLen, strLen;
15022 Jim_Obj *resObjPtr;
15023 int c;
15024 int len;
15026 if (argc != 2 && argc != 3) {
15027 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
15028 return JIM_ERR;
15031 str = Jim_GetString(argv[1], &len);
15032 if (len == 0) {
15033 return JIM_OK;
15035 strLen = Jim_Utf8Length(interp, argv[1]);
15037 /* Init */
15038 if (argc == 2) {
15039 splitChars = " \n\t\r";
15040 splitLen = 4;
15042 else {
15043 splitChars = Jim_String(argv[2]);
15044 splitLen = Jim_Utf8Length(interp, argv[2]);
15047 noMatchStart = str;
15048 resObjPtr = Jim_NewListObj(interp, NULL, 0);
15050 /* Split */
15051 if (splitLen) {
15052 Jim_Obj *objPtr;
15053 while (strLen--) {
15054 const char *sc = splitChars;
15055 int scLen = splitLen;
15056 int sl = utf8_tounicode(str, &c);
15057 while (scLen--) {
15058 int pc;
15059 sc += utf8_tounicode(sc, &pc);
15060 if (c == pc) {
15061 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
15062 Jim_ListAppendElement(interp, resObjPtr, objPtr);
15063 noMatchStart = str + sl;
15064 break;
15067 str += sl;
15069 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
15070 Jim_ListAppendElement(interp, resObjPtr, objPtr);
15072 else {
15073 /* This handles the special case of splitchars eq {}
15074 * Optimise by sharing common (ASCII) characters
15076 Jim_Obj **commonObj = NULL;
15077 #define NUM_COMMON (128 - 9)
15078 while (strLen--) {
15079 int n = utf8_tounicode(str, &c);
15080 #ifdef JIM_OPTIMIZATION
15081 if (c >= 9 && c < 128) {
15082 /* Common ASCII char. Note that 9 is the tab character */
15083 c -= 9;
15084 if (!commonObj) {
15085 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
15086 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
15088 if (!commonObj[c]) {
15089 commonObj[c] = Jim_NewStringObj(interp, str, 1);
15091 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
15092 str++;
15093 continue;
15095 #endif
15096 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
15097 str += n;
15099 Jim_Free(commonObj);
15102 Jim_SetResult(interp, resObjPtr);
15103 return JIM_OK;
15106 /* [join] */
15107 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15109 const char *joinStr;
15110 int joinStrLen;
15112 if (argc != 2 && argc != 3) {
15113 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
15114 return JIM_ERR;
15116 /* Init */
15117 if (argc == 2) {
15118 joinStr = " ";
15119 joinStrLen = 1;
15121 else {
15122 joinStr = Jim_GetString(argv[2], &joinStrLen);
15124 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
15125 return JIM_OK;
15128 /* [format] */
15129 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15131 Jim_Obj *objPtr;
15133 if (argc < 2) {
15134 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
15135 return JIM_ERR;
15137 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
15138 if (objPtr == NULL)
15139 return JIM_ERR;
15140 Jim_SetResult(interp, objPtr);
15141 return JIM_OK;
15144 /* [scan] */
15145 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15147 Jim_Obj *listPtr, **outVec;
15148 int outc, i;
15150 if (argc < 3) {
15151 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
15152 return JIM_ERR;
15154 if (argv[2]->typePtr != &scanFmtStringObjType)
15155 SetScanFmtFromAny(interp, argv[2]);
15156 if (FormatGetError(argv[2]) != 0) {
15157 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
15158 return JIM_ERR;
15160 if (argc > 3) {
15161 int maxPos = FormatGetMaxPos(argv[2]);
15162 int count = FormatGetCnvCount(argv[2]);
15164 if (maxPos > argc - 3) {
15165 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
15166 return JIM_ERR;
15168 else if (count > argc - 3) {
15169 Jim_SetResultString(interp, "different numbers of variable names and "
15170 "field specifiers", -1);
15171 return JIM_ERR;
15173 else if (count < argc - 3) {
15174 Jim_SetResultString(interp, "variable is not assigned by any "
15175 "conversion specifiers", -1);
15176 return JIM_ERR;
15179 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
15180 if (listPtr == 0)
15181 return JIM_ERR;
15182 if (argc > 3) {
15183 int rc = JIM_OK;
15184 int count = 0;
15186 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
15187 int len = Jim_ListLength(interp, listPtr);
15189 if (len != 0) {
15190 JimListGetElements(interp, listPtr, &outc, &outVec);
15191 for (i = 0; i < outc; ++i) {
15192 if (Jim_Length(outVec[i]) > 0) {
15193 ++count;
15194 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
15195 rc = JIM_ERR;
15200 Jim_FreeNewObj(interp, listPtr);
15202 else {
15203 count = -1;
15205 if (rc == JIM_OK) {
15206 Jim_SetResultInt(interp, count);
15208 return rc;
15210 else {
15211 if (listPtr == (Jim_Obj *)EOF) {
15212 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
15213 return JIM_OK;
15215 Jim_SetResult(interp, listPtr);
15217 return JIM_OK;
15220 /* [error] */
15221 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15223 if (argc != 2 && argc != 3) {
15224 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
15225 return JIM_ERR;
15227 Jim_SetResult(interp, argv[1]);
15228 if (argc == 3) {
15229 JimSetStackTrace(interp, argv[2]);
15230 return JIM_ERR;
15232 interp->addStackTrace++;
15233 return JIM_ERR;
15236 /* [lrange] */
15237 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15239 Jim_Obj *objPtr;
15241 if (argc != 4) {
15242 Jim_WrongNumArgs(interp, 1, argv, "list first last");
15243 return JIM_ERR;
15245 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
15246 return JIM_ERR;
15247 Jim_SetResult(interp, objPtr);
15248 return JIM_OK;
15251 /* [lrepeat] */
15252 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15254 Jim_Obj *objPtr;
15255 long count;
15257 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
15258 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15259 return JIM_ERR;
15262 if (count == 0 || argc == 2) {
15263 return JIM_OK;
15266 argc -= 2;
15267 argv += 2;
15269 objPtr = Jim_NewListObj(interp, argv, argc);
15270 while (--count) {
15271 ListInsertElements(objPtr, -1, argc, argv);
15274 Jim_SetResult(interp, objPtr);
15275 return JIM_OK;
15278 char **Jim_GetEnviron(void)
15280 #if defined(HAVE__NSGETENVIRON)
15281 return *_NSGetEnviron();
15282 #else
15283 #if !defined(NO_ENVIRON_EXTERN)
15284 extern char **environ;
15285 #endif
15287 return environ;
15288 #endif
15291 void Jim_SetEnviron(char **env)
15293 #if defined(HAVE__NSGETENVIRON)
15294 *_NSGetEnviron() = env;
15295 #else
15296 #if !defined(NO_ENVIRON_EXTERN)
15297 extern char **environ;
15298 #endif
15300 environ = env;
15301 #endif
15304 /* [env] */
15305 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15307 const char *key;
15308 const char *val;
15310 if (argc == 1) {
15311 char **e = Jim_GetEnviron();
15313 int i;
15314 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
15316 for (i = 0; e[i]; i++) {
15317 const char *equals = strchr(e[i], '=');
15319 if (equals) {
15320 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
15321 equals - e[i]));
15322 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
15326 Jim_SetResult(interp, listObjPtr);
15327 return JIM_OK;
15330 if (argc < 2) {
15331 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15332 return JIM_ERR;
15334 key = Jim_String(argv[1]);
15335 val = getenv(key);
15336 if (val == NULL) {
15337 if (argc < 3) {
15338 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
15339 return JIM_ERR;
15341 val = Jim_String(argv[2]);
15343 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
15344 return JIM_OK;
15347 /* [source] */
15348 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15350 int retval;
15352 if (argc != 2) {
15353 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15354 return JIM_ERR;
15356 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15357 if (retval == JIM_RETURN)
15358 return JIM_OK;
15359 return retval;
15362 /* [lreverse] */
15363 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15365 Jim_Obj *revObjPtr, **ele;
15366 int len;
15368 if (argc != 2) {
15369 Jim_WrongNumArgs(interp, 1, argv, "list");
15370 return JIM_ERR;
15372 JimListGetElements(interp, argv[1], &len, &ele);
15373 len--;
15374 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15375 while (len >= 0)
15376 ListAppendElement(revObjPtr, ele[len--]);
15377 Jim_SetResult(interp, revObjPtr);
15378 return JIM_OK;
15381 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15383 jim_wide len;
15385 if (step == 0)
15386 return -1;
15387 if (start == end)
15388 return 0;
15389 else if (step > 0 && start > end)
15390 return -1;
15391 else if (step < 0 && end > start)
15392 return -1;
15393 len = end - start;
15394 if (len < 0)
15395 len = -len; /* abs(len) */
15396 if (step < 0)
15397 step = -step; /* abs(step) */
15398 len = 1 + ((len - 1) / step);
15399 /* We can truncate safely to INT_MAX, the range command
15400 * will always return an error for a such long range
15401 * because Tcl lists can't be so long. */
15402 if (len > INT_MAX)
15403 len = INT_MAX;
15404 return (int)((len < 0) ? -1 : len);
15407 /* [range] */
15408 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15410 jim_wide start = 0, end, step = 1;
15411 int len, i;
15412 Jim_Obj *objPtr;
15414 if (argc < 2 || argc > 4) {
15415 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15416 return JIM_ERR;
15418 if (argc == 2) {
15419 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15420 return JIM_ERR;
15422 else {
15423 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15424 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15425 return JIM_ERR;
15426 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15427 return JIM_ERR;
15429 if ((len = JimRangeLen(start, end, step)) == -1) {
15430 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15431 return JIM_ERR;
15433 objPtr = Jim_NewListObj(interp, NULL, 0);
15434 for (i = 0; i < len; i++)
15435 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15436 Jim_SetResult(interp, objPtr);
15437 return JIM_OK;
15440 /* [rand] */
15441 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15443 jim_wide min = 0, max = 0, len, maxMul;
15445 if (argc < 1 || argc > 3) {
15446 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15447 return JIM_ERR;
15449 if (argc == 1) {
15450 max = JIM_WIDE_MAX;
15451 } else if (argc == 2) {
15452 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15453 return JIM_ERR;
15454 } else if (argc == 3) {
15455 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15456 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15457 return JIM_ERR;
15459 len = max-min;
15460 if (len < 0) {
15461 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15462 return JIM_ERR;
15464 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15465 while (1) {
15466 jim_wide r;
15468 JimRandomBytes(interp, &r, sizeof(jim_wide));
15469 if (r < 0 || r >= maxMul) continue;
15470 r = (len == 0) ? 0 : r%len;
15471 Jim_SetResultInt(interp, min+r);
15472 return JIM_OK;
15476 static const struct {
15477 const char *name;
15478 Jim_CmdProc *cmdProc;
15479 } Jim_CoreCommandsTable[] = {
15480 {"alias", Jim_AliasCoreCommand},
15481 {"set", Jim_SetCoreCommand},
15482 {"unset", Jim_UnsetCoreCommand},
15483 {"puts", Jim_PutsCoreCommand},
15484 {"+", Jim_AddCoreCommand},
15485 {"*", Jim_MulCoreCommand},
15486 {"-", Jim_SubCoreCommand},
15487 {"/", Jim_DivCoreCommand},
15488 {"incr", Jim_IncrCoreCommand},
15489 {"while", Jim_WhileCoreCommand},
15490 {"loop", Jim_LoopCoreCommand},
15491 {"for", Jim_ForCoreCommand},
15492 {"foreach", Jim_ForeachCoreCommand},
15493 {"lmap", Jim_LmapCoreCommand},
15494 {"lassign", Jim_LassignCoreCommand},
15495 {"if", Jim_IfCoreCommand},
15496 {"switch", Jim_SwitchCoreCommand},
15497 {"list", Jim_ListCoreCommand},
15498 {"lindex", Jim_LindexCoreCommand},
15499 {"lset", Jim_LsetCoreCommand},
15500 {"lsearch", Jim_LsearchCoreCommand},
15501 {"llength", Jim_LlengthCoreCommand},
15502 {"lappend", Jim_LappendCoreCommand},
15503 {"linsert", Jim_LinsertCoreCommand},
15504 {"lreplace", Jim_LreplaceCoreCommand},
15505 {"lsort", Jim_LsortCoreCommand},
15506 {"append", Jim_AppendCoreCommand},
15507 {"debug", Jim_DebugCoreCommand},
15508 {"eval", Jim_EvalCoreCommand},
15509 {"uplevel", Jim_UplevelCoreCommand},
15510 {"expr", Jim_ExprCoreCommand},
15511 {"break", Jim_BreakCoreCommand},
15512 {"continue", Jim_ContinueCoreCommand},
15513 {"proc", Jim_ProcCoreCommand},
15514 {"concat", Jim_ConcatCoreCommand},
15515 {"return", Jim_ReturnCoreCommand},
15516 {"upvar", Jim_UpvarCoreCommand},
15517 {"global", Jim_GlobalCoreCommand},
15518 {"string", Jim_StringCoreCommand},
15519 {"time", Jim_TimeCoreCommand},
15520 {"exit", Jim_ExitCoreCommand},
15521 {"catch", Jim_CatchCoreCommand},
15522 #ifdef JIM_REFERENCES
15523 {"ref", Jim_RefCoreCommand},
15524 {"getref", Jim_GetrefCoreCommand},
15525 {"setref", Jim_SetrefCoreCommand},
15526 {"finalize", Jim_FinalizeCoreCommand},
15527 {"collect", Jim_CollectCoreCommand},
15528 #endif
15529 {"rename", Jim_RenameCoreCommand},
15530 {"dict", Jim_DictCoreCommand},
15531 {"subst", Jim_SubstCoreCommand},
15532 {"info", Jim_InfoCoreCommand},
15533 {"exists", Jim_ExistsCoreCommand},
15534 {"split", Jim_SplitCoreCommand},
15535 {"join", Jim_JoinCoreCommand},
15536 {"format", Jim_FormatCoreCommand},
15537 {"scan", Jim_ScanCoreCommand},
15538 {"error", Jim_ErrorCoreCommand},
15539 {"lrange", Jim_LrangeCoreCommand},
15540 {"lrepeat", Jim_LrepeatCoreCommand},
15541 {"env", Jim_EnvCoreCommand},
15542 {"source", Jim_SourceCoreCommand},
15543 {"lreverse", Jim_LreverseCoreCommand},
15544 {"range", Jim_RangeCoreCommand},
15545 {"rand", Jim_RandCoreCommand},
15546 {"tailcall", Jim_TailcallCoreCommand},
15547 {"local", Jim_LocalCoreCommand},
15548 {"upcall", Jim_UpcallCoreCommand},
15549 {"apply", Jim_ApplyCoreCommand},
15550 {NULL, NULL},
15553 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15555 int i = 0;
15557 while (Jim_CoreCommandsTable[i].name != NULL) {
15558 Jim_CreateCommand(interp,
15559 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15560 i++;
15564 /* -----------------------------------------------------------------------------
15565 * Interactive prompt
15566 * ---------------------------------------------------------------------------*/
15567 void Jim_MakeErrorMessage(Jim_Interp *interp)
15569 Jim_Obj *argv[2];
15571 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15572 argv[1] = interp->result;
15574 Jim_EvalObjVector(interp, 2, argv);
15578 * Given a null terminated array of strings, returns an allocated, sorted
15579 * copy of the array.
15581 static char **JimSortStringTable(const char *const *tablePtr)
15583 int count;
15584 char **tablePtrSorted;
15586 /* Find the size of the table */
15587 for (count = 0; tablePtr[count]; count++) {
15590 /* Allocate one extra for the terminating NULL pointer */
15591 tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1));
15592 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15593 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15594 tablePtrSorted[count] = NULL;
15596 return tablePtrSorted;
15599 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15600 const char *prefix, const char *const *tablePtr, const char *name)
15602 char **tablePtrSorted;
15603 int i;
15605 if (name == NULL) {
15606 name = "option";
15609 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15610 tablePtrSorted = JimSortStringTable(tablePtr);
15611 for (i = 0; tablePtrSorted[i]; i++) {
15612 if (tablePtrSorted[i + 1] == NULL && i > 0) {
15613 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15615 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15616 if (tablePtrSorted[i + 1]) {
15617 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15620 Jim_Free(tablePtrSorted);
15625 * If objPtr is "-commands" sets the Jim result as a sorted list of options in the table
15626 * and returns JIM_OK.
15628 * Otherwise returns JIM_ERR.
15630 int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr)
15632 if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) {
15633 int i;
15634 char **tablePtrSorted = JimSortStringTable(tablePtr);
15635 Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
15636 for (i = 0; tablePtrSorted[i]; i++) {
15637 Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1));
15639 Jim_Free(tablePtrSorted);
15640 return JIM_OK;
15642 return JIM_ERR;
15645 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15646 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15648 const char *bad = "bad ";
15649 const char *const *entryPtr = NULL;
15650 int i;
15651 int match = -1;
15652 int arglen;
15653 const char *arg = Jim_GetString(objPtr, &arglen);
15655 *indexPtr = -1;
15657 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15658 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15659 /* Found an exact match */
15660 *indexPtr = i;
15661 return JIM_OK;
15663 if (flags & JIM_ENUM_ABBREV) {
15664 /* Accept an unambiguous abbreviation.
15665 * Note that '-' doesnt' consitute a valid abbreviation
15667 if (strncmp(arg, *entryPtr, arglen) == 0) {
15668 if (*arg == '-' && arglen == 1) {
15669 break;
15671 if (match >= 0) {
15672 bad = "ambiguous ";
15673 goto ambiguous;
15675 match = i;
15680 /* If we had an unambiguous partial match */
15681 if (match >= 0) {
15682 *indexPtr = match;
15683 return JIM_OK;
15686 ambiguous:
15687 if (flags & JIM_ERRMSG) {
15688 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15690 return JIM_ERR;
15693 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15695 int i;
15697 for (i = 0; i < (int)len; i++) {
15698 if (array[i] && strcmp(array[i], name) == 0) {
15699 return i;
15702 return -1;
15705 int Jim_IsDict(Jim_Obj *objPtr)
15707 return objPtr->typePtr == &dictObjType;
15710 int Jim_IsList(Jim_Obj *objPtr)
15712 return objPtr->typePtr == &listObjType;
15716 * Very simple printf-like formatting, designed for error messages.
15718 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15719 * The resulting string is created and set as the result.
15721 * Each '%s' should correspond to a regular string parameter.
15722 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15723 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15725 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15727 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15729 * Note that any Jim_Obj parameters with zero ref count will be freed as a result of this call.
15731 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15733 /* Initial space needed */
15734 int len = strlen(format);
15735 int extra = 0;
15736 int n = 0;
15737 const char *params[5];
15738 int nobjparam = 0;
15739 Jim_Obj *objparam[5];
15740 char *buf;
15741 va_list args;
15742 int i;
15744 va_start(args, format);
15746 for (i = 0; i < len && n < 5; i++) {
15747 int l;
15749 if (strncmp(format + i, "%s", 2) == 0) {
15750 params[n] = va_arg(args, char *);
15752 l = strlen(params[n]);
15754 else if (strncmp(format + i, "%#s", 3) == 0) {
15755 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15757 params[n] = Jim_GetString(objPtr, &l);
15758 objparam[nobjparam++] = objPtr;
15759 Jim_IncrRefCount(objPtr);
15761 else {
15762 if (format[i] == '%') {
15763 i++;
15765 continue;
15767 n++;
15768 extra += l;
15771 len += extra;
15772 buf = Jim_Alloc(len + 1);
15773 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15775 va_end(args);
15777 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15779 for (i = 0; i < nobjparam; i++) {
15780 Jim_DecrRefCount(interp, objparam[i]);
15784 /* stubs */
15785 #ifndef jim_ext_package
15786 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15788 return JIM_OK;
15790 #endif
15791 #ifndef jim_ext_aio
15792 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15794 Jim_SetResultString(interp, "aio not enabled", -1);
15795 return NULL;
15797 #endif
15801 * Local Variables: ***
15802 * c-basic-offset: 4 ***
15803 * tab-width: 4 ***
15804 * End: ***