bench.tcl: fix the pi benchmark
[jimtcl.git] / jim.c
blobfdbd71076cf0663703c01c79e08b27b57a37d918
1 /* Jim - A small embeddable Tcl interpreter
3 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
4 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
5 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
6 * Copyright 2008,2009 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
7 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
8 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
9 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
10 * Copyright 2008 Steve Bennett <steveb@workware.net.au>
11 * Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
12 * Copyright 2009 Zachary T Welch zw@superlucidity.net
13 * Copyright 2009 David Brownell
15 * Redistribution and use in source and binary forms, with or without
16 * modification, are permitted provided that the following conditions
17 * are met:
19 * 1. Redistributions of source code must retain the above copyright
20 * notice, this list of conditions and the following disclaimer.
21 * 2. Redistributions in binary form must reproduce the above
22 * copyright notice, this list of conditions and the following
23 * disclaimer in the documentation and/or other materials
24 * provided with the distribution.
26 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
27 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
28 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
29 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
30 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
31 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
32 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
33 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
34 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
35 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
36 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
37 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
39 * The views and conclusions contained in the software and documentation
40 * are those of the authors and should not be interpreted as representing
41 * official policies, either expressed or implied, of the Jim Tcl Project.
42 **/
43 #define JIM_OPTIMIZATION /* comment to avoid optimizations and reduce size */
45 #include <stdio.h>
46 #include <stdlib.h>
48 #include <string.h>
49 #include <stdarg.h>
50 #include <ctype.h>
51 #include <limits.h>
52 #include <assert.h>
53 #include <errno.h>
54 #include <time.h>
55 #include <setjmp.h>
57 #include "jim.h"
58 #include "jimautoconf.h"
59 #include "utf8.h"
61 #ifdef HAVE_SYS_TIME_H
62 #include <sys/time.h>
63 #endif
64 #ifdef HAVE_BACKTRACE
65 #include <execinfo.h>
66 #endif
67 #ifdef HAVE_CRT_EXTERNS_H
68 #include <crt_externs.h>
69 #endif
71 /* For INFINITY, even if math functions are not enabled */
72 #include <math.h>
74 /* We may decide to switch to using $[...] after all, so leave it as an option */
75 /*#define EXPRSUGAR_BRACKET*/
77 /* For the no-autoconf case */
78 #ifndef TCL_LIBRARY
79 #define TCL_LIBRARY "."
80 #endif
81 #ifndef TCL_PLATFORM_OS
82 #define TCL_PLATFORM_OS "unknown"
83 #endif
84 #ifndef TCL_PLATFORM_PLATFORM
85 #define TCL_PLATFORM_PLATFORM "unknown"
86 #endif
87 #ifndef TCL_PLATFORM_PATH_SEPARATOR
88 #define TCL_PLATFORM_PATH_SEPARATOR ":"
89 #endif
91 /*#define DEBUG_SHOW_SCRIPT*/
92 /*#define DEBUG_SHOW_SCRIPT_TOKENS*/
93 /*#define DEBUG_SHOW_SUBST*/
94 /*#define DEBUG_SHOW_EXPR*/
95 /*#define DEBUG_SHOW_EXPR_TOKENS*/
96 /*#define JIM_DEBUG_GC*/
97 #ifdef JIM_MAINTAINER
98 #define JIM_DEBUG_COMMAND
99 #define JIM_DEBUG_PANIC
100 #endif
101 /* Enable this (in conjunction with valgrind) to help debug
102 * reference counting issues
104 /*#define JIM_DISABLE_OBJECT_POOL*/
106 /* Maximum size of an integer */
107 #define JIM_INTEGER_SPACE 24
109 const char *jim_tt_name(int type);
111 #ifdef JIM_DEBUG_PANIC
112 static void JimPanicDump(int fail_condition, const char *fmt, ...);
113 #define JimPanic(X) JimPanicDump X
114 #else
115 #define JimPanic(X)
116 #endif
118 /* -----------------------------------------------------------------------------
119 * Global variables
120 * ---------------------------------------------------------------------------*/
122 /* A shared empty string for the objects string representation.
123 * Jim_InvalidateStringRep knows about it and doesn't try to free it. */
124 static char JimEmptyStringRep[] = "";
126 /* -----------------------------------------------------------------------------
127 * Required prototypes of not exported functions
128 * ---------------------------------------------------------------------------*/
129 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf);
130 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action);
131 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr,
132 int flags);
133 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands);
134 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr);
135 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
136 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len);
137 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
138 const char *prefix, const char *const *tablePtr, const char *name);
139 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv);
140 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr);
141 static int JimSign(jim_wide w);
142 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr);
143 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen);
144 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len);
147 /* Fast access to the int (wide) value of an object which is known to be of int type */
148 #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue
150 #define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none")
152 static int utf8_tounicode_case(const char *s, int *uc, int upper)
154 int l = utf8_tounicode(s, uc);
155 if (upper) {
156 *uc = utf8_upper(*uc);
158 return l;
161 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
162 #define JIM_CHARSET_SCAN 2
163 #define JIM_CHARSET_GLOB 0
166 * pattern points to a string like "[^a-z\ub5]"
168 * The pattern may contain trailing chars, which are ignored.
170 * The pattern is matched against unicode char 'c'.
172 * If (flags & JIM_NOCASE), case is ignored when matching.
173 * If (flags & JIM_CHARSET_SCAN), the considers ^ and ] special at the start
174 * of the charset, per scan, rather than glob/string match.
176 * If the unicode char 'c' matches that set, returns a pointer to the ']' character,
177 * or the null character if the ']' is missing.
179 * Returns NULL on no match.
181 static const char *JimCharsetMatch(const char *pattern, int c, int flags)
183 int not = 0;
184 int pchar;
185 int match = 0;
186 int nocase = 0;
188 if (flags & JIM_NOCASE) {
189 nocase++;
190 c = utf8_upper(c);
193 if (flags & JIM_CHARSET_SCAN) {
194 if (*pattern == '^') {
195 not++;
196 pattern++;
199 /* Special case. If the first char is ']', it is part of the set */
200 if (*pattern == ']') {
201 goto first;
205 while (*pattern && *pattern != ']') {
206 /* Exact match */
207 if (pattern[0] == '\\') {
208 first:
209 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
211 else {
212 /* Is this a range? a-z */
213 int start;
214 int end;
216 pattern += utf8_tounicode_case(pattern, &start, nocase);
217 if (pattern[0] == '-' && pattern[1]) {
218 /* skip '-' */
219 pattern += utf8_tounicode(pattern, &pchar);
220 pattern += utf8_tounicode_case(pattern, &end, nocase);
222 /* Handle reversed range too */
223 if ((c >= start && c <= end) || (c >= end && c <= start)) {
224 match = 1;
226 continue;
228 pchar = start;
231 if (pchar == c) {
232 match = 1;
235 if (not) {
236 match = !match;
239 return match ? pattern : NULL;
242 /* Glob-style pattern matching. */
244 /* Note: string *must* be valid UTF-8 sequences
246 static int JimGlobMatch(const char *pattern, const char *string, int nocase)
248 int c;
249 int pchar;
250 while (*pattern) {
251 switch (pattern[0]) {
252 case '*':
253 while (pattern[1] == '*') {
254 pattern++;
256 pattern++;
257 if (!pattern[0]) {
258 return 1; /* match */
260 while (*string) {
261 /* Recursive call - Does the remaining pattern match anywhere? */
262 if (JimGlobMatch(pattern, string, nocase))
263 return 1; /* match */
264 string += utf8_tounicode(string, &c);
266 return 0; /* no match */
268 case '?':
269 string += utf8_tounicode(string, &c);
270 break;
272 case '[': {
273 string += utf8_tounicode(string, &c);
274 pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
275 if (!pattern) {
276 return 0;
278 if (!*pattern) {
279 /* Ran out of pattern (no ']') */
280 continue;
282 break;
284 case '\\':
285 if (pattern[1]) {
286 pattern++;
288 /* fall through */
289 default:
290 string += utf8_tounicode_case(string, &c, nocase);
291 utf8_tounicode_case(pattern, &pchar, nocase);
292 if (pchar != c) {
293 return 0;
295 break;
297 pattern += utf8_tounicode_case(pattern, &pchar, nocase);
298 if (!*string) {
299 while (*pattern == '*') {
300 pattern++;
302 break;
305 if (!*pattern && !*string) {
306 return 1;
308 return 0;
312 * string comparison. Works on binary data.
314 * Returns -1, 0 or 1
316 * Note that the lengths are byte lengths, not char lengths.
318 static int JimStringCompare(const char *s1, int l1, const char *s2, int l2)
320 if (l1 < l2) {
321 return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
323 else if (l2 < l1) {
324 return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
326 else {
327 return JimSign(memcmp(s1, s2, l1));
332 * Compare null terminated strings, up to a maximum of 'maxchars' characters,
333 * (or end of string if 'maxchars' is -1).
335 * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
337 * Note: does not support embedded nulls.
339 static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase)
341 while (*s1 && *s2 && maxchars) {
342 int c1, c2;
343 s1 += utf8_tounicode_case(s1, &c1, nocase);
344 s2 += utf8_tounicode_case(s2, &c2, nocase);
345 if (c1 != c2) {
346 return JimSign(c1 - c2);
348 maxchars--;
350 if (!maxchars) {
351 return 0;
353 /* One string or both terminated */
354 if (*s1) {
355 return 1;
357 if (*s2) {
358 return -1;
360 return 0;
363 /* Search 's1' inside 's2', starting to search from char 'index' of 's2'.
364 * The index of the first occurrence of s1 in s2 is returned.
365 * If s1 is not found inside s2, -1 is returned. */
366 static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx)
368 int i;
369 int l1bytelen;
371 if (!l1 || !l2 || l1 > l2) {
372 return -1;
374 if (idx < 0)
375 idx = 0;
376 s2 += utf8_index(s2, idx);
378 l1bytelen = utf8_index(s1, l1);
380 for (i = idx; i <= l2 - l1; i++) {
381 int c;
382 if (memcmp(s2, s1, l1bytelen) == 0) {
383 return i;
385 s2 += utf8_tounicode(s2, &c);
387 return -1;
391 * Note: Lengths and return value are in bytes, not chars.
393 static int JimStringLast(const char *s1, int l1, const char *s2, int l2)
395 const char *p;
397 if (!l1 || !l2 || l1 > l2)
398 return -1;
400 /* Now search for the needle */
401 for (p = s2 + l2 - 1; p != s2 - 1; p--) {
402 if (*p == *s1 && memcmp(s1, p, l1) == 0) {
403 return p - s2;
406 return -1;
409 #ifdef JIM_UTF8
411 * Note: Lengths and return value are in chars.
413 static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2)
415 int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2));
416 if (n > 0) {
417 n = utf8_strlen(s2, n);
419 return n;
421 #endif
424 * After an strtol()/strtod()-like conversion,
425 * check whether something was converted and that
426 * the only thing left is white space.
428 * Returns JIM_OK or JIM_ERR.
430 static int JimCheckConversion(const char *str, const char *endptr)
432 if (str[0] == '\0' || str == endptr) {
433 return JIM_ERR;
436 if (endptr[0] != '\0') {
437 while (*endptr) {
438 if (!isspace(UCHAR(*endptr))) {
439 return JIM_ERR;
441 endptr++;
444 return JIM_OK;
447 /* Parses the front of a number to determine it's sign and base
448 * Returns the index to start parsing according to the given base
450 static int JimNumberBase(const char *str, int *base, int *sign)
452 int i = 0;
454 *base = 10;
456 while (isspace(UCHAR(str[i]))) {
457 i++;
460 if (str[i] == '-') {
461 *sign = -1;
462 i++;
464 else {
465 if (str[i] == '+') {
466 i++;
468 *sign = 1;
471 if (str[i] != '0') {
472 /* base 10 */
473 return 0;
476 /* We have 0<x>, so see if we can convert it */
477 switch (str[i + 1]) {
478 case 'x': case 'X': *base = 16; break;
479 case 'o': case 'O': *base = 8; break;
480 case 'b': case 'B': *base = 2; break;
481 default: return 0;
483 i += 2;
484 /* Ensure that (e.g.) 0x-5 fails to parse */
485 if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) {
486 /* Parse according to this base */
487 return i;
489 /* Parse as base 10 */
490 *base = 10;
491 return 0;
494 /* Converts a number as per strtol(..., 0) except leading zeros do *not*
495 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
497 static long jim_strtol(const char *str, char **endptr)
499 int sign;
500 int base;
501 int i = JimNumberBase(str, &base, &sign);
503 if (base != 10) {
504 long value = strtol(str + i, endptr, base);
505 if (endptr == NULL || *endptr != str + i) {
506 return value * sign;
510 /* Can just do a regular base-10 conversion */
511 return strtol(str, endptr, 10);
515 /* Converts a number as per strtoull(..., 0) except leading zeros do *not*
516 * imply octal. Instead, decimal is assumed unless the number begins with 0x, 0o or 0b
518 static jim_wide jim_strtoull(const char *str, char **endptr)
520 #ifdef HAVE_LONG_LONG
521 int sign;
522 int base;
523 int i = JimNumberBase(str, &base, &sign);
525 if (base != 10) {
526 jim_wide value = strtoull(str + i, endptr, base);
527 if (endptr == NULL || *endptr != str + i) {
528 return value * sign;
532 /* Can just do a regular base-10 conversion */
533 return strtoull(str, endptr, 10);
534 #else
535 return (unsigned long)jim_strtol(str, endptr);
536 #endif
539 int Jim_StringToWide(const char *str, jim_wide * widePtr, int base)
541 char *endptr;
543 if (base) {
544 *widePtr = strtoull(str, &endptr, base);
546 else {
547 *widePtr = jim_strtoull(str, &endptr);
550 return JimCheckConversion(str, endptr);
553 int Jim_StringToDouble(const char *str, double *doublePtr)
555 char *endptr;
557 /* Callers can check for underflow via ERANGE */
558 errno = 0;
560 *doublePtr = strtod(str, &endptr);
562 return JimCheckConversion(str, endptr);
565 static jim_wide JimPowWide(jim_wide b, jim_wide e)
567 jim_wide i, res = 1;
569 if ((b == 0 && e != 0) || (e < 0))
570 return 0;
571 for (i = 0; i < e; i++) {
572 res *= b;
574 return res;
577 /* -----------------------------------------------------------------------------
578 * Special functions
579 * ---------------------------------------------------------------------------*/
580 #ifdef JIM_DEBUG_PANIC
581 void JimPanicDump(int condition, const char *fmt, ...)
583 va_list ap;
585 if (!condition) {
586 return;
589 va_start(ap, fmt);
591 fprintf(stderr, JIM_NL "JIM INTERPRETER PANIC: ");
592 vfprintf(stderr, fmt, ap);
593 fprintf(stderr, JIM_NL JIM_NL);
594 va_end(ap);
596 #ifdef HAVE_BACKTRACE
598 void *array[40];
599 int size, i;
600 char **strings;
602 size = backtrace(array, 40);
603 strings = backtrace_symbols(array, size);
604 for (i = 0; i < size; i++)
605 fprintf(stderr, "[backtrace] %s" JIM_NL, strings[i]);
606 fprintf(stderr, "[backtrace] Include the above lines and the output" JIM_NL);
607 fprintf(stderr, "[backtrace] of 'nm <executable>' in the bug report." JIM_NL);
609 #endif
611 exit(1);
613 #endif
615 /* -----------------------------------------------------------------------------
616 * Memory allocation
617 * ---------------------------------------------------------------------------*/
619 void *Jim_Alloc(int size)
621 return size ? malloc(size) : NULL;
624 void Jim_Free(void *ptr)
626 free(ptr);
629 void *Jim_Realloc(void *ptr, int size)
631 return realloc(ptr, size);
634 char *Jim_StrDup(const char *s)
636 return strdup(s);
639 char *Jim_StrDupLen(const char *s, int l)
641 char *copy = Jim_Alloc(l + 1);
643 memcpy(copy, s, l + 1);
644 copy[l] = 0; /* Just to be sure, original could be substring */
645 return copy;
648 /* -----------------------------------------------------------------------------
649 * Time related functions
650 * ---------------------------------------------------------------------------*/
652 /* Returns current time in microseconds */
653 static jim_wide JimClock(void)
655 struct timeval tv;
657 gettimeofday(&tv, NULL);
658 return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec;
661 /* -----------------------------------------------------------------------------
662 * Hash Tables
663 * ---------------------------------------------------------------------------*/
665 /* -------------------------- private prototypes ---------------------------- */
666 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht);
667 static unsigned int JimHashTableNextPower(unsigned int size);
668 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace);
670 /* -------------------------- hash functions -------------------------------- */
672 /* Thomas Wang's 32 bit Mix Function */
673 unsigned int Jim_IntHashFunction(unsigned int key)
675 key += ~(key << 15);
676 key ^= (key >> 10);
677 key += (key << 3);
678 key ^= (key >> 6);
679 key += ~(key << 11);
680 key ^= (key >> 16);
681 return key;
684 /* Generic hash function (we are using to multiply by 9 and add the byte
685 * as Tcl) */
686 unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
688 unsigned int h = 0;
690 while (len--)
691 h += (h << 3) + *buf++;
692 return h;
695 /* ----------------------------- API implementation ------------------------- */
697 /* reset a hashtable already initialized */
698 static void JimResetHashTable(Jim_HashTable *ht)
700 ht->table = NULL;
701 ht->size = 0;
702 ht->sizemask = 0;
703 ht->used = 0;
704 ht->collisions = 0;
705 #ifdef JIM_RANDOMISE_HASH
706 /* This is initialised to a random value to avoid a hash collision attack.
707 * See: n.runs-SA-2011.004
709 ht->uniq = (rand() ^ time(NULL) ^ clock());
710 #else
711 ht->uniq = 0;
712 #endif
715 static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter)
717 iter->ht = ht;
718 iter->index = -1;
719 iter->entry = NULL;
720 iter->nextEntry = NULL;
723 /* Initialize the hash table */
724 int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr)
726 JimResetHashTable(ht);
727 ht->type = type;
728 ht->privdata = privDataPtr;
729 return JIM_OK;
732 /* Resize the table to the minimal size that contains all the elements,
733 * but with the invariant of a USER/BUCKETS ration near to <= 1 */
734 void Jim_ResizeHashTable(Jim_HashTable *ht)
736 int minimal = ht->used;
738 if (minimal < JIM_HT_INITIAL_SIZE)
739 minimal = JIM_HT_INITIAL_SIZE;
740 Jim_ExpandHashTable(ht, minimal);
743 /* Expand or create the hashtable */
744 void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size)
746 Jim_HashTable n; /* the new hashtable */
747 unsigned int realsize = JimHashTableNextPower(size), i;
749 /* the size is invalid if it is smaller than the number of
750 * elements already inside the hashtable */
751 if (size <= ht->used)
752 return;
754 Jim_InitHashTable(&n, ht->type, ht->privdata);
755 n.size = realsize;
756 n.sizemask = realsize - 1;
757 n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *));
758 /* Keep the same 'uniq' as the original */
759 n.uniq = ht->uniq;
761 /* Initialize all the pointers to NULL */
762 memset(n.table, 0, realsize * sizeof(Jim_HashEntry *));
764 /* Copy all the elements from the old to the new table:
765 * note that if the old hash table is empty ht->used is zero,
766 * so Jim_ExpandHashTable just creates an empty hash table. */
767 n.used = ht->used;
768 for (i = 0; ht->used > 0; i++) {
769 Jim_HashEntry *he, *nextHe;
771 if (ht->table[i] == NULL)
772 continue;
774 /* For each hash entry on this slot... */
775 he = ht->table[i];
776 while (he) {
777 unsigned int h;
779 nextHe = he->next;
780 /* Get the new element index */
781 h = Jim_HashKey(ht, he->key) & n.sizemask;
782 he->next = n.table[h];
783 n.table[h] = he;
784 ht->used--;
785 /* Pass to the next element */
786 he = nextHe;
789 assert(ht->used == 0);
790 Jim_Free(ht->table);
792 /* Remap the new hashtable in the old */
793 *ht = n;
796 /* Add an element to the target hash table */
797 int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val)
799 Jim_HashEntry *entry;
801 /* Get the index of the new element, or -1 if
802 * the element already exists. */
803 entry = JimInsertHashEntry(ht, key, 0);
804 if (entry == NULL)
805 return JIM_ERR;
807 /* Set the hash entry fields. */
808 Jim_SetHashKey(ht, entry, key);
809 Jim_SetHashVal(ht, entry, val);
810 return JIM_OK;
813 /* Add an element, discarding the old if the key already exists */
814 int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val)
816 int existed;
817 Jim_HashEntry *entry;
819 /* Get the index of the new element, or -1 if
820 * the element already exists. */
821 entry = JimInsertHashEntry(ht, key, 1);
822 if (entry->key) {
823 /* It already exists, so only replace the value.
824 * Note if both a destructor and a duplicate function exist,
825 * need to dup before destroy. perhaps they are the same
826 * reference counted object
828 if (ht->type->valDestructor && ht->type->valDup) {
829 void *newval = ht->type->valDup(ht->privdata, val);
830 ht->type->valDestructor(ht->privdata, entry->u.val);
831 entry->u.val = newval;
833 else {
834 Jim_FreeEntryVal(ht, entry);
835 Jim_SetHashVal(ht, entry, val);
837 existed = 1;
839 else {
840 /* Doesn't exist, so set the key */
841 Jim_SetHashKey(ht, entry, key);
842 Jim_SetHashVal(ht, entry, val);
843 existed = 0;
846 return existed;
849 /* Search and remove an element */
850 int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key)
852 unsigned int h;
853 Jim_HashEntry *he, *prevHe;
855 if (ht->used == 0)
856 return JIM_ERR;
857 h = Jim_HashKey(ht, key) & ht->sizemask;
858 he = ht->table[h];
860 prevHe = NULL;
861 while (he) {
862 if (Jim_CompareHashKeys(ht, key, he->key)) {
863 /* Unlink the element from the list */
864 if (prevHe)
865 prevHe->next = he->next;
866 else
867 ht->table[h] = he->next;
868 Jim_FreeEntryKey(ht, he);
869 Jim_FreeEntryVal(ht, he);
870 Jim_Free(he);
871 ht->used--;
872 return JIM_OK;
874 prevHe = he;
875 he = he->next;
877 return JIM_ERR; /* not found */
880 /* Destroy an entire hash table and leave it ready for reuse */
881 int Jim_FreeHashTable(Jim_HashTable *ht)
883 unsigned int i;
885 /* Free all the elements */
886 for (i = 0; ht->used > 0; i++) {
887 Jim_HashEntry *he, *nextHe;
889 if ((he = ht->table[i]) == NULL)
890 continue;
891 while (he) {
892 nextHe = he->next;
893 Jim_FreeEntryKey(ht, he);
894 Jim_FreeEntryVal(ht, he);
895 Jim_Free(he);
896 ht->used--;
897 he = nextHe;
900 /* Free the table and the allocated cache structure */
901 Jim_Free(ht->table);
902 /* Re-initialize the table */
903 JimResetHashTable(ht);
904 return JIM_OK; /* never fails */
907 Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key)
909 Jim_HashEntry *he;
910 unsigned int h;
912 if (ht->used == 0)
913 return NULL;
914 h = Jim_HashKey(ht, key) & ht->sizemask;
915 he = ht->table[h];
916 while (he) {
917 if (Jim_CompareHashKeys(ht, key, he->key))
918 return he;
919 he = he->next;
921 return NULL;
924 Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht)
926 Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter));
927 JimInitHashTableIterator(ht, iter);
928 return iter;
931 Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter)
933 while (1) {
934 if (iter->entry == NULL) {
935 iter->index++;
936 if (iter->index >= (signed)iter->ht->size)
937 break;
938 iter->entry = iter->ht->table[iter->index];
940 else {
941 iter->entry = iter->nextEntry;
943 if (iter->entry) {
944 /* We need to save the 'next' here, the iterator user
945 * may delete the entry we are returning. */
946 iter->nextEntry = iter->entry->next;
947 return iter->entry;
950 return NULL;
953 /* ------------------------- private functions ------------------------------ */
955 /* Expand the hash table if needed */
956 static void JimExpandHashTableIfNeeded(Jim_HashTable *ht)
958 /* If the hash table is empty expand it to the intial size,
959 * if the table is "full" dobule its size. */
960 if (ht->size == 0)
961 Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE);
962 if (ht->size == ht->used)
963 Jim_ExpandHashTable(ht, ht->size * 2);
966 /* Our hash table capability is a power of two */
967 static unsigned int JimHashTableNextPower(unsigned int size)
969 unsigned int i = JIM_HT_INITIAL_SIZE;
971 if (size >= 2147483648U)
972 return 2147483648U;
973 while (1) {
974 if (i >= size)
975 return i;
976 i *= 2;
980 /* Returns the index of a free slot that can be populated with
981 * a hash entry for the given 'key'.
982 * If the key already exists, -1 is returned. */
983 static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace)
985 unsigned int h;
986 Jim_HashEntry *he;
988 /* Expand the hashtable if needed */
989 JimExpandHashTableIfNeeded(ht);
991 /* Compute the key hash value */
992 h = Jim_HashKey(ht, key) & ht->sizemask;
993 /* Search if this slot does not already contain the given key */
994 he = ht->table[h];
995 while (he) {
996 if (Jim_CompareHashKeys(ht, key, he->key))
997 return replace ? he : NULL;
998 he = he->next;
1001 /* Allocates the memory and stores key */
1002 he = Jim_Alloc(sizeof(*he));
1003 he->next = ht->table[h];
1004 ht->table[h] = he;
1005 ht->used++;
1006 he->key = NULL;
1008 return he;
1011 /* ----------------------- StringCopy Hash Table Type ------------------------*/
1013 static unsigned int JimStringCopyHTHashFunction(const void *key)
1015 return Jim_GenHashFunction(key, strlen(key));
1018 static void *JimStringCopyHTDup(void *privdata, const void *key)
1020 return Jim_StrDup(key);
1023 static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2)
1025 return strcmp(key1, key2) == 0;
1028 static void JimStringCopyHTKeyDestructor(void *privdata, void *key)
1030 Jim_Free(key);
1033 static const Jim_HashTableType JimPackageHashTableType = {
1034 JimStringCopyHTHashFunction, /* hash function */
1035 JimStringCopyHTDup, /* key dup */
1036 NULL, /* val dup */
1037 JimStringCopyHTKeyCompare, /* key compare */
1038 JimStringCopyHTKeyDestructor, /* key destructor */
1039 NULL /* val destructor */
1042 typedef struct AssocDataValue
1044 Jim_InterpDeleteProc *delProc;
1045 void *data;
1046 } AssocDataValue;
1048 static void JimAssocDataHashTableValueDestructor(void *privdata, void *data)
1050 AssocDataValue *assocPtr = (AssocDataValue *) data;
1052 if (assocPtr->delProc != NULL)
1053 assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data);
1054 Jim_Free(data);
1057 static const Jim_HashTableType JimAssocDataHashTableType = {
1058 JimStringCopyHTHashFunction, /* hash function */
1059 JimStringCopyHTDup, /* key dup */
1060 NULL, /* val dup */
1061 JimStringCopyHTKeyCompare, /* key compare */
1062 JimStringCopyHTKeyDestructor, /* key destructor */
1063 JimAssocDataHashTableValueDestructor /* val destructor */
1066 /* -----------------------------------------------------------------------------
1067 * Stack - This is a simple generic stack implementation. It is used for
1068 * example in the 'expr' expression compiler.
1069 * ---------------------------------------------------------------------------*/
1070 void Jim_InitStack(Jim_Stack *stack)
1072 stack->len = 0;
1073 stack->maxlen = 0;
1074 stack->vector = NULL;
1077 void Jim_FreeStack(Jim_Stack *stack)
1079 Jim_Free(stack->vector);
1082 int Jim_StackLen(Jim_Stack *stack)
1084 return stack->len;
1087 void Jim_StackPush(Jim_Stack *stack, void *element)
1089 int neededLen = stack->len + 1;
1091 if (neededLen > stack->maxlen) {
1092 stack->maxlen = neededLen < 20 ? 20 : neededLen * 2;
1093 stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen);
1095 stack->vector[stack->len] = element;
1096 stack->len++;
1099 void *Jim_StackPop(Jim_Stack *stack)
1101 if (stack->len == 0)
1102 return NULL;
1103 stack->len--;
1104 return stack->vector[stack->len];
1107 void *Jim_StackPeek(Jim_Stack *stack)
1109 if (stack->len == 0)
1110 return NULL;
1111 return stack->vector[stack->len - 1];
1114 void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr))
1116 int i;
1118 for (i = 0; i < stack->len; i++)
1119 freeFunc(stack->vector[i]);
1122 /* -----------------------------------------------------------------------------
1123 * Tcl Parser
1124 * ---------------------------------------------------------------------------*/
1126 /* Token types */
1127 #define JIM_TT_NONE 0 /* No token returned */
1128 #define JIM_TT_STR 1 /* simple string */
1129 #define JIM_TT_ESC 2 /* string that needs escape chars conversion */
1130 #define JIM_TT_VAR 3 /* var substitution */
1131 #define JIM_TT_DICTSUGAR 4 /* Syntax sugar for [dict get], $foo(bar) */
1132 #define JIM_TT_CMD 5 /* command substitution */
1133 /* Note: Keep these three together for TOKEN_IS_SEP() */
1134 #define JIM_TT_SEP 6 /* word separator (white space) */
1135 #define JIM_TT_EOL 7 /* line separator */
1136 #define JIM_TT_EOF 8 /* end of script */
1138 #define JIM_TT_LINE 9 /* special 'start-of-line' token. arg is # of arguments to the command. -ve if {*} */
1139 #define JIM_TT_WORD 10 /* special 'start-of-word' token. arg is # of tokens to combine. -ve if {*} */
1141 /* Additional token types needed for expressions */
1142 #define JIM_TT_SUBEXPR_START 11
1143 #define JIM_TT_SUBEXPR_END 12
1144 #define JIM_TT_SUBEXPR_COMMA 13
1145 #define JIM_TT_EXPR_INT 14
1146 #define JIM_TT_EXPR_DOUBLE 15
1148 #define JIM_TT_EXPRSUGAR 16 /* $(expression) */
1150 /* Operator token types start here */
1151 #define JIM_TT_EXPR_OP 20
1153 #define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF)
1155 /* Parser states */
1156 #define JIM_PS_DEF 0 /* Default state */
1157 #define JIM_PS_QUOTE 1 /* Inside "" */
1158 #define JIM_PS_DICTSUGAR 2 /* Tokenising abc(def) into 4 separate tokens */
1160 /* Parser context structure. The same context is used both to parse
1161 * Tcl scripts and lists. */
1162 struct JimParserCtx
1164 const char *p; /* Pointer to the point of the program we are parsing */
1165 int len; /* Remaining length */
1166 int linenr; /* Current line number */
1167 const char *tstart;
1168 const char *tend; /* Returned token is at tstart-tend in 'prg'. */
1169 int tline; /* Line number of the returned token */
1170 int tt; /* Token type */
1171 int eof; /* Non zero if EOF condition is true. */
1172 int state; /* Parser state */
1173 int comment; /* Non zero if the next chars may be a comment. */
1174 char missing; /* At end of parse, ' ' if complete, '{' if braces incomplete, '"' if quotes incomplete */
1175 int missingline; /* Line number starting the missing token */
1179 * Results of missing quotes, braces, etc. from parsing.
1181 struct JimParseResult {
1182 char missing; /* From JimParserCtx.missing */
1183 int line; /* From JimParserCtx.missingline */
1186 static int JimParseScript(struct JimParserCtx *pc);
1187 static int JimParseSep(struct JimParserCtx *pc);
1188 static int JimParseEol(struct JimParserCtx *pc);
1189 static int JimParseCmd(struct JimParserCtx *pc);
1190 static int JimParseQuote(struct JimParserCtx *pc);
1191 static int JimParseVar(struct JimParserCtx *pc);
1192 static int JimParseBrace(struct JimParserCtx *pc);
1193 static int JimParseStr(struct JimParserCtx *pc);
1194 static int JimParseComment(struct JimParserCtx *pc);
1195 static void JimParseSubCmd(struct JimParserCtx *pc);
1196 static int JimParseSubQuote(struct JimParserCtx *pc);
1197 static void JimParseSubCmd(struct JimParserCtx *pc);
1198 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc);
1200 /* Initialize a parser context.
1201 * 'prg' is a pointer to the program text, linenr is the line
1202 * number of the first line contained in the program. */
1203 static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr)
1205 pc->p = prg;
1206 pc->len = len;
1207 pc->tstart = NULL;
1208 pc->tend = NULL;
1209 pc->tline = 0;
1210 pc->tt = JIM_TT_NONE;
1211 pc->eof = 0;
1212 pc->state = JIM_PS_DEF;
1213 pc->linenr = linenr;
1214 pc->comment = 1;
1215 pc->missing = ' ';
1216 pc->missingline = linenr;
1219 static int JimParseScript(struct JimParserCtx *pc)
1221 while (1) { /* the while is used to reiterate with continue if needed */
1222 if (!pc->len) {
1223 pc->tstart = pc->p;
1224 pc->tend = pc->p - 1;
1225 pc->tline = pc->linenr;
1226 pc->tt = JIM_TT_EOL;
1227 pc->eof = 1;
1228 return JIM_OK;
1230 switch (*(pc->p)) {
1231 case '\\':
1232 if (*(pc->p + 1) == '\n' && pc->state == JIM_PS_DEF) {
1233 return JimParseSep(pc);
1235 pc->comment = 0;
1236 return JimParseStr(pc);
1237 case ' ':
1238 case '\t':
1239 case '\r':
1240 case '\f':
1241 if (pc->state == JIM_PS_DEF)
1242 return JimParseSep(pc);
1243 pc->comment = 0;
1244 return JimParseStr(pc);
1245 case '\n':
1246 case ';':
1247 pc->comment = 1;
1248 if (pc->state == JIM_PS_DEF)
1249 return JimParseEol(pc);
1250 return JimParseStr(pc);
1251 case '[':
1252 pc->comment = 0;
1253 return JimParseCmd(pc);
1254 case '$':
1255 pc->comment = 0;
1256 if (JimParseVar(pc) == JIM_ERR) {
1257 /* An orphan $. Create as a separate token */
1258 pc->tstart = pc->tend = pc->p++;
1259 pc->len--;
1260 pc->tt = JIM_TT_ESC;
1262 return JIM_OK;
1263 case '#':
1264 if (pc->comment) {
1265 JimParseComment(pc);
1266 continue;
1268 return JimParseStr(pc);
1269 default:
1270 pc->comment = 0;
1271 return JimParseStr(pc);
1273 return JIM_OK;
1277 static int JimParseSep(struct JimParserCtx *pc)
1279 pc->tstart = pc->p;
1280 pc->tline = pc->linenr;
1281 while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) {
1282 if (*pc->p == '\n') {
1283 break;
1285 if (*pc->p == '\\') {
1286 pc->p++;
1287 pc->len--;
1288 pc->linenr++;
1290 pc->p++;
1291 pc->len--;
1293 pc->tend = pc->p - 1;
1294 pc->tt = JIM_TT_SEP;
1295 return JIM_OK;
1298 static int JimParseEol(struct JimParserCtx *pc)
1300 pc->tstart = pc->p;
1301 pc->tline = pc->linenr;
1302 while (isspace(UCHAR(*pc->p)) || *pc->p == ';') {
1303 if (*pc->p == '\n')
1304 pc->linenr++;
1305 pc->p++;
1306 pc->len--;
1308 pc->tend = pc->p - 1;
1309 pc->tt = JIM_TT_EOL;
1310 return JIM_OK;
1314 ** Here are the rules for parsing:
1315 ** {braced expression}
1316 ** - Count open and closing braces
1317 ** - Backslash escapes meaning of braces
1319 ** "quoted expression"
1320 ** - First double quote at start of word terminates the expression
1321 ** - Backslash escapes quote and bracket
1322 ** - [commands brackets] are counted/nested
1323 ** - command rules apply within [brackets], not quoting rules (i.e. quotes have their own rules)
1325 ** [command expression]
1326 ** - Count open and closing brackets
1327 ** - Backslash escapes quote, bracket and brace
1328 ** - [commands brackets] are counted/nested
1329 ** - "quoted expressions" are parsed according to quoting rules
1330 ** - {braced expressions} are parsed according to brace rules
1332 ** For everything, backslash escapes the next char, newline increments current line
1336 * Parses a braced expression starting at pc->p.
1338 * Positions the parser at the end of the braced expression,
1339 * sets pc->tend and possibly pc->missing.
1341 static void JimParseSubBrace(struct JimParserCtx *pc)
1343 int level = 1;
1345 /* Skip the brace */
1346 pc->p++;
1347 pc->len--;
1348 while (pc->len) {
1349 switch (*pc->p) {
1350 case '\\':
1351 if (pc->len > 1) {
1352 if (*++pc->p == '\n') {
1353 pc->linenr++;
1355 pc->len--;
1357 break;
1359 case '{':
1360 level++;
1361 break;
1363 case '}':
1364 if (--level == 0) {
1365 pc->tend = pc->p - 1;
1366 pc->p++;
1367 pc->len--;
1368 return;
1370 break;
1372 case '\n':
1373 pc->linenr++;
1374 break;
1376 pc->p++;
1377 pc->len--;
1379 pc->missing = '{';
1380 pc->missingline = pc->tline;
1381 pc->tend = pc->p - 1;
1385 * Parses a quoted expression starting at pc->p.
1387 * Positions the parser at the end of the quoted expression,
1388 * sets pc->tend and possibly pc->missing.
1390 * Returns the type of the token of the string,
1391 * either JIM_TT_ESC (if it contains values which need to be [subst]ed)
1392 * or JIM_TT_STR.
1394 static int JimParseSubQuote(struct JimParserCtx *pc)
1396 int tt = JIM_TT_STR;
1397 int line = pc->tline;
1399 /* Skip the quote */
1400 pc->p++;
1401 pc->len--;
1402 while (pc->len) {
1403 switch (*pc->p) {
1404 case '\\':
1405 if (pc->len > 1) {
1406 if (*++pc->p == '\n') {
1407 pc->linenr++;
1409 pc->len--;
1410 tt = JIM_TT_ESC;
1412 break;
1414 case '"':
1415 pc->tend = pc->p - 1;
1416 pc->p++;
1417 pc->len--;
1418 return tt;
1420 case '[':
1421 JimParseSubCmd(pc);
1422 tt = JIM_TT_ESC;
1423 continue;
1425 case '\n':
1426 pc->linenr++;
1427 break;
1429 case '$':
1430 tt = JIM_TT_ESC;
1431 break;
1433 pc->p++;
1434 pc->len--;
1436 pc->missing = '"';
1437 pc->missingline = line;
1438 pc->tend = pc->p - 1;
1439 return tt;
1443 * Parses a [command] expression starting at pc->p.
1445 * Positions the parser at the end of the command expression,
1446 * sets pc->tend and possibly pc->missing.
1448 static void JimParseSubCmd(struct JimParserCtx *pc)
1450 int level = 1;
1451 int startofword = 1;
1452 int line = pc->tline;
1454 /* Skip the bracket */
1455 pc->p++;
1456 pc->len--;
1457 while (pc->len) {
1458 switch (*pc->p) {
1459 case '\\':
1460 if (pc->len > 1) {
1461 if (*++pc->p == '\n') {
1462 pc->linenr++;
1464 pc->len--;
1466 break;
1468 case '[':
1469 level++;
1470 break;
1472 case ']':
1473 if (--level == 0) {
1474 pc->tend = pc->p - 1;
1475 pc->p++;
1476 pc->len--;
1477 return;
1479 break;
1481 case '"':
1482 if (startofword) {
1483 JimParseSubQuote(pc);
1484 continue;
1486 break;
1488 case '{':
1489 JimParseSubBrace(pc);
1490 startofword = 0;
1491 continue;
1493 case '\n':
1494 pc->linenr++;
1495 break;
1497 startofword = isspace(UCHAR(*pc->p));
1498 pc->p++;
1499 pc->len--;
1501 pc->missing = '[';
1502 pc->missingline = line;
1503 pc->tend = pc->p - 1;
1506 static int JimParseBrace(struct JimParserCtx *pc)
1508 pc->tstart = pc->p + 1;
1509 pc->tline = pc->linenr;
1510 pc->tt = JIM_TT_STR;
1511 JimParseSubBrace(pc);
1512 return JIM_OK;
1515 static int JimParseCmd(struct JimParserCtx *pc)
1517 pc->tstart = pc->p + 1;
1518 pc->tline = pc->linenr;
1519 pc->tt = JIM_TT_CMD;
1520 JimParseSubCmd(pc);
1521 return JIM_OK;
1524 static int JimParseQuote(struct JimParserCtx *pc)
1526 pc->tstart = pc->p + 1;
1527 pc->tline = pc->linenr;
1528 pc->tt = JimParseSubQuote(pc);
1529 return JIM_OK;
1532 static int JimParseVar(struct JimParserCtx *pc)
1534 /* skip the $ */
1535 pc->p++;
1536 pc->len--;
1538 #ifdef EXPRSUGAR_BRACKET
1539 if (*pc->p == '[') {
1540 /* Parse $[...] expr shorthand syntax */
1541 JimParseCmd(pc);
1542 pc->tt = JIM_TT_EXPRSUGAR;
1543 return JIM_OK;
1545 #endif
1547 pc->tstart = pc->p;
1548 pc->tt = JIM_TT_VAR;
1549 pc->tline = pc->linenr;
1551 if (*pc->p == '{') {
1552 pc->tstart = ++pc->p;
1553 pc->len--;
1555 while (pc->len && *pc->p != '}') {
1556 if (*pc->p == '\n') {
1557 pc->linenr++;
1559 pc->p++;
1560 pc->len--;
1562 pc->tend = pc->p - 1;
1563 if (pc->len) {
1564 pc->p++;
1565 pc->len--;
1568 else {
1569 while (1) {
1570 /* Skip double colon, but not single colon! */
1571 if (pc->p[0] == ':' && pc->p[1] == ':') {
1572 while (*pc->p == ':') {
1573 pc->p++;
1574 pc->len--;
1576 continue;
1578 /* Note that any char >= 0x80 must be part of a utf-8 char.
1579 * We consider all unicode points outside of ASCII as letters
1581 if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) {
1582 pc->p++;
1583 pc->len--;
1584 continue;
1586 break;
1588 /* Parse [dict get] syntax sugar. */
1589 if (*pc->p == '(') {
1590 int count = 1;
1591 const char *paren = NULL;
1593 pc->tt = JIM_TT_DICTSUGAR;
1595 while (count && pc->len) {
1596 pc->p++;
1597 pc->len--;
1598 if (*pc->p == '\\' && pc->len >= 1) {
1599 pc->p++;
1600 pc->len--;
1602 else if (*pc->p == '(') {
1603 count++;
1605 else if (*pc->p == ')') {
1606 paren = pc->p;
1607 count--;
1610 if (count == 0) {
1611 pc->p++;
1612 pc->len--;
1614 else if (paren) {
1615 /* Did not find a matching paren. Back up */
1616 paren++;
1617 pc->len += (pc->p - paren);
1618 pc->p = paren;
1620 #ifndef EXPRSUGAR_BRACKET
1621 if (*pc->tstart == '(') {
1622 pc->tt = JIM_TT_EXPRSUGAR;
1624 #endif
1626 pc->tend = pc->p - 1;
1628 /* Check if we parsed just the '$' character.
1629 * That's not a variable so an error is returned
1630 * to tell the state machine to consider this '$' just
1631 * a string. */
1632 if (pc->tstart == pc->p) {
1633 pc->p--;
1634 pc->len++;
1635 return JIM_ERR;
1637 return JIM_OK;
1640 static int JimParseStr(struct JimParserCtx *pc)
1642 if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
1643 pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) {
1644 /* Starting a new word */
1645 if (*pc->p == '{') {
1646 return JimParseBrace(pc);
1648 if (*pc->p == '"') {
1649 pc->state = JIM_PS_QUOTE;
1650 pc->p++;
1651 pc->len--;
1652 /* In case the end quote is missing */
1653 pc->missingline = pc->tline;
1656 pc->tstart = pc->p;
1657 pc->tline = pc->linenr;
1658 while (1) {
1659 if (pc->len == 0) {
1660 if (pc->state == JIM_PS_QUOTE) {
1661 pc->missing = '"';
1663 pc->tend = pc->p - 1;
1664 pc->tt = JIM_TT_ESC;
1665 return JIM_OK;
1667 switch (*pc->p) {
1668 case '\\':
1669 if (pc->state == JIM_PS_DEF && *(pc->p + 1) == '\n') {
1670 pc->tend = pc->p - 1;
1671 pc->tt = JIM_TT_ESC;
1672 return JIM_OK;
1674 if (pc->len >= 2) {
1675 if (*(pc->p + 1) == '\n') {
1676 pc->linenr++;
1678 pc->p++;
1679 pc->len--;
1681 else if (pc->len == 1) {
1682 /* End of script with trailing backslash */
1683 pc->missing = '\\';
1685 break;
1686 case '(':
1687 /* If the following token is not '$' just keep going */
1688 if (pc->len > 1 && pc->p[1] != '$') {
1689 break;
1691 case ')':
1692 /* Only need a separate ')' token if the previous was a var */
1693 if (*pc->p == '(' || pc->tt == JIM_TT_VAR) {
1694 if (pc->p == pc->tstart) {
1695 /* At the start of the token, so just return this char */
1696 pc->p++;
1697 pc->len--;
1699 pc->tend = pc->p - 1;
1700 pc->tt = JIM_TT_ESC;
1701 return JIM_OK;
1703 break;
1705 case '$':
1706 case '[':
1707 pc->tend = pc->p - 1;
1708 pc->tt = JIM_TT_ESC;
1709 return JIM_OK;
1710 case ' ':
1711 case '\t':
1712 case '\n':
1713 case '\r':
1714 case '\f':
1715 case ';':
1716 if (pc->state == JIM_PS_DEF) {
1717 pc->tend = pc->p - 1;
1718 pc->tt = JIM_TT_ESC;
1719 return JIM_OK;
1721 else if (*pc->p == '\n') {
1722 pc->linenr++;
1724 break;
1725 case '"':
1726 if (pc->state == JIM_PS_QUOTE) {
1727 pc->tend = pc->p - 1;
1728 pc->tt = JIM_TT_ESC;
1729 pc->p++;
1730 pc->len--;
1731 pc->state = JIM_PS_DEF;
1732 return JIM_OK;
1734 break;
1736 pc->p++;
1737 pc->len--;
1739 return JIM_OK; /* unreached */
1742 static int JimParseComment(struct JimParserCtx *pc)
1744 while (*pc->p) {
1745 if (*pc->p == '\\') {
1746 pc->p++;
1747 pc->len--;
1748 if (pc->len == 0) {
1749 pc->missing = '\\';
1750 return JIM_OK;
1752 if (*pc->p == '\n') {
1753 pc->linenr++;
1756 else if (*pc->p == '\n') {
1757 pc->p++;
1758 pc->len--;
1759 pc->linenr++;
1760 break;
1762 pc->p++;
1763 pc->len--;
1765 return JIM_OK;
1768 /* xdigitval and odigitval are helper functions for JimEscape() */
1769 static int xdigitval(int c)
1771 if (c >= '0' && c <= '9')
1772 return c - '0';
1773 if (c >= 'a' && c <= 'f')
1774 return c - 'a' + 10;
1775 if (c >= 'A' && c <= 'F')
1776 return c - 'A' + 10;
1777 return -1;
1780 static int odigitval(int c)
1782 if (c >= '0' && c <= '7')
1783 return c - '0';
1784 return -1;
1787 /* Perform Tcl escape substitution of 's', storing the result
1788 * string into 'dest'. The escaped string is guaranteed to
1789 * be the same length or shorted than the source string.
1790 * Slen is the length of the string at 's', if it's -1 the string
1791 * length will be calculated by the function.
1793 * The function returns the length of the resulting string. */
1794 static int JimEscape(char *dest, const char *s, int slen)
1796 char *p = dest;
1797 int i, len;
1799 if (slen == -1)
1800 slen = strlen(s);
1802 for (i = 0; i < slen; i++) {
1803 switch (s[i]) {
1804 case '\\':
1805 switch (s[i + 1]) {
1806 case 'a':
1807 *p++ = 0x7;
1808 i++;
1809 break;
1810 case 'b':
1811 *p++ = 0x8;
1812 i++;
1813 break;
1814 case 'f':
1815 *p++ = 0xc;
1816 i++;
1817 break;
1818 case 'n':
1819 *p++ = 0xa;
1820 i++;
1821 break;
1822 case 'r':
1823 *p++ = 0xd;
1824 i++;
1825 break;
1826 case 't':
1827 *p++ = 0x9;
1828 i++;
1829 break;
1830 case 'u':
1831 case 'U':
1832 case 'x':
1833 /* A unicode or hex sequence.
1834 * \x Expect 1-2 hex chars and convert to hex.
1835 * \u Expect 1-4 hex chars and convert to utf-8.
1836 * \U Expect 1-8 hex chars and convert to utf-8.
1837 * \u{NNN} supports 1-6 hex chars and convert to utf-8.
1838 * An invalid sequence means simply the escaped char.
1841 unsigned val = 0;
1842 int k;
1843 int maxchars = 2;
1845 i++;
1847 if (s[i] == 'U') {
1848 maxchars = 8;
1850 else if (s[i] == 'u') {
1851 if (s[i + 1] == '{') {
1852 maxchars = 6;
1853 i++;
1855 else {
1856 maxchars = 4;
1860 for (k = 0; k < maxchars; k++) {
1861 int c = xdigitval(s[i + k + 1]);
1862 if (c == -1) {
1863 break;
1865 val = (val << 4) | c;
1867 /* The \u{nnn} syntax supports up to 21 bit codepoints. */
1868 if (s[i] == '{') {
1869 if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') {
1870 /* Back up */
1871 i--;
1872 k = 0;
1874 else {
1875 /* Skip the closing brace */
1876 k++;
1879 if (k) {
1880 /* Got a valid sequence, so convert */
1881 if (s[i] == 'x') {
1882 *p++ = val;
1884 else {
1885 p += utf8_fromunicode(p, val);
1887 i += k;
1888 break;
1890 /* Not a valid codepoint, just an escaped char */
1891 *p++ = s[i];
1893 break;
1894 case 'v':
1895 *p++ = 0xb;
1896 i++;
1897 break;
1898 case '\0':
1899 *p++ = '\\';
1900 i++;
1901 break;
1902 case '\n':
1903 /* Replace all spaces and tabs after backslash newline with a single space*/
1904 *p++ = ' ';
1905 do {
1906 i++;
1907 } while (s[i + 1] == ' ' || s[i + 1] == '\t');
1908 break;
1909 case '0':
1910 case '1':
1911 case '2':
1912 case '3':
1913 case '4':
1914 case '5':
1915 case '6':
1916 case '7':
1917 /* octal escape */
1919 int val = 0;
1920 int c = odigitval(s[i + 1]);
1922 val = c;
1923 c = odigitval(s[i + 2]);
1924 if (c == -1) {
1925 *p++ = val;
1926 i++;
1927 break;
1929 val = (val * 8) + c;
1930 c = odigitval(s[i + 3]);
1931 if (c == -1) {
1932 *p++ = val;
1933 i += 2;
1934 break;
1936 val = (val * 8) + c;
1937 *p++ = val;
1938 i += 3;
1940 break;
1941 default:
1942 *p++ = s[i + 1];
1943 i++;
1944 break;
1946 break;
1947 default:
1948 *p++ = s[i];
1949 break;
1952 len = p - dest;
1953 *p = '\0';
1954 return len;
1957 /* Returns a dynamically allocated copy of the current token in the
1958 * parser context. The function performs conversion of escapes if
1959 * the token is of type JIM_TT_ESC.
1961 * Note that after the conversion, tokens that are grouped with
1962 * braces in the source code, are always recognizable from the
1963 * identical string obtained in a different way from the type.
1965 * For example the string:
1967 * {*}$a
1969 * will return as first token "*", of type JIM_TT_STR
1971 * While the string:
1973 * *$a
1975 * will return as first token "*", of type JIM_TT_ESC
1977 static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc)
1979 const char *start, *end;
1980 char *token;
1981 int len;
1983 start = pc->tstart;
1984 end = pc->tend;
1985 if (start > end) {
1986 len = 0;
1987 token = Jim_Alloc(1);
1988 token[0] = '\0';
1990 else {
1991 len = (end - start) + 1;
1992 token = Jim_Alloc(len + 1);
1993 if (pc->tt != JIM_TT_ESC) {
1994 /* No escape conversion needed? Just copy it. */
1995 memcpy(token, start, len);
1996 token[len] = '\0';
1998 else {
1999 /* Else convert the escape chars. */
2000 len = JimEscape(token, start, len);
2004 return Jim_NewStringObjNoAlloc(interp, token, len);
2007 /* Parses the given string to determine if it represents a complete script.
2009 * This is useful for interactive shells implementation, for [info complete].
2011 * If 'stateCharPtr' != NULL, the function stores ' ' on complete script,
2012 * '{' on scripts incomplete missing one or more '}' to be balanced.
2013 * '[' on scripts incomplete missing one or more ']' to be balanced.
2014 * '"' on scripts incomplete missing a '"' char.
2015 * '\\' on scripts with a trailing backslash.
2017 * If the script is complete, 1 is returned, otherwise 0.
2019 int Jim_ScriptIsComplete(const char *s, int len, char *stateCharPtr)
2021 struct JimParserCtx parser;
2023 JimParserInit(&parser, s, len, 1);
2024 while (!parser.eof) {
2025 JimParseScript(&parser);
2027 if (stateCharPtr) {
2028 *stateCharPtr = parser.missing;
2030 return parser.missing == ' ';
2033 /* -----------------------------------------------------------------------------
2034 * Tcl Lists parsing
2035 * ---------------------------------------------------------------------------*/
2036 static int JimParseListSep(struct JimParserCtx *pc);
2037 static int JimParseListStr(struct JimParserCtx *pc);
2038 static int JimParseListQuote(struct JimParserCtx *pc);
2040 static int JimParseList(struct JimParserCtx *pc)
2042 if (isspace(UCHAR(*pc->p))) {
2043 return JimParseListSep(pc);
2045 switch (*pc->p) {
2046 case '"':
2047 return JimParseListQuote(pc);
2049 case '{':
2050 return JimParseBrace(pc);
2052 default:
2053 if (pc->len) {
2054 return JimParseListStr(pc);
2056 break;
2059 pc->tstart = pc->tend = pc->p;
2060 pc->tline = pc->linenr;
2061 pc->tt = JIM_TT_EOL;
2062 pc->eof = 1;
2063 return JIM_OK;
2066 static int JimParseListSep(struct JimParserCtx *pc)
2068 pc->tstart = pc->p;
2069 pc->tline = pc->linenr;
2070 while (isspace(UCHAR(*pc->p))) {
2071 if (*pc->p == '\n') {
2072 pc->linenr++;
2074 pc->p++;
2075 pc->len--;
2077 pc->tend = pc->p - 1;
2078 pc->tt = JIM_TT_SEP;
2079 return JIM_OK;
2082 static int JimParseListQuote(struct JimParserCtx *pc)
2084 pc->p++;
2085 pc->len--;
2087 pc->tstart = pc->p;
2088 pc->tline = pc->linenr;
2089 pc->tt = JIM_TT_STR;
2091 while (pc->len) {
2092 switch (*pc->p) {
2093 case '\\':
2094 pc->tt = JIM_TT_ESC;
2095 if (--pc->len == 0) {
2096 /* Trailing backslash */
2097 pc->tend = pc->p;
2098 return JIM_OK;
2100 pc->p++;
2101 break;
2102 case '\n':
2103 pc->linenr++;
2104 break;
2105 case '"':
2106 pc->tend = pc->p - 1;
2107 pc->p++;
2108 pc->len--;
2109 return JIM_OK;
2111 pc->p++;
2112 pc->len--;
2115 pc->tend = pc->p - 1;
2116 return JIM_OK;
2119 static int JimParseListStr(struct JimParserCtx *pc)
2121 pc->tstart = pc->p;
2122 pc->tline = pc->linenr;
2123 pc->tt = JIM_TT_STR;
2125 while (pc->len) {
2126 if (isspace(UCHAR(*pc->p))) {
2127 pc->tend = pc->p - 1;
2128 return JIM_OK;
2130 if (*pc->p == '\\') {
2131 if (--pc->len == 0) {
2132 /* Trailing backslash */
2133 pc->tend = pc->p;
2134 return JIM_OK;
2136 pc->tt = JIM_TT_ESC;
2137 pc->p++;
2139 pc->p++;
2140 pc->len--;
2142 pc->tend = pc->p - 1;
2143 return JIM_OK;
2146 /* -----------------------------------------------------------------------------
2147 * Jim_Obj related functions
2148 * ---------------------------------------------------------------------------*/
2150 /* Return a new initialized object. */
2151 Jim_Obj *Jim_NewObj(Jim_Interp *interp)
2153 Jim_Obj *objPtr;
2155 /* -- Check if there are objects in the free list -- */
2156 if (interp->freeList != NULL) {
2157 /* -- Unlink the object from the free list -- */
2158 objPtr = interp->freeList;
2159 interp->freeList = objPtr->nextObjPtr;
2161 else {
2162 /* -- No ready to use objects: allocate a new one -- */
2163 objPtr = Jim_Alloc(sizeof(*objPtr));
2166 /* Object is returned with refCount of 0. Every
2167 * kind of GC implemented should take care to don't try
2168 * to scan objects with refCount == 0. */
2169 objPtr->refCount = 0;
2170 /* All the other fields are left not initialized to save time.
2171 * The caller will probably want to set them to the right
2172 * value anyway. */
2174 /* -- Put the object into the live list -- */
2175 objPtr->prevObjPtr = NULL;
2176 objPtr->nextObjPtr = interp->liveList;
2177 if (interp->liveList)
2178 interp->liveList->prevObjPtr = objPtr;
2179 interp->liveList = objPtr;
2181 return objPtr;
2184 /* Free an object. Actually objects are never freed, but
2185 * just moved to the free objects list, where they will be
2186 * reused by Jim_NewObj(). */
2187 void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr)
2189 /* Check if the object was already freed, panic. */
2190 JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr,
2191 objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "<none>"));
2193 /* Free the internal representation */
2194 Jim_FreeIntRep(interp, objPtr);
2195 /* Free the string representation */
2196 if (objPtr->bytes != NULL) {
2197 if (objPtr->bytes != JimEmptyStringRep)
2198 Jim_Free(objPtr->bytes);
2200 /* Unlink the object from the live objects list */
2201 if (objPtr->prevObjPtr)
2202 objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr;
2203 if (objPtr->nextObjPtr)
2204 objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr;
2205 if (interp->liveList == objPtr)
2206 interp->liveList = objPtr->nextObjPtr;
2207 #ifdef JIM_DISABLE_OBJECT_POOL
2208 Jim_Free(objPtr);
2209 #else
2210 /* Link the object into the free objects list */
2211 objPtr->prevObjPtr = NULL;
2212 objPtr->nextObjPtr = interp->freeList;
2213 if (interp->freeList)
2214 interp->freeList->prevObjPtr = objPtr;
2215 interp->freeList = objPtr;
2216 objPtr->refCount = -1;
2217 #endif
2220 /* Invalidate the string representation of an object. */
2221 void Jim_InvalidateStringRep(Jim_Obj *objPtr)
2223 if (objPtr->bytes != NULL) {
2224 if (objPtr->bytes != JimEmptyStringRep)
2225 Jim_Free(objPtr->bytes);
2227 objPtr->bytes = NULL;
2230 /* Duplicate an object. The returned object has refcount = 0. */
2231 Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr)
2233 Jim_Obj *dupPtr;
2235 dupPtr = Jim_NewObj(interp);
2236 if (objPtr->bytes == NULL) {
2237 /* Object does not have a valid string representation. */
2238 dupPtr->bytes = NULL;
2240 else if (objPtr->length == 0) {
2241 /* Zero length, so don't even bother with the type-specific dup, since all zero length objects look the same */
2242 dupPtr->bytes = JimEmptyStringRep;
2243 dupPtr->length = 0;
2244 dupPtr->typePtr = NULL;
2245 return dupPtr;
2247 else {
2248 dupPtr->bytes = Jim_Alloc(objPtr->length + 1);
2249 dupPtr->length = objPtr->length;
2250 /* Copy the null byte too */
2251 memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1);
2254 /* By default, the new object has the same type as the old object */
2255 dupPtr->typePtr = objPtr->typePtr;
2256 if (objPtr->typePtr != NULL) {
2257 if (objPtr->typePtr->dupIntRepProc == NULL) {
2258 dupPtr->internalRep = objPtr->internalRep;
2260 else {
2261 /* The dup proc may set a different type, e.g. NULL */
2262 objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr);
2265 return dupPtr;
2268 /* Return the string representation for objPtr. If the object's
2269 * string representation is invalid, calls the updateStringProc method to create
2270 * a new one from the internal representation of the object.
2272 const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr)
2274 if (objPtr->bytes == NULL) {
2275 /* Invalid string repr. Generate it. */
2276 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2277 objPtr->typePtr->updateStringProc(objPtr);
2279 if (lenPtr)
2280 *lenPtr = objPtr->length;
2281 return objPtr->bytes;
2284 /* Just returns the length of the object's string rep */
2285 int Jim_Length(Jim_Obj *objPtr)
2287 if (objPtr->bytes == NULL) {
2288 /* Invalid string repr. Generate it. */
2289 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2290 objPtr->typePtr->updateStringProc(objPtr);
2292 return objPtr->length;
2295 /* Just returns the length of the object's string rep */
2296 const char *Jim_String(Jim_Obj *objPtr)
2298 if (objPtr->bytes == NULL) {
2299 /* Invalid string repr. Generate it. */
2300 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2301 objPtr->typePtr->updateStringProc(objPtr);
2303 return objPtr->bytes;
2306 static void JimSetStringBytes(Jim_Obj *objPtr, const char *str)
2308 objPtr->bytes = Jim_StrDup(str);
2309 objPtr->length = strlen(str);
2312 static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
2313 static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2315 static const Jim_ObjType dictSubstObjType = {
2316 "dict-substitution",
2317 FreeDictSubstInternalRep,
2318 DupDictSubstInternalRep,
2319 NULL,
2320 JIM_TYPE_NONE,
2323 static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
2325 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
2328 static const Jim_ObjType interpolatedObjType = {
2329 "interpolated",
2330 FreeInterpolatedInternalRep,
2331 NULL,
2332 NULL,
2333 JIM_TYPE_NONE,
2336 /* -----------------------------------------------------------------------------
2337 * String Object
2338 * ---------------------------------------------------------------------------*/
2339 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
2340 static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
2342 static const Jim_ObjType stringObjType = {
2343 "string",
2344 NULL,
2345 DupStringInternalRep,
2346 NULL,
2347 JIM_TYPE_REFERENCES,
2350 static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
2352 JIM_NOTUSED(interp);
2354 /* This is a bit subtle: the only caller of this function
2355 * should be Jim_DuplicateObj(), that will copy the
2356 * string representaion. After the copy, the duplicated
2357 * object will not have more room in the buffer than
2358 * srcPtr->length bytes. So we just set it to length. */
2359 dupPtr->internalRep.strValue.maxLength = srcPtr->length;
2360 dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength;
2363 static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
2365 if (objPtr->typePtr != &stringObjType) {
2366 /* Get a fresh string representation. */
2367 if (objPtr->bytes == NULL) {
2368 /* Invalid string repr. Generate it. */
2369 JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name));
2370 objPtr->typePtr->updateStringProc(objPtr);
2372 /* Free any other internal representation. */
2373 Jim_FreeIntRep(interp, objPtr);
2374 /* Set it as string, i.e. just set the maxLength field. */
2375 objPtr->typePtr = &stringObjType;
2376 objPtr->internalRep.strValue.maxLength = objPtr->length;
2377 /* Don't know the utf-8 length yet */
2378 objPtr->internalRep.strValue.charLength = -1;
2380 return JIM_OK;
2384 * Returns the length of the object string in chars, not bytes.
2386 * These may be different for a utf-8 string.
2388 int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr)
2390 #ifdef JIM_UTF8
2391 SetStringFromAny(interp, objPtr);
2393 if (objPtr->internalRep.strValue.charLength < 0) {
2394 objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length);
2396 return objPtr->internalRep.strValue.charLength;
2397 #else
2398 return Jim_Length(objPtr);
2399 #endif
2402 /* len is in bytes -- see also Jim_NewStringObjUtf8() */
2403 Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len)
2405 Jim_Obj *objPtr = Jim_NewObj(interp);
2407 /* Need to find out how many bytes the string requires */
2408 if (len == -1)
2409 len = strlen(s);
2410 /* Alloc/Set the string rep. */
2411 if (len == 0) {
2412 objPtr->bytes = JimEmptyStringRep;
2414 else {
2415 objPtr->bytes = Jim_Alloc(len + 1);
2416 memcpy(objPtr->bytes, s, len);
2417 objPtr->bytes[len] = '\0';
2419 objPtr->length = len;
2421 /* No typePtr field for the vanilla string object. */
2422 objPtr->typePtr = NULL;
2423 return objPtr;
2426 /* charlen is in characters -- see also Jim_NewStringObj() */
2427 Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen)
2429 #ifdef JIM_UTF8
2430 /* Need to find out how many bytes the string requires */
2431 int bytelen = utf8_index(s, charlen);
2433 Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen);
2435 /* Remember the utf8 length, so set the type */
2436 objPtr->typePtr = &stringObjType;
2437 objPtr->internalRep.strValue.maxLength = bytelen;
2438 objPtr->internalRep.strValue.charLength = charlen;
2440 return objPtr;
2441 #else
2442 return Jim_NewStringObj(interp, s, charlen);
2443 #endif
2446 /* This version does not try to duplicate the 's' pointer, but
2447 * use it directly. */
2448 Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len)
2450 Jim_Obj *objPtr = Jim_NewObj(interp);
2452 objPtr->bytes = s;
2453 objPtr->length = (len == -1) ? strlen(s) : len;
2454 objPtr->typePtr = NULL;
2455 return objPtr;
2458 /* Low-level string append. Use it only against unshared objects
2459 * of type "string". */
2460 static void StringAppendString(Jim_Obj *objPtr, const char *str, int len)
2462 int needlen;
2464 if (len == -1)
2465 len = strlen(str);
2466 needlen = objPtr->length + len;
2467 if (objPtr->internalRep.strValue.maxLength < needlen ||
2468 objPtr->internalRep.strValue.maxLength == 0) {
2469 needlen *= 2;
2470 /* Inefficient to malloc() for less than 8 bytes */
2471 if (needlen < 7) {
2472 needlen = 7;
2474 if (objPtr->bytes == JimEmptyStringRep) {
2475 objPtr->bytes = Jim_Alloc(needlen + 1);
2477 else {
2478 objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1);
2480 objPtr->internalRep.strValue.maxLength = needlen;
2482 memcpy(objPtr->bytes + objPtr->length, str, len);
2483 objPtr->bytes[objPtr->length + len] = '\0';
2485 if (objPtr->internalRep.strValue.charLength >= 0) {
2486 /* Update the utf-8 char length */
2487 objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len);
2489 objPtr->length += len;
2492 /* Higher level API to append strings to objects.
2493 * Object must not be unshared for each of these.
2495 void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len)
2497 JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object"));
2498 SetStringFromAny(interp, objPtr);
2499 StringAppendString(objPtr, str, len);
2502 void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr)
2504 int len;
2505 const char *str = Jim_GetString(appendObjPtr, &len);
2506 Jim_AppendString(interp, objPtr, str, len);
2509 void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...)
2511 va_list ap;
2513 SetStringFromAny(interp, objPtr);
2514 va_start(ap, objPtr);
2515 while (1) {
2516 const char *s = va_arg(ap, const char *);
2518 if (s == NULL)
2519 break;
2520 Jim_AppendString(interp, objPtr, s, -1);
2522 va_end(ap);
2525 int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr)
2527 if (aObjPtr == bObjPtr) {
2528 return 1;
2530 else {
2531 int Alen, Blen;
2532 const char *sA = Jim_GetString(aObjPtr, &Alen);
2533 const char *sB = Jim_GetString(bObjPtr, &Blen);
2535 return Alen == Blen && memcmp(sA, sB, Alen) == 0;
2540 * Note. Does not support embedded nulls in either the pattern or the object.
2542 int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase)
2544 return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2548 * Note: does not support embedded nulls for the nocase option.
2550 int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2552 int l1, l2;
2553 const char *s1 = Jim_GetString(firstObjPtr, &l1);
2554 const char *s2 = Jim_GetString(secondObjPtr, &l2);
2556 if (nocase) {
2557 /* Do a character compare for nocase */
2558 return JimStringCompareLen(s1, s2, -1, nocase);
2560 return JimStringCompare(s1, l1, s2, l2);
2564 * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2566 * Note: does not support embedded nulls
2568 int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2570 const char *s1 = Jim_String(firstObjPtr);
2571 const char *s2 = Jim_String(secondObjPtr);
2573 return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
2576 /* Convert a range, as returned by Jim_GetRange(), into
2577 * an absolute index into an object of the specified length.
2578 * This function may return negative values, or values
2579 * greater than or equal to the length of the list if the index
2580 * is out of range. */
2581 static int JimRelToAbsIndex(int len, int idx)
2583 if (idx < 0)
2584 return len + idx;
2585 return idx;
2588 /* Convert a pair of indexes (*firstPtr, *lastPtr) as normalized by JimRelToAbsIndex(),
2589 * into a form suitable for implementation of commands like [string range] and [lrange].
2591 * The resulting range is guaranteed to address valid elements of
2592 * the structure.
2594 static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr)
2596 int rangeLen;
2598 if (*firstPtr > *lastPtr) {
2599 rangeLen = 0;
2601 else {
2602 rangeLen = *lastPtr - *firstPtr + 1;
2603 if (rangeLen) {
2604 if (*firstPtr < 0) {
2605 rangeLen += *firstPtr;
2606 *firstPtr = 0;
2608 if (*lastPtr >= len) {
2609 rangeLen -= (*lastPtr - (len - 1));
2610 *lastPtr = len - 1;
2614 if (rangeLen < 0)
2615 rangeLen = 0;
2617 *rangeLenPtr = rangeLen;
2620 static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr,
2621 int len, int *first, int *last, int *range)
2623 if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) {
2624 return JIM_ERR;
2626 if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) {
2627 return JIM_ERR;
2629 *first = JimRelToAbsIndex(len, *first);
2630 *last = JimRelToAbsIndex(len, *last);
2631 JimRelToAbsRange(len, first, last, range);
2632 return JIM_OK;
2635 Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp,
2636 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2638 int first, last;
2639 const char *str;
2640 int rangeLen;
2641 int bytelen;
2643 str = Jim_GetString(strObjPtr, &bytelen);
2645 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) {
2646 return NULL;
2649 if (first == 0 && rangeLen == bytelen) {
2650 return strObjPtr;
2652 return Jim_NewStringObj(interp, str + first, rangeLen);
2655 Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp,
2656 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr)
2658 #ifdef JIM_UTF8
2659 int first, last;
2660 const char *str;
2661 int len, rangeLen;
2662 int bytelen;
2664 str = Jim_GetString(strObjPtr, &bytelen);
2665 len = Jim_Utf8Length(interp, strObjPtr);
2667 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2668 return NULL;
2671 if (first == 0 && rangeLen == len) {
2672 return strObjPtr;
2674 if (len == bytelen) {
2675 /* ASCII optimisation */
2676 return Jim_NewStringObj(interp, str + first, rangeLen);
2678 return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen);
2679 #else
2680 return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr);
2681 #endif
2684 Jim_Obj *JimStringReplaceObj(Jim_Interp *interp,
2685 Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj)
2687 int first, last;
2688 const char *str;
2689 int len, rangeLen;
2690 Jim_Obj *objPtr;
2692 len = Jim_Utf8Length(interp, strObjPtr);
2694 if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) {
2695 return NULL;
2698 if (last < first) {
2699 return strObjPtr;
2702 str = Jim_String(strObjPtr);
2704 /* Before part */
2705 objPtr = Jim_NewStringObjUtf8(interp, str, first);
2707 /* Replacement */
2708 if (newStrObj) {
2709 Jim_AppendObj(interp, objPtr, newStrObj);
2712 /* After part */
2713 Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1);
2715 return objPtr;
2719 * Note: does not support embedded nulls.
2721 static void JimStrCopyUpperLower(char *dest, const char *str, int uc)
2723 while (*str) {
2724 int c;
2725 str += utf8_tounicode(str, &c);
2726 dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c));
2728 *dest = 0;
2732 * Note: does not support embedded nulls.
2734 static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr)
2736 char *buf;
2737 int len;
2738 const char *str;
2740 SetStringFromAny(interp, strObjPtr);
2742 str = Jim_GetString(strObjPtr, &len);
2744 #ifdef JIM_UTF8
2745 /* Case mapping can change the utf-8 length of the string.
2746 * But at worst it will be by one extra byte per char
2748 len *= 2;
2749 #endif
2750 buf = Jim_Alloc(len + 1);
2751 JimStrCopyUpperLower(buf, str, 0);
2752 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2756 * Note: does not support embedded nulls.
2758 static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr)
2760 char *buf;
2761 const char *str;
2762 int len;
2764 if (strObjPtr->typePtr != &stringObjType) {
2765 SetStringFromAny(interp, strObjPtr);
2768 str = Jim_GetString(strObjPtr, &len);
2770 #ifdef JIM_UTF8
2771 /* Case mapping can change the utf-8 length of the string.
2772 * But at worst it will be by one extra byte per char
2774 len *= 2;
2775 #endif
2776 buf = Jim_Alloc(len + 1);
2777 JimStrCopyUpperLower(buf, str, 1);
2778 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2782 * Note: does not support embedded nulls.
2784 static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr)
2786 char *buf, *p;
2787 int len;
2788 int c;
2789 const char *str;
2791 str = Jim_GetString(strObjPtr, &len);
2792 if (len == 0) {
2793 return strObjPtr;
2795 #ifdef JIM_UTF8
2796 /* Case mapping can change the utf-8 length of the string.
2797 * But at worst it will be by one extra byte per char
2799 len *= 2;
2800 #endif
2801 buf = p = Jim_Alloc(len + 1);
2803 str += utf8_tounicode(str, &c);
2804 p += utf8_getchars(p, utf8_title(c));
2806 JimStrCopyUpperLower(p, str, 0);
2808 return Jim_NewStringObjNoAlloc(interp, buf, -1);
2811 /* Similar to memchr() except searches a UTF-8 string 'str' of byte length 'len'
2812 * for unicode character 'c'.
2813 * Returns the position if found or NULL if not
2815 static const char *utf8_memchr(const char *str, int len, int c)
2817 #ifdef JIM_UTF8
2818 while (len) {
2819 int sc;
2820 int n = utf8_tounicode(str, &sc);
2821 if (sc == c) {
2822 return str;
2824 str += n;
2825 len -= n;
2827 return NULL;
2828 #else
2829 return memchr(str, c, len);
2830 #endif
2834 * Searches for the first non-trim char in string (str, len)
2836 * If none is found, returns just past the last char.
2838 * Lengths are in bytes.
2840 static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen)
2842 while (len) {
2843 int c;
2844 int n = utf8_tounicode(str, &c);
2846 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2847 /* Not a trim char, so stop */
2848 break;
2850 str += n;
2851 len -= n;
2853 return str;
2857 * Searches backwards for a non-trim char in string (str, len).
2859 * Returns a pointer to just after the non-trim char, or NULL if not found.
2861 * Lengths are in bytes.
2863 static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen)
2865 str += len;
2867 while (len) {
2868 int c;
2869 int n = utf8_prev_len(str, len);
2871 len -= n;
2872 str -= n;
2874 n = utf8_tounicode(str, &c);
2876 if (utf8_memchr(trimchars, trimlen, c) == NULL) {
2877 return str + n;
2881 return NULL;
2884 static const char default_trim_chars[] = " \t\n\r";
2885 /* sizeof() here includes the null byte */
2886 static int default_trim_chars_len = sizeof(default_trim_chars);
2888 static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2890 int len;
2891 const char *str = Jim_GetString(strObjPtr, &len);
2892 const char *trimchars = default_trim_chars;
2893 int trimcharslen = default_trim_chars_len;
2894 const char *newstr;
2896 if (trimcharsObjPtr) {
2897 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2900 newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen);
2901 if (newstr == str) {
2902 return strObjPtr;
2905 return Jim_NewStringObj(interp, newstr, len - (newstr - str));
2908 static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2910 int len;
2911 const char *trimchars = default_trim_chars;
2912 int trimcharslen = default_trim_chars_len;
2913 const char *nontrim;
2915 if (trimcharsObjPtr) {
2916 trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen);
2919 SetStringFromAny(interp, strObjPtr);
2921 len = Jim_Length(strObjPtr);
2922 nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen);
2924 if (nontrim == NULL) {
2925 /* All trim, so return a zero-length string */
2926 return Jim_NewEmptyStringObj(interp);
2928 if (nontrim == strObjPtr->bytes + len) {
2929 /* All non-trim, so return the original object */
2930 return strObjPtr;
2933 if (Jim_IsShared(strObjPtr)) {
2934 strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes));
2936 else {
2937 /* Can modify this string in place */
2938 strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0;
2939 strObjPtr->length = (nontrim - strObjPtr->bytes);
2942 return strObjPtr;
2945 static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr)
2947 /* First trim left. */
2948 Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr);
2950 /* Now trim right */
2951 strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr);
2953 /* Note: refCount check is needed since objPtr may be emptyObj */
2954 if (objPtr != strObjPtr && objPtr->refCount == 0) {
2955 /* We don't want this object to be leaked */
2956 Jim_FreeNewObj(interp, objPtr);
2959 return strObjPtr;
2962 /* Some platforms don't have isascii - need a non-macro version */
2963 #ifdef HAVE_ISASCII
2964 #define jim_isascii isascii
2965 #else
2966 static int jim_isascii(int c)
2968 return !(c & ~0x7f);
2970 #endif
2972 static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict)
2974 static const char * const strclassnames[] = {
2975 "integer", "alpha", "alnum", "ascii", "digit",
2976 "double", "lower", "upper", "space", "xdigit",
2977 "control", "print", "graph", "punct",
2978 NULL
2980 enum {
2981 STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT,
2982 STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT,
2983 STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT
2985 int strclass;
2986 int len;
2987 int i;
2988 const char *str;
2989 int (*isclassfunc)(int c) = NULL;
2991 if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
2992 return JIM_ERR;
2995 str = Jim_GetString(strObjPtr, &len);
2996 if (len == 0) {
2997 Jim_SetResultBool(interp, !strict);
2998 return JIM_OK;
3001 switch (strclass) {
3002 case STR_IS_INTEGER:
3004 jim_wide w;
3005 Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK);
3006 return JIM_OK;
3009 case STR_IS_DOUBLE:
3011 double d;
3012 Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE);
3013 return JIM_OK;
3016 case STR_IS_ALPHA: isclassfunc = isalpha; break;
3017 case STR_IS_ALNUM: isclassfunc = isalnum; break;
3018 case STR_IS_ASCII: isclassfunc = jim_isascii; break;
3019 case STR_IS_DIGIT: isclassfunc = isdigit; break;
3020 case STR_IS_LOWER: isclassfunc = islower; break;
3021 case STR_IS_UPPER: isclassfunc = isupper; break;
3022 case STR_IS_SPACE: isclassfunc = isspace; break;
3023 case STR_IS_XDIGIT: isclassfunc = isxdigit; break;
3024 case STR_IS_CONTROL: isclassfunc = iscntrl; break;
3025 case STR_IS_PRINT: isclassfunc = isprint; break;
3026 case STR_IS_GRAPH: isclassfunc = isgraph; break;
3027 case STR_IS_PUNCT: isclassfunc = ispunct; break;
3028 default:
3029 return JIM_ERR;
3032 for (i = 0; i < len; i++) {
3033 if (!isclassfunc(str[i])) {
3034 Jim_SetResultBool(interp, 0);
3035 return JIM_OK;
3038 Jim_SetResultBool(interp, 1);
3039 return JIM_OK;
3042 /* -----------------------------------------------------------------------------
3043 * Compared String Object
3044 * ---------------------------------------------------------------------------*/
3046 /* This is strange object that allows comparison of a C literal string
3047 * with a Jim object in a very short time if the same comparison is done
3048 * multiple times. For example every time the [if] command is executed,
3049 * Jim has to check if a given argument is "else".
3050 * If the code has no errors, this comparison is true most of the time,
3051 * so we can cache the pointer of the string of the last matching
3052 * comparison inside the object. Because most C compilers perform literal sharing,
3053 * so that: char *x = "foo", char *y = "foo", will lead to x == y,
3054 * this works pretty well even if comparisons are at different places
3055 * inside the C code. */
3057 static const Jim_ObjType comparedStringObjType = {
3058 "compared-string",
3059 NULL,
3060 NULL,
3061 NULL,
3062 JIM_TYPE_REFERENCES,
3065 /* The only way this object is exposed to the API is via the following
3066 * function. Returns true if the string and the object string repr.
3067 * are the same, otherwise zero is returned.
3069 * Note: this isn't binary safe, but it hardly needs to be.*/
3070 int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str)
3072 if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) {
3073 return 1;
3075 else {
3076 const char *objStr = Jim_String(objPtr);
3078 if (strcmp(str, objStr) != 0)
3079 return 0;
3081 if (objPtr->typePtr != &comparedStringObjType) {
3082 Jim_FreeIntRep(interp, objPtr);
3083 objPtr->typePtr = &comparedStringObjType;
3085 objPtr->internalRep.ptr = (char *)str; /*ATTENTION: const cast */
3086 return 1;
3090 static int qsortCompareStringPointers(const void *a, const void *b)
3092 char *const *sa = (char *const *)a;
3093 char *const *sb = (char *const *)b;
3095 return strcmp(*sa, *sb);
3099 /* -----------------------------------------------------------------------------
3100 * Source Object
3102 * This object is just a string from the language point of view, but
3103 * the internal representation contains the filename and line number
3104 * where this token was read. This information is used by
3105 * Jim_EvalObj() if the object passed happens to be of type "source".
3107 * This allows propagation of the information about line numbers and file
3108 * names and gives error messages with absolute line numbers.
3110 * Note that this object uses the internal representation of the Jim_Object,
3111 * so there is almost no memory overhead. (One Jim_Obj for each filename).
3113 * Also the object will be converted to something else if the given
3114 * token it represents in the source file is not something to be
3115 * evaluated (not a script), and will be specialized in some other way,
3116 * so the time overhead is also almost zero.
3117 * ---------------------------------------------------------------------------*/
3119 static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3120 static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3122 static const Jim_ObjType sourceObjType = {
3123 "source",
3124 FreeSourceInternalRep,
3125 DupSourceInternalRep,
3126 NULL,
3127 JIM_TYPE_REFERENCES,
3130 void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3132 Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj);
3135 void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3137 dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue;
3138 Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj);
3141 static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr,
3142 Jim_Obj *fileNameObj, int lineNumber)
3144 JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object"));
3145 JimPanic((objPtr->typePtr == &sourceObjType, "JimSetSourceInfo called with non-source object"));
3146 Jim_IncrRefCount(fileNameObj);
3147 objPtr->internalRep.sourceValue.fileNameObj = fileNameObj;
3148 objPtr->internalRep.sourceValue.lineNumber = lineNumber;
3149 objPtr->typePtr = &sourceObjType;
3152 /* -----------------------------------------------------------------------------
3153 * ScriptLine Object
3155 * This object is used only in the Script internal represenation.
3156 * For each line of the script, it holds the number of tokens on the line
3157 * and the source line number.
3159 static const Jim_ObjType scriptLineObjType = {
3160 "scriptline",
3161 NULL,
3162 NULL,
3163 NULL,
3164 JIM_NONE,
3167 static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line)
3169 Jim_Obj *objPtr;
3171 #ifdef DEBUG_SHOW_SCRIPT
3172 char buf[100];
3173 snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc);
3174 objPtr = Jim_NewStringObj(interp, buf, -1);
3175 #else
3176 objPtr = Jim_NewEmptyStringObj(interp);
3177 #endif
3178 objPtr->typePtr = &scriptLineObjType;
3179 objPtr->internalRep.scriptLineValue.argc = argc;
3180 objPtr->internalRep.scriptLineValue.line = line;
3182 return objPtr;
3185 /* -----------------------------------------------------------------------------
3186 * Script Object
3188 * This object holds the parsed internal representation of a script.
3189 * This representation is help within an allocated ScriptObj (see below)
3191 static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
3192 static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
3193 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result);
3195 static const Jim_ObjType scriptObjType = {
3196 "script",
3197 FreeScriptInternalRep,
3198 DupScriptInternalRep,
3199 NULL,
3200 JIM_TYPE_REFERENCES,
3203 /* Each token of a script is represented by a ScriptToken.
3204 * The ScriptToken contains a type and a Jim_Obj. The Jim_Obj
3205 * can be specialized by commands operating on it.
3207 typedef struct ScriptToken
3209 Jim_Obj *objPtr;
3210 int type;
3211 } ScriptToken;
3213 /* This is the script object internal representation. An array of
3214 * ScriptToken structures, including a pre-computed representation of the
3215 * command length and arguments.
3217 * For example the script:
3219 * puts hello
3220 * set $i $x$y [foo]BAR
3222 * will produce a ScriptObj with the following ScriptToken's:
3224 * LIN 2
3225 * ESC puts
3226 * ESC hello
3227 * LIN 4
3228 * ESC set
3229 * VAR i
3230 * WRD 2
3231 * VAR x
3232 * VAR y
3233 * WRD 2
3234 * CMD foo
3235 * ESC BAR
3237 * "puts hello" has two args (LIN 2), composed of single tokens.
3238 * (Note that the WRD token is omitted for the common case of a single token.)
3240 * "set $i $x$y [foo]BAR" has four (LIN 4) args, the first word
3241 * has 1 token (ESC SET), and the last has two tokens (WRD 2 CMD foo ESC BAR)
3243 * The precomputation of the command structure makes Jim_Eval() faster,
3244 * and simpler because there aren't dynamic lengths / allocations.
3246 * -- {expand}/{*} handling --
3248 * Expand is handled in a special way.
3250 * If a "word" begins with {*}, the word token count is -ve.
3252 * For example the command:
3254 * list {*}{a b}
3256 * Will produce the following cmdstruct array:
3258 * LIN 2
3259 * ESC list
3260 * WRD -1
3261 * STR a b
3263 * Note that the 'LIN' token also contains the source information for the
3264 * first word of the line for error reporting purposes
3266 * -- the substFlags field of the structure --
3268 * The scriptObj structure is used to represent both "script" objects
3269 * and "subst" objects. In the second case, the there are no LIN and WRD
3270 * tokens. Instead SEP and EOL tokens are added as-is.
3271 * In addition, the field 'substFlags' is used to represent the flags used to turn
3272 * the string into the internal representation.
3273 * If these flags do not match what the application requires,
3274 * the scriptObj is created again. For example the script:
3276 * subst -nocommands $string
3277 * subst -novariables $string
3279 * Will (re)create the internal representation of the $string object
3280 * two times.
3282 typedef struct ScriptObj
3284 ScriptToken *token; /* Tokens array. */
3285 Jim_Obj *fileNameObj; /* Filename */
3286 int len; /* Length of token[] */
3287 int substFlags; /* flags used for the compilation of "subst" objects */
3288 int inUse; /* Used to share a ScriptObj. Currently
3289 only used by Jim_EvalObj() as protection against
3290 shimmering of the currently evaluated object. */
3291 int firstline; /* Line number of the first line */
3292 int linenr; /* Line number of the current line */
3293 } ScriptObj;
3295 void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
3297 int i;
3298 struct ScriptObj *script = (void *)objPtr->internalRep.ptr;
3300 if (--script->inUse != 0)
3301 return;
3302 for (i = 0; i < script->len; i++) {
3303 Jim_DecrRefCount(interp, script->token[i].objPtr);
3305 Jim_Free(script->token);
3306 Jim_DecrRefCount(interp, script->fileNameObj);
3307 Jim_Free(script);
3310 void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
3312 JIM_NOTUSED(interp);
3313 JIM_NOTUSED(srcPtr);
3315 /* Just return a simple string. We don't try to preserve the source info
3316 * since in practice scripts are never duplicated
3318 dupPtr->typePtr = NULL;
3321 /* A simple parse token.
3322 * As the script is parsed, the created tokens point into the script string rep.
3324 typedef struct
3326 const char *token; /* Pointer to the start of the token */
3327 int len; /* Length of this token */
3328 int type; /* Token type */
3329 int line; /* Line number */
3330 } ParseToken;
3332 /* A list of parsed tokens representing a script.
3333 * Tokens are added to this list as the script is parsed.
3334 * It grows as needed.
3336 typedef struct
3338 /* Start with a statically allocated list of tokens which will be expanded with realloc if needed */
3339 ParseToken *list; /* Array of tokens */
3340 int size; /* Current size of the list */
3341 int count; /* Number of entries used */
3342 ParseToken static_list[20]; /* Small initial token space to avoid allocation */
3343 } ParseTokenList;
3345 static void ScriptTokenListInit(ParseTokenList *tokenlist)
3347 tokenlist->list = tokenlist->static_list;
3348 tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken);
3349 tokenlist->count = 0;
3352 static void ScriptTokenListFree(ParseTokenList *tokenlist)
3354 if (tokenlist->list != tokenlist->static_list) {
3355 Jim_Free(tokenlist->list);
3360 * Adds the new token to the tokenlist.
3361 * The token has the given length, type and line number.
3362 * The token list is resized as necessary.
3364 static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type,
3365 int line)
3367 ParseToken *t;
3369 if (tokenlist->count == tokenlist->size) {
3370 /* Resize the list */
3371 tokenlist->size *= 2;
3372 if (tokenlist->list != tokenlist->static_list) {
3373 tokenlist->list =
3374 Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list));
3376 else {
3377 /* The list needs to become allocated */
3378 tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list));
3379 memcpy(tokenlist->list, tokenlist->static_list,
3380 tokenlist->count * sizeof(*tokenlist->list));
3383 t = &tokenlist->list[tokenlist->count++];
3384 t->token = token;
3385 t->len = len;
3386 t->type = type;
3387 t->line = line;
3390 /* Counts the number of adjoining non-separator tokens.
3392 * Returns -ve if the first token is the expansion
3393 * operator (in which case the count doesn't include
3394 * that token).
3396 static int JimCountWordTokens(ParseToken *t)
3398 int expand = 1;
3399 int count = 0;
3401 /* Is the first word {*} or {expand}? */
3402 if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) {
3403 if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) {
3404 /* Create an expand token */
3405 expand = -1;
3406 t++;
3410 /* Now count non-separator words */
3411 while (!TOKEN_IS_SEP(t->type)) {
3412 t++;
3413 count++;
3416 return count * expand;
3420 * Create a script/subst object from the given token.
3422 static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t)
3424 Jim_Obj *objPtr;
3426 if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) {
3427 /* Convert backlash escapes. The result will never be longer than the original */
3428 int len = t->len;
3429 char *str = Jim_Alloc(len + 1);
3430 len = JimEscape(str, t->token, len);
3431 objPtr = Jim_NewStringObjNoAlloc(interp, str, len);
3433 else {
3434 /* XXX: For strict Tcl compatibility, JIM_TT_STR should replace <backslash><newline><whitespace>
3435 * with a single space.
3437 objPtr = Jim_NewStringObj(interp, t->token, t->len);
3439 return objPtr;
3443 * Takes a tokenlist and creates the allocated list of script tokens
3444 * in script->token, of length script->len.
3446 * Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
3447 * as required.
3449 * Also sets script->line to the line number of the first token
3451 static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3452 ParseTokenList *tokenlist)
3454 int i;
3455 struct ScriptToken *token;
3456 /* Number of tokens so far for the current command */
3457 int lineargs = 0;
3458 /* This is the first token for the current command */
3459 ScriptToken *linefirst;
3460 int count;
3461 int linenr;
3463 #ifdef DEBUG_SHOW_SCRIPT_TOKENS
3464 printf("==== Tokens ====\n");
3465 for (i = 0; i < tokenlist->count; i++) {
3466 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type),
3467 tokenlist->list[i].len, tokenlist->list[i].token);
3469 #endif
3471 /* May need up to one extra script token for each EOL in the worst case */
3472 count = tokenlist->count;
3473 for (i = 0; i < tokenlist->count; i++) {
3474 if (tokenlist->list[i].type == JIM_TT_EOL) {
3475 count++;
3478 linenr = script->firstline = tokenlist->list[0].line;
3480 token = script->token = Jim_Alloc(sizeof(ScriptToken) * count);
3482 /* This is the first token for the current command */
3483 linefirst = token++;
3485 for (i = 0; i < tokenlist->count; ) {
3486 /* Look ahead to find out how many tokens make up the next word */
3487 int wordtokens;
3489 /* Skip any leading separators */
3490 while (tokenlist->list[i].type == JIM_TT_SEP) {
3491 i++;
3494 wordtokens = JimCountWordTokens(tokenlist->list + i);
3496 if (wordtokens == 0) {
3497 /* None, so at end of line */
3498 if (lineargs) {
3499 linefirst->type = JIM_TT_LINE;
3500 linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr);
3501 Jim_IncrRefCount(linefirst->objPtr);
3503 /* Reset for new line */
3504 lineargs = 0;
3505 linefirst = token++;
3507 i++;
3508 continue;
3510 else if (wordtokens != 1) {
3511 /* More than 1, or {*}, so insert a WORD token */
3512 token->type = JIM_TT_WORD;
3513 token->objPtr = Jim_NewIntObj(interp, wordtokens);
3514 Jim_IncrRefCount(token->objPtr);
3515 token++;
3516 if (wordtokens < 0) {
3517 /* Skip the expand token */
3518 i++;
3519 wordtokens = -wordtokens - 1;
3520 lineargs--;
3524 if (lineargs == 0) {
3525 /* First real token on the line, so record the line number */
3526 linenr = tokenlist->list[i].line;
3528 lineargs++;
3530 /* Add each non-separator word token to the line */
3531 while (wordtokens--) {
3532 const ParseToken *t = &tokenlist->list[i++];
3534 token->type = t->type;
3535 token->objPtr = JimMakeScriptObj(interp, t);
3536 Jim_IncrRefCount(token->objPtr);
3538 /* Every object is initially a string of type 'source', but the
3539 * internal type may be specialized during execution of the
3540 * script. */
3541 JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line);
3542 token++;
3546 if (lineargs == 0) {
3547 token--;
3550 script->len = token - script->token;
3552 JimPanic((script->len >= count, "allocated script array is too short"));
3554 #ifdef DEBUG_SHOW_SCRIPT
3555 printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj));
3556 for (i = 0; i < script->len; i++) {
3557 const ScriptToken *t = &script->token[i];
3558 printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
3560 #endif
3565 * Similar to ScriptObjAddTokens(), but for subst objects.
3567 static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script,
3568 ParseTokenList *tokenlist)
3570 int i;
3571 struct ScriptToken *token;
3573 token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count);
3575 for (i = 0; i < tokenlist->count; i++) {
3576 const ParseToken *t = &tokenlist->list[i];
3578 /* Create a token for 't' */
3579 token->type = t->type;
3580 token->objPtr = JimMakeScriptObj(interp, t);
3581 Jim_IncrRefCount(token->objPtr);
3582 token++;
3585 script->len = i;
3588 /* This method takes the string representation of an object
3589 * as a Tcl script, and generates the pre-parsed internal representation
3590 * of the script. */
3591 static int SetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, struct JimParseResult *result)
3593 int scriptTextLen;
3594 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
3595 struct JimParserCtx parser;
3596 struct ScriptObj *script;
3597 ParseTokenList tokenlist;
3598 int line = 1;
3600 /* Try to get information about filename / line number */
3601 if (objPtr->typePtr == &sourceObjType) {
3602 line = objPtr->internalRep.sourceValue.lineNumber;
3605 /* Initially parse the script into tokens (in tokenlist) */
3606 ScriptTokenListInit(&tokenlist);
3608 JimParserInit(&parser, scriptText, scriptTextLen, line);
3609 while (!parser.eof) {
3610 JimParseScript(&parser);
3611 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
3612 parser.tline);
3614 /* Note that we accept a trailing backslash without error */
3615 if (result && parser.missing != ' ' && parser.missing != '\\') {
3616 ScriptTokenListFree(&tokenlist);
3617 result->missing = parser.missing;
3618 result->line = parser.missingline;
3619 return JIM_ERR;
3622 /* Add a final EOF token */
3623 ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0);
3625 /* Create the "real" script tokens from the parsed tokens */
3626 script = Jim_Alloc(sizeof(*script));
3627 memset(script, 0, sizeof(*script));
3628 script->inUse = 1;
3629 if (objPtr->typePtr == &sourceObjType) {
3630 script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
3632 else {
3633 script->fileNameObj = interp->emptyObj;
3635 Jim_IncrRefCount(script->fileNameObj);
3637 ScriptObjAddTokens(interp, script, &tokenlist);
3639 /* No longer need the token list */
3640 ScriptTokenListFree(&tokenlist);
3642 /* Free the old internal rep and set the new one. */
3643 Jim_FreeIntRep(interp, objPtr);
3644 Jim_SetIntRepPtr(objPtr, script);
3645 objPtr->typePtr = &scriptObjType;
3647 return JIM_OK;
3650 ScriptObj *Jim_GetScript(Jim_Interp *interp, Jim_Obj *objPtr)
3652 if (objPtr == interp->emptyObj) {
3653 /* Avoid converting emptyObj to a script. use nullScriptObj instead. */
3654 objPtr = interp->nullScriptObj;
3657 if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) {
3658 SetScriptFromAny(interp, objPtr, NULL);
3660 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
3663 /* -----------------------------------------------------------------------------
3664 * Commands
3665 * ---------------------------------------------------------------------------*/
3666 static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3668 cmdPtr->inUse++;
3671 static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr)
3673 if (--cmdPtr->inUse == 0) {
3674 if (cmdPtr->isproc) {
3675 Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr);
3676 Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr);
3677 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3678 if (cmdPtr->u.proc.staticVars) {
3679 Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
3680 Jim_Free(cmdPtr->u.proc.staticVars);
3683 else {
3684 /* native (C) */
3685 if (cmdPtr->u.native.delProc) {
3686 cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData);
3689 if (cmdPtr->prevCmd) {
3690 /* Delete any pushed command too */
3691 JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3693 Jim_Free(cmdPtr);
3697 /* Variables HashTable Type.
3699 * Keys are dynamically allocated strings, Values are Jim_Var structures.
3702 /* Variables HashTable Type.
3704 * Keys are dynamic allocated strings, Values are Jim_Var structures. */
3705 static void JimVariablesHTValDestructor(void *interp, void *val)
3707 Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr);
3708 Jim_Free(val);
3711 static const Jim_HashTableType JimVariablesHashTableType = {
3712 JimStringCopyHTHashFunction, /* hash function */
3713 JimStringCopyHTDup, /* key dup */
3714 NULL, /* val dup */
3715 JimStringCopyHTKeyCompare, /* key compare */
3716 JimStringCopyHTKeyDestructor, /* key destructor */
3717 JimVariablesHTValDestructor /* val destructor */
3720 /* Commands HashTable Type.
3722 * Keys are dynamic allocated strings, Values are Jim_Cmd structures.
3724 static void JimCommandsHT_ValDestructor(void *interp, void *val)
3726 JimDecrCmdRefCount(interp, val);
3729 static const Jim_HashTableType JimCommandsHashTableType = {
3730 JimStringCopyHTHashFunction, /* hash function */
3731 JimStringCopyHTDup, /* key dup */
3732 NULL, /* val dup */
3733 JimStringCopyHTKeyCompare, /* key compare */
3734 JimStringCopyHTKeyDestructor, /* key destructor */
3735 JimCommandsHT_ValDestructor /* val destructor */
3738 /* ------------------------- Commands related functions --------------------- */
3740 #ifdef jim_ext_namespace
3742 * Returns the "unscoped" version of the given namespace.
3743 * That is, the fully qualfied name without the leading ::
3744 * The returned value is either nsObj, or an object with a zero ref count.
3746 static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj)
3748 const char *name = Jim_String(nsObj);
3749 if (name[0] == ':' && name[1] == ':') {
3750 /* This command is being defined in the global namespace */
3751 while (*++name == ':') {
3753 nsObj = Jim_NewStringObj(interp, name, -1);
3755 else if (Jim_Length(interp->framePtr->nsObj)) {
3756 /* This command is being defined in a non-global namespace */
3757 nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3758 Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3760 return nsObj;
3763 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3765 Jim_Obj *resultObj;
3767 const char *name = Jim_String(nameObjPtr);
3768 if (name[0] == ':' && name[1] == ':') {
3769 return nameObjPtr;
3771 Jim_IncrRefCount(nameObjPtr);
3772 resultObj = Jim_NewStringObj(interp, "::", -1);
3773 Jim_AppendObj(interp, resultObj, nameObjPtr);
3774 Jim_DecrRefCount(interp, nameObjPtr);
3776 return resultObj;
3780 * An efficient version of JimQualifyNameObj() where the name is
3781 * available (and needed) as a 'const char *'.
3782 * Avoids creating an object if not necessary.
3783 * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
3785 static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr)
3787 Jim_Obj *objPtr = interp->emptyObj;
3789 if (name[0] == ':' && name[1] == ':') {
3790 /* This command is being defined in the global namespace */
3791 while (*++name == ':') {
3794 else if (Jim_Length(interp->framePtr->nsObj)) {
3795 /* This command is being defined in a non-global namespace */
3796 objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3797 Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3798 name = Jim_String(objPtr);
3800 Jim_IncrRefCount(objPtr);
3801 *objPtrPtr = objPtr;
3802 return name;
3805 #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3807 #else
3808 /* We can be more efficient in the no-namespace case */
3809 #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3810 #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3812 Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr)
3814 return nameObjPtr;
3816 #endif
3818 static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd)
3820 /* It may already exist, so we try to delete the old one.
3821 * Note that reference count means that it won't be deleted yet if
3822 * it exists in the call stack.
3824 * BUT, if 'local' is in force, instead of deleting the existing
3825 * proc, we stash a reference to the old proc here.
3827 Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3828 if (he) {
3829 /* There was an old cmd with the same name,
3830 * so this requires a 'proc epoch' update. */
3832 /* If a procedure with the same name didn't exist there is no need
3833 * to increment the 'proc epoch' because creation of a new procedure
3834 * can never affect existing cached commands. We don't do
3835 * negative caching. */
3836 Jim_InterpIncrProcEpoch(interp);
3839 if (he && interp->local) {
3840 /* Push this command over the top of the previous one */
3841 cmd->prevCmd = he->u.val;
3842 he->u.val = cmd;
3844 else {
3845 if (he) {
3846 /* Replace the existing command */
3847 Jim_DeleteHashEntry(&interp->commands, name);
3850 Jim_AddHashEntry(&interp->commands, name, cmd);
3852 return JIM_OK;
3856 int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr,
3857 Jim_CmdProc cmdProc, void *privData, Jim_DelCmdProc delProc)
3859 Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
3861 /* Store the new details for this command */
3862 memset(cmdPtr, 0, sizeof(*cmdPtr));
3863 cmdPtr->inUse = 1;
3864 cmdPtr->u.native.delProc = delProc;
3865 cmdPtr->u.native.cmdProc = cmdProc;
3866 cmdPtr->u.native.privData = privData;
3868 JimCreateCommand(interp, cmdNameStr, cmdPtr);
3870 return JIM_OK;
3873 static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr)
3875 int len, i;
3877 len = Jim_ListLength(interp, staticsListObjPtr);
3878 if (len == 0) {
3879 return JIM_OK;
3882 cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable));
3883 Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp);
3884 for (i = 0; i < len; i++) {
3885 Jim_Obj *objPtr = NULL, *initObjPtr = NULL, *nameObjPtr = NULL;
3886 Jim_Var *varPtr;
3887 int subLen;
3889 Jim_ListIndex(interp, staticsListObjPtr, i, &objPtr, JIM_NONE);
3890 /* Check if it's composed of two elements. */
3891 subLen = Jim_ListLength(interp, objPtr);
3892 if (subLen == 1 || subLen == 2) {
3893 /* Try to get the variable value from the current
3894 * environment. */
3895 Jim_ListIndex(interp, objPtr, 0, &nameObjPtr, JIM_NONE);
3896 if (subLen == 1) {
3897 initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE);
3898 if (initObjPtr == NULL) {
3899 Jim_SetResultFormatted(interp,
3900 "variable for initialization of static \"%#s\" not found in the local context",
3901 nameObjPtr);
3902 return JIM_ERR;
3905 else {
3906 Jim_ListIndex(interp, objPtr, 1, &initObjPtr, JIM_NONE);
3908 if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
3909 return JIM_ERR;
3912 varPtr = Jim_Alloc(sizeof(*varPtr));
3913 varPtr->objPtr = initObjPtr;
3914 Jim_IncrRefCount(initObjPtr);
3915 varPtr->linkFramePtr = NULL;
3916 if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
3917 Jim_String(nameObjPtr), varPtr) != JIM_OK) {
3918 Jim_SetResultFormatted(interp,
3919 "static variable name \"%#s\" duplicated in statics list", nameObjPtr);
3920 Jim_DecrRefCount(interp, initObjPtr);
3921 Jim_Free(varPtr);
3922 return JIM_ERR;
3925 else {
3926 Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
3927 objPtr);
3928 return JIM_ERR;
3931 return JIM_OK;
3934 static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname)
3936 #ifdef jim_ext_namespace
3937 if (cmdPtr->isproc) {
3938 /* XXX: Really need JimNamespaceSplit() */
3939 const char *pt = strrchr(cmdname, ':');
3940 if (pt && pt != cmdname && pt[-1] == ':') {
3941 Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
3942 cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
3943 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3945 if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
3946 /* This commands shadows a global command, so a proc epoch update is required */
3947 Jim_InterpIncrProcEpoch(interp);
3951 #endif
3954 static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr,
3955 Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj)
3957 Jim_Cmd *cmdPtr;
3958 int argListLen;
3959 int i;
3961 argListLen = Jim_ListLength(interp, argListObjPtr);
3963 /* Allocate space for both the command pointer and the arg list */
3964 cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
3965 memset(cmdPtr, 0, sizeof(*cmdPtr));
3966 cmdPtr->inUse = 1;
3967 cmdPtr->isproc = 1;
3968 cmdPtr->u.proc.argListObjPtr = argListObjPtr;
3969 cmdPtr->u.proc.argListLen = argListLen;
3970 cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
3971 cmdPtr->u.proc.argsPos = -1;
3972 cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
3973 cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj;
3974 Jim_IncrRefCount(argListObjPtr);
3975 Jim_IncrRefCount(bodyObjPtr);
3976 Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
3978 /* Create the statics hash table. */
3979 if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) {
3980 goto err;
3983 /* Parse the args out into arglist, validating as we go */
3984 /* Examine the argument list for default parameters and 'args' */
3985 for (i = 0; i < argListLen; i++) {
3986 Jim_Obj *argPtr;
3987 Jim_Obj *nameObjPtr;
3988 Jim_Obj *defaultObjPtr;
3989 int len;
3991 /* Examine a parameter */
3992 Jim_ListIndex(interp, argListObjPtr, i, &argPtr, JIM_NONE);
3993 len = Jim_ListLength(interp, argPtr);
3994 if (len == 0) {
3995 Jim_SetResultString(interp, "argument with no name", -1);
3996 err:
3997 JimDecrCmdRefCount(interp, cmdPtr);
3998 return NULL;
4000 if (len > 2) {
4001 Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr);
4002 goto err;
4005 if (len == 2) {
4006 /* Optional parameter */
4007 Jim_ListIndex(interp, argPtr, 0, &nameObjPtr, JIM_NONE);
4008 Jim_ListIndex(interp, argPtr, 1, &defaultObjPtr, JIM_NONE);
4010 else {
4011 /* Required parameter */
4012 nameObjPtr = argPtr;
4013 defaultObjPtr = NULL;
4017 if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
4018 if (cmdPtr->u.proc.argsPos >= 0) {
4019 Jim_SetResultString(interp, "'args' specified more than once", -1);
4020 goto err;
4022 cmdPtr->u.proc.argsPos = i;
4024 else {
4025 if (len == 2) {
4026 cmdPtr->u.proc.optArity++;
4028 else {
4029 cmdPtr->u.proc.reqArity++;
4033 cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
4034 cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
4037 return cmdPtr;
4040 int Jim_DeleteCommand(Jim_Interp *interp, const char *name)
4042 int ret = JIM_OK;
4043 Jim_Obj *qualifiedNameObj;
4044 const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4046 if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4047 Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
4048 ret = JIM_ERR;
4050 else {
4051 Jim_InterpIncrProcEpoch(interp);
4054 JimFreeQualifiedName(interp, qualifiedNameObj);
4056 return ret;
4059 int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName)
4061 int ret = JIM_ERR;
4062 Jim_HashEntry *he;
4063 Jim_Cmd *cmdPtr;
4064 Jim_Obj *qualifiedOldNameObj;
4065 Jim_Obj *qualifiedNewNameObj;
4066 const char *fqold;
4067 const char *fqnew;
4069 if (newName[0] == 0) {
4070 return Jim_DeleteCommand(interp, oldName);
4073 fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4074 fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
4076 /* Does it exist? */
4077 he = Jim_FindHashEntry(&interp->commands, fqold);
4078 if (he == NULL) {
4079 Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4081 else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4082 Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
4084 else {
4085 /* Add the new name first */
4086 cmdPtr = he->u.val;
4087 JimIncrCmdRefCount(cmdPtr);
4088 JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4089 Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4091 /* Now remove the old name */
4092 Jim_DeleteHashEntry(&interp->commands, fqold);
4094 /* Increment the epoch */
4095 Jim_InterpIncrProcEpoch(interp);
4097 ret = JIM_OK;
4100 JimFreeQualifiedName(interp, qualifiedOldNameObj);
4101 JimFreeQualifiedName(interp, qualifiedNewNameObj);
4103 return ret;
4106 /* -----------------------------------------------------------------------------
4107 * Command object
4108 * ---------------------------------------------------------------------------*/
4110 static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4112 Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj);
4115 static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4117 dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue;
4118 dupPtr->typePtr = srcPtr->typePtr;
4119 Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj);
4122 static const Jim_ObjType commandObjType = {
4123 "command",
4124 FreeCommandInternalRep,
4125 DupCommandInternalRep,
4126 NULL,
4127 JIM_TYPE_REFERENCES,
4130 /* This function returns the command structure for the command name
4131 * stored in objPtr. It tries to specialize the objPtr to contain
4132 * a cached info instead to perform the lookup into the hash table
4133 * every time. The information cached may not be uptodate, in such
4134 * a case the lookup is performed and the cache updated.
4136 * Respects the 'upcall' setting
4138 Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4140 Jim_Cmd *cmd;
4142 /* In order to be valid, the proc epoch must match and
4143 * the lookup must have occurred in the same namespace
4145 if (objPtr->typePtr != &commandObjType ||
4146 objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
4147 #ifdef jim_ext_namespace
4148 || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4149 #endif
4151 /* Not cached or out of date, so lookup */
4153 /* Do we need to try the local namespace? */
4154 const char *name = Jim_String(objPtr);
4155 Jim_HashEntry *he;
4157 if (name[0] == ':' && name[1] == ':') {
4158 while (*++name == ':') {
4161 #ifdef jim_ext_namespace
4162 else if (Jim_Length(interp->framePtr->nsObj)) {
4163 /* This command is being defined in a non-global namespace */
4164 Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4165 Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4166 he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4167 Jim_FreeNewObj(interp, nameObj);
4168 if (he) {
4169 goto found;
4172 #endif
4174 /* Lookup in the global namespace */
4175 he = Jim_FindHashEntry(&interp->commands, name);
4176 if (he == NULL) {
4177 if (flags & JIM_ERRMSG) {
4178 Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4180 return NULL;
4182 #ifdef jim_ext_namespace
4183 found:
4184 #endif
4185 cmd = (Jim_Cmd *)he->u.val;
4187 /* Free the old internal repr and set the new one. */
4188 Jim_FreeIntRep(interp, objPtr);
4189 objPtr->typePtr = &commandObjType;
4190 objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch;
4191 objPtr->internalRep.cmdValue.cmdPtr = cmd;
4192 objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4193 Jim_IncrRefCount(interp->framePtr->nsObj);
4195 else {
4196 cmd = objPtr->internalRep.cmdValue.cmdPtr;
4198 while (cmd->u.proc.upcall) {
4199 cmd = cmd->prevCmd;
4201 return cmd;
4204 /* -----------------------------------------------------------------------------
4205 * Variables
4206 * ---------------------------------------------------------------------------*/
4208 /* -----------------------------------------------------------------------------
4209 * Variable object
4210 * ---------------------------------------------------------------------------*/
4212 #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */
4214 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
4216 static const Jim_ObjType variableObjType = {
4217 "variable",
4218 NULL,
4219 NULL,
4220 NULL,
4221 JIM_TYPE_REFERENCES,
4225 * Check that the name does not contain embedded nulls.
4227 * Variable and procedure names are maniplated as null terminated strings, so
4228 * don't allow names with embedded nulls.
4230 static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr)
4232 /* Variable names and proc names can't contain embedded nulls */
4233 if (nameObjPtr->typePtr != &variableObjType) {
4234 int len;
4235 const char *str = Jim_GetString(nameObjPtr, &len);
4236 if (memchr(str, '\0', len)) {
4237 Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4238 return JIM_ERR;
4241 return JIM_OK;
4244 /* This method should be called only by the variable API.
4245 * It returns JIM_OK on success (variable already exists),
4246 * JIM_ERR if it does not exists, JIM_DICT_SUGAR if it's not
4247 * a variable name, but syntax glue for [dict] i.e. the last
4248 * character is ')' */
4249 static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
4251 const char *varName;
4252 Jim_CallFrame *framePtr;
4253 Jim_HashEntry *he;
4254 int global;
4255 int len;
4257 /* Check if the object is already an uptodate variable */
4258 if (objPtr->typePtr == &variableObjType) {
4259 framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr;
4260 if (objPtr->internalRep.varValue.callFrameId == framePtr->id) {
4261 /* nothing to do */
4262 return JIM_OK;
4264 /* Need to re-resolve the variable in the updated callframe */
4266 else if (objPtr->typePtr == &dictSubstObjType) {
4267 return JIM_DICT_SUGAR;
4269 else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4270 return JIM_ERR;
4274 varName = Jim_GetString(objPtr, &len);
4276 /* Make sure it's not syntax glue to get/set dict. */
4277 if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) {
4278 return JIM_DICT_SUGAR;
4281 if (varName[0] == ':' && varName[1] == ':') {
4282 while (*++varName == ':') {
4284 global = 1;
4285 framePtr = interp->topFramePtr;
4287 else {
4288 global = 0;
4289 framePtr = interp->framePtr;
4292 /* Resolve this name in the variables hash table */
4293 he = Jim_FindHashEntry(&framePtr->vars, varName);
4294 if (he == NULL) {
4295 if (!global && framePtr->staticVars) {
4296 /* Try with static vars. */
4297 he = Jim_FindHashEntry(framePtr->staticVars, varName);
4299 if (he == NULL) {
4300 return JIM_ERR;
4304 /* Free the old internal repr and set the new one. */
4305 Jim_FreeIntRep(interp, objPtr);
4306 objPtr->typePtr = &variableObjType;
4307 objPtr->internalRep.varValue.callFrameId = framePtr->id;
4308 objPtr->internalRep.varValue.varPtr = he->u.val;
4309 objPtr->internalRep.varValue.global = global;
4310 return JIM_OK;
4313 /* -------------------- Variables related functions ------------------------- */
4314 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr);
4315 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags);
4317 static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4319 const char *name;
4320 Jim_CallFrame *framePtr;
4321 int global;
4323 /* New variable to create */
4324 Jim_Var *var = Jim_Alloc(sizeof(*var));
4326 var->objPtr = valObjPtr;
4327 Jim_IncrRefCount(valObjPtr);
4328 var->linkFramePtr = NULL;
4330 name = Jim_String(nameObjPtr);
4331 if (name[0] == ':' && name[1] == ':') {
4332 while (*++name == ':') {
4334 framePtr = interp->topFramePtr;
4335 global = 1;
4337 else {
4338 framePtr = interp->framePtr;
4339 global = 0;
4342 /* Insert the new variable */
4343 Jim_AddHashEntry(&framePtr->vars, name, var);
4345 /* Make the object int rep a variable */
4346 Jim_FreeIntRep(interp, nameObjPtr);
4347 nameObjPtr->typePtr = &variableObjType;
4348 nameObjPtr->internalRep.varValue.callFrameId = framePtr->id;
4349 nameObjPtr->internalRep.varValue.varPtr = var;
4350 nameObjPtr->internalRep.varValue.global = global;
4352 return var;
4355 /* For now that's dummy. Variables lookup should be optimized
4356 * in many ways, with caching of lookups, and possibly with
4357 * a table of pre-allocated vars in every CallFrame for local vars.
4358 * All the caching should also have an 'epoch' mechanism similar
4359 * to the one used by Tcl for procedures lookup caching. */
4361 int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr)
4363 int err;
4364 Jim_Var *var;
4366 switch (SetVariableFromAny(interp, nameObjPtr)) {
4367 case JIM_DICT_SUGAR:
4368 return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4370 case JIM_ERR:
4371 if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4372 return JIM_ERR;
4374 JimCreateVariable(interp, nameObjPtr, valObjPtr);
4375 break;
4377 case JIM_OK:
4378 var = nameObjPtr->internalRep.varValue.varPtr;
4379 if (var->linkFramePtr == NULL) {
4380 Jim_IncrRefCount(valObjPtr);
4381 Jim_DecrRefCount(interp, var->objPtr);
4382 var->objPtr = valObjPtr;
4384 else { /* Else handle the link */
4385 Jim_CallFrame *savedCallFrame;
4387 savedCallFrame = interp->framePtr;
4388 interp->framePtr = var->linkFramePtr;
4389 err = Jim_SetVariable(interp, var->objPtr, valObjPtr);
4390 interp->framePtr = savedCallFrame;
4391 if (err != JIM_OK)
4392 return err;
4395 return JIM_OK;
4398 int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4400 Jim_Obj *nameObjPtr;
4401 int result;
4403 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4404 Jim_IncrRefCount(nameObjPtr);
4405 result = Jim_SetVariable(interp, nameObjPtr, objPtr);
4406 Jim_DecrRefCount(interp, nameObjPtr);
4407 return result;
4410 int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr)
4412 Jim_CallFrame *savedFramePtr;
4413 int result;
4415 savedFramePtr = interp->framePtr;
4416 interp->framePtr = interp->topFramePtr;
4417 result = Jim_SetVariableStr(interp, name, objPtr);
4418 interp->framePtr = savedFramePtr;
4419 return result;
4422 int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val)
4424 Jim_Obj *nameObjPtr, *valObjPtr;
4425 int result;
4427 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4428 valObjPtr = Jim_NewStringObj(interp, val, -1);
4429 Jim_IncrRefCount(nameObjPtr);
4430 Jim_IncrRefCount(valObjPtr);
4431 result = Jim_SetVariable(interp, nameObjPtr, valObjPtr);
4432 Jim_DecrRefCount(interp, nameObjPtr);
4433 Jim_DecrRefCount(interp, valObjPtr);
4434 return result;
4437 int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr,
4438 Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame)
4440 const char *varName;
4441 const char *targetName;
4442 Jim_CallFrame *framePtr;
4443 Jim_Var *varPtr;
4445 /* Check for an existing variable or link */
4446 switch (SetVariableFromAny(interp, nameObjPtr)) {
4447 case JIM_DICT_SUGAR:
4448 /* XXX: This message seem unnecessarily verbose, but it matches Tcl */
4449 Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr);
4450 return JIM_ERR;
4452 case JIM_OK:
4453 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4455 if (varPtr->linkFramePtr == NULL) {
4456 Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr);
4457 return JIM_ERR;
4460 /* It exists, but is a link, so first delete the link */
4461 varPtr->linkFramePtr = NULL;
4462 break;
4465 /* Resolve the call frames for both variables */
4466 /* XXX: SetVariableFromAny() already did this! */
4467 varName = Jim_String(nameObjPtr);
4469 if (varName[0] == ':' && varName[1] == ':') {
4470 while (*++varName == ':') {
4472 /* Linking a global var does nothing */
4473 framePtr = interp->topFramePtr;
4475 else {
4476 framePtr = interp->framePtr;
4479 targetName = Jim_String(targetNameObjPtr);
4480 if (targetName[0] == ':' && targetName[1] == ':') {
4481 while (*++targetName == ':') {
4483 targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
4484 targetCallFrame = interp->topFramePtr;
4486 Jim_IncrRefCount(targetNameObjPtr);
4488 if (framePtr->level < targetCallFrame->level) {
4489 Jim_SetResultFormatted(interp,
4490 "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable",
4491 nameObjPtr);
4492 Jim_DecrRefCount(interp, targetNameObjPtr);
4493 return JIM_ERR;
4496 /* Check for cycles. */
4497 if (framePtr == targetCallFrame) {
4498 Jim_Obj *objPtr = targetNameObjPtr;
4500 /* Cycles are only possible with 'uplevel 0' */
4501 while (1) {
4502 if (strcmp(Jim_String(objPtr), varName) == 0) {
4503 Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4504 Jim_DecrRefCount(interp, targetNameObjPtr);
4505 return JIM_ERR;
4507 if (SetVariableFromAny(interp, objPtr) != JIM_OK)
4508 break;
4509 varPtr = objPtr->internalRep.varValue.varPtr;
4510 if (varPtr->linkFramePtr != targetCallFrame)
4511 break;
4512 objPtr = varPtr->objPtr;
4516 /* Perform the binding */
4517 Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr);
4518 /* We are now sure 'nameObjPtr' type is variableObjType */
4519 nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame;
4520 Jim_DecrRefCount(interp, targetNameObjPtr);
4521 return JIM_OK;
4524 /* Return the Jim_Obj pointer associated with a variable name,
4525 * or NULL if the variable was not found in the current context.
4526 * The same optimization discussed in the comment to the
4527 * 'SetVariable' function should apply here.
4529 * If JIM_UNSHARED is set and the variable is an array element (dict sugar)
4530 * in a dictionary which is shared, the array variable value is duplicated first.
4531 * This allows the array element to be updated (e.g. append, lappend) without
4532 * affecting other references to the dictionary.
4534 Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4536 switch (SetVariableFromAny(interp, nameObjPtr)) {
4537 case JIM_OK:{
4538 Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;
4540 if (varPtr->linkFramePtr == NULL) {
4541 return varPtr->objPtr;
4543 else {
4544 Jim_Obj *objPtr;
4546 /* The variable is a link? Resolve it. */
4547 Jim_CallFrame *savedCallFrame = interp->framePtr;
4549 interp->framePtr = varPtr->linkFramePtr;
4550 objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags);
4551 interp->framePtr = savedCallFrame;
4552 if (objPtr) {
4553 return objPtr;
4555 /* Error, so fall through to the error message */
4558 break;
4560 case JIM_DICT_SUGAR:
4561 /* [dict] syntax sugar. */
4562 return JimDictSugarGet(interp, nameObjPtr, flags);
4564 if (flags & JIM_ERRMSG) {
4565 Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr);
4567 return NULL;
4570 Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4572 Jim_CallFrame *savedFramePtr;
4573 Jim_Obj *objPtr;
4575 savedFramePtr = interp->framePtr;
4576 interp->framePtr = interp->topFramePtr;
4577 objPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4578 interp->framePtr = savedFramePtr;
4580 return objPtr;
4583 Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags)
4585 Jim_Obj *nameObjPtr, *varObjPtr;
4587 nameObjPtr = Jim_NewStringObj(interp, name, -1);
4588 Jim_IncrRefCount(nameObjPtr);
4589 varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags);
4590 Jim_DecrRefCount(interp, nameObjPtr);
4591 return varObjPtr;
4594 Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags)
4596 Jim_CallFrame *savedFramePtr;
4597 Jim_Obj *objPtr;
4599 savedFramePtr = interp->framePtr;
4600 interp->framePtr = interp->topFramePtr;
4601 objPtr = Jim_GetVariableStr(interp, name, flags);
4602 interp->framePtr = savedFramePtr;
4604 return objPtr;
4607 /* Unset a variable.
4608 * Note: On success unset invalidates all the variable objects created
4609 * in the current call frame incrementing. */
4610 int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags)
4612 Jim_Var *varPtr;
4613 int retval;
4614 Jim_CallFrame *framePtr;
4616 retval = SetVariableFromAny(interp, nameObjPtr);
4617 if (retval == JIM_DICT_SUGAR) {
4618 /* [dict] syntax sugar. */
4619 return JimDictSugarSet(interp, nameObjPtr, NULL);
4621 else if (retval == JIM_OK) {
4622 varPtr = nameObjPtr->internalRep.varValue.varPtr;
4624 /* If it's a link call UnsetVariable recursively */
4625 if (varPtr->linkFramePtr) {
4626 framePtr = interp->framePtr;
4627 interp->framePtr = varPtr->linkFramePtr;
4628 retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE);
4629 interp->framePtr = framePtr;
4631 else {
4632 const char *name = Jim_String(nameObjPtr);
4633 if (nameObjPtr->internalRep.varValue.global) {
4634 name += 2;
4635 framePtr = interp->topFramePtr;
4637 else {
4638 framePtr = interp->framePtr;
4641 retval = Jim_DeleteHashEntry(&framePtr->vars, name);
4642 if (retval == JIM_OK) {
4643 /* Change the callframe id, invalidating var lookup caching */
4644 JimChangeCallFrameId(interp, framePtr);
4648 if (retval != JIM_OK && (flags & JIM_ERRMSG)) {
4649 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr);
4651 return retval;
4654 /* ---------- Dict syntax sugar (similar to array Tcl syntax) -------------- */
4656 /* Given a variable name for [dict] operation syntax sugar,
4657 * this function returns two objects, the first with the name
4658 * of the variable to set, and the second with the rispective key.
4659 * For example "foo(bar)" will return objects with string repr. of
4660 * "foo" and "bar".
4662 * The returned objects have refcount = 1. The function can't fail. */
4663 static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr,
4664 Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr)
4666 const char *str, *p;
4667 int len, keyLen;
4668 Jim_Obj *varObjPtr, *keyObjPtr;
4670 str = Jim_GetString(objPtr, &len);
4672 p = strchr(str, '(');
4673 JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str));
4675 varObjPtr = Jim_NewStringObj(interp, str, p - str);
4677 p++;
4678 keyLen = (str + len) - p;
4679 if (str[len - 1] == ')') {
4680 keyLen--;
4683 /* Create the objects with the variable name and key. */
4684 keyObjPtr = Jim_NewStringObj(interp, p, keyLen);
4686 Jim_IncrRefCount(varObjPtr);
4687 Jim_IncrRefCount(keyObjPtr);
4688 *varPtrPtr = varObjPtr;
4689 *keyPtrPtr = keyObjPtr;
4692 /* Helper of Jim_SetVariable() to deal with dict-syntax variable names.
4693 * Also used by Jim_UnsetVariable() with valObjPtr = NULL. */
4694 static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr)
4696 int err;
4698 SetDictSubstFromAny(interp, objPtr);
4700 err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4701 &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST);
4703 if (err == JIM_OK) {
4704 /* Don't keep an extra ref to the result */
4705 Jim_SetEmptyResult(interp);
4707 else {
4708 if (!valObjPtr) {
4709 /* Better error message for unset a(2) where a exists but a(2) doesn't */
4710 if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) {
4711 Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array",
4712 objPtr);
4713 return err;
4716 /* Make the error more informative and Tcl-compatible */
4717 Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array",
4718 (valObjPtr ? "set" : "unset"), objPtr);
4720 return err;
4724 * Expands the array variable (dict sugar) and returns the result, or NULL on error.
4726 * If JIM_UNSHARED is set and the dictionary is shared, it will be duplicated
4727 * and stored back to the variable before expansion.
4729 static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr,
4730 Jim_Obj *keyObjPtr, int flags)
4732 Jim_Obj *dictObjPtr;
4733 Jim_Obj *resObjPtr = NULL;
4734 int ret;
4736 dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG);
4737 if (!dictObjPtr) {
4738 return NULL;
4741 ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE);
4742 if (ret != JIM_OK) {
4743 Jim_SetResultFormatted(interp,
4744 "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr,
4745 ret < 0 ? "variable isn't" : "no such element in");
4747 else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) {
4748 /* Update the variable to have an unshared copy */
4749 Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr));
4752 return resObjPtr;
4755 /* Helper of Jim_GetVariable() to deal with dict-syntax variable names */
4756 static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
4758 SetDictSubstFromAny(interp, objPtr);
4760 return JimDictExpandArrayVariable(interp,
4761 objPtr->internalRep.dictSubstValue.varNameObjPtr,
4762 objPtr->internalRep.dictSubstValue.indexObjPtr, flags);
4765 /* --------- $var(INDEX) substitution, using a specialized object ----------- */
4767 void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
4769 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr);
4770 Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr);
4773 void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
4775 JIM_NOTUSED(interp);
4777 dupPtr->internalRep.dictSubstValue.varNameObjPtr =
4778 srcPtr->internalRep.dictSubstValue.varNameObjPtr;
4779 dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr;
4780 dupPtr->typePtr = &dictSubstObjType;
4783 /* Note: The object *must* be in dict-sugar format */
4784 static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
4786 if (objPtr->typePtr != &dictSubstObjType) {
4787 Jim_Obj *varObjPtr, *keyObjPtr;
4789 if (objPtr->typePtr == &interpolatedObjType) {
4790 /* An interpolated object in dict-sugar form */
4792 varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr;
4793 keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr;
4795 Jim_IncrRefCount(varObjPtr);
4796 Jim_IncrRefCount(keyObjPtr);
4798 else {
4799 JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr);
4802 Jim_FreeIntRep(interp, objPtr);
4803 objPtr->typePtr = &dictSubstObjType;
4804 objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr;
4805 objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr;
4809 /* This function is used to expand [dict get] sugar in the form
4810 * of $var(INDEX). The function is mainly used by Jim_EvalObj()
4811 * to deal with tokens of type JIM_TT_DICTSUGAR. objPtr points to an
4812 * object that is *guaranteed* to be in the form VARNAME(INDEX).
4813 * The 'index' part is [subst]ituted, and is used to lookup a key inside
4814 * the [dict]ionary contained in variable VARNAME. */
4815 static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4817 Jim_Obj *resObjPtr = NULL;
4818 Jim_Obj *substKeyObjPtr = NULL;
4820 SetDictSubstFromAny(interp, objPtr);
4822 if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,
4823 &substKeyObjPtr, JIM_NONE)
4824 != JIM_OK) {
4825 return NULL;
4827 Jim_IncrRefCount(substKeyObjPtr);
4828 resObjPtr =
4829 JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr,
4830 substKeyObjPtr, 0);
4831 Jim_DecrRefCount(interp, substKeyObjPtr);
4833 return resObjPtr;
4836 static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr)
4838 Jim_Obj *resultObjPtr;
4840 if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) {
4841 /* Note that the result has a ref count of 1, but we need a ref count of 0 */
4842 resultObjPtr->refCount--;
4843 return resultObjPtr;
4845 return NULL;
4848 /* -----------------------------------------------------------------------------
4849 * CallFrame
4850 * ---------------------------------------------------------------------------*/
4852 static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj)
4854 Jim_CallFrame *cf;
4856 if (interp->freeFramesList) {
4857 cf = interp->freeFramesList;
4858 interp->freeFramesList = cf->next;
4860 cf->argv = NULL;
4861 cf->argc = 0;
4862 cf->procArgsObjPtr = NULL;
4863 cf->procBodyObjPtr = NULL;
4864 cf->next = NULL;
4865 cf->staticVars = NULL;
4866 cf->localCommands = NULL;
4867 cf->tailcall = 0;
4868 cf->tailcallObj = NULL;
4869 cf->tailcallCmd = NULL;
4871 else {
4872 cf = Jim_Alloc(sizeof(*cf));
4873 memset(cf, 0, sizeof(*cf));
4875 Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp);
4878 cf->id = interp->callFrameEpoch++;
4879 cf->parent = parent;
4880 cf->level = parent ? parent->level + 1 : 0;
4881 cf->nsObj = nsObj;
4882 Jim_IncrRefCount(nsObj);
4884 return cf;
4887 /* Used to invalidate every caching related to callframe stability. */
4888 static void JimChangeCallFrameId(Jim_Interp *interp, Jim_CallFrame *cf)
4890 cf->id = interp->callFrameEpoch++;
4893 static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands)
4895 /* Delete any local procs */
4896 if (localCommands) {
4897 Jim_Obj *cmdNameObj;
4899 while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4900 Jim_HashEntry *he;
4901 Jim_Obj *fqObjName;
4903 const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4905 he = Jim_FindHashEntry(&interp->commands, fqname);
4907 if (he) {
4908 Jim_Cmd *cmd = he->u.val;
4909 if (cmd->prevCmd) {
4910 Jim_Cmd *prevCmd = cmd->prevCmd;
4911 cmd->prevCmd = NULL;
4913 /* Delete the old command */
4914 JimDecrCmdRefCount(interp, cmd);
4916 /* And restore the original */
4917 he->u.val = prevCmd;
4919 else {
4920 Jim_DeleteHashEntry(&interp->commands, fqname);
4921 Jim_InterpIncrProcEpoch(interp);
4924 Jim_DecrRefCount(interp, cmdNameObj);
4925 JimFreeQualifiedName(interp, fqObjName);
4927 Jim_FreeStack(localCommands);
4928 Jim_Free(localCommands);
4930 return JIM_OK;
4934 #define JIM_FCF_FULL 0 /* Always free the vars hash table */
4935 #define JIM_FCF_REUSE 1 /* Reuse the vars hash table if possible */
4936 static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
4938 JimDeleteLocalProcs(interp, cf->localCommands);
4940 if (cf->procArgsObjPtr)
4941 Jim_DecrRefCount(interp, cf->procArgsObjPtr);
4942 if (cf->procBodyObjPtr)
4943 Jim_DecrRefCount(interp, cf->procBodyObjPtr);
4944 Jim_DecrRefCount(interp, cf->nsObj);
4945 if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE)
4946 Jim_FreeHashTable(&cf->vars);
4947 else {
4948 int i;
4949 Jim_HashEntry **table = cf->vars.table, *he;
4951 for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
4952 he = table[i];
4953 while (he != NULL) {
4954 Jim_HashEntry *nextEntry = he->next;
4955 Jim_Var *varPtr = (void *)he->u.val;
4957 Jim_DecrRefCount(interp, varPtr->objPtr);
4958 Jim_Free(he->u.val);
4959 Jim_Free((void *)he->key); /* ATTENTION: const cast */
4960 Jim_Free(he);
4961 table[i] = NULL;
4962 he = nextEntry;
4965 cf->vars.used = 0;
4967 cf->next = interp->freeFramesList;
4968 interp->freeFramesList = cf;
4972 /* -----------------------------------------------------------------------------
4973 * References
4974 * ---------------------------------------------------------------------------*/
4975 #ifdef JIM_REFERENCES
4977 /* References HashTable Type.
4979 * Keys are unsigned long integers, dynamically allocated for now but in the
4980 * future it's worth to cache this 4 bytes objects. Values are pointers
4981 * to Jim_References. */
4982 static void JimReferencesHTValDestructor(void *interp, void *val)
4984 Jim_Reference *refPtr = (void *)val;
4986 Jim_DecrRefCount(interp, refPtr->objPtr);
4987 if (refPtr->finalizerCmdNamePtr != NULL) {
4988 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
4990 Jim_Free(val);
4993 static unsigned int JimReferencesHTHashFunction(const void *key)
4995 /* Only the least significant bits are used. */
4996 const unsigned long *widePtr = key;
4997 unsigned int intValue = (unsigned int)*widePtr;
4999 return Jim_IntHashFunction(intValue);
5002 static void *JimReferencesHTKeyDup(void *privdata, const void *key)
5004 void *copy = Jim_Alloc(sizeof(unsigned long));
5006 JIM_NOTUSED(privdata);
5008 memcpy(copy, key, sizeof(unsigned long));
5009 return copy;
5012 static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2)
5014 JIM_NOTUSED(privdata);
5016 return memcmp(key1, key2, sizeof(unsigned long)) == 0;
5019 static void JimReferencesHTKeyDestructor(void *privdata, void *key)
5021 JIM_NOTUSED(privdata);
5023 Jim_Free(key);
5026 static const Jim_HashTableType JimReferencesHashTableType = {
5027 JimReferencesHTHashFunction, /* hash function */
5028 JimReferencesHTKeyDup, /* key dup */
5029 NULL, /* val dup */
5030 JimReferencesHTKeyCompare, /* key compare */
5031 JimReferencesHTKeyDestructor, /* key destructor */
5032 JimReferencesHTValDestructor /* val destructor */
5035 /* -----------------------------------------------------------------------------
5036 * Reference object type and References API
5037 * ---------------------------------------------------------------------------*/
5039 /* The string representation of references has two features in order
5040 * to make the GC faster. The first is that every reference starts
5041 * with a non common character '<', in order to make the string matching
5042 * faster. The second is that the reference string rep is 42 characters
5043 * in length, this allows to avoid to check every object with a string
5044 * repr < 42, and usually there aren't many of these objects. */
5046 #define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN)
5048 static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id)
5050 const char *fmt = "<reference.<%s>.%020lu>";
5052 sprintf(buf, fmt, refPtr->tag, id);
5053 return JIM_REFERENCE_SPACE;
5056 static void UpdateStringOfReference(struct Jim_Obj *objPtr);
5058 static const Jim_ObjType referenceObjType = {
5059 "reference",
5060 NULL,
5061 NULL,
5062 UpdateStringOfReference,
5063 JIM_TYPE_REFERENCES,
5066 void UpdateStringOfReference(struct Jim_Obj *objPtr)
5068 char buf[JIM_REFERENCE_SPACE + 1];
5070 JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id);
5071 JimSetStringBytes(objPtr, buf);
5074 /* returns true if 'c' is a valid reference tag character.
5075 * i.e. inside the range [_a-zA-Z0-9] */
5076 static int isrefchar(int c)
5078 return (c == '_' || isalnum(c));
5081 static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5083 unsigned long value;
5084 int i, len;
5085 const char *str, *start, *end;
5086 char refId[21];
5087 Jim_Reference *refPtr;
5088 Jim_HashEntry *he;
5089 char *endptr;
5091 /* Get the string representation */
5092 str = Jim_GetString(objPtr, &len);
5093 /* Check if it looks like a reference */
5094 if (len < JIM_REFERENCE_SPACE)
5095 goto badformat;
5096 /* Trim spaces */
5097 start = str;
5098 end = str + len - 1;
5099 while (*start == ' ')
5100 start++;
5101 while (*end == ' ' && end > start)
5102 end--;
5103 if (end - start + 1 != JIM_REFERENCE_SPACE)
5104 goto badformat;
5105 /* <reference.<1234567>.%020> */
5106 if (memcmp(start, "<reference.<", 12) != 0)
5107 goto badformat;
5108 if (start[12 + JIM_REFERENCE_TAGLEN] != '>' || end[0] != '>')
5109 goto badformat;
5110 /* The tag can't contain chars other than a-zA-Z0-9 + '_'. */
5111 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5112 if (!isrefchar(start[12 + i]))
5113 goto badformat;
5115 /* Extract info from the reference. */
5116 memcpy(refId, start + 14 + JIM_REFERENCE_TAGLEN, 20);
5117 refId[20] = '\0';
5118 /* Try to convert the ID into an unsigned long */
5119 value = strtoul(refId, &endptr, 10);
5120 if (JimCheckConversion(refId, endptr) != JIM_OK)
5121 goto badformat;
5122 /* Check if the reference really exists! */
5123 he = Jim_FindHashEntry(&interp->references, &value);
5124 if (he == NULL) {
5125 Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr);
5126 return JIM_ERR;
5128 refPtr = he->u.val;
5129 /* Free the old internal repr and set the new one. */
5130 Jim_FreeIntRep(interp, objPtr);
5131 objPtr->typePtr = &referenceObjType;
5132 objPtr->internalRep.refValue.id = value;
5133 objPtr->internalRep.refValue.refPtr = refPtr;
5134 return JIM_OK;
5136 badformat:
5137 Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr);
5138 return JIM_ERR;
5141 /* Returns a new reference pointing to objPtr, having cmdNamePtr
5142 * as finalizer command (or NULL if there is no finalizer).
5143 * The returned reference object has refcount = 0. */
5144 Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr)
5146 struct Jim_Reference *refPtr;
5147 unsigned long id;
5148 Jim_Obj *refObjPtr;
5149 const char *tag;
5150 int tagLen, i;
5152 /* Perform the Garbage Collection if needed. */
5153 Jim_CollectIfNeeded(interp);
5155 refPtr = Jim_Alloc(sizeof(*refPtr));
5156 refPtr->objPtr = objPtr;
5157 Jim_IncrRefCount(objPtr);
5158 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5159 if (cmdNamePtr)
5160 Jim_IncrRefCount(cmdNamePtr);
5161 id = interp->referenceNextId++;
5162 Jim_AddHashEntry(&interp->references, &id, refPtr);
5163 refObjPtr = Jim_NewObj(interp);
5164 refObjPtr->typePtr = &referenceObjType;
5165 refObjPtr->bytes = NULL;
5166 refObjPtr->internalRep.refValue.id = id;
5167 refObjPtr->internalRep.refValue.refPtr = refPtr;
5168 interp->referenceNextId++;
5169 /* Set the tag. Trimmed at JIM_REFERENCE_TAGLEN. Everything
5170 * that does not pass the 'isrefchar' test is replaced with '_' */
5171 tag = Jim_GetString(tagPtr, &tagLen);
5172 if (tagLen > JIM_REFERENCE_TAGLEN)
5173 tagLen = JIM_REFERENCE_TAGLEN;
5174 for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) {
5175 if (i < tagLen && isrefchar(tag[i]))
5176 refPtr->tag[i] = tag[i];
5177 else
5178 refPtr->tag[i] = '_';
5180 refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0';
5181 return refObjPtr;
5184 Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr)
5186 if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR)
5187 return NULL;
5188 return objPtr->internalRep.refValue.refPtr;
5191 int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr)
5193 Jim_Reference *refPtr;
5195 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5196 return JIM_ERR;
5197 Jim_IncrRefCount(cmdNamePtr);
5198 if (refPtr->finalizerCmdNamePtr)
5199 Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr);
5200 refPtr->finalizerCmdNamePtr = cmdNamePtr;
5201 return JIM_OK;
5204 int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr)
5206 Jim_Reference *refPtr;
5208 if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL)
5209 return JIM_ERR;
5210 *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr;
5211 return JIM_OK;
5214 /* -----------------------------------------------------------------------------
5215 * References Garbage Collection
5216 * ---------------------------------------------------------------------------*/
5218 /* This the hash table type for the "MARK" phase of the GC */
5219 static const Jim_HashTableType JimRefMarkHashTableType = {
5220 JimReferencesHTHashFunction, /* hash function */
5221 JimReferencesHTKeyDup, /* key dup */
5222 NULL, /* val dup */
5223 JimReferencesHTKeyCompare, /* key compare */
5224 JimReferencesHTKeyDestructor, /* key destructor */
5225 NULL /* val destructor */
5228 /* Performs the garbage collection. */
5229 int Jim_Collect(Jim_Interp *interp)
5231 int collected = 0;
5232 #ifndef JIM_BOOTSTRAP
5233 Jim_HashTable marks;
5234 Jim_HashTableIterator htiter;
5235 Jim_HashEntry *he;
5236 Jim_Obj *objPtr;
5238 /* Avoid recursive calls */
5239 if (interp->lastCollectId == -1) {
5240 /* Jim_Collect() already running. Return just now. */
5241 return 0;
5243 interp->lastCollectId = -1;
5245 /* Mark all the references found into the 'mark' hash table.
5246 * The references are searched in every live object that
5247 * is of a type that can contain references. */
5248 Jim_InitHashTable(&marks, &JimRefMarkHashTableType, NULL);
5249 objPtr = interp->liveList;
5250 while (objPtr) {
5251 if (objPtr->typePtr == NULL || objPtr->typePtr->flags & JIM_TYPE_REFERENCES) {
5252 const char *str, *p;
5253 int len;
5255 /* If the object is of type reference, to get the
5256 * Id is simple... */
5257 if (objPtr->typePtr == &referenceObjType) {
5258 Jim_AddHashEntry(&marks, &objPtr->internalRep.refValue.id, NULL);
5259 #ifdef JIM_DEBUG_GC
5260 printf("MARK (reference): %d refcount: %d" JIM_NL,
5261 (int)objPtr->internalRep.refValue.id, objPtr->refCount);
5262 #endif
5263 objPtr = objPtr->nextObjPtr;
5264 continue;
5266 /* Get the string repr of the object we want
5267 * to scan for references. */
5268 p = str = Jim_GetString(objPtr, &len);
5269 /* Skip objects too little to contain references. */
5270 if (len < JIM_REFERENCE_SPACE) {
5271 objPtr = objPtr->nextObjPtr;
5272 continue;
5274 /* Extract references from the object string repr. */
5275 while (1) {
5276 int i;
5277 unsigned long id;
5279 if ((p = strstr(p, "<reference.<")) == NULL)
5280 break;
5281 /* Check if it's a valid reference. */
5282 if (len - (p - str) < JIM_REFERENCE_SPACE)
5283 break;
5284 if (p[41] != '>' || p[19] != '>' || p[20] != '.')
5285 break;
5286 for (i = 21; i <= 40; i++)
5287 if (!isdigit(UCHAR(p[i])))
5288 break;
5289 /* Get the ID */
5290 id = strtoul(p + 21, NULL, 10);
5292 /* Ok, a reference for the given ID
5293 * was found. Mark it. */
5294 Jim_AddHashEntry(&marks, &id, NULL);
5295 #ifdef JIM_DEBUG_GC
5296 printf("MARK: %d" JIM_NL, (int)id);
5297 #endif
5298 p += JIM_REFERENCE_SPACE;
5301 objPtr = objPtr->nextObjPtr;
5304 /* Run the references hash table to destroy every reference that
5305 * is not referenced outside (not present in the mark HT). */
5306 JimInitHashTableIterator(&interp->references, &htiter);
5307 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
5308 const unsigned long *refId;
5309 Jim_Reference *refPtr;
5311 refId = he->key;
5312 /* Check if in the mark phase we encountered
5313 * this reference. */
5314 if (Jim_FindHashEntry(&marks, refId) == NULL) {
5315 #ifdef JIM_DEBUG_GC
5316 printf("COLLECTING %d" JIM_NL, (int)*refId);
5317 #endif
5318 collected++;
5319 /* Drop the reference, but call the
5320 * finalizer first if registered. */
5321 refPtr = he->u.val;
5322 if (refPtr->finalizerCmdNamePtr) {
5323 char *refstr = Jim_Alloc(JIM_REFERENCE_SPACE + 1);
5324 Jim_Obj *objv[3], *oldResult;
5326 JimFormatReference(refstr, refPtr, *refId);
5328 objv[0] = refPtr->finalizerCmdNamePtr;
5329 objv[1] = Jim_NewStringObjNoAlloc(interp, refstr, JIM_REFERENCE_SPACE);
5330 objv[2] = refPtr->objPtr;
5332 /* Drop the reference itself */
5333 /* Avoid the finaliser being freed here */
5334 Jim_IncrRefCount(objv[0]);
5335 /* Don't remove the reference from the hash table just yet
5336 * since that will free refPtr, and hence refPtr->objPtr
5339 /* Call the finalizer. Errors ignored. (should we use bgerror?) */
5340 oldResult = interp->result;
5341 Jim_IncrRefCount(oldResult);
5342 Jim_EvalObjVector(interp, 3, objv);
5343 Jim_SetResult(interp, oldResult);
5344 Jim_DecrRefCount(interp, oldResult);
5346 Jim_DecrRefCount(interp, objv[0]);
5348 Jim_DeleteHashEntry(&interp->references, refId);
5351 Jim_FreeHashTable(&marks);
5352 interp->lastCollectId = interp->referenceNextId;
5353 interp->lastCollectTime = time(NULL);
5354 #endif /* JIM_BOOTSTRAP */
5355 return collected;
5358 #define JIM_COLLECT_ID_PERIOD 5000
5359 #define JIM_COLLECT_TIME_PERIOD 300
5361 void Jim_CollectIfNeeded(Jim_Interp *interp)
5363 unsigned long elapsedId;
5364 int elapsedTime;
5366 elapsedId = interp->referenceNextId - interp->lastCollectId;
5367 elapsedTime = time(NULL) - interp->lastCollectTime;
5370 if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) {
5371 Jim_Collect(interp);
5374 #endif
5376 int Jim_IsBigEndian(void)
5378 union {
5379 unsigned short s;
5380 unsigned char c[2];
5381 } uval = {0x0102};
5383 return uval.c[0] == 1;
5386 /* -----------------------------------------------------------------------------
5387 * Interpreter related functions
5388 * ---------------------------------------------------------------------------*/
5390 Jim_Interp *Jim_CreateInterp(void)
5392 Jim_Interp *i = Jim_Alloc(sizeof(*i));
5394 memset(i, 0, sizeof(*i));
5396 i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5397 i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5398 i->lastCollectTime = time(NULL);
5400 /* Note that we can create objects only after the
5401 * interpreter liveList and freeList pointers are
5402 * initialized to NULL. */
5403 Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i);
5404 #ifdef JIM_REFERENCES
5405 Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i);
5406 #endif
5407 Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i);
5408 Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL);
5409 i->emptyObj = Jim_NewEmptyStringObj(i);
5410 i->trueObj = Jim_NewIntObj(i, 1);
5411 i->falseObj = Jim_NewIntObj(i, 0);
5412 i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj);
5413 i->errorFileNameObj = i->emptyObj;
5414 i->result = i->emptyObj;
5415 i->stackTrace = Jim_NewListObj(i, NULL, 0);
5416 i->unknown = Jim_NewStringObj(i, "unknown", -1);
5417 i->errorProc = i->emptyObj;
5418 i->currentScriptObj = Jim_NewEmptyStringObj(i);
5419 i->nullScriptObj = Jim_NewEmptyStringObj(i);
5420 Jim_IncrRefCount(i->emptyObj);
5421 Jim_IncrRefCount(i->errorFileNameObj);
5422 Jim_IncrRefCount(i->result);
5423 Jim_IncrRefCount(i->stackTrace);
5424 Jim_IncrRefCount(i->unknown);
5425 Jim_IncrRefCount(i->currentScriptObj);
5426 Jim_IncrRefCount(i->nullScriptObj);
5427 Jim_IncrRefCount(i->errorProc);
5428 Jim_IncrRefCount(i->trueObj);
5429 Jim_IncrRefCount(i->falseObj);
5431 /* Initialize key variables every interpreter should contain */
5432 Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
5433 Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");
5435 Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
5436 Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
5437 Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5438 Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5439 Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
5440 Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5441 Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5443 return i;
5446 void Jim_FreeInterp(Jim_Interp *i)
5448 Jim_CallFrame *cf = i->framePtr, *prevcf;
5449 Jim_Obj *objPtr, *nextObjPtr;
5451 /* Free the call frames list - must be done before i->commands is destroyed */
5452 while (cf) {
5453 prevcf = cf->parent;
5454 JimFreeCallFrame(i, cf, JIM_FCF_FULL);
5455 Jim_Free(cf);
5456 cf = prevcf;
5459 Jim_DecrRefCount(i, i->emptyObj);
5460 Jim_DecrRefCount(i, i->trueObj);
5461 Jim_DecrRefCount(i, i->falseObj);
5462 Jim_DecrRefCount(i, i->result);
5463 Jim_DecrRefCount(i, i->stackTrace);
5464 Jim_DecrRefCount(i, i->errorProc);
5465 Jim_DecrRefCount(i, i->unknown);
5466 Jim_DecrRefCount(i, i->errorFileNameObj);
5467 Jim_DecrRefCount(i, i->currentScriptObj);
5468 Jim_DecrRefCount(i, i->nullScriptObj);
5469 Jim_FreeHashTable(&i->commands);
5470 #ifdef JIM_REFERENCES
5471 Jim_FreeHashTable(&i->references);
5472 #endif
5473 Jim_FreeHashTable(&i->packages);
5474 Jim_Free(i->prngState);
5475 Jim_FreeHashTable(&i->assocData);
5477 /* Check that the live object list is empty, otherwise
5478 * there is a memory leak. */
5479 #ifdef JIM_MAINTAINER
5480 if (i->liveList != NULL) {
5481 printf(JIM_NL "-------------------------------------" JIM_NL);
5482 printf("Objects still in the free list:" JIM_NL);
5484 objPtr = i->liveList;
5486 while (objPtr) {
5487 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string";
5489 if (objPtr->bytes && strlen(objPtr->bytes) > 20) {
5490 printf("%p (%d) %-10s: '%.20s...'" JIM_NL,
5491 (void *)objPtr, objPtr->refCount, type, objPtr->bytes);
5493 else {
5494 printf("%p (%d) %-10s: '%s'" JIM_NL,
5495 (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)");
5497 if (objPtr->typePtr == &sourceObjType) {
5498 printf("FILE %s LINE %d" JIM_NL,
5499 Jim_String(objPtr->internalRep.sourceValue.fileNameObj),
5500 objPtr->internalRep.sourceValue.lineNumber);
5502 objPtr = objPtr->nextObjPtr;
5504 printf("-------------------------------------" JIM_NL JIM_NL);
5505 JimPanic((1, "Live list non empty freeing the interpreter! Leak?"));
5507 #endif
5509 /* Free all the freed objects. */
5510 objPtr = i->freeList;
5511 while (objPtr) {
5512 nextObjPtr = objPtr->nextObjPtr;
5513 Jim_Free(objPtr);
5514 objPtr = nextObjPtr;
5517 /* Free the interpreter structure. */
5518 Jim_Free(i);
5521 /* Returns the call frame relative to the level represented by
5522 * levelObjPtr. If levelObjPtr == NULL, the * level is assumed to be '1'.
5524 * This function accepts the 'level' argument in the form
5525 * of the commands [uplevel] and [upvar].
5527 * For a function accepting a relative integer as level suitable
5528 * for implementation of [info level ?level?] check the
5529 * JimGetCallFrameByInteger() function.
5531 * Returns NULL on error.
5533 Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5535 long level;
5536 const char *str;
5537 Jim_CallFrame *framePtr;
5539 if (levelObjPtr) {
5540 str = Jim_String(levelObjPtr);
5541 if (str[0] == '#') {
5542 char *endptr;
5544 level = jim_strtol(str + 1, &endptr);
5545 if (str[1] == '\0' || endptr[0] != '\0') {
5546 level = -1;
5549 else {
5550 if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) {
5551 level = -1;
5553 else {
5554 /* Convert from a relative to an absolute level */
5555 level = interp->framePtr->level - level;
5559 else {
5560 str = "1"; /* Needed to format the error message. */
5561 level = interp->framePtr->level - 1;
5564 if (level == 0) {
5565 return interp->topFramePtr;
5567 if (level > 0) {
5568 /* Lookup */
5569 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5570 if (framePtr->level == level) {
5571 return framePtr;
5576 Jim_SetResultFormatted(interp, "bad level \"%s\"", str);
5577 return NULL;
5580 /* Similar to Jim_GetCallFrameByLevel() but the level is specified
5581 * as a relative integer like in the [info level ?level?] command.
5583 static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr)
5585 long level;
5586 Jim_CallFrame *framePtr;
5588 if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
5589 if (level <= 0) {
5590 /* Convert from a relative to an absolute level */
5591 level = interp->framePtr->level + level;
5594 if (level == 0) {
5595 return interp->topFramePtr;
5598 /* Lookup */
5599 for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) {
5600 if (framePtr->level == level) {
5601 return framePtr;
5606 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
5607 return NULL;
5610 static void JimResetStackTrace(Jim_Interp *interp)
5612 Jim_DecrRefCount(interp, interp->stackTrace);
5613 interp->stackTrace = Jim_NewListObj(interp, NULL, 0);
5614 Jim_IncrRefCount(interp->stackTrace);
5617 static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj)
5619 int len;
5621 /* Increment reference first in case these are the same object */
5622 Jim_IncrRefCount(stackTraceObj);
5623 Jim_DecrRefCount(interp, interp->stackTrace);
5624 interp->stackTrace = stackTraceObj;
5625 interp->errorFlag = 1;
5627 /* This is a bit ugly.
5628 * If the filename of the last entry of the stack trace is empty,
5629 * the next stack level should be added.
5631 len = Jim_ListLength(interp, interp->stackTrace);
5632 if (len >= 3) {
5633 if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) {
5634 interp->addStackTrace = 1;
5639 /* Returns 1 if the stack trace information was used or 0 if not */
5640 static void JimAppendStackTrace(Jim_Interp *interp, const char *procname,
5641 Jim_Obj *fileNameObj, int linenr)
5643 if (strcmp(procname, "unknown") == 0) {
5644 procname = "";
5646 if (!*procname && !Jim_Length(fileNameObj)) {
5647 /* No useful info here */
5648 return;
5651 if (Jim_IsShared(interp->stackTrace)) {
5652 Jim_DecrRefCount(interp, interp->stackTrace);
5653 interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace);
5654 Jim_IncrRefCount(interp->stackTrace);
5657 /* If we have no procname but the previous element did, merge with that frame */
5658 if (!*procname && Jim_Length(fileNameObj)) {
5659 /* Just a filename. Check the previous entry */
5660 int len = Jim_ListLength(interp, interp->stackTrace);
5662 if (len >= 3) {
5663 Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3);
5664 if (Jim_Length(objPtr)) {
5665 /* Yes, the previous level had procname */
5666 objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2);
5667 if (Jim_Length(objPtr) == 0) {
5668 /* But no filename, so merge the new info with that frame */
5669 ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0);
5670 ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0);
5671 return;
5677 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1));
5678 Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj);
5679 Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr));
5682 int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc,
5683 void *data)
5685 AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue));
5687 assocEntryPtr->delProc = delProc;
5688 assocEntryPtr->data = data;
5689 return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr);
5692 void *Jim_GetAssocData(Jim_Interp *interp, const char *key)
5694 Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key);
5696 if (entryPtr != NULL) {
5697 AssocDataValue *assocEntryPtr = (AssocDataValue *) entryPtr->u.val;
5699 return assocEntryPtr->data;
5701 return NULL;
5704 int Jim_DeleteAssocData(Jim_Interp *interp, const char *key)
5706 return Jim_DeleteHashEntry(&interp->assocData, key);
5709 int Jim_GetExitCode(Jim_Interp *interp)
5711 return interp->exitCode;
5714 /* -----------------------------------------------------------------------------
5715 * Integer object
5716 * ---------------------------------------------------------------------------*/
5717 static void UpdateStringOfInt(struct Jim_Obj *objPtr);
5718 static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags);
5720 static const Jim_ObjType intObjType = {
5721 "int",
5722 NULL,
5723 NULL,
5724 UpdateStringOfInt,
5725 JIM_TYPE_NONE,
5728 /* A coerced double is closer to an int than a double.
5729 * It is an int value temporarily masquerading as a double value.
5730 * i.e. it has the same string value as an int and Jim_GetWide()
5731 * succeeds, but also Jim_GetDouble() returns the value directly.
5733 static const Jim_ObjType coercedDoubleObjType = {
5734 "coerced-double",
5735 NULL,
5736 NULL,
5737 UpdateStringOfInt,
5738 JIM_TYPE_NONE,
5742 static void UpdateStringOfInt(struct Jim_Obj *objPtr)
5744 char buf[JIM_INTEGER_SPACE + 1];
5745 jim_wide wideValue = JimWideValue(objPtr);
5746 int pos = 0;
5748 if (wideValue == 0) {
5749 buf[pos++] = '0';
5751 else {
5752 char tmp[JIM_INTEGER_SPACE];
5753 int num = 0;
5754 int i;
5756 if (wideValue < 0) {
5757 buf[pos++] = '-';
5758 /* -106 % 10 may be -6 or 4! */
5759 i = wideValue % 10;
5760 tmp[num++] = (i > 0) ? (10 - i) : -i;
5761 wideValue /= -10;
5764 while (wideValue) {
5765 tmp[num++] = wideValue % 10;
5766 wideValue /= 10;
5769 for (i = 0; i < num; i++) {
5770 buf[pos++] = '0' + tmp[num - i - 1];
5773 buf[pos] = 0;
5775 JimSetStringBytes(objPtr, buf);
5778 int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
5780 jim_wide wideValue;
5781 const char *str;
5783 if (objPtr->typePtr == &coercedDoubleObjType) {
5784 /* Simple switcheroo */
5785 objPtr->typePtr = &intObjType;
5786 return JIM_OK;
5789 /* Get the string representation */
5790 str = Jim_String(objPtr);
5791 /* Try to convert into a jim_wide */
5792 if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) {
5793 if (flags & JIM_ERRMSG) {
5794 Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr);
5796 return JIM_ERR;
5798 if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) {
5799 Jim_SetResultString(interp, "Integer value too big to be represented", -1);
5800 return JIM_ERR;
5802 /* Free the old internal repr and set the new one. */
5803 Jim_FreeIntRep(interp, objPtr);
5804 objPtr->typePtr = &intObjType;
5805 objPtr->internalRep.wideValue = wideValue;
5806 return JIM_OK;
5809 #ifdef JIM_OPTIMIZATION
5810 static int JimIsWide(Jim_Obj *objPtr)
5812 return objPtr->typePtr == &intObjType;
5814 #endif
5816 int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5818 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR)
5819 return JIM_ERR;
5820 *widePtr = JimWideValue(objPtr);
5821 return JIM_OK;
5824 /* Get a wide but does not set an error if the format is bad. */
5825 static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
5827 if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR)
5828 return JIM_ERR;
5829 *widePtr = JimWideValue(objPtr);
5830 return JIM_OK;
5833 int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr)
5835 jim_wide wideValue;
5836 int retval;
5838 retval = Jim_GetWide(interp, objPtr, &wideValue);
5839 if (retval == JIM_OK) {
5840 *longPtr = (long)wideValue;
5841 return JIM_OK;
5843 return JIM_ERR;
5846 Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue)
5848 Jim_Obj *objPtr;
5850 objPtr = Jim_NewObj(interp);
5851 objPtr->typePtr = &intObjType;
5852 objPtr->bytes = NULL;
5853 objPtr->internalRep.wideValue = wideValue;
5854 return objPtr;
5857 /* -----------------------------------------------------------------------------
5858 * Double object
5859 * ---------------------------------------------------------------------------*/
5860 #define JIM_DOUBLE_SPACE 30
5862 static void UpdateStringOfDouble(struct Jim_Obj *objPtr);
5863 static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
5865 static const Jim_ObjType doubleObjType = {
5866 "double",
5867 NULL,
5868 NULL,
5869 UpdateStringOfDouble,
5870 JIM_TYPE_NONE,
5873 #ifndef HAVE_ISNAN
5874 #undef isnan
5875 #define isnan(X) ((X) != (X))
5876 #endif
5877 #ifndef HAVE_ISINF
5878 #undef isinf
5879 #define isinf(X) (1.0 / (X) == 0.0)
5880 #endif
5882 void UpdateStringOfDouble(struct Jim_Obj *objPtr)
5884 double value = objPtr->internalRep.doubleValue;
5886 if (isnan(value)) {
5887 JimSetStringBytes(objPtr, "NaN");
5888 return;
5890 if (isinf(value)) {
5891 if (value < 0) {
5892 JimSetStringBytes(objPtr, "-Inf");
5894 else {
5895 JimSetStringBytes(objPtr, "Inf");
5897 return;
5900 char buf[JIM_DOUBLE_SPACE + 1];
5901 int i;
5902 int len = sprintf(buf, "%.12g", value);
5904 /* Add a final ".0" if necessary */
5905 for (i = 0; i < len; i++) {
5906 if (buf[i] == '.' || buf[i] == 'e') {
5907 #if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX)
5908 /* If 'buf' ends in e-0nn or e+0nn, remove
5909 * the 0 after the + or - and reduce the length by 1
5911 char *e = strchr(buf, 'e');
5912 if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') {
5913 /* Move it up */
5914 e += 2;
5915 memmove(e, e + 1, len - (e - buf));
5917 #endif
5918 break;
5921 if (buf[i] == '\0') {
5922 buf[i++] = '.';
5923 buf[i++] = '0';
5924 buf[i] = '\0';
5926 JimSetStringBytes(objPtr, buf);
5930 int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
5932 double doubleValue;
5933 jim_wide wideValue;
5934 const char *str;
5936 /* Preserve the string representation.
5937 * Needed so we can convert back to int without loss
5939 str = Jim_String(objPtr);
5941 #ifdef HAVE_LONG_LONG
5942 /* Assume a 53 bit mantissa */
5943 #define MIN_INT_IN_DOUBLE -(1LL << 53)
5944 #define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1)
5946 if (objPtr->typePtr == &intObjType
5947 && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE
5948 && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) {
5950 /* Direct conversion to coerced double */
5951 objPtr->typePtr = &coercedDoubleObjType;
5952 return JIM_OK;
5954 else
5955 #endif
5956 if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) {
5957 /* Managed to convert to an int, so we can use this as a cooerced double */
5958 Jim_FreeIntRep(interp, objPtr);
5959 objPtr->typePtr = &coercedDoubleObjType;
5960 objPtr->internalRep.wideValue = wideValue;
5961 return JIM_OK;
5963 else {
5964 /* Try to convert into a double */
5965 if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) {
5966 Jim_SetResultFormatted(interp, "expected number but got \"%#s\"", objPtr);
5967 return JIM_ERR;
5969 /* Free the old internal repr and set the new one. */
5970 Jim_FreeIntRep(interp, objPtr);
5972 objPtr->typePtr = &doubleObjType;
5973 objPtr->internalRep.doubleValue = doubleValue;
5974 return JIM_OK;
5977 int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr)
5979 if (objPtr->typePtr == &coercedDoubleObjType) {
5980 *doublePtr = JimWideValue(objPtr);
5981 return JIM_OK;
5983 if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR)
5984 return JIM_ERR;
5986 if (objPtr->typePtr == &coercedDoubleObjType) {
5987 *doublePtr = JimWideValue(objPtr);
5989 else {
5990 *doublePtr = objPtr->internalRep.doubleValue;
5992 return JIM_OK;
5995 Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue)
5997 Jim_Obj *objPtr;
5999 objPtr = Jim_NewObj(interp);
6000 objPtr->typePtr = &doubleObjType;
6001 objPtr->bytes = NULL;
6002 objPtr->internalRep.doubleValue = doubleValue;
6003 return objPtr;
6006 /* -----------------------------------------------------------------------------
6007 * List object
6008 * ---------------------------------------------------------------------------*/
6009 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec);
6010 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr);
6011 static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6012 static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6013 static void UpdateStringOfList(struct Jim_Obj *objPtr);
6014 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6016 /* Note that while the elements of the list may contain references,
6017 * the list object itself can't. This basically means that the
6018 * list object string representation as a whole can't contain references
6019 * that are not presents in the single elements. */
6020 static const Jim_ObjType listObjType = {
6021 "list",
6022 FreeListInternalRep,
6023 DupListInternalRep,
6024 UpdateStringOfList,
6025 JIM_TYPE_NONE,
6028 void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6030 int i;
6032 for (i = 0; i < objPtr->internalRep.listValue.len; i++) {
6033 Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]);
6035 Jim_Free(objPtr->internalRep.listValue.ele);
6038 void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6040 int i;
6042 JIM_NOTUSED(interp);
6044 dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len;
6045 dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen;
6046 dupPtr->internalRep.listValue.ele =
6047 Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen);
6048 memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele,
6049 sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len);
6050 for (i = 0; i < dupPtr->internalRep.listValue.len; i++) {
6051 Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]);
6053 dupPtr->typePtr = &listObjType;
6056 /* The following function checks if a given string can be encoded
6057 * into a list element without any kind of quoting, surrounded by braces,
6058 * or using escapes to quote. */
6059 #define JIM_ELESTR_SIMPLE 0
6060 #define JIM_ELESTR_BRACE 1
6061 #define JIM_ELESTR_QUOTE 2
6062 static unsigned char ListElementQuotingType(const char *s, int len)
6064 int i, level, blevel, trySimple = 1;
6066 /* Try with the SIMPLE case */
6067 if (len == 0)
6068 return JIM_ELESTR_BRACE;
6069 if (s[0] == '"' || s[0] == '{') {
6070 trySimple = 0;
6071 goto testbrace;
6073 for (i = 0; i < len; i++) {
6074 switch (s[i]) {
6075 case ' ':
6076 case '$':
6077 case '"':
6078 case '[':
6079 case ']':
6080 case ';':
6081 case '\\':
6082 case '\r':
6083 case '\n':
6084 case '\t':
6085 case '\f':
6086 case '\v':
6087 trySimple = 0;
6088 case '{':
6089 case '}':
6090 goto testbrace;
6093 return JIM_ELESTR_SIMPLE;
6095 testbrace:
6096 /* Test if it's possible to do with braces */
6097 if (s[len - 1] == '\\')
6098 return JIM_ELESTR_QUOTE;
6099 level = 0;
6100 blevel = 0;
6101 for (i = 0; i < len; i++) {
6102 switch (s[i]) {
6103 case '{':
6104 level++;
6105 break;
6106 case '}':
6107 level--;
6108 if (level < 0)
6109 return JIM_ELESTR_QUOTE;
6110 break;
6111 case '[':
6112 blevel++;
6113 break;
6114 case ']':
6115 blevel--;
6116 break;
6117 case '\\':
6118 if (s[i + 1] == '\n')
6119 return JIM_ELESTR_QUOTE;
6120 else if (s[i + 1] != '\0')
6121 i++;
6122 break;
6125 if (blevel < 0) {
6126 return JIM_ELESTR_QUOTE;
6129 if (level == 0) {
6130 if (!trySimple)
6131 return JIM_ELESTR_BRACE;
6132 for (i = 0; i < len; i++) {
6133 switch (s[i]) {
6134 case ' ':
6135 case '$':
6136 case '"':
6137 case '[':
6138 case ']':
6139 case ';':
6140 case '\\':
6141 case '\r':
6142 case '\n':
6143 case '\t':
6144 case '\f':
6145 case '\v':
6146 return JIM_ELESTR_BRACE;
6147 break;
6150 return JIM_ELESTR_SIMPLE;
6152 return JIM_ELESTR_QUOTE;
6155 /* Backslashes-escapes the null-terminated string 's' into the buffer at 'q'
6156 * The buffer must be at least strlen(s) * 2 + 1 bytes long for the worst-case
6157 * scenario.
6158 * Returns the length of the result.
6160 static int BackslashQuoteString(const char *s, int len, char *q)
6162 char *p = q;
6164 while (len--) {
6165 switch (*s) {
6166 case ' ':
6167 case '$':
6168 case '"':
6169 case '[':
6170 case ']':
6171 case '{':
6172 case '}':
6173 case ';':
6174 case '\\':
6175 *p++ = '\\';
6176 *p++ = *s++;
6177 break;
6178 case '\n':
6179 *p++ = '\\';
6180 *p++ = 'n';
6181 s++;
6182 break;
6183 case '\r':
6184 *p++ = '\\';
6185 *p++ = 'r';
6186 s++;
6187 break;
6188 case '\t':
6189 *p++ = '\\';
6190 *p++ = 't';
6191 s++;
6192 break;
6193 case '\f':
6194 *p++ = '\\';
6195 *p++ = 'f';
6196 s++;
6197 break;
6198 case '\v':
6199 *p++ = '\\';
6200 *p++ = 'v';
6201 s++;
6202 break;
6203 default:
6204 *p++ = *s++;
6205 break;
6208 *p = '\0';
6210 return p - q;
6213 static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc)
6215 #define STATIC_QUOTING_LEN 32
6216 int i, bufLen, realLength;
6217 const char *strRep;
6218 char *p;
6219 unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN];
6221 /* Estimate the space needed. */
6222 if (objc > STATIC_QUOTING_LEN) {
6223 quotingType = Jim_Alloc(objc);
6225 else {
6226 quotingType = staticQuoting;
6228 bufLen = 0;
6229 for (i = 0; i < objc; i++) {
6230 int len;
6232 strRep = Jim_GetString(objv[i], &len);
6233 quotingType[i] = ListElementQuotingType(strRep, len);
6234 switch (quotingType[i]) {
6235 case JIM_ELESTR_SIMPLE:
6236 if (i != 0 || strRep[0] != '#') {
6237 bufLen += len;
6238 break;
6240 /* Special case '#' on first element needs braces */
6241 quotingType[i] = JIM_ELESTR_BRACE;
6242 /* fall through */
6243 case JIM_ELESTR_BRACE:
6244 bufLen += len + 2;
6245 break;
6246 case JIM_ELESTR_QUOTE:
6247 bufLen += len * 2;
6248 break;
6250 bufLen++; /* elements separator. */
6252 bufLen++;
6254 /* Generate the string rep. */
6255 p = objPtr->bytes = Jim_Alloc(bufLen + 1);
6256 realLength = 0;
6257 for (i = 0; i < objc; i++) {
6258 int len, qlen;
6260 strRep = Jim_GetString(objv[i], &len);
6262 switch (quotingType[i]) {
6263 case JIM_ELESTR_SIMPLE:
6264 memcpy(p, strRep, len);
6265 p += len;
6266 realLength += len;
6267 break;
6268 case JIM_ELESTR_BRACE:
6269 *p++ = '{';
6270 memcpy(p, strRep, len);
6271 p += len;
6272 *p++ = '}';
6273 realLength += len + 2;
6274 break;
6275 case JIM_ELESTR_QUOTE:
6276 if (i == 0 && strRep[0] == '#') {
6277 *p++ = '\\';
6278 realLength++;
6280 qlen = BackslashQuoteString(strRep, len, p);
6281 p += qlen;
6282 realLength += qlen;
6283 break;
6285 /* Add a separating space */
6286 if (i + 1 != objc) {
6287 *p++ = ' ';
6288 realLength++;
6291 *p = '\0'; /* nul term. */
6292 objPtr->length = realLength;
6294 if (quotingType != staticQuoting) {
6295 Jim_Free(quotingType);
6299 static void UpdateStringOfList(struct Jim_Obj *objPtr)
6301 JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len);
6304 static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
6306 struct JimParserCtx parser;
6307 const char *str;
6308 int strLen;
6309 Jim_Obj *fileNameObj;
6310 int linenr;
6312 if (objPtr->typePtr == &listObjType) {
6313 return JIM_OK;
6316 /* Optimise dict -> list for unshared object. Note that this may only save a little time, but
6317 * it also preserves any source location of the dict elements
6318 * which can be very useful
6320 if (Jim_IsDict(objPtr) && !Jim_IsShared(objPtr)) {
6321 Jim_Obj **listObjPtrPtr;
6322 int len;
6323 int i;
6325 listObjPtrPtr = JimDictPairs(objPtr, &len);
6326 for (i = 0; i < len; i++) {
6327 Jim_IncrRefCount(listObjPtrPtr[i]);
6330 /* Now just switch the internal rep */
6331 Jim_FreeIntRep(interp, objPtr);
6332 objPtr->typePtr = &listObjType;
6333 objPtr->internalRep.listValue.len = len;
6334 objPtr->internalRep.listValue.maxLen = len;
6335 objPtr->internalRep.listValue.ele = listObjPtrPtr;
6337 return JIM_OK;
6340 /* Try to preserve information about filename / line number */
6341 if (objPtr->typePtr == &sourceObjType) {
6342 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
6343 linenr = objPtr->internalRep.sourceValue.lineNumber;
6345 else {
6346 fileNameObj = interp->emptyObj;
6347 linenr = 1;
6349 Jim_IncrRefCount(fileNameObj);
6351 /* Get the string representation */
6352 str = Jim_GetString(objPtr, &strLen);
6354 /* Free the old internal repr just now and initialize the
6355 * new one just now. The string->list conversion can't fail. */
6356 Jim_FreeIntRep(interp, objPtr);
6357 objPtr->typePtr = &listObjType;
6358 objPtr->internalRep.listValue.len = 0;
6359 objPtr->internalRep.listValue.maxLen = 0;
6360 objPtr->internalRep.listValue.ele = NULL;
6362 /* Convert into a list */
6363 if (strLen) {
6364 JimParserInit(&parser, str, strLen, linenr);
6365 while (!parser.eof) {
6366 Jim_Obj *elementPtr;
6368 JimParseList(&parser);
6369 if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC)
6370 continue;
6371 elementPtr = JimParserGetTokenObj(interp, &parser);
6372 JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline);
6373 ListAppendElement(objPtr, elementPtr);
6376 Jim_DecrRefCount(interp, fileNameObj);
6377 return JIM_OK;
6380 Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
6382 Jim_Obj *objPtr;
6384 objPtr = Jim_NewObj(interp);
6385 objPtr->typePtr = &listObjType;
6386 objPtr->bytes = NULL;
6387 objPtr->internalRep.listValue.ele = NULL;
6388 objPtr->internalRep.listValue.len = 0;
6389 objPtr->internalRep.listValue.maxLen = 0;
6391 if (len) {
6392 ListInsertElements(objPtr, 0, len, elements);
6395 return objPtr;
6398 /* Return a vector of Jim_Obj with the elements of a Jim list, and the
6399 * length of the vector. Note that the user of this function should make
6400 * sure that the list object can't shimmer while the vector returned
6401 * is in use, this vector is the one stored inside the internal representation
6402 * of the list object. This function is not exported, extensions should
6403 * always access to the List object elements using Jim_ListIndex(). */
6404 static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen,
6405 Jim_Obj ***listVec)
6407 *listLen = Jim_ListLength(interp, listObj);
6408 *listVec = listObj->internalRep.listValue.ele;
6411 /* Sorting uses ints, but commands may return wide */
6412 static int JimSign(jim_wide w)
6414 if (w == 0) {
6415 return 0;
6417 else if (w < 0) {
6418 return -1;
6420 return 1;
6423 /* ListSortElements type values */
6424 struct lsort_info {
6425 jmp_buf jmpbuf;
6426 Jim_Obj *command;
6427 Jim_Interp *interp;
6428 enum {
6429 JIM_LSORT_ASCII,
6430 JIM_LSORT_NOCASE,
6431 JIM_LSORT_INTEGER,
6432 JIM_LSORT_REAL,
6433 JIM_LSORT_COMMAND
6434 } type;
6435 int order;
6436 int index;
6437 int indexed;
6438 int unique;
6439 int (*subfn)(Jim_Obj **, Jim_Obj **);
6442 static struct lsort_info *sort_info;
6444 static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6446 Jim_Obj *lObj, *rObj;
6448 if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK ||
6449 Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
6450 longjmp(sort_info->jmpbuf, JIM_ERR);
6452 return sort_info->subfn(&lObj, &rObj);
6455 /* Sort the internal rep of a list. */
6456 static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6458 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order;
6461 static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6463 return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order;
6466 static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6468 jim_wide lhs = 0, rhs = 0;
6470 if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6471 Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6472 longjmp(sort_info->jmpbuf, JIM_ERR);
6475 return JimSign(lhs - rhs) * sort_info->order;
6478 static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6480 double lhs = 0, rhs = 0;
6482 if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK ||
6483 Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) {
6484 longjmp(sort_info->jmpbuf, JIM_ERR);
6486 if (lhs == rhs) {
6487 return 0;
6489 if (lhs > rhs) {
6490 return sort_info->order;
6492 return -sort_info->order;
6495 static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj)
6497 Jim_Obj *compare_script;
6498 int rc;
6500 jim_wide ret = 0;
6502 /* This must be a valid list */
6503 compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command);
6504 Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj);
6505 Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj);
6507 rc = Jim_EvalObj(sort_info->interp, compare_script);
6509 if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) {
6510 longjmp(sort_info->jmpbuf, rc);
6513 return JimSign(ret) * sort_info->order;
6516 /* Remove duplicate elements from the (sorted) list in-place, according to the
6517 * comparison function, comp.
6519 * Note that the last unique value is kept, not the first
6521 static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs))
6523 int src;
6524 int dst = 0;
6525 Jim_Obj **ele = listObjPtr->internalRep.listValue.ele;
6527 for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) {
6528 if (comp(&ele[dst], &ele[src]) == 0) {
6529 /* Match, so replace the dest with the current source */
6530 Jim_DecrRefCount(sort_info->interp, ele[dst]);
6532 else {
6533 /* No match, so keep the current source and move to the next destination */
6534 dst++;
6536 ele[dst] = ele[src];
6538 /* At end of list, keep the final element */
6539 ele[++dst] = ele[src];
6541 /* Set the new length */
6542 listObjPtr->internalRep.listValue.len = dst;
6545 /* Sort a list *in place*. MUST be called with non-shared objects. */
6546 static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info)
6548 struct lsort_info *prev_info;
6550 typedef int (qsort_comparator) (const void *, const void *);
6551 int (*fn) (Jim_Obj **, Jim_Obj **);
6552 Jim_Obj **vector;
6553 int len;
6554 int rc;
6556 JimPanic((Jim_IsShared(listObjPtr), "Jim_ListSortElements called with shared object"));
6557 SetListFromAny(interp, listObjPtr);
6559 /* Allow lsort to be called reentrantly */
6560 prev_info = sort_info;
6561 sort_info = info;
6563 vector = listObjPtr->internalRep.listValue.ele;
6564 len = listObjPtr->internalRep.listValue.len;
6565 switch (info->type) {
6566 case JIM_LSORT_ASCII:
6567 fn = ListSortString;
6568 break;
6569 case JIM_LSORT_NOCASE:
6570 fn = ListSortStringNoCase;
6571 break;
6572 case JIM_LSORT_INTEGER:
6573 fn = ListSortInteger;
6574 break;
6575 case JIM_LSORT_REAL:
6576 fn = ListSortReal;
6577 break;
6578 case JIM_LSORT_COMMAND:
6579 fn = ListSortCommand;
6580 break;
6581 default:
6582 fn = NULL; /* avoid warning */
6583 JimPanic((1, "ListSort called with invalid sort type"));
6586 if (info->indexed) {
6587 /* Need to interpose a "list index" function */
6588 info->subfn = fn;
6589 fn = ListSortIndexHelper;
6592 if ((rc = setjmp(info->jmpbuf)) == 0) {
6593 qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn);
6595 if (info->unique && len > 1) {
6596 ListRemoveDuplicates(listObjPtr, fn);
6599 Jim_InvalidateStringRep(listObjPtr);
6601 sort_info = prev_info;
6603 return rc;
6606 /* This is the low-level function to insert elements into a list.
6607 * The higher-level Jim_ListInsertElements() performs shared object
6608 * check and invalidate the string repr. This version is used
6609 * in the internals of the List Object and is not exported.
6611 * NOTE: this function can be called only against objects
6612 * with internal type of List.
6614 * An insertion point (idx) of -1 means end-of-list.
6616 static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec)
6618 int currentLen = listPtr->internalRep.listValue.len;
6619 int requiredLen = currentLen + elemc;
6620 int i;
6621 Jim_Obj **point;
6623 if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6624 if (requiredLen < 2) {
6625 /* Don't do allocations of under 4 pointers. */
6626 requiredLen = 4;
6628 else {
6629 requiredLen *= 2;
6632 listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6633 sizeof(Jim_Obj *) * requiredLen);
6635 listPtr->internalRep.listValue.maxLen = requiredLen;
6637 if (idx < 0) {
6638 idx = currentLen;
6640 point = listPtr->internalRep.listValue.ele + idx;
6641 memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *));
6642 for (i = 0; i < elemc; ++i) {
6643 point[i] = elemVec[i];
6644 Jim_IncrRefCount(point[i]);
6646 listPtr->internalRep.listValue.len += elemc;
6649 /* Convenience call to ListInsertElements() to append a single element.
6651 static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr)
6653 ListInsertElements(listPtr, -1, 1, &objPtr);
6656 /* Appends every element of appendListPtr into listPtr.
6657 * Both have to be of the list type.
6658 * Convenience call to ListInsertElements()
6660 static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6662 ListInsertElements(listPtr, -1,
6663 appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele);
6666 void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr)
6668 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object"));
6669 SetListFromAny(interp, listPtr);
6670 Jim_InvalidateStringRep(listPtr);
6671 ListAppendElement(listPtr, objPtr);
6674 void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr)
6676 JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object"));
6677 SetListFromAny(interp, listPtr);
6678 SetListFromAny(interp, appendListPtr);
6679 Jim_InvalidateStringRep(listPtr);
6680 ListAppendList(listPtr, appendListPtr);
6683 int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr)
6685 SetListFromAny(interp, objPtr);
6686 return objPtr->internalRep.listValue.len;
6689 void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6690 int objc, Jim_Obj *const *objVec)
6692 JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object"));
6693 SetListFromAny(interp, listPtr);
6694 if (idx >= 0 && idx > listPtr->internalRep.listValue.len)
6695 idx = listPtr->internalRep.listValue.len;
6696 else if (idx < 0)
6697 idx = 0;
6698 Jim_InvalidateStringRep(listPtr);
6699 ListInsertElements(listPtr, idx, objc, objVec);
6702 Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx)
6704 SetListFromAny(interp, listPtr);
6705 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6706 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6707 return NULL;
6709 if (idx < 0)
6710 idx = listPtr->internalRep.listValue.len + idx;
6711 return listPtr->internalRep.listValue.ele[idx];
6714 int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags)
6716 *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx);
6717 if (*objPtrPtr == NULL) {
6718 if (flags & JIM_ERRMSG) {
6719 Jim_SetResultString(interp, "list index out of range", -1);
6721 return JIM_ERR;
6723 return JIM_OK;
6726 static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx,
6727 Jim_Obj *newObjPtr, int flags)
6729 SetListFromAny(interp, listPtr);
6730 if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) ||
6731 (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) {
6732 if (flags & JIM_ERRMSG) {
6733 Jim_SetResultString(interp, "list index out of range", -1);
6735 return JIM_ERR;
6737 if (idx < 0)
6738 idx = listPtr->internalRep.listValue.len + idx;
6739 Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]);
6740 listPtr->internalRep.listValue.ele[idx] = newObjPtr;
6741 Jim_IncrRefCount(newObjPtr);
6742 return JIM_OK;
6745 /* Modify the list stored into the variable named 'varNamePtr'
6746 * setting the element specified by the 'indexc' indexes objects in 'indexv',
6747 * with the new element 'newObjptr'. */
6748 int Jim_SetListIndex(Jim_Interp *interp, Jim_Obj *varNamePtr,
6749 Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr)
6751 Jim_Obj *varObjPtr, *objPtr, *listObjPtr;
6752 int shared, i, idx;
6754 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED);
6755 if (objPtr == NULL)
6756 return JIM_ERR;
6757 if ((shared = Jim_IsShared(objPtr)))
6758 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
6759 for (i = 0; i < indexc - 1; i++) {
6760 listObjPtr = objPtr;
6761 if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6762 goto err;
6763 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
6764 goto err;
6766 if (Jim_IsShared(objPtr)) {
6767 objPtr = Jim_DuplicateObj(interp, objPtr);
6768 ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE);
6770 Jim_InvalidateStringRep(listObjPtr);
6772 if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK)
6773 goto err;
6774 if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR)
6775 goto err;
6776 Jim_InvalidateStringRep(objPtr);
6777 Jim_InvalidateStringRep(varObjPtr);
6778 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK)
6779 goto err;
6780 Jim_SetResult(interp, varObjPtr);
6781 return JIM_OK;
6782 err:
6783 if (shared) {
6784 Jim_FreeNewObj(interp, varObjPtr);
6786 return JIM_ERR;
6789 Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen)
6791 int i;
6792 int listLen = Jim_ListLength(interp, listObjPtr);
6793 Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp);
6795 for (i = 0; i < listLen; ) {
6796 Jim_Obj *objPtr;
6798 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
6799 Jim_AppendObj(interp, resObjPtr, objPtr);
6800 if (++i != listLen) {
6801 Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen);
6804 return resObjPtr;
6807 Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
6809 int i;
6811 /* If all the objects in objv are lists,
6812 * it's possible to return a list as result, that's the
6813 * concatenation of all the lists. */
6814 for (i = 0; i < objc; i++) {
6815 if (!Jim_IsList(objv[i]))
6816 break;
6818 if (i == objc) {
6819 Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0);
6821 for (i = 0; i < objc; i++)
6822 ListAppendList(objPtr, objv[i]);
6823 return objPtr;
6825 else {
6826 /* Else... we have to glue strings together */
6827 int len = 0, objLen;
6828 char *bytes, *p;
6830 /* Compute the length */
6831 for (i = 0; i < objc; i++) {
6832 Jim_GetString(objv[i], &objLen);
6833 len += objLen;
6835 if (objc)
6836 len += objc - 1;
6837 /* Create the string rep, and a string object holding it. */
6838 p = bytes = Jim_Alloc(len + 1);
6839 for (i = 0; i < objc; i++) {
6840 const char *s = Jim_GetString(objv[i], &objLen);
6842 /* Remove leading space */
6843 while (objLen && (*s == ' ' || *s == '\t' || *s == '\n')) {
6844 s++;
6845 objLen--;
6846 len--;
6848 /* And trailing space */
6849 while (objLen && (s[objLen - 1] == ' ' ||
6850 s[objLen - 1] == '\n' || s[objLen - 1] == '\t')) {
6851 /* Handle trailing backslash-space case */
6852 if (objLen > 1 && s[objLen - 2] == '\\') {
6853 break;
6855 objLen--;
6856 len--;
6858 memcpy(p, s, objLen);
6859 p += objLen;
6860 if (objLen && i + 1 != objc) {
6861 *p++ = ' ';
6863 else if (i + 1 != objc) {
6864 /* Drop the space calcuated for this
6865 * element that is instead null. */
6866 len--;
6869 *p = '\0';
6870 return Jim_NewStringObjNoAlloc(interp, bytes, len);
6874 /* Returns a list composed of the elements in the specified range.
6875 * first and start are directly accepted as Jim_Objects and
6876 * processed for the end?-index? case. */
6877 Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr,
6878 Jim_Obj *lastObjPtr)
6880 int first, last;
6881 int len, rangeLen;
6883 if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK ||
6884 Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK)
6885 return NULL;
6886 len = Jim_ListLength(interp, listObjPtr); /* will convert into list */
6887 first = JimRelToAbsIndex(len, first);
6888 last = JimRelToAbsIndex(len, last);
6889 JimRelToAbsRange(len, &first, &last, &rangeLen);
6890 if (first == 0 && last == len) {
6891 return listObjPtr;
6893 return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen);
6896 /* -----------------------------------------------------------------------------
6897 * Dict object
6898 * ---------------------------------------------------------------------------*/
6899 static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
6900 static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
6901 static void UpdateStringOfDict(struct Jim_Obj *objPtr);
6902 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
6904 /* Dict HashTable Type.
6906 * Keys and Values are Jim objects. */
6908 static unsigned int JimObjectHTHashFunction(const void *key)
6910 int len;
6911 const char *str = Jim_GetString((Jim_Obj *)key, &len);
6912 return Jim_GenHashFunction((const unsigned char *)str, len);
6915 static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2)
6917 return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2);
6920 static void *JimObjectHTKeyValDup(void *privdata, const void *val)
6922 Jim_IncrRefCount((Jim_Obj *)val);
6923 return (void *)val;
6926 static void JimObjectHTKeyValDestructor(void *interp, void *val)
6928 Jim_DecrRefCount(interp, (Jim_Obj *)val);
6931 static const Jim_HashTableType JimDictHashTableType = {
6932 JimObjectHTHashFunction, /* hash function */
6933 JimObjectHTKeyValDup, /* key dup */
6934 JimObjectHTKeyValDup, /* val dup */
6935 JimObjectHTKeyCompare, /* key compare */
6936 JimObjectHTKeyValDestructor, /* key destructor */
6937 JimObjectHTKeyValDestructor /* val destructor */
6940 /* Note that while the elements of the dict may contain references,
6941 * the list object itself can't. This basically means that the
6942 * dict object string representation as a whole can't contain references
6943 * that are not presents in the single elements. */
6944 static const Jim_ObjType dictObjType = {
6945 "dict",
6946 FreeDictInternalRep,
6947 DupDictInternalRep,
6948 UpdateStringOfDict,
6949 JIM_TYPE_NONE,
6952 void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
6954 JIM_NOTUSED(interp);
6956 Jim_FreeHashTable(objPtr->internalRep.ptr);
6957 Jim_Free(objPtr->internalRep.ptr);
6960 void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
6962 Jim_HashTable *ht, *dupHt;
6963 Jim_HashTableIterator htiter;
6964 Jim_HashEntry *he;
6966 /* Create a new hash table */
6967 ht = srcPtr->internalRep.ptr;
6968 dupHt = Jim_Alloc(sizeof(*dupHt));
6969 Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
6970 if (ht->size != 0)
6971 Jim_ExpandHashTable(dupHt, ht->size);
6972 /* Copy every element from the source to the dup hash table */
6973 JimInitHashTableIterator(ht, &htiter);
6974 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6975 Jim_AddHashEntry(dupHt, he->key, he->u.val);
6978 dupPtr->internalRep.ptr = dupHt;
6979 dupPtr->typePtr = &dictObjType;
6982 static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len)
6984 Jim_HashTable *ht;
6985 Jim_HashTableIterator htiter;
6986 Jim_HashEntry *he;
6987 Jim_Obj **objv;
6988 int i;
6990 ht = dictPtr->internalRep.ptr;
6992 /* Turn the hash table into a flat vector of Jim_Objects. */
6993 objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
6994 JimInitHashTableIterator(ht, &htiter);
6995 i = 0;
6996 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
6997 objv[i++] = (Jim_Obj *)he->key;
6998 objv[i++] = he->u.val;
7000 *len = i;
7001 return objv;
7004 static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7006 /* Turn the hash table into a flat vector of Jim_Objects. */
7007 int len;
7008 Jim_Obj **objv = JimDictPairs(objPtr, &len);
7010 JimMakeListStringRep(objPtr, objv, len);
7012 Jim_Free(objv);
7015 static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
7017 int listlen;
7019 if (objPtr->typePtr == &dictObjType) {
7020 return JIM_OK;
7023 /* Get the string representation. Do this first so we don't
7024 * change order in case of fast conversion to dict.
7026 Jim_String(objPtr);
7028 /* For simplicity, convert a non-list object to a list and then to a dict */
7029 listlen = Jim_ListLength(interp, objPtr);
7030 if (listlen % 2) {
7031 Jim_SetResultString(interp, "missing value to go with key", -1);
7032 return JIM_ERR;
7034 else {
7035 /* Now it is easy to convert to a dict from a list, and it can't fail */
7036 Jim_HashTable *ht;
7037 int i;
7039 ht = Jim_Alloc(sizeof(*ht));
7040 Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7042 for (i = 0; i < listlen; i += 2) {
7043 Jim_Obj *keyObjPtr;
7044 Jim_Obj *valObjPtr;
7046 Jim_ListIndex(interp, objPtr, i, &keyObjPtr, JIM_NONE);
7047 Jim_ListIndex(interp, objPtr, i + 1, &valObjPtr, JIM_NONE);
7049 Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7052 Jim_FreeIntRep(interp, objPtr);
7053 objPtr->typePtr = &dictObjType;
7054 objPtr->internalRep.ptr = ht;
7056 return JIM_OK;
7060 /* Dict object API */
7062 /* Add an element to a dict. objPtr must be of the "dict" type.
7063 * The higer-level exported function is Jim_DictAddElement().
7064 * If an element with the specified key already exists, the value
7065 * associated is replaced with the new one.
7067 * if valueObjPtr == NULL, the key is instead removed if it exists. */
7068 static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7069 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7071 Jim_HashTable *ht = objPtr->internalRep.ptr;
7073 if (valueObjPtr == NULL) { /* unset */
7074 return Jim_DeleteHashEntry(ht, keyObjPtr);
7076 Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7077 return JIM_OK;
7080 /* Add an element, higher-level interface for DictAddElement().
7081 * If valueObjPtr == NULL, the key is removed if it exists. */
7082 int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr,
7083 Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr)
7085 int retcode;
7087 JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object"));
7088 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
7089 return JIM_ERR;
7091 retcode = DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr);
7092 Jim_InvalidateStringRep(objPtr);
7093 return retcode;
7096 Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len)
7098 Jim_Obj *objPtr;
7099 int i;
7101 JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even"));
7103 objPtr = Jim_NewObj(interp);
7104 objPtr->typePtr = &dictObjType;
7105 objPtr->bytes = NULL;
7106 objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7107 Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
7108 for (i = 0; i < len; i += 2)
7109 DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7110 return objPtr;
7113 /* Return the value associated to the specified dict key
7114 * Returns JIM_OK if OK, JIM_ERR if entry not found or -1 if can't create dict value
7116 * Sets *objPtrPtr to non-NULL only upon success.
7118 int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr,
7119 Jim_Obj **objPtrPtr, int flags)
7121 Jim_HashEntry *he;
7122 Jim_HashTable *ht;
7124 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7125 return -1;
7127 ht = dictPtr->internalRep.ptr;
7128 if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
7129 if (flags & JIM_ERRMSG) {
7130 Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7132 return JIM_ERR;
7134 *objPtrPtr = he->u.val;
7135 return JIM_OK;
7138 /* Return an allocated array of key/value pairs for the dictionary. Stores the length in *len */
7139 int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len)
7141 if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7142 return JIM_ERR;
7144 *objPtrPtr = JimDictPairs(dictPtr, len);
7146 return JIM_OK;
7150 /* Return the value associated to the specified dict keys */
7151 int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr,
7152 Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags)
7154 int i;
7156 if (keyc == 0) {
7157 *objPtrPtr = dictPtr;
7158 return JIM_OK;
7161 for (i = 0; i < keyc; i++) {
7162 Jim_Obj *objPtr;
7164 int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags);
7165 if (rc != JIM_OK) {
7166 return rc;
7168 dictPtr = objPtr;
7170 *objPtrPtr = dictPtr;
7171 return JIM_OK;
7174 /* Modify the dict stored into the variable named 'varNamePtr'
7175 * setting the element specified by the 'keyc' keys objects in 'keyv',
7176 * with the new value of the element 'newObjPtr'.
7178 * If newObjPtr == NULL the operation is to remove the given key
7179 * from the dictionary.
7181 * If flags & JIM_ERRMSG, then failure to remove the key is considered an error
7182 * and JIM_ERR is returned. Otherwise it is ignored and JIM_OK is returned.
7184 int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr,
7185 Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags)
7187 Jim_Obj *varObjPtr, *objPtr, *dictObjPtr;
7188 int shared, i;
7190 varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags);
7191 if (objPtr == NULL) {
7192 if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) {
7193 /* Cannot remove a key from non existing var */
7194 return JIM_ERR;
7196 varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0);
7197 if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) {
7198 Jim_FreeNewObj(interp, varObjPtr);
7199 return JIM_ERR;
7202 if ((shared = Jim_IsShared(objPtr)))
7203 varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr);
7204 for (i = 0; i < keyc; i++) {
7205 dictObjPtr = objPtr;
7207 /* Check if it's a valid dictionary */
7208 if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) {
7209 goto err;
7212 if (i == keyc - 1) {
7213 /* Last key: Note that error on unset with missing last key is OK */
7214 if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) {
7215 if (newObjPtr || (flags & JIM_MUSTEXIST)) {
7216 goto err;
7219 break;
7222 /* Check if the given key exists. */
7223 Jim_InvalidateStringRep(dictObjPtr);
7224 if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr,
7225 newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) {
7226 /* This key exists at the current level.
7227 * Make sure it's not shared!. */
7228 if (Jim_IsShared(objPtr)) {
7229 objPtr = Jim_DuplicateObj(interp, objPtr);
7230 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7233 else {
7234 /* Key not found. If it's an [unset] operation
7235 * this is an error. Only the last key may not
7236 * exist. */
7237 if (newObjPtr == NULL) {
7238 goto err;
7240 /* Otherwise set an empty dictionary
7241 * as key's value. */
7242 objPtr = Jim_NewDictObj(interp, NULL, 0);
7243 DictAddElement(interp, dictObjPtr, keyv[i], objPtr);
7246 Jim_InvalidateStringRep(objPtr);
7247 Jim_InvalidateStringRep(varObjPtr);
7248 if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) {
7249 goto err;
7251 Jim_SetResult(interp, varObjPtr);
7252 return JIM_OK;
7253 err:
7254 if (shared) {
7255 Jim_FreeNewObj(interp, varObjPtr);
7257 return JIM_ERR;
7260 /* -----------------------------------------------------------------------------
7261 * Index object
7262 * ---------------------------------------------------------------------------*/
7263 static void UpdateStringOfIndex(struct Jim_Obj *objPtr);
7264 static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
7266 static const Jim_ObjType indexObjType = {
7267 "index",
7268 NULL,
7269 NULL,
7270 UpdateStringOfIndex,
7271 JIM_TYPE_NONE,
7274 void UpdateStringOfIndex(struct Jim_Obj *objPtr)
7276 if (objPtr->internalRep.intValue == -1) {
7277 JimSetStringBytes(objPtr, "end");
7279 else {
7280 char buf[JIM_INTEGER_SPACE + 1];
7281 if (objPtr->internalRep.intValue >= 0) {
7282 sprintf(buf, "%d", objPtr->internalRep.intValue);
7284 else {
7285 /* Must be <= -2 */
7286 sprintf(buf, "end%d", objPtr->internalRep.intValue + 1);
7288 JimSetStringBytes(objPtr, buf);
7292 int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7294 int idx, end = 0;
7295 const char *str;
7296 char *endptr;
7298 /* Get the string representation */
7299 str = Jim_String(objPtr);
7301 /* Try to convert into an index */
7302 if (strncmp(str, "end", 3) == 0) {
7303 end = 1;
7304 str += 3;
7305 idx = 0;
7307 else {
7308 idx = jim_strtol(str, &endptr);
7310 if (endptr == str) {
7311 goto badindex;
7313 str = endptr;
7316 /* Now str may include or +<num> or -<num> */
7317 if (*str == '+' || *str == '-') {
7318 int sign = (*str == '+' ? 1 : -1);
7320 idx += sign * jim_strtol(++str, &endptr);
7321 if (str == endptr || *endptr) {
7322 goto badindex;
7324 str = endptr;
7326 /* The only thing left should be spaces */
7327 while (isspace(UCHAR(*str))) {
7328 str++;
7330 if (*str) {
7331 goto badindex;
7333 if (end) {
7334 if (idx > 0) {
7335 idx = INT_MAX;
7337 else {
7338 /* end-1 is repesented as -2 */
7339 idx--;
7342 else if (idx < 0) {
7343 idx = -INT_MAX;
7346 /* Free the old internal repr and set the new one. */
7347 Jim_FreeIntRep(interp, objPtr);
7348 objPtr->typePtr = &indexObjType;
7349 objPtr->internalRep.intValue = idx;
7350 return JIM_OK;
7352 badindex:
7353 Jim_SetResultFormatted(interp,
7354 "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
7355 return JIM_ERR;
7358 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
7360 /* Avoid shimmering if the object is an integer. */
7361 if (objPtr->typePtr == &intObjType) {
7362 jim_wide val = JimWideValue(objPtr);
7364 if (!(val < LONG_MIN) && !(val > LONG_MAX)) {
7365 *indexPtr = (val < 0) ? -INT_MAX : (long)val;;
7366 return JIM_OK;
7369 if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR)
7370 return JIM_ERR;
7371 *indexPtr = objPtr->internalRep.intValue;
7372 return JIM_OK;
7375 /* -----------------------------------------------------------------------------
7376 * Return Code Object.
7377 * ---------------------------------------------------------------------------*/
7379 /* NOTE: These must be kept in the same order as JIM_OK, JIM_ERR, ... */
7380 static const char * const jimReturnCodes[] = {
7381 "ok",
7382 "error",
7383 "return",
7384 "break",
7385 "continue",
7386 "signal",
7387 "exit",
7388 "eval",
7389 NULL
7392 #define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes))
7394 static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr);
7396 static const Jim_ObjType returnCodeObjType = {
7397 "return-code",
7398 NULL,
7399 NULL,
7400 NULL,
7401 JIM_TYPE_NONE,
7404 /* Converts a (standard) return code to a string. Returns "?" for
7405 * non-standard return codes.
7407 const char *Jim_ReturnCode(int code)
7409 if (code < 0 || code >= (int)jimReturnCodesSize) {
7410 return "?";
7412 else {
7413 return jimReturnCodes[code];
7417 int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
7419 int returnCode;
7420 jim_wide wideValue;
7422 /* Try to convert into an integer */
7423 if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR)
7424 returnCode = (int)wideValue;
7425 else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) {
7426 Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr);
7427 return JIM_ERR;
7429 /* Free the old internal repr and set the new one. */
7430 Jim_FreeIntRep(interp, objPtr);
7431 objPtr->typePtr = &returnCodeObjType;
7432 objPtr->internalRep.intValue = returnCode;
7433 return JIM_OK;
7436 int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)
7438 if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR)
7439 return JIM_ERR;
7440 *intPtr = objPtr->internalRep.intValue;
7441 return JIM_OK;
7444 /* -----------------------------------------------------------------------------
7445 * Expression Parsing
7446 * ---------------------------------------------------------------------------*/
7447 static int JimParseExprOperator(struct JimParserCtx *pc);
7448 static int JimParseExprNumber(struct JimParserCtx *pc);
7449 static int JimParseExprIrrational(struct JimParserCtx *pc);
7451 /* Exrp's Stack machine operators opcodes. */
7453 /* Binary operators (numbers) */
7454 enum
7456 /* Continues on from the JIM_TT_ space */
7457 /* Operations */
7458 JIM_EXPROP_MUL = JIM_TT_EXPR_OP, /* 20 */
7459 JIM_EXPROP_DIV,
7460 JIM_EXPROP_MOD,
7461 JIM_EXPROP_SUB,
7462 JIM_EXPROP_ADD,
7463 JIM_EXPROP_LSHIFT,
7464 JIM_EXPROP_RSHIFT,
7465 JIM_EXPROP_ROTL,
7466 JIM_EXPROP_ROTR,
7467 JIM_EXPROP_LT,
7468 JIM_EXPROP_GT,
7469 JIM_EXPROP_LTE,
7470 JIM_EXPROP_GTE,
7471 JIM_EXPROP_NUMEQ,
7472 JIM_EXPROP_NUMNE,
7473 JIM_EXPROP_BITAND, /* 35 */
7474 JIM_EXPROP_BITXOR,
7475 JIM_EXPROP_BITOR,
7477 /* Note must keep these together */
7478 JIM_EXPROP_LOGICAND, /* 38 */
7479 JIM_EXPROP_LOGICAND_LEFT,
7480 JIM_EXPROP_LOGICAND_RIGHT,
7482 /* and these */
7483 JIM_EXPROP_LOGICOR, /* 41 */
7484 JIM_EXPROP_LOGICOR_LEFT,
7485 JIM_EXPROP_LOGICOR_RIGHT,
7487 /* and these */
7488 /* Ternary operators */
7489 JIM_EXPROP_TERNARY, /* 44 */
7490 JIM_EXPROP_TERNARY_LEFT,
7491 JIM_EXPROP_TERNARY_RIGHT,
7493 /* and these */
7494 JIM_EXPROP_COLON, /* 47 */
7495 JIM_EXPROP_COLON_LEFT,
7496 JIM_EXPROP_COLON_RIGHT,
7498 JIM_EXPROP_POW, /* 50 */
7500 /* Binary operators (strings) */
7501 JIM_EXPROP_STREQ, /* 51 */
7502 JIM_EXPROP_STRNE,
7503 JIM_EXPROP_STRIN,
7504 JIM_EXPROP_STRNI,
7506 /* Unary operators (numbers) */
7507 JIM_EXPROP_NOT, /* 55 */
7508 JIM_EXPROP_BITNOT,
7509 JIM_EXPROP_UNARYMINUS,
7510 JIM_EXPROP_UNARYPLUS,
7512 /* Functions */
7513 JIM_EXPROP_FUNC_FIRST, /* 59 */
7514 JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST,
7515 JIM_EXPROP_FUNC_ABS,
7516 JIM_EXPROP_FUNC_DOUBLE,
7517 JIM_EXPROP_FUNC_ROUND,
7518 JIM_EXPROP_FUNC_RAND,
7519 JIM_EXPROP_FUNC_SRAND,
7521 /* math functions from libm */
7522 JIM_EXPROP_FUNC_SIN, /* 64 */
7523 JIM_EXPROP_FUNC_COS,
7524 JIM_EXPROP_FUNC_TAN,
7525 JIM_EXPROP_FUNC_ASIN,
7526 JIM_EXPROP_FUNC_ACOS,
7527 JIM_EXPROP_FUNC_ATAN,
7528 JIM_EXPROP_FUNC_SINH,
7529 JIM_EXPROP_FUNC_COSH,
7530 JIM_EXPROP_FUNC_TANH,
7531 JIM_EXPROP_FUNC_CEIL,
7532 JIM_EXPROP_FUNC_FLOOR,
7533 JIM_EXPROP_FUNC_EXP,
7534 JIM_EXPROP_FUNC_LOG,
7535 JIM_EXPROP_FUNC_LOG10,
7536 JIM_EXPROP_FUNC_SQRT,
7537 JIM_EXPROP_FUNC_POW,
7540 struct JimExprState
7542 Jim_Obj **stack;
7543 int stacklen;
7544 int opcode;
7545 int skip;
7548 /* Operators table */
7549 typedef struct Jim_ExprOperator
7551 const char *name;
7552 int (*funcop) (Jim_Interp *interp, struct JimExprState * e);
7553 unsigned char precedence;
7554 unsigned char arity;
7555 unsigned char lazy;
7556 unsigned char namelen;
7557 } Jim_ExprOperator;
7559 static void ExprPush(struct JimExprState *e, Jim_Obj *obj)
7561 Jim_IncrRefCount(obj);
7562 e->stack[e->stacklen++] = obj;
7565 static Jim_Obj *ExprPop(struct JimExprState *e)
7567 return e->stack[--e->stacklen];
7570 static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e)
7572 int intresult = 0;
7573 int rc = JIM_OK;
7574 Jim_Obj *A = ExprPop(e);
7575 double dA, dC = 0;
7576 jim_wide wA, wC = 0;
7578 if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) {
7579 intresult = 1;
7581 switch (e->opcode) {
7582 case JIM_EXPROP_FUNC_INT:
7583 wC = wA;
7584 break;
7585 case JIM_EXPROP_FUNC_ROUND:
7586 wC = wA;
7587 break;
7588 case JIM_EXPROP_FUNC_DOUBLE:
7589 dC = wA;
7590 intresult = 0;
7591 break;
7592 case JIM_EXPROP_FUNC_ABS:
7593 wC = wA >= 0 ? wA : -wA;
7594 break;
7595 case JIM_EXPROP_UNARYMINUS:
7596 wC = -wA;
7597 break;
7598 case JIM_EXPROP_UNARYPLUS:
7599 wC = wA;
7600 break;
7601 case JIM_EXPROP_NOT:
7602 wC = !wA;
7603 break;
7604 default:
7605 abort();
7608 else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) {
7609 switch (e->opcode) {
7610 case JIM_EXPROP_FUNC_INT:
7611 wC = dA;
7612 intresult = 1;
7613 break;
7614 case JIM_EXPROP_FUNC_ROUND:
7615 wC = dA < 0 ? (dA - 0.5) : (dA + 0.5);
7616 intresult = 1;
7617 break;
7618 case JIM_EXPROP_FUNC_DOUBLE:
7619 dC = dA;
7620 break;
7621 case JIM_EXPROP_FUNC_ABS:
7622 dC = dA >= 0 ? dA : -dA;
7623 break;
7624 case JIM_EXPROP_UNARYMINUS:
7625 dC = -dA;
7626 break;
7627 case JIM_EXPROP_UNARYPLUS:
7628 dC = dA;
7629 break;
7630 case JIM_EXPROP_NOT:
7631 wC = !dA;
7632 intresult = 1;
7633 break;
7634 default:
7635 abort();
7639 if (rc == JIM_OK) {
7640 if (intresult) {
7641 ExprPush(e, Jim_NewIntObj(interp, wC));
7643 else {
7644 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7648 Jim_DecrRefCount(interp, A);
7650 return rc;
7653 static double JimRandDouble(Jim_Interp *interp)
7655 unsigned long x;
7656 JimRandomBytes(interp, &x, sizeof(x));
7658 return (double)x / (unsigned long)~0;
7661 static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e)
7663 Jim_Obj *A = ExprPop(e);
7664 jim_wide wA;
7666 int rc = Jim_GetWide(interp, A, &wA);
7667 if (rc == JIM_OK) {
7668 switch (e->opcode) {
7669 case JIM_EXPROP_BITNOT:
7670 ExprPush(e, Jim_NewIntObj(interp, ~wA));
7671 break;
7672 case JIM_EXPROP_FUNC_SRAND:
7673 JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA));
7674 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7675 break;
7676 default:
7677 abort();
7681 Jim_DecrRefCount(interp, A);
7683 return rc;
7686 static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e)
7688 JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()"));
7690 ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp)));
7692 return JIM_OK;
7695 #ifdef JIM_MATH_FUNCTIONS
7696 static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e)
7698 int rc;
7699 Jim_Obj *A = ExprPop(e);
7700 double dA, dC;
7702 rc = Jim_GetDouble(interp, A, &dA);
7703 if (rc == JIM_OK) {
7704 switch (e->opcode) {
7705 case JIM_EXPROP_FUNC_SIN:
7706 dC = sin(dA);
7707 break;
7708 case JIM_EXPROP_FUNC_COS:
7709 dC = cos(dA);
7710 break;
7711 case JIM_EXPROP_FUNC_TAN:
7712 dC = tan(dA);
7713 break;
7714 case JIM_EXPROP_FUNC_ASIN:
7715 dC = asin(dA);
7716 break;
7717 case JIM_EXPROP_FUNC_ACOS:
7718 dC = acos(dA);
7719 break;
7720 case JIM_EXPROP_FUNC_ATAN:
7721 dC = atan(dA);
7722 break;
7723 case JIM_EXPROP_FUNC_SINH:
7724 dC = sinh(dA);
7725 break;
7726 case JIM_EXPROP_FUNC_COSH:
7727 dC = cosh(dA);
7728 break;
7729 case JIM_EXPROP_FUNC_TANH:
7730 dC = tanh(dA);
7731 break;
7732 case JIM_EXPROP_FUNC_CEIL:
7733 dC = ceil(dA);
7734 break;
7735 case JIM_EXPROP_FUNC_FLOOR:
7736 dC = floor(dA);
7737 break;
7738 case JIM_EXPROP_FUNC_EXP:
7739 dC = exp(dA);
7740 break;
7741 case JIM_EXPROP_FUNC_LOG:
7742 dC = log(dA);
7743 break;
7744 case JIM_EXPROP_FUNC_LOG10:
7745 dC = log10(dA);
7746 break;
7747 case JIM_EXPROP_FUNC_SQRT:
7748 dC = sqrt(dA);
7749 break;
7750 default:
7751 abort();
7753 ExprPush(e, Jim_NewDoubleObj(interp, dC));
7756 Jim_DecrRefCount(interp, A);
7758 return rc;
7760 #endif
7762 /* A binary operation on two ints */
7763 static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e)
7765 Jim_Obj *B = ExprPop(e);
7766 Jim_Obj *A = ExprPop(e);
7767 jim_wide wA, wB;
7768 int rc = JIM_ERR;
7770 if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) {
7771 jim_wide wC;
7773 rc = JIM_OK;
7775 switch (e->opcode) {
7776 case JIM_EXPROP_LSHIFT:
7777 wC = wA << wB;
7778 break;
7779 case JIM_EXPROP_RSHIFT:
7780 wC = wA >> wB;
7781 break;
7782 case JIM_EXPROP_BITAND:
7783 wC = wA & wB;
7784 break;
7785 case JIM_EXPROP_BITXOR:
7786 wC = wA ^ wB;
7787 break;
7788 case JIM_EXPROP_BITOR:
7789 wC = wA | wB;
7790 break;
7791 case JIM_EXPROP_MOD:
7792 if (wB == 0) {
7793 wC = 0;
7794 Jim_SetResultString(interp, "Division by zero", -1);
7795 rc = JIM_ERR;
7797 else {
7799 * From Tcl 8.x
7801 * This code is tricky: C doesn't guarantee much
7802 * about the quotient or remainder, but Tcl does.
7803 * The remainder always has the same sign as the
7804 * divisor and a smaller absolute value.
7806 int negative = 0;
7808 if (wB < 0) {
7809 wB = -wB;
7810 wA = -wA;
7811 negative = 1;
7813 wC = wA % wB;
7814 if (wC < 0) {
7815 wC += wB;
7817 if (negative) {
7818 wC = -wC;
7821 break;
7822 case JIM_EXPROP_ROTL:
7823 case JIM_EXPROP_ROTR:{
7824 /* uint32_t would be better. But not everyone has inttypes.h? */
7825 unsigned long uA = (unsigned long)wA;
7826 unsigned long uB = (unsigned long)wB;
7827 const unsigned int S = sizeof(unsigned long) * 8;
7829 /* Shift left by the word size or more is undefined. */
7830 uB %= S;
7832 if (e->opcode == JIM_EXPROP_ROTR) {
7833 uB = S - uB;
7835 wC = (unsigned long)(uA << uB) | (uA >> (S - uB));
7836 break;
7838 default:
7839 abort();
7841 ExprPush(e, Jim_NewIntObj(interp, wC));
7845 Jim_DecrRefCount(interp, A);
7846 Jim_DecrRefCount(interp, B);
7848 return rc;
7852 /* A binary operation on two ints or two doubles (or two strings for some ops) */
7853 static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e)
7855 int intresult = 0;
7856 int rc = JIM_OK;
7857 double dA, dB, dC = 0;
7858 jim_wide wA, wB, wC = 0;
7860 Jim_Obj *B = ExprPop(e);
7861 Jim_Obj *A = ExprPop(e);
7863 if ((A->typePtr != &doubleObjType || A->bytes) &&
7864 (B->typePtr != &doubleObjType || B->bytes) &&
7865 JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) {
7867 /* Both are ints */
7869 intresult = 1;
7871 switch (e->opcode) {
7872 case JIM_EXPROP_POW:
7873 case JIM_EXPROP_FUNC_POW:
7874 wC = JimPowWide(wA, wB);
7875 break;
7876 case JIM_EXPROP_ADD:
7877 wC = wA + wB;
7878 break;
7879 case JIM_EXPROP_SUB:
7880 wC = wA - wB;
7881 break;
7882 case JIM_EXPROP_MUL:
7883 wC = wA * wB;
7884 break;
7885 case JIM_EXPROP_DIV:
7886 if (wB == 0) {
7887 Jim_SetResultString(interp, "Division by zero", -1);
7888 rc = JIM_ERR;
7890 else {
7892 * From Tcl 8.x
7894 * This code is tricky: C doesn't guarantee much
7895 * about the quotient or remainder, but Tcl does.
7896 * The remainder always has the same sign as the
7897 * divisor and a smaller absolute value.
7899 if (wB < 0) {
7900 wB = -wB;
7901 wA = -wA;
7903 wC = wA / wB;
7904 if (wA % wB < 0) {
7905 wC--;
7908 break;
7909 case JIM_EXPROP_LT:
7910 wC = wA < wB;
7911 break;
7912 case JIM_EXPROP_GT:
7913 wC = wA > wB;
7914 break;
7915 case JIM_EXPROP_LTE:
7916 wC = wA <= wB;
7917 break;
7918 case JIM_EXPROP_GTE:
7919 wC = wA >= wB;
7920 break;
7921 case JIM_EXPROP_NUMEQ:
7922 wC = wA == wB;
7923 break;
7924 case JIM_EXPROP_NUMNE:
7925 wC = wA != wB;
7926 break;
7927 default:
7928 abort();
7931 else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) {
7932 switch (e->opcode) {
7933 case JIM_EXPROP_POW:
7934 case JIM_EXPROP_FUNC_POW:
7935 #ifdef JIM_MATH_FUNCTIONS
7936 dC = pow(dA, dB);
7937 #else
7938 Jim_SetResultString(interp, "unsupported", -1);
7939 rc = JIM_ERR;
7940 #endif
7941 break;
7942 case JIM_EXPROP_ADD:
7943 dC = dA + dB;
7944 break;
7945 case JIM_EXPROP_SUB:
7946 dC = dA - dB;
7947 break;
7948 case JIM_EXPROP_MUL:
7949 dC = dA * dB;
7950 break;
7951 case JIM_EXPROP_DIV:
7952 if (dB == 0) {
7953 #ifdef INFINITY
7954 dC = dA < 0 ? -INFINITY : INFINITY;
7955 #else
7956 dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL);
7957 #endif
7959 else {
7960 dC = dA / dB;
7962 break;
7963 case JIM_EXPROP_LT:
7964 wC = dA < dB;
7965 intresult = 1;
7966 break;
7967 case JIM_EXPROP_GT:
7968 wC = dA > dB;
7969 intresult = 1;
7970 break;
7971 case JIM_EXPROP_LTE:
7972 wC = dA <= dB;
7973 intresult = 1;
7974 break;
7975 case JIM_EXPROP_GTE:
7976 wC = dA >= dB;
7977 intresult = 1;
7978 break;
7979 case JIM_EXPROP_NUMEQ:
7980 wC = dA == dB;
7981 intresult = 1;
7982 break;
7983 case JIM_EXPROP_NUMNE:
7984 wC = dA != dB;
7985 intresult = 1;
7986 break;
7987 default:
7988 abort();
7991 else {
7992 /* Handle the string case */
7994 /* REVISIT: Could optimise the eq/ne case by checking lengths */
7995 int i = Jim_StringCompareObj(interp, A, B, 0);
7997 intresult = 1;
7999 switch (e->opcode) {
8000 case JIM_EXPROP_LT:
8001 wC = i < 0;
8002 break;
8003 case JIM_EXPROP_GT:
8004 wC = i > 0;
8005 break;
8006 case JIM_EXPROP_LTE:
8007 wC = i <= 0;
8008 break;
8009 case JIM_EXPROP_GTE:
8010 wC = i >= 0;
8011 break;
8012 case JIM_EXPROP_NUMEQ:
8013 wC = i == 0;
8014 break;
8015 case JIM_EXPROP_NUMNE:
8016 wC = i != 0;
8017 break;
8018 default:
8019 rc = JIM_ERR;
8020 break;
8024 if (rc == JIM_OK) {
8025 if (intresult) {
8026 ExprPush(e, Jim_NewIntObj(interp, wC));
8028 else {
8029 ExprPush(e, Jim_NewDoubleObj(interp, dC));
8033 Jim_DecrRefCount(interp, A);
8034 Jim_DecrRefCount(interp, B);
8036 return rc;
8039 static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj)
8041 int listlen;
8042 int i;
8044 listlen = Jim_ListLength(interp, listObjPtr);
8045 for (i = 0; i < listlen; i++) {
8046 Jim_Obj *objPtr;
8048 Jim_ListIndex(interp, listObjPtr, i, &objPtr, JIM_NONE);
8050 if (Jim_StringEqObj(objPtr, valObj)) {
8051 return 1;
8054 return 0;
8057 static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e)
8059 Jim_Obj *B = ExprPop(e);
8060 Jim_Obj *A = ExprPop(e);
8062 jim_wide wC;
8064 switch (e->opcode) {
8065 case JIM_EXPROP_STREQ:
8066 case JIM_EXPROP_STRNE:
8067 wC = Jim_StringEqObj(A, B);
8068 if (e->opcode == JIM_EXPROP_STRNE) {
8069 wC = !wC;
8071 break;
8072 case JIM_EXPROP_STRIN:
8073 wC = JimSearchList(interp, B, A);
8074 break;
8075 case JIM_EXPROP_STRNI:
8076 wC = !JimSearchList(interp, B, A);
8077 break;
8078 default:
8079 abort();
8081 ExprPush(e, Jim_NewIntObj(interp, wC));
8083 Jim_DecrRefCount(interp, A);
8084 Jim_DecrRefCount(interp, B);
8086 return JIM_OK;
8089 static int ExprBool(Jim_Interp *interp, Jim_Obj *obj)
8091 long l;
8092 double d;
8094 if (Jim_GetLong(interp, obj, &l) == JIM_OK) {
8095 return l != 0;
8097 if (Jim_GetDouble(interp, obj, &d) == JIM_OK) {
8098 return d != 0;
8100 return -1;
8103 static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e)
8105 Jim_Obj *skip = ExprPop(e);
8106 Jim_Obj *A = ExprPop(e);
8107 int rc = JIM_OK;
8109 switch (ExprBool(interp, A)) {
8110 case 0:
8111 /* false, so skip RHS opcodes with a 0 result */
8112 e->skip = JimWideValue(skip);
8113 ExprPush(e, Jim_NewIntObj(interp, 0));
8114 break;
8116 case 1:
8117 /* true so continue */
8118 break;
8120 case -1:
8121 /* Invalid */
8122 rc = JIM_ERR;
8124 Jim_DecrRefCount(interp, A);
8125 Jim_DecrRefCount(interp, skip);
8127 return rc;
8130 static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e)
8132 Jim_Obj *skip = ExprPop(e);
8133 Jim_Obj *A = ExprPop(e);
8134 int rc = JIM_OK;
8136 switch (ExprBool(interp, A)) {
8137 case 0:
8138 /* false, so do nothing */
8139 break;
8141 case 1:
8142 /* true so skip RHS opcodes with a 1 result */
8143 e->skip = JimWideValue(skip);
8144 ExprPush(e, Jim_NewIntObj(interp, 1));
8145 break;
8147 case -1:
8148 /* Invalid */
8149 rc = JIM_ERR;
8150 break;
8152 Jim_DecrRefCount(interp, A);
8153 Jim_DecrRefCount(interp, skip);
8155 return rc;
8158 static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e)
8160 Jim_Obj *A = ExprPop(e);
8161 int rc = JIM_OK;
8163 switch (ExprBool(interp, A)) {
8164 case 0:
8165 ExprPush(e, Jim_NewIntObj(interp, 0));
8166 break;
8168 case 1:
8169 ExprPush(e, Jim_NewIntObj(interp, 1));
8170 break;
8172 case -1:
8173 /* Invalid */
8174 rc = JIM_ERR;
8175 break;
8177 Jim_DecrRefCount(interp, A);
8179 return rc;
8182 static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e)
8184 Jim_Obj *skip = ExprPop(e);
8185 Jim_Obj *A = ExprPop(e);
8186 int rc = JIM_OK;
8188 /* Repush A */
8189 ExprPush(e, A);
8191 switch (ExprBool(interp, A)) {
8192 case 0:
8193 /* false, skip RHS opcodes */
8194 e->skip = JimWideValue(skip);
8195 /* Push a dummy value */
8196 ExprPush(e, Jim_NewIntObj(interp, 0));
8197 break;
8199 case 1:
8200 /* true so do nothing */
8201 break;
8203 case -1:
8204 /* Invalid */
8205 rc = JIM_ERR;
8206 break;
8208 Jim_DecrRefCount(interp, A);
8209 Jim_DecrRefCount(interp, skip);
8211 return rc;
8214 static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e)
8216 Jim_Obj *skip = ExprPop(e);
8217 Jim_Obj *B = ExprPop(e);
8218 Jim_Obj *A = ExprPop(e);
8220 /* No need to check for A as non-boolean */
8221 if (ExprBool(interp, A)) {
8222 /* true, so skip RHS opcodes */
8223 e->skip = JimWideValue(skip);
8224 /* Repush B as the answer */
8225 ExprPush(e, B);
8228 Jim_DecrRefCount(interp, skip);
8229 Jim_DecrRefCount(interp, A);
8230 Jim_DecrRefCount(interp, B);
8231 return JIM_OK;
8234 static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e)
8236 return JIM_OK;
8239 enum
8241 LAZY_NONE,
8242 LAZY_OP,
8243 LAZY_LEFT,
8244 LAZY_RIGHT
8247 /* name - precedence - arity - opcode
8249 * This array *must* be kept in sync with the JIM_EXPROP enum.
8251 * The following macro pre-computes the string length at compile time.
8253 #define OPRINIT(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1}
8255 static const struct Jim_ExprOperator Jim_ExprOperators[] = {
8256 OPRINIT("*", 110, 2, JimExprOpBin, LAZY_NONE),
8257 OPRINIT("/", 110, 2, JimExprOpBin, LAZY_NONE),
8258 OPRINIT("%", 110, 2, JimExprOpIntBin, LAZY_NONE),
8260 OPRINIT("-", 100, 2, JimExprOpBin, LAZY_NONE),
8261 OPRINIT("+", 100, 2, JimExprOpBin, LAZY_NONE),
8263 OPRINIT("<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8264 OPRINIT(">>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8266 OPRINIT("<<<", 90, 2, JimExprOpIntBin, LAZY_NONE),
8267 OPRINIT(">>>", 90, 2, JimExprOpIntBin, LAZY_NONE),
8269 OPRINIT("<", 80, 2, JimExprOpBin, LAZY_NONE),
8270 OPRINIT(">", 80, 2, JimExprOpBin, LAZY_NONE),
8271 OPRINIT("<=", 80, 2, JimExprOpBin, LAZY_NONE),
8272 OPRINIT(">=", 80, 2, JimExprOpBin, LAZY_NONE),
8274 OPRINIT("==", 70, 2, JimExprOpBin, LAZY_NONE),
8275 OPRINIT("!=", 70, 2, JimExprOpBin, LAZY_NONE),
8277 OPRINIT("&", 50, 2, JimExprOpIntBin, LAZY_NONE),
8278 OPRINIT("^", 49, 2, JimExprOpIntBin, LAZY_NONE),
8279 OPRINIT("|", 48, 2, JimExprOpIntBin, LAZY_NONE),
8281 OPRINIT("&&", 10, 2, NULL, LAZY_OP),
8282 OPRINIT(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT),
8283 OPRINIT(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8285 OPRINIT("||", 9, 2, NULL, LAZY_OP),
8286 OPRINIT(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT),
8287 OPRINIT(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT),
8289 OPRINIT("?", 5, 2, JimExprOpNull, LAZY_OP),
8290 OPRINIT(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT),
8291 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8293 OPRINIT(":", 5, 2, JimExprOpNull, LAZY_OP),
8294 OPRINIT(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT),
8295 OPRINIT(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT),
8297 OPRINIT("**", 250, 2, JimExprOpBin, LAZY_NONE),
8299 OPRINIT("eq", 60, 2, JimExprOpStrBin, LAZY_NONE),
8300 OPRINIT("ne", 60, 2, JimExprOpStrBin, LAZY_NONE),
8302 OPRINIT("in", 55, 2, JimExprOpStrBin, LAZY_NONE),
8303 OPRINIT("ni", 55, 2, JimExprOpStrBin, LAZY_NONE),
8305 OPRINIT("!", 150, 1, JimExprOpNumUnary, LAZY_NONE),
8306 OPRINIT("~", 150, 1, JimExprOpIntUnary, LAZY_NONE),
8307 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8308 OPRINIT(NULL, 150, 1, JimExprOpNumUnary, LAZY_NONE),
8312 OPRINIT("int", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8313 OPRINIT("abs", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8314 OPRINIT("double", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8315 OPRINIT("round", 200, 1, JimExprOpNumUnary, LAZY_NONE),
8316 OPRINIT("rand", 200, 0, JimExprOpNone, LAZY_NONE),
8317 OPRINIT("srand", 200, 1, JimExprOpIntUnary, LAZY_NONE),
8319 #ifdef JIM_MATH_FUNCTIONS
8320 OPRINIT("sin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8321 OPRINIT("cos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8322 OPRINIT("tan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8323 OPRINIT("asin", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8324 OPRINIT("acos", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8325 OPRINIT("atan", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8326 OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8327 OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8328 OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8329 OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8330 OPRINIT("floor", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8331 OPRINIT("exp", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8332 OPRINIT("log", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8333 OPRINIT("log10", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8334 OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary, LAZY_NONE),
8335 OPRINIT("pow", 200, 2, JimExprOpBin, LAZY_NONE),
8336 #endif
8338 #undef OPRINIT
8340 #define JIM_EXPR_OPERATORS_NUM \
8341 (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator))
8343 static int JimParseExpression(struct JimParserCtx *pc)
8345 /* Discard spaces and quoted newline */
8346 while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8347 if (*pc->p == '\n') {
8348 pc->linenr++;
8350 pc->p++;
8351 pc->len--;
8354 /* Common case */
8355 pc->tline = pc->linenr;
8356 pc->tstart = pc->p;
8358 if (pc->len == 0) {
8359 pc->tend = pc->p;
8360 pc->tt = JIM_TT_EOL;
8361 pc->eof = 1;
8362 return JIM_OK;
8364 switch (*(pc->p)) {
8365 case '(':
8366 pc->tt = JIM_TT_SUBEXPR_START;
8367 goto singlechar;
8368 case ')':
8369 pc->tt = JIM_TT_SUBEXPR_END;
8370 goto singlechar;
8371 case ',':
8372 pc->tt = JIM_TT_SUBEXPR_COMMA;
8373 singlechar:
8374 pc->tend = pc->p;
8375 pc->p++;
8376 pc->len--;
8377 break;
8378 case '[':
8379 return JimParseCmd(pc);
8380 case '$':
8381 if (JimParseVar(pc) == JIM_ERR)
8382 return JimParseExprOperator(pc);
8383 else {
8384 /* Don't allow expr sugar in expressions */
8385 if (pc->tt == JIM_TT_EXPRSUGAR) {
8386 return JIM_ERR;
8388 return JIM_OK;
8390 break;
8391 case '0':
8392 case '1':
8393 case '2':
8394 case '3':
8395 case '4':
8396 case '5':
8397 case '6':
8398 case '7':
8399 case '8':
8400 case '9':
8401 case '.':
8402 return JimParseExprNumber(pc);
8403 case '"':
8404 return JimParseQuote(pc);
8405 case '{':
8406 return JimParseBrace(pc);
8408 case 'N':
8409 case 'I':
8410 case 'n':
8411 case 'i':
8412 if (JimParseExprIrrational(pc) == JIM_ERR)
8413 return JimParseExprOperator(pc);
8414 break;
8415 default:
8416 return JimParseExprOperator(pc);
8417 break;
8419 return JIM_OK;
8422 static int JimParseExprNumber(struct JimParserCtx *pc)
8424 char *end;
8426 /* Assume an integer for now */
8427 pc->tt = JIM_TT_EXPR_INT;
8429 jim_strtoull(pc->p, (char **)&pc->p);
8430 /* Tried as an integer, but perhaps it parses as a double */
8431 if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) {
8432 strtod(pc->tstart, &end);
8433 if (end == pc->tstart)
8434 return JIM_ERR;
8435 if (end > pc->p) {
8436 /* Yes, double captured more chars */
8437 pc->tt = JIM_TT_EXPR_DOUBLE;
8438 pc->p = end;
8441 pc->tend = pc->p - 1;
8442 pc->len -= (pc->p - pc->tstart);
8443 return JIM_OK;
8446 static int JimParseExprIrrational(struct JimParserCtx *pc)
8448 const char *Tokens[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL };
8449 const char **token;
8451 for (token = Tokens; *token != NULL; token++) {
8452 int len = strlen(*token);
8454 if (strncmp(*token, pc->p, len) == 0) {
8455 pc->tend = pc->p + len - 1;
8456 pc->p += len;
8457 pc->len -= len;
8458 pc->tt = JIM_TT_EXPR_DOUBLE;
8459 return JIM_OK;
8462 return JIM_ERR;
8465 static int JimParseExprOperator(struct JimParserCtx *pc)
8467 int i;
8468 int bestIdx = -1, bestLen = 0;
8470 /* Try to get the longest match. */
8471 for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) {
8472 const char * const opname = Jim_ExprOperators[i].name;
8473 const int oplen = Jim_ExprOperators[i].namelen;
8475 if (opname == NULL || opname[0] != pc->p[0]) {
8476 continue;
8479 if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) {
8480 bestIdx = i + JIM_TT_EXPR_OP;
8481 bestLen = oplen;
8484 if (bestIdx == -1) {
8485 return JIM_ERR;
8488 /* Validate paretheses around function arguments */
8489 if (bestIdx >= JIM_EXPROP_FUNC_FIRST) {
8490 const char *p = pc->p + bestLen;
8491 int len = pc->len - bestLen;
8493 while (len && isspace(UCHAR(*p))) {
8494 len--;
8495 p++;
8497 if (*p != '(') {
8498 return JIM_ERR;
8501 pc->tend = pc->p + bestLen - 1;
8502 pc->p += bestLen;
8503 pc->len -= bestLen;
8505 pc->tt = bestIdx;
8506 return JIM_OK;
8509 static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode)
8511 static Jim_ExprOperator dummy_op;
8512 if (opcode < JIM_TT_EXPR_OP) {
8513 return &dummy_op;
8515 return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP];
8518 const char *jim_tt_name(int type)
8520 static const char * const tt_names[JIM_TT_EXPR_OP] =
8521 { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT",
8522 "DBL", "$()" };
8523 if (type < JIM_TT_EXPR_OP) {
8524 return tt_names[type];
8526 else {
8527 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type);
8528 static char buf[20];
8530 if (op->name) {
8531 return op->name;
8533 sprintf(buf, "(%d)", type);
8534 return buf;
8538 /* -----------------------------------------------------------------------------
8539 * Expression Object
8540 * ---------------------------------------------------------------------------*/
8541 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
8542 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
8543 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr);
8545 static const Jim_ObjType exprObjType = {
8546 "expression",
8547 FreeExprInternalRep,
8548 DupExprInternalRep,
8549 NULL,
8550 JIM_TYPE_REFERENCES,
8553 /* Expr bytecode structure */
8554 typedef struct ExprByteCode
8556 ScriptToken *token; /* Tokens array. */
8557 int len; /* Length as number of tokens. */
8558 int inUse; /* Used for sharing. */
8559 } ExprByteCode;
8561 static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr)
8563 int i;
8565 for (i = 0; i < expr->len; i++) {
8566 Jim_DecrRefCount(interp, expr->token[i].objPtr);
8568 Jim_Free(expr->token);
8569 Jim_Free(expr);
8572 static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
8574 ExprByteCode *expr = (void *)objPtr->internalRep.ptr;
8576 if (expr) {
8577 if (--expr->inUse != 0) {
8578 return;
8581 ExprFreeByteCode(interp, expr);
8585 static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
8587 JIM_NOTUSED(interp);
8588 JIM_NOTUSED(srcPtr);
8590 /* Just returns an simple string. */
8591 dupPtr->typePtr = NULL;
8594 /* Check if an expr program looks correct. */
8595 static int ExprCheckCorrectness(ExprByteCode * expr)
8597 int i;
8598 int stacklen = 0;
8599 int ternary = 0;
8601 /* Try to check if there are stack underflows,
8602 * and make sure at the end of the program there is
8603 * a single result on the stack. */
8604 for (i = 0; i < expr->len; i++) {
8605 ScriptToken *t = &expr->token[i];
8606 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8608 stacklen -= op->arity;
8609 if (stacklen < 0) {
8610 break;
8612 if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) {
8613 ternary++;
8615 else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) {
8616 ternary--;
8619 /* All operations and operands add one to the stack */
8620 stacklen++;
8622 if (stacklen != 1 || ternary != 0) {
8623 return JIM_ERR;
8625 return JIM_OK;
8628 /* This procedure converts every occurrence of || and && opereators
8629 * in lazy unary versions.
8631 * a b || is converted into:
8633 * a <offset> |L b |R
8635 * a b && is converted into:
8637 * a <offset> &L b &R
8639 * "|L" checks if 'a' is true:
8640 * 1) if it is true pushes 1 and skips <offset> instructions to reach
8641 * the opcode just after |R.
8642 * 2) if it is false does nothing.
8643 * "|R" checks if 'b' is true:
8644 * 1) if it is true pushes 1, otherwise pushes 0.
8646 * "&L" checks if 'a' is true:
8647 * 1) if it is true does nothing.
8648 * 2) If it is false pushes 0 and skips <offset> instructions to reach
8649 * the opcode just after &R
8650 * "&R" checks if 'a' is true:
8651 * if it is true pushes 1, otherwise pushes 0.
8653 static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8655 int i;
8657 int leftindex, arity, offset;
8659 /* Search for the end of the first operator */
8660 leftindex = expr->len - 1;
8662 arity = 1;
8663 while (arity) {
8664 ScriptToken *tt = &expr->token[leftindex];
8666 if (tt->type >= JIM_TT_EXPR_OP) {
8667 arity += JimExprOperatorInfoByOpcode(tt->type)->arity;
8669 arity--;
8670 if (--leftindex < 0) {
8671 return JIM_ERR;
8674 leftindex++;
8676 /* Move them up */
8677 memmove(&expr->token[leftindex + 2], &expr->token[leftindex],
8678 sizeof(*expr->token) * (expr->len - leftindex));
8679 expr->len += 2;
8680 offset = (expr->len - leftindex) - 1;
8682 /* Now we rely on the fact the the left and right version have opcodes
8683 * 1 and 2 after the main opcode respectively
8685 expr->token[leftindex + 1].type = t->type + 1;
8686 expr->token[leftindex + 1].objPtr = interp->emptyObj;
8688 expr->token[leftindex].type = JIM_TT_EXPR_INT;
8689 expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset);
8691 /* Now add the 'R' operator */
8692 expr->token[expr->len].objPtr = interp->emptyObj;
8693 expr->token[expr->len].type = t->type + 2;
8694 expr->len++;
8696 /* Do we need to adjust the skip count for any &L, |L, ?L or :L in the left operand? */
8697 for (i = leftindex - 1; i > 0; i--) {
8698 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type);
8699 if (op->lazy == LAZY_LEFT) {
8700 if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) {
8701 JimWideValue(expr->token[i - 1].objPtr) += 2;
8705 return JIM_OK;
8708 static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
8710 struct ScriptToken *token = &expr->token[expr->len];
8711 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8713 if (op->lazy == LAZY_OP) {
8714 if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
8715 Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
8716 return JIM_ERR;
8719 else {
8720 token->objPtr = interp->emptyObj;
8721 token->type = t->type;
8722 expr->len++;
8724 return JIM_OK;
8728 * Returns the index of the COLON_LEFT to the left of 'right_index'
8729 * taking into account nesting.
8731 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
8733 static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index)
8735 int ternary_count = 1;
8737 right_index--;
8739 while (right_index > 1) {
8740 if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) {
8741 ternary_count--;
8743 else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) {
8744 ternary_count++;
8746 else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) {
8747 return right_index;
8749 right_index--;
8752 /*notreached*/
8753 return -1;
8757 * Find the left/right indices for the ternary expression to the left of 'right_index'.
8759 * Returns 1 if found, and fills in *prev_right_index and *prev_left_index.
8760 * Otherwise returns 0.
8762 static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index)
8764 int i = right_index - 1;
8765 int ternary_count = 1;
8767 while (i > 1) {
8768 if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) {
8769 if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) {
8770 *prev_right_index = i - 2;
8771 *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index);
8772 return 1;
8775 else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) {
8776 if (ternary_count == 0) {
8777 return 0;
8779 ternary_count++;
8781 i--;
8783 return 0;
8787 * ExprTernaryReorderExpression description
8788 * ========================================
8790 * ?: is right-to-left associative which doesn't work with the stack-based
8791 * expression engine. The fix is to reorder the bytecode.
8793 * The expression:
8795 * expr 1?2:0?3:4
8797 * Has initial bytecode:
8799 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '0' (44=COLON_RIGHT)
8800 * '2' (40=TERNARY_LEFT) '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT)
8802 * The fix involves simulating this expression instead:
8804 * expr 1?2:(0?3:4)
8806 * With the following bytecode:
8808 * '1' '2' (40=TERNARY_LEFT) '2' (41=TERNARY_RIGHT) '10' (43=COLON_LEFT) '0' '2' (40=TERNARY_LEFT)
8809 * '3' (41=TERNARY_RIGHT) '2' (43=COLON_LEFT) '4' (44=COLON_RIGHT) (44=COLON_RIGHT)
8811 * i.e. The token COLON_RIGHT at index 8 is moved towards the end of the stack, all tokens above 8
8812 * are shifted down and the skip count of the token JIM_EXPROP_COLON_LEFT at index 5 is
8813 * incremented by the amount tokens shifted down. The token JIM_EXPROP_COLON_RIGHT that is moved
8814 * is identified as immediately preceeding a token JIM_EXPROP_TERNARY_LEFT
8816 * ExprTernaryReorderExpression works thus as follows :
8817 * - start from the end of the stack
8818 * - while walking towards the beginning of the stack
8819 * if token=JIM_EXPROP_COLON_RIGHT then
8820 * find the associated token JIM_EXPROP_TERNARY_LEFT, which allows to
8821 * find the associated token previous(JIM_EXPROP_COLON_RIGHT)
8822 * find the associated token previous(JIM_EXPROP_LEFT_RIGHT)
8823 * if all found then
8824 * perform the rotation
8825 * update the skip count of the token previous(JIM_EXPROP_LEFT_RIGHT)
8826 * end if
8827 * end if
8829 * Note: care has to be taken for nested ternary constructs!!!
8831 static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr)
8833 int i;
8835 for (i = expr->len - 1; i > 1; i--) {
8836 int prev_right_index;
8837 int prev_left_index;
8838 int j;
8839 ScriptToken tmp;
8841 if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) {
8842 continue;
8845 /* COLON_RIGHT found: get the indexes needed to move the tokens in the stack (if any) */
8846 if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) {
8847 continue;
8851 ** rotate tokens down
8853 ** +-> [i] : JIM_EXPROP_COLON_RIGHT
8854 ** | | |
8855 ** | V V
8856 ** | [...] : ...
8857 ** | | |
8858 ** | V V
8859 ** | [...] : ...
8860 ** | | |
8861 ** | V V
8862 ** +- [prev_right_index] : JIM_EXPROP_COLON_RIGHT
8864 tmp = expr->token[prev_right_index];
8865 for (j = prev_right_index; j < i; j++) {
8866 expr->token[j] = expr->token[j + 1];
8868 expr->token[i] = tmp;
8870 /* Increment the 'skip' count associated to the previous JIM_EXPROP_COLON_LEFT token
8872 * This is 'colon left increment' = i - prev_right_index
8874 * [prev_left_index] : JIM_EXPROP_LEFT_RIGHT
8875 * [prev_left_index-1] : skip_count
8878 JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index);
8880 /* Adjust for i-- in the loop */
8881 i++;
8885 static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj)
8887 Jim_Stack stack;
8888 ExprByteCode *expr;
8889 int ok = 1;
8890 int i;
8891 int prevtt = JIM_TT_NONE;
8892 int have_ternary = 0;
8894 /* -1 for EOL */
8895 int count = tokenlist->count - 1;
8897 expr = Jim_Alloc(sizeof(*expr));
8898 expr->inUse = 1;
8899 expr->len = 0;
8901 Jim_InitStack(&stack);
8903 /* Need extra bytecodes for lazy operators.
8904 * Also check for the ternary operator
8906 for (i = 0; i < tokenlist->count; i++) {
8907 ParseToken *t = &tokenlist->list[i];
8908 const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);
8910 if (op->lazy == LAZY_OP) {
8911 count += 2;
8912 /* Ternary is a lazy op but also needs reordering */
8913 if (t->type == JIM_EXPROP_TERNARY) {
8914 have_ternary = 1;
8919 expr->token = Jim_Alloc(sizeof(ScriptToken) * count);
8921 for (i = 0; i < tokenlist->count && ok; i++) {
8922 ParseToken *t = &tokenlist->list[i];
8924 /* Next token will be stored here */
8925 struct ScriptToken *token = &expr->token[expr->len];
8927 if (t->type == JIM_TT_EOL) {
8928 break;
8931 switch (t->type) {
8932 case JIM_TT_STR:
8933 case JIM_TT_ESC:
8934 case JIM_TT_VAR:
8935 case JIM_TT_DICTSUGAR:
8936 case JIM_TT_EXPRSUGAR:
8937 case JIM_TT_CMD:
8938 token->type = t->type;
8939 strexpr:
8940 token->objPtr = Jim_NewStringObj(interp, t->token, t->len);
8941 if (t->type == JIM_TT_CMD) {
8942 /* Only commands need source info */
8943 JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line);
8945 expr->len++;
8946 break;
8948 case JIM_TT_EXPR_INT:
8949 case JIM_TT_EXPR_DOUBLE:
8951 char *endptr;
8952 if (t->type == JIM_TT_EXPR_INT) {
8953 token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr));
8955 else {
8956 token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr));
8958 if (endptr != t->token + t->len) {
8959 /* Conversion failed, so just store it as a string */
8960 Jim_FreeNewObj(interp, token->objPtr);
8961 token->type = JIM_TT_STR;
8962 goto strexpr;
8964 token->type = t->type;
8965 expr->len++;
8967 break;
8969 case JIM_TT_SUBEXPR_START:
8970 Jim_StackPush(&stack, t);
8971 prevtt = JIM_TT_NONE;
8972 continue;
8974 case JIM_TT_SUBEXPR_COMMA:
8975 /* Simple approach. Comma is simply ignored */
8976 continue;
8978 case JIM_TT_SUBEXPR_END:
8979 ok = 0;
8980 while (Jim_StackLen(&stack)) {
8981 ParseToken *tt = Jim_StackPop(&stack);
8983 if (tt->type == JIM_TT_SUBEXPR_START) {
8984 ok = 1;
8985 break;
8988 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
8989 goto err;
8992 if (!ok) {
8993 Jim_SetResultString(interp, "Unexpected close parenthesis", -1);
8994 goto err;
8996 break;
8999 default:{
9000 /* Must be an operator */
9001 const struct Jim_ExprOperator *op;
9002 ParseToken *tt;
9004 /* Convert -/+ to unary minus or unary plus if necessary */
9005 if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) {
9006 if (t->type == JIM_EXPROP_SUB) {
9007 t->type = JIM_EXPROP_UNARYMINUS;
9009 else if (t->type == JIM_EXPROP_ADD) {
9010 t->type = JIM_EXPROP_UNARYPLUS;
9014 op = JimExprOperatorInfoByOpcode(t->type);
9016 /* Now handle precedence */
9017 while ((tt = Jim_StackPeek(&stack)) != NULL) {
9018 const struct Jim_ExprOperator *tt_op =
9019 JimExprOperatorInfoByOpcode(tt->type);
9021 /* Note that right-to-left associativity of ?: operator is handled later */
9023 if (op->arity != 1 && tt_op->precedence >= op->precedence) {
9024 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9025 ok = 0;
9026 goto err;
9028 Jim_StackPop(&stack);
9030 else {
9031 break;
9034 Jim_StackPush(&stack, t);
9035 break;
9038 prevtt = t->type;
9041 /* Reduce any remaining subexpr */
9042 while (Jim_StackLen(&stack)) {
9043 ParseToken *tt = Jim_StackPop(&stack);
9045 if (tt->type == JIM_TT_SUBEXPR_START) {
9046 ok = 0;
9047 Jim_SetResultString(interp, "Missing close parenthesis", -1);
9048 goto err;
9050 if (ExprAddOperator(interp, expr, tt) != JIM_OK) {
9051 ok = 0;
9052 goto err;
9056 if (have_ternary) {
9057 ExprTernaryReorderExpression(interp, expr);
9060 err:
9061 /* Free the stack used for the compilation. */
9062 Jim_FreeStack(&stack);
9064 for (i = 0; i < expr->len; i++) {
9065 Jim_IncrRefCount(expr->token[i].objPtr);
9068 if (!ok) {
9069 ExprFreeByteCode(interp, expr);
9070 return NULL;
9073 return expr;
9077 /* This method takes the string representation of an expression
9078 * and generates a program for the Expr's stack-based VM. */
9079 static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr)
9081 int exprTextLen;
9082 const char *exprText;
9083 struct JimParserCtx parser;
9084 struct ExprByteCode *expr;
9085 ParseTokenList tokenlist;
9086 int line;
9087 Jim_Obj *fileNameObj;
9088 int rc = JIM_ERR;
9090 /* Try to get information about filename / line number */
9091 if (objPtr->typePtr == &sourceObjType) {
9092 fileNameObj = objPtr->internalRep.sourceValue.fileNameObj;
9093 line = objPtr->internalRep.sourceValue.lineNumber;
9095 else {
9096 fileNameObj = interp->emptyObj;
9097 line = 1;
9099 Jim_IncrRefCount(fileNameObj);
9101 exprText = Jim_GetString(objPtr, &exprTextLen);
9103 /* Initially tokenise the expression into tokenlist */
9104 ScriptTokenListInit(&tokenlist);
9106 JimParserInit(&parser, exprText, exprTextLen, line);
9107 while (!parser.eof) {
9108 if (JimParseExpression(&parser) != JIM_OK) {
9109 ScriptTokenListFree(&tokenlist);
9110 invalidexpr:
9111 Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr);
9112 expr = NULL;
9113 goto err;
9116 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
9117 parser.tline);
9120 #ifdef DEBUG_SHOW_EXPR_TOKENS
9122 int i;
9123 printf("==== Expr Tokens ====\n");
9124 for (i = 0; i < tokenlist.count; i++) {
9125 printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type),
9126 tokenlist.list[i].len, tokenlist.list[i].token);
9129 #endif
9131 /* Now create the expression bytecode from the tokenlist */
9132 expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj);
9134 /* No longer need the token list */
9135 ScriptTokenListFree(&tokenlist);
9137 if (!expr) {
9138 goto err;
9141 #ifdef DEBUG_SHOW_EXPR
9143 int i;
9145 printf("==== Expr ====\n");
9146 for (i = 0; i < expr->len; i++) {
9147 ScriptToken *t = &expr->token[i];
9149 printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr));
9152 #endif
9154 /* Check program correctness. */
9155 if (ExprCheckCorrectness(expr) != JIM_OK) {
9156 ExprFreeByteCode(interp, expr);
9157 goto invalidexpr;
9160 rc = JIM_OK;
9162 err:
9163 /* Free the old internal rep and set the new one. */
9164 Jim_DecrRefCount(interp, fileNameObj);
9165 Jim_FreeIntRep(interp, objPtr);
9166 Jim_SetIntRepPtr(objPtr, expr);
9167 objPtr->typePtr = &exprObjType;
9168 return rc;
9171 static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr)
9173 if (objPtr->typePtr != &exprObjType) {
9174 if (SetExprFromAny(interp, objPtr) != JIM_OK) {
9175 return NULL;
9178 return (ExprByteCode *) Jim_GetIntRepPtr(objPtr);
9181 #ifdef JIM_OPTIMIZATION
9182 static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token)
9184 if (token->type == JIM_TT_EXPR_INT)
9185 return token->objPtr;
9186 else if (token->type == JIM_TT_VAR)
9187 return Jim_GetVariable(interp, token->objPtr, JIM_NONE);
9188 else if (token->type == JIM_TT_DICTSUGAR)
9189 return JimExpandDictSugar(interp, token->objPtr);
9190 else
9191 return NULL;
9193 #endif
9195 /* -----------------------------------------------------------------------------
9196 * Expressions evaluation.
9197 * Jim uses a specialized stack-based virtual machine for expressions,
9198 * that takes advantage of the fact that expr's operators
9199 * can't be redefined.
9201 * Jim_EvalExpression() uses the bytecode compiled by
9202 * SetExprFromAny() method of the "expression" object.
9204 * On success a Tcl Object containing the result of the evaluation
9205 * is stored into expResultPtrPtr (having refcount of 1), and JIM_OK is
9206 * returned.
9207 * On error the function returns a retcode != to JIM_OK and set a suitable
9208 * error on the interp.
9209 * ---------------------------------------------------------------------------*/
9210 #define JIM_EE_STATICSTACK_LEN 10
9212 int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr)
9214 ExprByteCode *expr;
9215 Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN];
9216 int i;
9217 int retcode = JIM_OK;
9218 struct JimExprState e;
9220 expr = JimGetExpression(interp, exprObjPtr);
9221 if (!expr) {
9222 return JIM_ERR; /* error in expression. */
9225 #ifdef JIM_OPTIMIZATION
9226 /* Check for one of the following common expressions used by while/for
9228 * CONST
9229 * $a
9230 * !$a
9231 * $a < CONST, $a < $b
9232 * $a <= CONST, $a <= $b
9233 * $a > CONST, $a > $b
9234 * $a >= CONST, $a >= $b
9235 * $a != CONST, $a != $b
9236 * $a == CONST, $a == $b
9239 Jim_Obj *objPtr;
9241 /* STEP 1 -- Check if there are the conditions to run the specialized
9242 * version of while */
9244 switch (expr->len) {
9245 case 1:
9246 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9247 if (objPtr) {
9248 Jim_IncrRefCount(objPtr);
9249 *exprResultPtrPtr = objPtr;
9250 return JIM_OK;
9252 break;
9254 case 2:
9255 if (expr->token[1].type == JIM_EXPROP_NOT) {
9256 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9258 if (objPtr && JimIsWide(objPtr)) {
9259 *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj;
9260 Jim_IncrRefCount(*exprResultPtrPtr);
9261 return JIM_OK;
9264 break;
9266 case 3:
9267 objPtr = JimExprIntValOrVar(interp, &expr->token[0]);
9268 if (objPtr && JimIsWide(objPtr)) {
9269 Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]);
9270 if (objPtr2 && JimIsWide(objPtr2)) {
9271 jim_wide wideValueA = JimWideValue(objPtr);
9272 jim_wide wideValueB = JimWideValue(objPtr2);
9273 int cmpRes;
9274 switch (expr->token[2].type) {
9275 case JIM_EXPROP_LT:
9276 cmpRes = wideValueA < wideValueB;
9277 break;
9278 case JIM_EXPROP_LTE:
9279 cmpRes = wideValueA <= wideValueB;
9280 break;
9281 case JIM_EXPROP_GT:
9282 cmpRes = wideValueA > wideValueB;
9283 break;
9284 case JIM_EXPROP_GTE:
9285 cmpRes = wideValueA >= wideValueB;
9286 break;
9287 case JIM_EXPROP_NUMEQ:
9288 cmpRes = wideValueA == wideValueB;
9289 break;
9290 case JIM_EXPROP_NUMNE:
9291 cmpRes = wideValueA != wideValueB;
9292 break;
9293 default:
9294 goto noopt;
9296 *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj;
9297 Jim_IncrRefCount(*exprResultPtrPtr);
9298 return JIM_OK;
9301 break;
9304 noopt:
9305 #endif
9307 /* In order to avoid that the internal repr gets freed due to
9308 * shimmering of the exprObjPtr's object, we make the internal rep
9309 * shared. */
9310 expr->inUse++;
9312 /* The stack-based expr VM itself */
9314 /* Stack allocation. Expr programs have the feature that
9315 * a program of length N can't require a stack longer than
9316 * N. */
9317 if (expr->len > JIM_EE_STATICSTACK_LEN)
9318 e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len);
9319 else
9320 e.stack = staticStack;
9322 e.stacklen = 0;
9324 /* Execute every instruction */
9325 for (i = 0; i < expr->len && retcode == JIM_OK; i++) {
9326 Jim_Obj *objPtr;
9328 switch (expr->token[i].type) {
9329 case JIM_TT_EXPR_INT:
9330 case JIM_TT_EXPR_DOUBLE:
9331 case JIM_TT_STR:
9332 ExprPush(&e, expr->token[i].objPtr);
9333 break;
9335 case JIM_TT_VAR:
9336 objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG);
9337 if (objPtr) {
9338 ExprPush(&e, objPtr);
9340 else {
9341 retcode = JIM_ERR;
9343 break;
9345 case JIM_TT_DICTSUGAR:
9346 objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr);
9347 if (objPtr) {
9348 ExprPush(&e, objPtr);
9350 else {
9351 retcode = JIM_ERR;
9353 break;
9355 case JIM_TT_ESC:
9356 retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE);
9357 if (retcode == JIM_OK) {
9358 ExprPush(&e, objPtr);
9360 break;
9362 case JIM_TT_CMD:
9363 retcode = Jim_EvalObj(interp, expr->token[i].objPtr);
9364 if (retcode == JIM_OK) {
9365 ExprPush(&e, Jim_GetResult(interp));
9367 break;
9369 default:{
9370 /* Find and execute the operation */
9371 e.skip = 0;
9372 e.opcode = expr->token[i].type;
9374 retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e);
9375 /* Skip some opcodes if necessary */
9376 i += e.skip;
9377 continue;
9382 expr->inUse--;
9384 if (retcode == JIM_OK) {
9385 *exprResultPtrPtr = ExprPop(&e);
9387 else {
9388 for (i = 0; i < e.stacklen; i++) {
9389 Jim_DecrRefCount(interp, e.stack[i]);
9392 if (e.stack != staticStack) {
9393 Jim_Free(e.stack);
9395 return retcode;
9398 int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr)
9400 int retcode;
9401 jim_wide wideValue;
9402 double doubleValue;
9403 Jim_Obj *exprResultPtr;
9405 retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr);
9406 if (retcode != JIM_OK)
9407 return retcode;
9409 if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) {
9410 if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) {
9411 Jim_DecrRefCount(interp, exprResultPtr);
9412 return JIM_ERR;
9414 else {
9415 Jim_DecrRefCount(interp, exprResultPtr);
9416 *boolPtr = doubleValue != 0;
9417 return JIM_OK;
9420 *boolPtr = wideValue != 0;
9422 Jim_DecrRefCount(interp, exprResultPtr);
9423 return JIM_OK;
9426 /* -----------------------------------------------------------------------------
9427 * ScanFormat String Object
9428 * ---------------------------------------------------------------------------*/
9430 /* This Jim_Obj will held a parsed representation of a format string passed to
9431 * the Jim_ScanString command. For error diagnostics, the scanformat string has
9432 * to be parsed in its entirely first and then, if correct, can be used for
9433 * scanning. To avoid endless re-parsing, the parsed representation will be
9434 * stored in an internal representation and re-used for performance reason. */
9436 /* A ScanFmtPartDescr will held the information of /one/ part of the whole
9437 * scanformat string. This part will later be used to extract information
9438 * out from the string to be parsed by Jim_ScanString */
9440 typedef struct ScanFmtPartDescr
9442 char *arg; /* Specification of a CHARSET conversion */
9443 char *prefix; /* Prefix to be scanned literally before conversion */
9444 size_t width; /* Maximal width of input to be converted */
9445 int pos; /* -1 - no assign, 0 - natural pos, >0 - XPG3 pos */
9446 char type; /* Type of conversion (e.g. c, d, f) */
9447 char modifier; /* Modify type (e.g. l - long, h - short */
9448 } ScanFmtPartDescr;
9450 /* The ScanFmtStringObj will hold the internal representation of a scanformat
9451 * string parsed and separated in part descriptions. Furthermore it contains
9452 * the original string representation of the scanformat string to allow for
9453 * fast update of the Jim_Obj's string representation part.
9455 * As an add-on the internal object representation adds some scratch pad area
9456 * for usage by Jim_ScanString to avoid endless allocating and freeing of
9457 * memory for purpose of string scanning.
9459 * The error member points to a static allocated string in case of a mal-
9460 * formed scanformat string or it contains '0' (NULL) in case of a valid
9461 * parse representation.
9463 * The whole memory of the internal representation is allocated as a single
9464 * area of memory that will be internally separated. So freeing and duplicating
9465 * of such an object is cheap */
9467 typedef struct ScanFmtStringObj
9469 jim_wide size; /* Size of internal repr in bytes */
9470 char *stringRep; /* Original string representation */
9471 size_t count; /* Number of ScanFmtPartDescr contained */
9472 size_t convCount; /* Number of conversions that will assign */
9473 size_t maxPos; /* Max position index if XPG3 is used */
9474 const char *error; /* Ptr to error text (NULL if no error */
9475 char *scratch; /* Some scratch pad used by Jim_ScanString */
9476 ScanFmtPartDescr descr[1]; /* The vector of partial descriptions */
9477 } ScanFmtStringObj;
9480 static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr);
9481 static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr);
9482 static void UpdateStringOfScanFmt(Jim_Obj *objPtr);
9484 static const Jim_ObjType scanFmtStringObjType = {
9485 "scanformatstring",
9486 FreeScanFmtInternalRep,
9487 DupScanFmtInternalRep,
9488 UpdateStringOfScanFmt,
9489 JIM_TYPE_NONE,
9492 void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
9494 JIM_NOTUSED(interp);
9495 Jim_Free((char *)objPtr->internalRep.ptr);
9496 objPtr->internalRep.ptr = 0;
9499 void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr)
9501 size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size;
9502 ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size);
9504 JIM_NOTUSED(interp);
9505 memcpy(newVec, srcPtr->internalRep.ptr, size);
9506 dupPtr->internalRep.ptr = newVec;
9507 dupPtr->typePtr = &scanFmtStringObjType;
9510 void UpdateStringOfScanFmt(Jim_Obj *objPtr)
9512 JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep);
9515 /* SetScanFmtFromAny will parse a given string and create the internal
9516 * representation of the format specification. In case of an error
9517 * the error data member of the internal representation will be set
9518 * to an descriptive error text and the function will be left with
9519 * JIM_ERR to indicate unsucessful parsing (aka. malformed scanformat
9520 * specification */
9522 static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
9524 ScanFmtStringObj *fmtObj;
9525 char *buffer;
9526 int maxCount, i, approxSize, lastPos = -1;
9527 const char *fmt = objPtr->bytes;
9528 int maxFmtLen = objPtr->length;
9529 const char *fmtEnd = fmt + maxFmtLen;
9530 int curr;
9532 Jim_FreeIntRep(interp, objPtr);
9533 /* Count how many conversions could take place maximally */
9534 for (i = 0, maxCount = 0; i < maxFmtLen; ++i)
9535 if (fmt[i] == '%')
9536 ++maxCount;
9537 /* Calculate an approximation of the memory necessary */
9538 approxSize = sizeof(ScanFmtStringObj) /* Size of the container */
9539 +(maxCount + 1) * sizeof(ScanFmtPartDescr) /* Size of all partials */
9540 +maxFmtLen * sizeof(char) + 3 + 1 /* Scratch + "%n" + '\0' */
9541 + maxFmtLen * sizeof(char) + 1 /* Original stringrep */
9542 + maxFmtLen * sizeof(char) /* Arg for CHARSETs */
9543 +(maxCount + 1) * sizeof(char) /* '\0' for every partial */
9544 +1; /* safety byte */
9545 fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize);
9546 memset(fmtObj, 0, approxSize);
9547 fmtObj->size = approxSize;
9548 fmtObj->maxPos = 0;
9549 fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1];
9550 fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1;
9551 memcpy(fmtObj->stringRep, fmt, maxFmtLen);
9552 buffer = fmtObj->stringRep + maxFmtLen + 1;
9553 objPtr->internalRep.ptr = fmtObj;
9554 objPtr->typePtr = &scanFmtStringObjType;
9555 for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) {
9556 int width = 0, skip;
9557 ScanFmtPartDescr *descr = &fmtObj->descr[curr];
9559 fmtObj->count++;
9560 descr->width = 0; /* Assume width unspecified */
9561 /* Overread and store any "literal" prefix */
9562 if (*fmt != '%' || fmt[1] == '%') {
9563 descr->type = 0;
9564 descr->prefix = &buffer[i];
9565 for (; fmt < fmtEnd; ++fmt) {
9566 if (*fmt == '%') {
9567 if (fmt[1] != '%')
9568 break;
9569 ++fmt;
9571 buffer[i++] = *fmt;
9573 buffer[i++] = 0;
9575 /* Skip the conversion introducing '%' sign */
9576 ++fmt;
9577 /* End reached due to non-conversion literal only? */
9578 if (fmt >= fmtEnd)
9579 goto done;
9580 descr->pos = 0; /* Assume "natural" positioning */
9581 if (*fmt == '*') {
9582 descr->pos = -1; /* Okay, conversion will not be assigned */
9583 ++fmt;
9585 else
9586 fmtObj->convCount++; /* Otherwise count as assign-conversion */
9587 /* Check if next token is a number (could be width or pos */
9588 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9589 fmt += skip;
9590 /* Was the number a XPG3 position specifier? */
9591 if (descr->pos != -1 && *fmt == '$') {
9592 int prev;
9594 ++fmt;
9595 descr->pos = width;
9596 width = 0;
9597 /* Look if "natural" postioning and XPG3 one was mixed */
9598 if ((lastPos == 0 && descr->pos > 0)
9599 || (lastPos > 0 && descr->pos == 0)) {
9600 fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers";
9601 return JIM_ERR;
9603 /* Look if this position was already used */
9604 for (prev = 0; prev < curr; ++prev) {
9605 if (fmtObj->descr[prev].pos == -1)
9606 continue;
9607 if (fmtObj->descr[prev].pos == descr->pos) {
9608 fmtObj->error =
9609 "variable is assigned by multiple \"%n$\" conversion specifiers";
9610 return JIM_ERR;
9613 /* Try to find a width after the XPG3 specifier */
9614 if (sscanf(fmt, "%d%n", &width, &skip) == 1) {
9615 descr->width = width;
9616 fmt += skip;
9618 if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos)
9619 fmtObj->maxPos = descr->pos;
9621 else {
9622 /* Number was not a XPG3, so it has to be a width */
9623 descr->width = width;
9626 /* If positioning mode was undetermined yet, fix this */
9627 if (lastPos == -1)
9628 lastPos = descr->pos;
9629 /* Handle CHARSET conversion type ... */
9630 if (*fmt == '[') {
9631 int swapped = 1, beg = i, end, j;
9633 descr->type = '[';
9634 descr->arg = &buffer[i];
9635 ++fmt;
9636 if (*fmt == '^')
9637 buffer[i++] = *fmt++;
9638 if (*fmt == ']')
9639 buffer[i++] = *fmt++;
9640 while (*fmt && *fmt != ']')
9641 buffer[i++] = *fmt++;
9642 if (*fmt != ']') {
9643 fmtObj->error = "unmatched [ in format string";
9644 return JIM_ERR;
9646 end = i;
9647 buffer[i++] = 0;
9648 /* In case a range fence was given "backwards", swap it */
9649 while (swapped) {
9650 swapped = 0;
9651 for (j = beg + 1; j < end - 1; ++j) {
9652 if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) {
9653 char tmp = buffer[j - 1];
9655 buffer[j - 1] = buffer[j + 1];
9656 buffer[j + 1] = tmp;
9657 swapped = 1;
9662 else {
9663 /* Remember any valid modifier if given */
9664 if (strchr("hlL", *fmt) != 0)
9665 descr->modifier = tolower((int)*fmt++);
9667 descr->type = *fmt;
9668 if (strchr("efgcsndoxui", *fmt) == 0) {
9669 fmtObj->error = "bad scan conversion character";
9670 return JIM_ERR;
9672 else if (*fmt == 'c' && descr->width != 0) {
9673 fmtObj->error = "field width may not be specified in %c " "conversion";
9674 return JIM_ERR;
9676 else if (*fmt == 'u' && descr->modifier == 'l') {
9677 fmtObj->error = "unsigned wide not supported";
9678 return JIM_ERR;
9681 curr++;
9683 done:
9684 return JIM_OK;
9687 /* Some accessor macros to allow lowlevel access to fields of internal repr */
9689 #define FormatGetCnvCount(_fo_) \
9690 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount
9691 #define FormatGetMaxPos(_fo_) \
9692 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos
9693 #define FormatGetError(_fo_) \
9694 ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error
9696 /* JimScanAString is used to scan an unspecified string that ends with
9697 * next WS, or a string that is specified via a charset.
9700 static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str)
9702 char *buffer = Jim_StrDup(str);
9703 char *p = buffer;
9705 while (*str) {
9706 int c;
9707 int n;
9709 if (!sdescr && isspace(UCHAR(*str)))
9710 break; /* EOS via WS if unspecified */
9712 n = utf8_tounicode(str, &c);
9713 if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
9714 break;
9715 while (n--)
9716 *p++ = *str++;
9718 *p = 0;
9719 return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer);
9722 /* ScanOneEntry will scan one entry out of the string passed as argument.
9723 * It use the sscanf() function for this task. After extracting and
9724 * converting of the value, the count of scanned characters will be
9725 * returned of -1 in case of no conversion tool place and string was
9726 * already scanned thru */
9728 static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen,
9729 ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9731 const char *tok;
9732 const ScanFmtPartDescr *descr = &fmtObj->descr[idx];
9733 size_t scanned = 0;
9734 size_t anchor = pos;
9735 int i;
9736 Jim_Obj *tmpObj = NULL;
9738 /* First pessimistically assume, we will not scan anything :-) */
9739 *valObjPtr = 0;
9740 if (descr->prefix) {
9741 /* There was a prefix given before the conversion, skip it and adjust
9742 * the string-to-be-parsed accordingly */
9743 /* XXX: Should be checking strLen, not str[pos] */
9744 for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
9745 /* If prefix require, skip WS */
9746 if (isspace(UCHAR(descr->prefix[i])))
9747 while (pos < strLen && isspace(UCHAR(str[pos])))
9748 ++pos;
9749 else if (descr->prefix[i] != str[pos])
9750 break; /* Prefix do not match here, leave the loop */
9751 else
9752 ++pos; /* Prefix matched so far, next round */
9754 if (pos >= strLen) {
9755 return -1; /* All of str consumed: EOF condition */
9757 else if (descr->prefix[i] != 0)
9758 return 0; /* Not whole prefix consumed, no conversion possible */
9760 /* For all but following conversion, skip leading WS */
9761 if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9762 while (isspace(UCHAR(str[pos])))
9763 ++pos;
9764 /* Determine how much skipped/scanned so far */
9765 scanned = pos - anchor;
9767 /* %c is a special, simple case. no width */
9768 if (descr->type == 'n') {
9769 /* Return pseudo conversion means: how much scanned so far? */
9770 *valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9772 else if (pos >= strLen) {
9773 /* Cannot scan anything, as str is totally consumed */
9774 return -1;
9776 else if (descr->type == 'c') {
9777 int c;
9778 scanned += utf8_tounicode(&str[pos], &c);
9779 *valObjPtr = Jim_NewIntObj(interp, c);
9780 return scanned;
9782 else {
9783 /* Processing of conversions follows ... */
9784 if (descr->width > 0) {
9785 /* Do not try to scan as fas as possible but only the given width.
9786 * To ensure this, we copy the part that should be scanned. */
9787 size_t sLen = utf8_strlen(&str[pos], strLen - pos);
9788 size_t tLen = descr->width > sLen ? sLen : descr->width;
9790 tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);
9791 tok = tmpObj->bytes;
9793 else {
9794 /* As no width was given, simply refer to the original string */
9795 tok = &str[pos];
9797 switch (descr->type) {
9798 case 'd':
9799 case 'o':
9800 case 'x':
9801 case 'u':
9802 case 'i':{
9803 char *endp; /* Position where the number finished */
9804 jim_wide w;
9806 int base = descr->type == 'o' ? 8
9807 : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10;
9809 /* Try to scan a number with the given base */
9810 if (base == 0) {
9811 w = jim_strtoull(tok, &endp);
9813 else {
9814 w = strtoull(tok, &endp, base);
9817 if (endp != tok) {
9818 /* There was some number sucessfully scanned! */
9819 *valObjPtr = Jim_NewIntObj(interp, w);
9821 /* Adjust the number-of-chars scanned so far */
9822 scanned += endp - tok;
9824 else {
9825 /* Nothing was scanned. We have to determine if this
9826 * happened due to e.g. prefix mismatch or input str
9827 * exhausted */
9828 scanned = *tok ? 0 : -1;
9830 break;
9832 case 's':
9833 case '[':{
9834 *valObjPtr = JimScanAString(interp, descr->arg, tok);
9835 scanned += Jim_Length(*valObjPtr);
9836 break;
9838 case 'e':
9839 case 'f':
9840 case 'g':{
9841 char *endp;
9842 double value = strtod(tok, &endp);
9844 if (endp != tok) {
9845 /* There was some number sucessfully scanned! */
9846 *valObjPtr = Jim_NewDoubleObj(interp, value);
9847 /* Adjust the number-of-chars scanned so far */
9848 scanned += endp - tok;
9850 else {
9851 /* Nothing was scanned. We have to determine if this
9852 * happened due to e.g. prefix mismatch or input str
9853 * exhausted */
9854 scanned = *tok ? 0 : -1;
9856 break;
9859 /* If a substring was allocated (due to pre-defined width) do not
9860 * forget to free it */
9861 if (tmpObj) {
9862 Jim_FreeNewObj(interp, tmpObj);
9865 return scanned;
9868 /* Jim_ScanString is the workhorse of string scanning. It will scan a given
9869 * string and returns all converted (and not ignored) values in a list back
9870 * to the caller. If an error occured, a NULL pointer will be returned */
9872 Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags)
9874 size_t i, pos;
9875 int scanned = 1;
9876 const char *str = Jim_String(strObjPtr);
9877 int strLen = Jim_Utf8Length(interp, strObjPtr);
9878 Jim_Obj *resultList = 0;
9879 Jim_Obj **resultVec = 0;
9880 int resultc;
9881 Jim_Obj *emptyStr = 0;
9882 ScanFmtStringObj *fmtObj;
9884 /* This should never happen. The format object should already be of the correct type */
9885 JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format"));
9887 fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr;
9888 /* Check if format specification was valid */
9889 if (fmtObj->error != 0) {
9890 if (flags & JIM_ERRMSG)
9891 Jim_SetResultString(interp, fmtObj->error, -1);
9892 return 0;
9894 /* Allocate a new "shared" empty string for all unassigned conversions */
9895 emptyStr = Jim_NewEmptyStringObj(interp);
9896 Jim_IncrRefCount(emptyStr);
9897 /* Create a list and fill it with empty strings up to max specified XPG3 */
9898 resultList = Jim_NewListObj(interp, NULL, 0);
9899 if (fmtObj->maxPos > 0) {
9900 for (i = 0; i < fmtObj->maxPos; ++i)
9901 Jim_ListAppendElement(interp, resultList, emptyStr);
9902 JimListGetElements(interp, resultList, &resultc, &resultVec);
9904 /* Now handle every partial format description */
9905 for (i = 0, pos = 0; i < fmtObj->count; ++i) {
9906 ScanFmtPartDescr *descr = &(fmtObj->descr[i]);
9907 Jim_Obj *value = 0;
9909 /* Only last type may be "literal" w/o conversion - skip it! */
9910 if (descr->type == 0)
9911 continue;
9912 /* As long as any conversion could be done, we will proceed */
9913 if (scanned > 0)
9914 scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
9915 /* In case our first try results in EOF, we will leave */
9916 if (scanned == -1 && i == 0)
9917 goto eof;
9918 /* Advance next pos-to-be-scanned for the amount scanned already */
9919 pos += scanned;
9921 /* value == 0 means no conversion took place so take empty string */
9922 if (value == 0)
9923 value = Jim_NewEmptyStringObj(interp);
9924 /* If value is a non-assignable one, skip it */
9925 if (descr->pos == -1) {
9926 Jim_FreeNewObj(interp, value);
9928 else if (descr->pos == 0)
9929 /* Otherwise append it to the result list if no XPG3 was given */
9930 Jim_ListAppendElement(interp, resultList, value);
9931 else if (resultVec[descr->pos - 1] == emptyStr) {
9932 /* But due to given XPG3, put the value into the corr. slot */
9933 Jim_DecrRefCount(interp, resultVec[descr->pos - 1]);
9934 Jim_IncrRefCount(value);
9935 resultVec[descr->pos - 1] = value;
9937 else {
9938 /* Otherwise, the slot was already used - free obj and ERROR */
9939 Jim_FreeNewObj(interp, value);
9940 goto err;
9943 Jim_DecrRefCount(interp, emptyStr);
9944 return resultList;
9945 eof:
9946 Jim_DecrRefCount(interp, emptyStr);
9947 Jim_FreeNewObj(interp, resultList);
9948 return (Jim_Obj *)EOF;
9949 err:
9950 Jim_DecrRefCount(interp, emptyStr);
9951 Jim_FreeNewObj(interp, resultList);
9952 return 0;
9955 /* -----------------------------------------------------------------------------
9956 * Pseudo Random Number Generation
9957 * ---------------------------------------------------------------------------*/
9958 /* Initialize the sbox with the numbers from 0 to 255 */
9959 static void JimPrngInit(Jim_Interp *interp)
9961 #define PRNG_SEED_SIZE 256
9962 int i;
9963 unsigned int *seed;
9964 time_t t = time(NULL);
9966 interp->prngState = Jim_Alloc(sizeof(Jim_PrngState));
9968 seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed));
9969 for (i = 0; i < PRNG_SEED_SIZE; i++) {
9970 seed[i] = (rand() ^ t ^ clock());
9972 JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed));
9973 Jim_Free(seed);
9976 /* Generates N bytes of random data */
9977 static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len)
9979 Jim_PrngState *prng;
9980 unsigned char *destByte = (unsigned char *)dest;
9981 unsigned int si, sj, x;
9983 /* initialization, only needed the first time */
9984 if (interp->prngState == NULL)
9985 JimPrngInit(interp);
9986 prng = interp->prngState;
9987 /* generates 'len' bytes of pseudo-random numbers */
9988 for (x = 0; x < len; x++) {
9989 prng->i = (prng->i + 1) & 0xff;
9990 si = prng->sbox[prng->i];
9991 prng->j = (prng->j + si) & 0xff;
9992 sj = prng->sbox[prng->j];
9993 prng->sbox[prng->i] = sj;
9994 prng->sbox[prng->j] = si;
9995 *destByte++ = prng->sbox[(si + sj) & 0xff];
9999 /* Re-seed the generator with user-provided bytes */
10000 static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen)
10002 int i;
10003 Jim_PrngState *prng;
10005 /* initialization, only needed the first time */
10006 if (interp->prngState == NULL)
10007 JimPrngInit(interp);
10008 prng = interp->prngState;
10010 /* Set the sbox[i] with i */
10011 for (i = 0; i < 256; i++)
10012 prng->sbox[i] = i;
10013 /* Now use the seed to perform a random permutation of the sbox */
10014 for (i = 0; i < seedLen; i++) {
10015 unsigned char t;
10017 t = prng->sbox[i & 0xFF];
10018 prng->sbox[i & 0xFF] = prng->sbox[seed[i]];
10019 prng->sbox[seed[i]] = t;
10021 prng->i = prng->j = 0;
10023 /* discard at least the first 256 bytes of stream.
10024 * borrow the seed buffer for this
10026 for (i = 0; i < 256; i += seedLen) {
10027 JimRandomBytes(interp, seed, seedLen);
10031 /* [incr] */
10032 static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10034 jim_wide wideValue, increment = 1;
10035 Jim_Obj *intObjPtr;
10037 if (argc != 2 && argc != 3) {
10038 Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?");
10039 return JIM_ERR;
10041 if (argc == 3) {
10042 if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
10043 return JIM_ERR;
10045 intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
10046 if (!intObjPtr) {
10047 /* Set missing variable to 0 */
10048 wideValue = 0;
10050 else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) {
10051 return JIM_ERR;
10053 if (!intObjPtr || Jim_IsShared(intObjPtr)) {
10054 intObjPtr = Jim_NewIntObj(interp, wideValue + increment);
10055 if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) {
10056 Jim_FreeNewObj(interp, intObjPtr);
10057 return JIM_ERR;
10060 else {
10061 /* Can do it the quick way */
10062 Jim_InvalidateStringRep(intObjPtr);
10063 JimWideValue(intObjPtr) = wideValue + increment;
10065 /* The following step is required in order to invalidate the
10066 * string repr of "FOO" if the var name is on the form of "FOO(IDX)" */
10067 if (argv[1]->typePtr != &variableObjType) {
10068 /* Note that this can't fail since GetVariable already succeeded */
10069 Jim_SetVariable(interp, argv[1], intObjPtr);
10072 Jim_SetResult(interp, intObjPtr);
10073 return JIM_OK;
10077 /* -----------------------------------------------------------------------------
10078 * Eval
10079 * ---------------------------------------------------------------------------*/
10080 #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10081 #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10083 /* Handle calls to the [unknown] command */
10084 static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
10086 int retcode;
10088 /* If JimUnknown() is recursively called too many times...
10089 * done here
10091 if (interp->unknown_called > 50) {
10092 return JIM_ERR;
10095 /* The object interp->unknown just contains
10096 * the "unknown" string, it is used in order to
10097 * avoid to lookup the unknown command every time
10098 * but instead to cache the result. */
10100 /* If the [unknown] command does not exist ... */
10101 if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL)
10102 return JIM_ERR;
10104 interp->unknown_called++;
10105 /* XXX: Are we losing fileNameObj and linenr? */
10106 retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv);
10107 interp->unknown_called--;
10109 return retcode;
10112 static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10114 int retcode;
10115 Jim_Cmd *cmdPtr;
10117 #if 0
10118 printf("invoke");
10119 int j;
10120 for (j = 0; j < objc; j++) {
10121 printf(" '%s'", Jim_String(objv[j]));
10123 printf("\n");
10124 #endif
10126 if (interp->framePtr->tailcallCmd) {
10127 /* Special tailcall command was pre-resolved */
10128 cmdPtr = interp->framePtr->tailcallCmd;
10129 interp->framePtr->tailcallCmd = NULL;
10131 else {
10132 cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10133 if (cmdPtr == NULL) {
10134 return JimUnknown(interp, objc, objv);
10136 JimIncrCmdRefCount(cmdPtr);
10139 if (interp->evalDepth == interp->maxEvalDepth) {
10140 Jim_SetResultString(interp, "Infinite eval recursion", -1);
10141 retcode = JIM_ERR;
10142 goto out;
10144 interp->evalDepth++;
10146 /* Call it -- Make sure result is an empty object. */
10147 Jim_SetEmptyResult(interp);
10148 if (cmdPtr->isproc) {
10149 retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10151 else {
10152 interp->cmdPrivData = cmdPtr->u.native.privData;
10153 retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10155 interp->evalDepth--;
10157 out:
10158 JimDecrCmdRefCount(interp, cmdPtr);
10160 return retcode;
10163 /* Eval the object vector 'objv' composed of 'objc' elements.
10164 * Every element is used as single argument.
10165 * Jim_EvalObj() will call this function every time its object
10166 * argument is of "list" type, with no string representation.
10168 * This is possible because the string representation of a
10169 * list object generated by the UpdateStringOfList is made
10170 * in a way that ensures that every list element is a different
10171 * command argument. */
10172 int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv)
10174 int i, retcode;
10176 /* Incr refcount of arguments. */
10177 for (i = 0; i < objc; i++)
10178 Jim_IncrRefCount(objv[i]);
10180 retcode = JimInvokeCommand(interp, objc, objv);
10182 /* Decr refcount of arguments and return the retcode */
10183 for (i = 0; i < objc; i++)
10184 Jim_DecrRefCount(interp, objv[i]);
10186 return retcode;
10190 * Invokes 'prefix' as a command with the objv array as arguments.
10192 int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv)
10194 int ret;
10195 Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv));
10197 nargv[0] = prefix;
10198 memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc);
10199 ret = Jim_EvalObjVector(interp, objc + 1, nargv);
10200 Jim_Free(nargv);
10201 return ret;
10204 static void JimAddErrorToStack(Jim_Interp *interp, int retcode, ScriptObj *script)
10206 int rc = retcode;
10208 if (rc == JIM_ERR && !interp->errorFlag) {
10209 /* This is the first error, so save the file/line information and reset the stack */
10210 interp->errorFlag = 1;
10211 Jim_IncrRefCount(script->fileNameObj);
10212 Jim_DecrRefCount(interp, interp->errorFileNameObj);
10213 interp->errorFileNameObj = script->fileNameObj;
10214 interp->errorLine = script->linenr;
10216 JimResetStackTrace(interp);
10217 /* Always add a level where the error first occurs */
10218 interp->addStackTrace++;
10221 /* Now if this is an "interesting" level, add it to the stack trace */
10222 if (rc == JIM_ERR && interp->addStackTrace > 0) {
10223 /* Add the stack info for the current level */
10225 JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr);
10227 /* Note: if we didn't have a filename for this level,
10228 * don't clear the addStackTrace flag
10229 * so we can pick it up at the next level
10231 if (Jim_Length(script->fileNameObj)) {
10232 interp->addStackTrace = 0;
10235 Jim_DecrRefCount(interp, interp->errorProc);
10236 interp->errorProc = interp->emptyObj;
10237 Jim_IncrRefCount(interp->errorProc);
10239 else if (rc == JIM_RETURN && interp->returnCode == JIM_ERR) {
10240 /* Propagate the addStackTrace value through 'return -code error' */
10242 else {
10243 interp->addStackTrace = 0;
10247 static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr)
10249 Jim_Obj *objPtr;
10251 switch (token->type) {
10252 case JIM_TT_STR:
10253 case JIM_TT_ESC:
10254 objPtr = token->objPtr;
10255 break;
10256 case JIM_TT_VAR:
10257 objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG);
10258 break;
10259 case JIM_TT_DICTSUGAR:
10260 objPtr = JimExpandDictSugar(interp, token->objPtr);
10261 break;
10262 case JIM_TT_EXPRSUGAR:
10263 objPtr = JimExpandExprSugar(interp, token->objPtr);
10264 break;
10265 case JIM_TT_CMD:
10266 switch (Jim_EvalObj(interp, token->objPtr)) {
10267 case JIM_OK:
10268 case JIM_RETURN:
10269 objPtr = interp->result;
10270 break;
10271 case JIM_BREAK:
10272 /* Stop substituting */
10273 return JIM_BREAK;
10274 case JIM_CONTINUE:
10275 /* just skip this one */
10276 return JIM_CONTINUE;
10277 default:
10278 return JIM_ERR;
10280 break;
10281 default:
10282 JimPanic((1,
10283 "default token type (%d) reached " "in Jim_SubstObj().", token->type));
10284 objPtr = NULL;
10285 break;
10287 if (objPtr) {
10288 *objPtrPtr = objPtr;
10289 return JIM_OK;
10291 return JIM_ERR;
10294 /* Interpolate the given tokens into a unique Jim_Obj returned by reference
10295 * via *objPtrPtr. This function is only called by Jim_EvalObj() and Jim_SubstObj()
10296 * The returned object has refcount = 0.
10298 static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags)
10300 int totlen = 0, i;
10301 Jim_Obj **intv;
10302 Jim_Obj *sintv[JIM_EVAL_SINTV_LEN];
10303 Jim_Obj *objPtr;
10304 char *s;
10306 if (tokens <= JIM_EVAL_SINTV_LEN)
10307 intv = sintv;
10308 else
10309 intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens);
10311 /* Compute every token forming the argument
10312 * in the intv objects vector. */
10313 for (i = 0; i < tokens; i++) {
10314 switch (JimSubstOneToken(interp, &token[i], &intv[i])) {
10315 case JIM_OK:
10316 case JIM_RETURN:
10317 break;
10318 case JIM_BREAK:
10319 if (flags & JIM_SUBST_FLAG) {
10320 /* Stop here */
10321 tokens = i;
10322 continue;
10324 /* XXX: Should probably set an error about break outside loop */
10325 /* fall through to error */
10326 case JIM_CONTINUE:
10327 if (flags & JIM_SUBST_FLAG) {
10328 intv[i] = NULL;
10329 continue;
10331 /* XXX: Ditto continue outside loop */
10332 /* fall through to error */
10333 default:
10334 while (i--) {
10335 Jim_DecrRefCount(interp, intv[i]);
10337 if (intv != sintv) {
10338 Jim_Free(intv);
10340 return NULL;
10342 Jim_IncrRefCount(intv[i]);
10343 Jim_String(intv[i]);
10344 totlen += intv[i]->length;
10347 /* Fast path return for a single token */
10348 if (tokens == 1 && intv[0] && intv == sintv) {
10349 Jim_DecrRefCount(interp, intv[0]);
10350 return intv[0];
10353 /* Concatenate every token in an unique
10354 * object. */
10355 objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0);
10357 if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC
10358 && token[2].type == JIM_TT_VAR) {
10359 /* May be able to do fast interpolated object -> dictSubst */
10360 objPtr->typePtr = &interpolatedObjType;
10361 objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr;
10362 objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2];
10363 Jim_IncrRefCount(intv[2]);
10366 s = objPtr->bytes = Jim_Alloc(totlen + 1);
10367 objPtr->length = totlen;
10368 for (i = 0; i < tokens; i++) {
10369 if (intv[i]) {
10370 memcpy(s, intv[i]->bytes, intv[i]->length);
10371 s += intv[i]->length;
10372 Jim_DecrRefCount(interp, intv[i]);
10375 objPtr->bytes[totlen] = '\0';
10376 /* Free the intv vector if not static. */
10377 if (intv != sintv) {
10378 Jim_Free(intv);
10381 return objPtr;
10385 /* listPtr *must* be a list.
10386 * The contents of the list is evaluated with the first element as the command and
10387 * the remaining elements as the arguments.
10389 static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10391 int retcode = JIM_OK;
10393 if (listPtr->internalRep.listValue.len) {
10394 Jim_IncrRefCount(listPtr);
10395 retcode = JimInvokeCommand(interp,
10396 listPtr->internalRep.listValue.len,
10397 listPtr->internalRep.listValue.ele);
10398 Jim_DecrRefCount(interp, listPtr);
10400 return retcode;
10403 int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr)
10405 SetListFromAny(interp, listPtr);
10406 return JimEvalObjList(interp, listPtr);
10409 int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
10411 int i;
10412 ScriptObj *script;
10413 ScriptToken *token;
10414 int retcode = JIM_OK;
10415 Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL;
10416 Jim_Obj *prevScriptObj;
10418 /* If the object is of type "list", with no string rep we can call
10419 * a specialized version of Jim_EvalObj() */
10420 if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) {
10421 return JimEvalObjList(interp, scriptObjPtr);
10424 Jim_IncrRefCount(scriptObjPtr); /* Make sure it's shared. */
10425 script = Jim_GetScript(interp, scriptObjPtr);
10427 /* Reset the interpreter result. This is useful to
10428 * return the empty result in the case of empty program. */
10429 Jim_SetEmptyResult(interp);
10431 token = script->token;
10433 #ifdef JIM_OPTIMIZATION
10434 /* Check for one of the following common scripts used by for, while
10436 * {}
10437 * incr a
10439 if (script->len == 0) {
10440 Jim_DecrRefCount(interp, scriptObjPtr);
10441 return JIM_OK;
10443 if (script->len == 3
10444 && token[1].objPtr->typePtr == &commandObjType
10445 && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0
10446 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand
10447 && token[2].objPtr->typePtr == &variableObjType) {
10449 Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE);
10451 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
10452 JimWideValue(objPtr)++;
10453 Jim_InvalidateStringRep(objPtr);
10454 Jim_DecrRefCount(interp, scriptObjPtr);
10455 Jim_SetResult(interp, objPtr);
10456 return JIM_OK;
10459 #endif
10461 /* Now we have to make sure the internal repr will not be
10462 * freed on shimmering.
10464 * Think for example to this:
10466 * set x {llength $x; ... some more code ...}; eval $x
10468 * In order to preserve the internal rep, we increment the
10469 * inUse field of the script internal rep structure. */
10470 script->inUse++;
10472 /* Stash the current script */
10473 prevScriptObj = interp->currentScriptObj;
10474 interp->currentScriptObj = scriptObjPtr;
10476 interp->errorFlag = 0;
10477 argv = sargv;
10479 /* Execute every command sequentially until the end of the script
10480 * or an error occurs.
10482 for (i = 0; i < script->len && retcode == JIM_OK; ) {
10483 int argc;
10484 int j;
10486 /* First token of the line is always JIM_TT_LINE */
10487 argc = token[i].objPtr->internalRep.scriptLineValue.argc;
10488 script->linenr = token[i].objPtr->internalRep.scriptLineValue.line;
10490 /* Allocate the arguments vector if required */
10491 if (argc > JIM_EVAL_SARGV_LEN)
10492 argv = Jim_Alloc(sizeof(Jim_Obj *) * argc);
10494 /* Skip the JIM_TT_LINE token */
10495 i++;
10497 /* Populate the arguments objects.
10498 * If an error occurs, retcode will be set and
10499 * 'j' will be set to the number of args expanded
10501 for (j = 0; j < argc; j++) {
10502 long wordtokens = 1;
10503 int expand = 0;
10504 Jim_Obj *wordObjPtr = NULL;
10506 if (token[i].type == JIM_TT_WORD) {
10507 wordtokens = JimWideValue(token[i++].objPtr);
10508 if (wordtokens < 0) {
10509 expand = 1;
10510 wordtokens = -wordtokens;
10514 if (wordtokens == 1) {
10515 /* Fast path if the token does not
10516 * need interpolation */
10518 switch (token[i].type) {
10519 case JIM_TT_ESC:
10520 case JIM_TT_STR:
10521 wordObjPtr = token[i].objPtr;
10522 break;
10523 case JIM_TT_VAR:
10524 wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG);
10525 break;
10526 case JIM_TT_EXPRSUGAR:
10527 wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr);
10528 break;
10529 case JIM_TT_DICTSUGAR:
10530 wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr);
10531 break;
10532 case JIM_TT_CMD:
10533 retcode = Jim_EvalObj(interp, token[i].objPtr);
10534 if (retcode == JIM_OK) {
10535 wordObjPtr = Jim_GetResult(interp);
10537 break;
10538 default:
10539 JimPanic((1, "default token type reached " "in Jim_EvalObj()."));
10542 else {
10543 /* For interpolation we call a helper
10544 * function to do the work for us. */
10545 wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE);
10548 if (!wordObjPtr) {
10549 if (retcode == JIM_OK) {
10550 retcode = JIM_ERR;
10552 break;
10555 Jim_IncrRefCount(wordObjPtr);
10556 i += wordtokens;
10558 if (!expand) {
10559 argv[j] = wordObjPtr;
10561 else {
10562 /* Need to expand wordObjPtr into multiple args from argv[j] ... */
10563 int len = Jim_ListLength(interp, wordObjPtr);
10564 int newargc = argc + len - 1;
10565 int k;
10567 if (len > 1) {
10568 if (argv == sargv) {
10569 if (newargc > JIM_EVAL_SARGV_LEN) {
10570 argv = Jim_Alloc(sizeof(*argv) * newargc);
10571 memcpy(argv, sargv, sizeof(*argv) * j);
10574 else {
10575 /* Need to realloc to make room for (len - 1) more entries */
10576 argv = Jim_Realloc(argv, sizeof(*argv) * newargc);
10580 /* Now copy in the expanded version */
10581 for (k = 0; k < len; k++) {
10582 argv[j++] = wordObjPtr->internalRep.listValue.ele[k];
10583 Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]);
10586 /* The original object reference is no longer needed,
10587 * after the expansion it is no longer present on
10588 * the argument vector, but the single elements are
10589 * in its place. */
10590 Jim_DecrRefCount(interp, wordObjPtr);
10592 /* And update the indexes */
10593 j--;
10594 argc += len - 1;
10598 if (retcode == JIM_OK && argc) {
10599 /* Invoke the command */
10600 retcode = JimInvokeCommand(interp, argc, argv);
10601 /* Check for a signal after each command */
10602 if (Jim_CheckSignal(interp)) {
10603 retcode = JIM_SIGNAL;
10607 /* Finished with the command, so decrement ref counts of each argument */
10608 while (j-- > 0) {
10609 Jim_DecrRefCount(interp, argv[j]);
10612 if (argv != sargv) {
10613 Jim_Free(argv);
10614 argv = sargv;
10618 /* Possibly add to the error stack trace */
10619 JimAddErrorToStack(interp, retcode, script);
10621 /* Restore the current script */
10622 interp->currentScriptObj = prevScriptObj;
10624 /* Note that we don't have to decrement inUse, because the
10625 * following code transfers our use of the reference again to
10626 * the script object. */
10627 Jim_FreeIntRep(interp, scriptObjPtr);
10628 scriptObjPtr->typePtr = &scriptObjType;
10629 Jim_SetIntRepPtr(scriptObjPtr, script);
10630 Jim_DecrRefCount(interp, scriptObjPtr);
10632 return retcode;
10635 static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj)
10637 int retcode;
10638 /* If argObjPtr begins with '&', do an automatic upvar */
10639 const char *varname = Jim_String(argNameObj);
10640 if (*varname == '&') {
10641 /* First check that the target variable exists */
10642 Jim_Obj *objPtr;
10643 Jim_CallFrame *savedCallFrame = interp->framePtr;
10645 interp->framePtr = interp->framePtr->parent;
10646 objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG);
10647 interp->framePtr = savedCallFrame;
10648 if (!objPtr) {
10649 return JIM_ERR;
10652 /* It exists, so perform the binding. */
10653 objPtr = Jim_NewStringObj(interp, varname + 1, -1);
10654 Jim_IncrRefCount(objPtr);
10655 retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent);
10656 Jim_DecrRefCount(interp, objPtr);
10658 else {
10659 retcode = Jim_SetVariable(interp, argNameObj, argValObj);
10661 return retcode;
10665 * Sets the interp result to be an error message indicating the required proc args.
10667 static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
10669 /* Create a nice error message, consistent with Tcl 8.5 */
10670 Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
10671 int i;
10673 for (i = 0; i < cmd->u.proc.argListLen; i++) {
10674 Jim_AppendString(interp, argmsg, " ", 1);
10676 if (i == cmd->u.proc.argsPos) {
10677 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10678 /* Renamed args */
10679 Jim_AppendString(interp, argmsg, "?", 1);
10680 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
10681 Jim_AppendString(interp, argmsg, " ...?", -1);
10683 else {
10684 /* We have plain args */
10685 Jim_AppendString(interp, argmsg, "?arg...?", -1);
10688 else {
10689 if (cmd->u.proc.arglist[i].defaultObjPtr) {
10690 Jim_AppendString(interp, argmsg, "?", 1);
10691 Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
10692 Jim_AppendString(interp, argmsg, "?", 1);
10694 else {
10695 const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr);
10696 if (*arg == '&') {
10697 arg++;
10699 Jim_AppendString(interp, argmsg, arg, -1);
10703 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
10704 Jim_FreeNewObj(interp, argmsg);
10707 #ifdef jim_ext_namespace
10709 * [namespace eval]
10711 int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj)
10713 Jim_CallFrame *callFramePtr;
10714 int retcode;
10716 /* Create a new callframe */
10717 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj);
10718 callFramePtr->argv = &interp->emptyObj;
10719 callFramePtr->argc = 0;
10720 callFramePtr->procArgsObjPtr = NULL;
10721 callFramePtr->procBodyObjPtr = scriptObj;
10722 callFramePtr->staticVars = NULL;
10723 callFramePtr->fileNameObj = interp->emptyObj;
10724 callFramePtr->line = 0;
10725 Jim_IncrRefCount(scriptObj);
10726 interp->framePtr = callFramePtr;
10728 /* Check if there are too nested calls */
10729 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10730 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10731 retcode = JIM_ERR;
10733 else {
10734 /* Eval the body */
10735 retcode = Jim_EvalObj(interp, scriptObj);
10738 /* Destroy the callframe */
10739 interp->framePtr = interp->framePtr->parent;
10740 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10742 return retcode;
10744 #endif
10746 /* Call a procedure implemented in Tcl.
10747 * It's possible to speed-up a lot this function, currently
10748 * the callframes are not cached, but allocated and
10749 * destroied every time. What is expecially costly is
10750 * to create/destroy the local vars hash table every time.
10752 * This can be fixed just implementing callframes caching
10753 * in JimCreateCallFrame() and JimFreeCallFrame(). */
10754 static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv)
10756 Jim_CallFrame *callFramePtr;
10757 int i, d, retcode, optargs;
10758 ScriptObj *script;
10760 /* Check arity */
10761 if (argc - 1 < cmd->u.proc.reqArity ||
10762 (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
10763 JimSetProcWrongArgs(interp, argv[0], cmd);
10764 return JIM_ERR;
10767 if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) {
10768 /* Optimise for procedure with no body - useful for optional debugging */
10769 return JIM_OK;
10772 /* Check if there are too nested calls */
10773 if (interp->framePtr->level == interp->maxCallFrameDepth) {
10774 Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
10775 return JIM_ERR;
10778 /* Create a new callframe */
10779 callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj);
10780 callFramePtr->argv = argv;
10781 callFramePtr->argc = argc;
10782 callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr;
10783 callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr;
10784 callFramePtr->staticVars = cmd->u.proc.staticVars;
10786 /* Remember where we were called from. */
10787 script = Jim_GetScript(interp, interp->currentScriptObj);
10788 callFramePtr->fileNameObj = script->fileNameObj;
10789 callFramePtr->line = script->linenr;
10791 Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
10792 Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
10793 interp->framePtr = callFramePtr;
10795 /* How many optional args are available */
10796 optargs = (argc - 1 - cmd->u.proc.reqArity);
10798 /* Step 'i' along the actual args, and step 'd' along the formal args */
10799 i = 1;
10800 for (d = 0; d < cmd->u.proc.argListLen; d++) {
10801 Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
10802 if (d == cmd->u.proc.argsPos) {
10803 /* assign $args */
10804 Jim_Obj *listObjPtr;
10805 int argsLen = 0;
10806 if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
10807 argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
10809 listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
10811 /* It is possible to rename args. */
10812 if (cmd->u.proc.arglist[d].defaultObjPtr) {
10813 nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
10815 retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
10816 if (retcode != JIM_OK) {
10817 goto badargset;
10820 i += argsLen;
10821 continue;
10824 /* Optional or required? */
10825 if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
10826 retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
10828 else {
10829 /* Ran out, so use the default */
10830 retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
10832 if (retcode != JIM_OK) {
10833 goto badargset;
10837 /* Eval the body */
10838 retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
10840 badargset:
10842 /* Free the callframe */
10843 interp->framePtr = interp->framePtr->parent;
10844 JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10846 if (interp->framePtr->tailcallObj) {
10847 /* If a tailcall is already being executed, merge this tailcall with that one */
10848 if (interp->framePtr->tailcall++ == 0) {
10849 /* No current tailcall in this frame, so invoke the tailcall command */
10850 do {
10851 Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10853 interp->framePtr->tailcallObj = NULL;
10855 if (retcode == JIM_EVAL) {
10856 retcode = Jim_EvalObjList(interp, tailcallObj);
10857 if (retcode == JIM_RETURN) {
10858 /* If the result of the tailcall is 'return', push
10859 * it up to the caller
10861 interp->returnLevel++;
10864 Jim_DecrRefCount(interp, tailcallObj);
10865 } while (interp->framePtr->tailcallObj);
10867 /* If the tailcall chain finished early, may need to manually discard the command */
10868 if (interp->framePtr->tailcallCmd) {
10869 JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10870 interp->framePtr->tailcallCmd = NULL;
10873 interp->framePtr->tailcall--;
10876 /* Handle the JIM_RETURN return code */
10877 if (retcode == JIM_RETURN) {
10878 if (--interp->returnLevel <= 0) {
10879 retcode = interp->returnCode;
10880 interp->returnCode = JIM_OK;
10881 interp->returnLevel = 0;
10884 else if (retcode == JIM_ERR) {
10885 interp->addStackTrace++;
10886 Jim_DecrRefCount(interp, interp->errorProc);
10887 interp->errorProc = argv[0];
10888 Jim_IncrRefCount(interp->errorProc);
10891 return retcode;
10894 int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script)
10896 int retval;
10897 Jim_Obj *scriptObjPtr;
10899 scriptObjPtr = Jim_NewStringObj(interp, script, -1);
10900 Jim_IncrRefCount(scriptObjPtr);
10902 if (filename) {
10903 Jim_Obj *prevScriptObj;
10905 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno);
10907 prevScriptObj = interp->currentScriptObj;
10908 interp->currentScriptObj = scriptObjPtr;
10910 retval = Jim_EvalObj(interp, scriptObjPtr);
10912 interp->currentScriptObj = prevScriptObj;
10914 else {
10915 retval = Jim_EvalObj(interp, scriptObjPtr);
10917 Jim_DecrRefCount(interp, scriptObjPtr);
10918 return retval;
10921 int Jim_Eval(Jim_Interp *interp, const char *script)
10923 return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1));
10926 /* Execute script in the scope of the global level */
10927 int Jim_EvalGlobal(Jim_Interp *interp, const char *script)
10929 int retval;
10930 Jim_CallFrame *savedFramePtr = interp->framePtr;
10932 interp->framePtr = interp->topFramePtr;
10933 retval = Jim_Eval(interp, script);
10934 interp->framePtr = savedFramePtr;
10936 return retval;
10939 int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename)
10941 int retval;
10942 Jim_CallFrame *savedFramePtr = interp->framePtr;
10944 interp->framePtr = interp->topFramePtr;
10945 retval = Jim_EvalFile(interp, filename);
10946 interp->framePtr = savedFramePtr;
10948 return retval;
10951 #include <sys/stat.h>
10953 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
10955 FILE *fp;
10956 char *buf;
10957 Jim_Obj *scriptObjPtr;
10958 Jim_Obj *prevScriptObj;
10959 struct stat sb;
10960 int retcode;
10961 int readlen;
10962 struct JimParseResult result;
10964 if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) {
10965 Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno));
10966 return JIM_ERR;
10968 if (sb.st_size == 0) {
10969 fclose(fp);
10970 return JIM_OK;
10973 buf = Jim_Alloc(sb.st_size + 1);
10974 readlen = fread(buf, 1, sb.st_size, fp);
10975 if (ferror(fp)) {
10976 fclose(fp);
10977 Jim_Free(buf);
10978 Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno));
10979 return JIM_ERR;
10981 fclose(fp);
10982 buf[readlen] = 0;
10984 scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen);
10985 JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
10986 Jim_IncrRefCount(scriptObjPtr);
10988 /* Now check the script for unmatched braces, etc. */
10989 if (SetScriptFromAny(interp, scriptObjPtr, &result) == JIM_ERR) {
10990 const char *msg;
10991 char linebuf[20];
10993 switch (result.missing) {
10994 case '[':
10995 msg = "unmatched \"[\"";
10996 break;
10997 case '{':
10998 msg = "missing close-brace";
10999 break;
11000 case '"':
11001 default:
11002 msg = "missing quote";
11003 break;
11006 snprintf(linebuf, sizeof(linebuf), "%d", result.line);
11008 Jim_SetResultFormatted(interp, "%s in \"%s\" at line %s",
11009 msg, filename, linebuf);
11010 Jim_DecrRefCount(interp, scriptObjPtr);
11011 return JIM_ERR;
11014 prevScriptObj = interp->currentScriptObj;
11015 interp->currentScriptObj = scriptObjPtr;
11017 retcode = Jim_EvalObj(interp, scriptObjPtr);
11019 /* Handle the JIM_RETURN return code */
11020 if (retcode == JIM_RETURN) {
11021 if (--interp->returnLevel <= 0) {
11022 retcode = interp->returnCode;
11023 interp->returnCode = JIM_OK;
11024 interp->returnLevel = 0;
11027 if (retcode == JIM_ERR) {
11028 /* EvalFile changes context, so add a stack frame here */
11029 interp->addStackTrace++;
11032 interp->currentScriptObj = prevScriptObj;
11034 Jim_DecrRefCount(interp, scriptObjPtr);
11036 return retcode;
11039 /* -----------------------------------------------------------------------------
11040 * Subst
11041 * ---------------------------------------------------------------------------*/
11042 static void JimParseSubst(struct JimParserCtx *pc, int flags)
11044 pc->tstart = pc->p;
11045 pc->tline = pc->linenr;
11047 if (pc->len == 0) {
11048 pc->tend = pc->p;
11049 pc->tt = JIM_TT_EOL;
11050 pc->eof = 1;
11051 return;
11053 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11054 JimParseCmd(pc);
11055 return;
11057 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11058 if (JimParseVar(pc) == JIM_OK) {
11059 return;
11061 /* Not a var, so treat as a string */
11062 pc->tstart = pc->p;
11063 flags |= JIM_SUBST_NOVAR;
11065 while (pc->len) {
11066 if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) {
11067 break;
11069 if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) {
11070 break;
11072 if (*pc->p == '\\' && pc->len > 1) {
11073 pc->p++;
11074 pc->len--;
11076 pc->p++;
11077 pc->len--;
11079 pc->tend = pc->p - 1;
11080 pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC;
11083 /* The subst object type reuses most of the data structures and functions
11084 * of the script object. Script's data structures are a bit more complex
11085 * for what is needed for [subst]itution tasks, but the reuse helps to
11086 * deal with a single data structure at the cost of some more memory
11087 * usage for substitutions. */
11089 /* This method takes the string representation of an object
11090 * as a Tcl string where to perform [subst]itution, and generates
11091 * the pre-parsed internal representation. */
11092 static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags)
11094 int scriptTextLen;
11095 const char *scriptText = Jim_GetString(objPtr, &scriptTextLen);
11096 struct JimParserCtx parser;
11097 struct ScriptObj *script = Jim_Alloc(sizeof(*script));
11098 ParseTokenList tokenlist;
11100 /* Initially parse the subst into tokens (in tokenlist) */
11101 ScriptTokenListInit(&tokenlist);
11103 JimParserInit(&parser, scriptText, scriptTextLen, 1);
11104 while (1) {
11105 JimParseSubst(&parser, flags);
11106 if (parser.eof) {
11107 /* Note that subst doesn't need the EOL token */
11108 break;
11110 ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt,
11111 parser.tline);
11114 /* Create the "real" subst/script tokens from the initial token list */
11115 script->inUse = 1;
11116 script->substFlags = flags;
11117 script->fileNameObj = interp->emptyObj;
11118 Jim_IncrRefCount(script->fileNameObj);
11119 SubstObjAddTokens(interp, script, &tokenlist);
11121 /* No longer need the token list */
11122 ScriptTokenListFree(&tokenlist);
11124 #ifdef DEBUG_SHOW_SUBST
11126 int i;
11128 printf("==== Subst ====\n");
11129 for (i = 0; i < script->len; i++) {
11130 printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type),
11131 Jim_String(script->token[i].objPtr));
11134 #endif
11136 /* Free the old internal rep and set the new one. */
11137 Jim_FreeIntRep(interp, objPtr);
11138 Jim_SetIntRepPtr(objPtr, script);
11139 objPtr->typePtr = &scriptObjType;
11140 return JIM_OK;
11143 static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags)
11145 if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags)
11146 SetSubstFromAny(interp, objPtr, flags);
11147 return (ScriptObj *) Jim_GetIntRepPtr(objPtr);
11150 /* Performs commands,variables,blackslashes substitution,
11151 * storing the result object (with refcount 0) into
11152 * resObjPtrPtr. */
11153 int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags)
11155 ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags);
11157 Jim_IncrRefCount(substObjPtr); /* Make sure it's shared. */
11158 /* In order to preserve the internal rep, we increment the
11159 * inUse field of the script internal rep structure. */
11160 script->inUse++;
11162 *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags);
11164 script->inUse--;
11165 Jim_DecrRefCount(interp, substObjPtr);
11166 if (*resObjPtrPtr == NULL) {
11167 return JIM_ERR;
11169 return JIM_OK;
11172 /* -----------------------------------------------------------------------------
11173 * Core commands utility functions
11174 * ---------------------------------------------------------------------------*/
11175 void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg)
11177 Jim_Obj *objPtr;
11178 Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
11180 if (*msg) {
11181 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1));
11183 Jim_IncrRefCount(listObjPtr);
11184 objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1);
11185 Jim_DecrRefCount(interp, listObjPtr);
11187 Jim_IncrRefCount(objPtr);
11188 Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr);
11189 Jim_DecrRefCount(interp, objPtr);
11193 * May add the key and/or value to the list.
11195 typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr,
11196 Jim_HashEntry *he, int type);
11198 #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11201 * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11202 * invoke the callback to add entries to a list.
11203 * Returns the list.
11205 static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
11206 JimHashtableIteratorCallbackType *callback, int type)
11208 Jim_HashEntry *he;
11209 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
11211 /* Check for the non-pattern case. We can do this much more efficiently. */
11212 if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11213 he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
11214 if (he) {
11215 callback(interp, listObjPtr, he, type);
11218 else {
11219 Jim_HashTableIterator htiter;
11220 JimInitHashTableIterator(ht, &htiter);
11221 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11222 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11223 callback(interp, listObjPtr, he, type);
11227 return listObjPtr;
11230 /* Keep these in order */
11231 #define JIM_CMDLIST_COMMANDS 0
11232 #define JIM_CMDLIST_PROCS 1
11233 #define JIM_CMDLIST_CHANNELS 2
11236 * Adds matching command names (procs, channels) to the list.
11238 static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11239 Jim_HashEntry *he, int type)
11241 Jim_Cmd *cmdPtr = (Jim_Cmd *)he->u.val;
11242 Jim_Obj *objPtr;
11244 if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11245 /* not a proc */
11246 return;
11249 objPtr = Jim_NewStringObj(interp, he->key, -1);
11250 Jim_IncrRefCount(objPtr);
11252 if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) {
11253 Jim_ListAppendElement(interp, listObjPtr, objPtr);
11255 Jim_DecrRefCount(interp, objPtr);
11258 /* type is JIM_CMDLIST_xxx */
11259 static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type)
11261 return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);
11264 /* Keep these in order */
11265 #define JIM_VARLIST_GLOBALS 0
11266 #define JIM_VARLIST_LOCALS 1
11267 #define JIM_VARLIST_VARS 2
11269 #define JIM_VARLIST_VALUES 0x1000
11272 * Adds matching variable names to the list.
11274 static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
11275 Jim_HashEntry *he, int type)
11277 Jim_Var *varPtr = (Jim_Var *)he->u.val;
11279 if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) {
11280 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11281 if (type & JIM_VARLIST_VALUES) {
11282 Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
11287 /* mode is JIM_VARLIST_xxx */
11288 static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode)
11290 if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11291 /* For [info locals], if we are at top level an emtpy list
11292 * is returned. I don't agree, but we aim at compatibility (SS) */
11293 return interp->emptyObj;
11295 else {
11296 Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11297 return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
11301 static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr,
11302 Jim_Obj **objPtrPtr, int info_level_cmd)
11304 Jim_CallFrame *targetCallFrame;
11306 targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr);
11307 if (targetCallFrame == NULL) {
11308 return JIM_ERR;
11310 /* No proc call at toplevel callframe */
11311 if (targetCallFrame == interp->topFramePtr) {
11312 Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr);
11313 return JIM_ERR;
11315 if (info_level_cmd) {
11316 *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
11318 else {
11319 Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
11321 Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]);
11322 Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj);
11323 Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line));
11324 *objPtrPtr = listObj;
11326 return JIM_OK;
11329 /* -----------------------------------------------------------------------------
11330 * Core commands
11331 * ---------------------------------------------------------------------------*/
11333 /* fake [puts] -- not the real puts, just for debugging. */
11334 static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11336 if (argc != 2 && argc != 3) {
11337 Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string");
11338 return JIM_ERR;
11340 if (argc == 3) {
11341 if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
11342 Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1);
11343 return JIM_ERR;
11345 else {
11346 fputs(Jim_String(argv[2]), stdout);
11349 else {
11350 puts(Jim_String(argv[1]));
11352 return JIM_OK;
11355 /* Helper for [+] and [*] */
11356 static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11358 jim_wide wideValue, res;
11359 double doubleValue, doubleRes;
11360 int i;
11362 res = (op == JIM_EXPROP_ADD) ? 0 : 1;
11364 for (i = 1; i < argc; i++) {
11365 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK)
11366 goto trydouble;
11367 if (op == JIM_EXPROP_ADD)
11368 res += wideValue;
11369 else
11370 res *= wideValue;
11372 Jim_SetResultInt(interp, res);
11373 return JIM_OK;
11374 trydouble:
11375 doubleRes = (double)res;
11376 for (; i < argc; i++) {
11377 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11378 return JIM_ERR;
11379 if (op == JIM_EXPROP_ADD)
11380 doubleRes += doubleValue;
11381 else
11382 doubleRes *= doubleValue;
11384 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11385 return JIM_OK;
11388 /* Helper for [-] and [/] */
11389 static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op)
11391 jim_wide wideValue, res = 0;
11392 double doubleValue, doubleRes = 0;
11393 int i = 2;
11395 if (argc < 2) {
11396 Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?");
11397 return JIM_ERR;
11399 else if (argc == 2) {
11400 /* The arity = 2 case is different. For [- x] returns -x,
11401 * while [/ x] returns 1/x. */
11402 if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) {
11403 if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) {
11404 return JIM_ERR;
11406 else {
11407 if (op == JIM_EXPROP_SUB)
11408 doubleRes = -doubleValue;
11409 else
11410 doubleRes = 1.0 / doubleValue;
11411 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11412 return JIM_OK;
11415 if (op == JIM_EXPROP_SUB) {
11416 res = -wideValue;
11417 Jim_SetResultInt(interp, res);
11419 else {
11420 doubleRes = 1.0 / wideValue;
11421 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11423 return JIM_OK;
11425 else {
11426 if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) {
11427 if (Jim_GetDouble(interp, argv[1], &doubleRes)
11428 != JIM_OK) {
11429 return JIM_ERR;
11431 else {
11432 goto trydouble;
11436 for (i = 2; i < argc; i++) {
11437 if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) {
11438 doubleRes = (double)res;
11439 goto trydouble;
11441 if (op == JIM_EXPROP_SUB)
11442 res -= wideValue;
11443 else
11444 res /= wideValue;
11446 Jim_SetResultInt(interp, res);
11447 return JIM_OK;
11448 trydouble:
11449 for (; i < argc; i++) {
11450 if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK)
11451 return JIM_ERR;
11452 if (op == JIM_EXPROP_SUB)
11453 doubleRes -= doubleValue;
11454 else
11455 doubleRes /= doubleValue;
11457 Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes));
11458 return JIM_OK;
11462 /* [+] */
11463 static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11465 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD);
11468 /* [*] */
11469 static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11471 return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL);
11474 /* [-] */
11475 static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11477 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB);
11480 /* [/] */
11481 static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11483 return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV);
11486 /* [set] */
11487 static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11489 if (argc != 2 && argc != 3) {
11490 Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?");
11491 return JIM_ERR;
11493 if (argc == 2) {
11494 Jim_Obj *objPtr;
11496 objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11497 if (!objPtr)
11498 return JIM_ERR;
11499 Jim_SetResult(interp, objPtr);
11500 return JIM_OK;
11502 /* argc == 3 case. */
11503 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
11504 return JIM_ERR;
11505 Jim_SetResult(interp, argv[2]);
11506 return JIM_OK;
11509 /* [unset]
11511 * unset ?-nocomplain? ?--? ?varName ...?
11513 static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11515 int i = 1;
11516 int complain = 1;
11518 while (i < argc) {
11519 if (Jim_CompareStringImmediate(interp, argv[i], "--")) {
11520 i++;
11521 break;
11523 if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) {
11524 complain = 0;
11525 i++;
11526 continue;
11528 break;
11531 while (i < argc) {
11532 if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK
11533 && complain) {
11534 return JIM_ERR;
11536 i++;
11538 return JIM_OK;
11541 /* [while] */
11542 static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11544 if (argc != 3) {
11545 Jim_WrongNumArgs(interp, 1, argv, "condition body");
11546 return JIM_ERR;
11549 /* The general purpose implementation of while starts here */
11550 while (1) {
11551 int boolean, retval;
11553 if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK)
11554 return retval;
11555 if (!boolean)
11556 break;
11558 if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) {
11559 switch (retval) {
11560 case JIM_BREAK:
11561 goto out;
11562 break;
11563 case JIM_CONTINUE:
11564 continue;
11565 break;
11566 default:
11567 return retval;
11571 out:
11572 Jim_SetEmptyResult(interp);
11573 return JIM_OK;
11576 /* [for] */
11577 static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11579 int retval;
11580 int boolean = 1;
11581 Jim_Obj *varNamePtr = NULL;
11582 Jim_Obj *stopVarNamePtr = NULL;
11584 if (argc != 5) {
11585 Jim_WrongNumArgs(interp, 1, argv, "start test next body");
11586 return JIM_ERR;
11589 /* Do the initialisation */
11590 if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) {
11591 return retval;
11594 /* And do the first test now. Better for optimisation
11595 * if we can do next/test at the bottom of the loop
11597 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11599 /* Ready to do the body as follows:
11600 * while (1) {
11601 * body // check retcode
11602 * next // check retcode
11603 * test // check retcode/test bool
11607 #ifdef JIM_OPTIMIZATION
11608 /* Check if the for is on the form:
11609 * for ... {$i < CONST} {incr i}
11610 * for ... {$i < $j} {incr i}
11612 if (retval == JIM_OK && boolean) {
11613 ScriptObj *incrScript;
11614 ExprByteCode *expr;
11615 jim_wide stop, currentVal;
11616 Jim_Obj *objPtr;
11617 int cmpOffset;
11619 /* Do it only if there aren't shared arguments */
11620 expr = JimGetExpression(interp, argv[2]);
11621 incrScript = Jim_GetScript(interp, argv[3]);
11623 /* Ensure proper lengths to start */
11624 if (incrScript->len != 3 || !expr || expr->len != 3) {
11625 goto evalstart;
11627 /* Ensure proper token types. */
11628 if (incrScript->token[1].type != JIM_TT_ESC ||
11629 expr->token[0].type != JIM_TT_VAR ||
11630 (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) {
11631 goto evalstart;
11634 if (expr->token[2].type == JIM_EXPROP_LT) {
11635 cmpOffset = 0;
11637 else if (expr->token[2].type == JIM_EXPROP_LTE) {
11638 cmpOffset = 1;
11640 else {
11641 goto evalstart;
11644 /* Update command must be incr */
11645 if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) {
11646 goto evalstart;
11649 /* incr, expression must be about the same variable */
11650 if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) {
11651 goto evalstart;
11654 /* Get the stop condition (must be a variable or integer) */
11655 if (expr->token[1].type == JIM_TT_EXPR_INT) {
11656 if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) {
11657 goto evalstart;
11660 else {
11661 stopVarNamePtr = expr->token[1].objPtr;
11662 Jim_IncrRefCount(stopVarNamePtr);
11663 /* Keep the compiler happy */
11664 stop = 0;
11667 /* Initialization */
11668 varNamePtr = expr->token[0].objPtr;
11669 Jim_IncrRefCount(varNamePtr);
11671 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE);
11672 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK) {
11673 goto testcond;
11676 /* --- OPTIMIZED FOR --- */
11677 while (retval == JIM_OK) {
11678 /* === Check condition === */
11679 /* Note that currentVal is already set here */
11681 /* Immediate or Variable? get the 'stop' value if the latter. */
11682 if (stopVarNamePtr) {
11683 objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE);
11684 if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) {
11685 goto testcond;
11689 if (currentVal >= stop + cmpOffset) {
11690 break;
11693 /* Eval body */
11694 retval = Jim_EvalObj(interp, argv[4]);
11695 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11696 retval = JIM_OK;
11698 objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG);
11700 /* Increment */
11701 if (objPtr == NULL) {
11702 retval = JIM_ERR;
11703 goto out;
11705 if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11706 currentVal = ++JimWideValue(objPtr);
11707 Jim_InvalidateStringRep(objPtr);
11709 else {
11710 if (Jim_GetWide(interp, objPtr, &currentVal) != JIM_OK ||
11711 Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp,
11712 ++currentVal)) != JIM_OK) {
11713 goto evalnext;
11718 goto out;
11720 evalstart:
11721 #endif
11723 while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) {
11724 /* Body */
11725 retval = Jim_EvalObj(interp, argv[4]);
11727 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11728 /* increment */
11729 evalnext:
11730 retval = Jim_EvalObj(interp, argv[3]);
11731 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11732 /* test */
11733 testcond:
11734 retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean);
11738 out:
11739 if (stopVarNamePtr) {
11740 Jim_DecrRefCount(interp, stopVarNamePtr);
11742 if (varNamePtr) {
11743 Jim_DecrRefCount(interp, varNamePtr);
11746 if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) {
11747 Jim_SetEmptyResult(interp);
11748 return JIM_OK;
11751 return retval;
11754 /* [loop] */
11755 static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11757 int retval;
11758 jim_wide i;
11759 jim_wide limit;
11760 jim_wide incr = 1;
11761 Jim_Obj *bodyObjPtr;
11763 if (argc != 5 && argc != 6) {
11764 Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
11765 return JIM_ERR;
11768 if (Jim_GetWide(interp, argv[2], &i) != JIM_OK ||
11769 Jim_GetWide(interp, argv[3], &limit) != JIM_OK ||
11770 (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11771 return JIM_ERR;
11773 bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11775 retval = Jim_SetVariable(interp, argv[1], argv[2]);
11777 while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) {
11778 retval = Jim_EvalObj(interp, bodyObjPtr);
11779 if (retval == JIM_OK || retval == JIM_CONTINUE) {
11780 Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
11782 retval = JIM_OK;
11784 /* Increment */
11785 i += incr;
11787 if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) {
11788 if (argv[1]->typePtr != &variableObjType) {
11789 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11790 return JIM_ERR;
11793 JimWideValue(objPtr) = i;
11794 Jim_InvalidateStringRep(objPtr);
11796 /* The following step is required in order to invalidate the
11797 * string repr of "FOO" if the var name is of the form of "FOO(IDX)" */
11798 if (argv[1]->typePtr != &variableObjType) {
11799 if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
11800 retval = JIM_ERR;
11801 break;
11805 else {
11806 objPtr = Jim_NewIntObj(interp, i);
11807 retval = Jim_SetVariable(interp, argv[1], objPtr);
11808 if (retval != JIM_OK) {
11809 Jim_FreeNewObj(interp, objPtr);
11815 if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) {
11816 Jim_SetEmptyResult(interp);
11817 return JIM_OK;
11819 return retval;
11822 /* List iterators make it easy to iterate over a list.
11823 * At some point iterators will be expanded to support generators.
11825 typedef struct {
11826 Jim_Obj *objPtr;
11827 int idx;
11828 } Jim_ListIter;
11831 * Initialise the iterator at the start of the list.
11833 static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr)
11835 iter->objPtr = objPtr;
11836 iter->idx = 0;
11840 * Returns the next object from the list, or NULL on end-of-list.
11842 static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter)
11844 if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) {
11845 return NULL;
11847 return iter->objPtr->internalRep.listValue.ele[iter->idx++];
11851 * Returns 1 if end-of-list has been reached.
11853 static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter)
11855 return iter->idx >= Jim_ListLength(interp, iter->objPtr);
11858 /* foreach + lmap implementation. */
11859 static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap)
11861 int result = JIM_ERR;
11862 int i, numargs;
11863 Jim_ListIter twoiters[2]; /* Avoid allocation for a single list */
11864 Jim_ListIter *iters;
11865 Jim_Obj *script;
11866 Jim_Obj *resultObj;
11868 if (argc < 4 || argc % 2 != 0) {
11869 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script");
11870 return JIM_ERR;
11872 script = argv[argc - 1]; /* Last argument is a script */
11873 numargs = (argc - 1 - 1); /* argc - 'foreach' - script */
11875 if (numargs == 2) {
11876 iters = twoiters;
11878 else {
11879 iters = Jim_Alloc(numargs * sizeof(*iters));
11881 for (i = 0; i < numargs; i++) {
11882 JimListIterInit(&iters[i], argv[i + 1]);
11883 if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) {
11884 Jim_SetResultString(interp, "foreach varlist is empty", -1);
11885 return JIM_ERR;
11889 if (doMap) {
11890 resultObj = Jim_NewListObj(interp, NULL, 0);
11892 else {
11893 resultObj = interp->emptyObj;
11895 Jim_IncrRefCount(resultObj);
11897 while (1) {
11898 /* Have we expired all lists? */
11899 for (i = 0; i < numargs; i += 2) {
11900 if (!JimListIterDone(interp, &iters[i + 1])) {
11901 break;
11904 if (i == numargs) {
11905 /* All done */
11906 break;
11909 /* For each list */
11910 for (i = 0; i < numargs; i += 2) {
11911 Jim_Obj *varName;
11913 /* foreach var */
11914 JimListIterInit(&iters[i], argv[i + 1]);
11915 while ((varName = JimListIterNext(interp, &iters[i])) != NULL) {
11916 Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]);
11917 if (!valObj) {
11918 /* Ran out, so store the empty string */
11919 valObj = interp->emptyObj;
11921 /* Avoid shimmering */
11922 Jim_IncrRefCount(valObj);
11923 result = Jim_SetVariable(interp, varName, valObj);
11924 Jim_DecrRefCount(interp, valObj);
11925 if (result != JIM_OK) {
11926 goto err;
11930 switch (result = Jim_EvalObj(interp, script)) {
11931 case JIM_OK:
11932 if (doMap) {
11933 Jim_ListAppendElement(interp, resultObj, interp->result);
11935 break;
11936 case JIM_CONTINUE:
11937 break;
11938 case JIM_BREAK:
11939 goto out;
11940 default:
11941 goto err;
11944 out:
11945 result = JIM_OK;
11946 Jim_SetResult(interp, resultObj);
11947 err:
11948 Jim_DecrRefCount(interp, resultObj);
11949 if (numargs > 2) {
11950 Jim_Free(iters);
11952 return result;
11955 /* [foreach] */
11956 static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11958 return JimForeachMapHelper(interp, argc, argv, 0);
11961 /* [lmap] */
11962 static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11964 return JimForeachMapHelper(interp, argc, argv, 1);
11967 /* [lassign] */
11968 static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
11970 int result = JIM_ERR;
11971 int i;
11972 Jim_ListIter iter;
11973 Jim_Obj *resultObj;
11975 if (argc < 2) {
11976 Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
11977 return JIM_ERR;
11980 JimListIterInit(&iter, argv[1]);
11982 for (i = 2; i < argc; i++) {
11983 Jim_Obj *valObj = JimListIterNext(interp, &iter);
11984 result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
11985 if (result != JIM_OK) {
11986 return result;
11990 resultObj = Jim_NewListObj(interp, NULL, 0);
11991 while (!JimListIterDone(interp, &iter)) {
11992 Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
11995 Jim_SetResult(interp, resultObj);
11997 return JIM_OK;
12000 /* [if] */
12001 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12003 int boolean, retval, current = 1, falsebody = 0;
12005 if (argc >= 3) {
12006 while (1) {
12007 /* Far not enough arguments given! */
12008 if (current >= argc)
12009 goto err;
12010 if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean))
12011 != JIM_OK)
12012 return retval;
12013 /* There lacks something, isn't it? */
12014 if (current >= argc)
12015 goto err;
12016 if (Jim_CompareStringImmediate(interp, argv[current], "then"))
12017 current++;
12018 /* Tsk tsk, no then-clause? */
12019 if (current >= argc)
12020 goto err;
12021 if (boolean)
12022 return Jim_EvalObj(interp, argv[current]);
12023 /* Ok: no else-clause follows */
12024 if (++current >= argc) {
12025 Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
12026 return JIM_OK;
12028 falsebody = current++;
12029 if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) {
12030 /* IIICKS - else-clause isn't last cmd? */
12031 if (current != argc - 1)
12032 goto err;
12033 return Jim_EvalObj(interp, argv[current]);
12035 else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif"))
12036 /* Ok: elseif follows meaning all the stuff
12037 * again (how boring...) */
12038 continue;
12039 /* OOPS - else-clause is not last cmd? */
12040 else if (falsebody != argc - 1)
12041 goto err;
12042 return Jim_EvalObj(interp, argv[falsebody]);
12044 return JIM_OK;
12046 err:
12047 Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody");
12048 return JIM_ERR;
12052 /* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
12053 int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj,
12054 Jim_Obj *stringObj, int nocase)
12056 Jim_Obj *parms[4];
12057 int argc = 0;
12058 long eq;
12059 int rc;
12061 parms[argc++] = commandObj;
12062 if (nocase) {
12063 parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
12065 parms[argc++] = patternObj;
12066 parms[argc++] = stringObj;
12068 rc = Jim_EvalObjVector(interp, argc, parms);
12070 if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) {
12071 eq = -rc;
12074 return eq;
12077 enum
12078 { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12080 /* [switch] */
12081 static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12083 int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
12084 Jim_Obj *command = 0, *const *caseList = 0, *strObj;
12085 Jim_Obj *script = 0;
12087 if (argc < 3) {
12088 wrongnumargs:
12089 Jim_WrongNumArgs(interp, 1, argv, "?options? string "
12090 "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}");
12091 return JIM_ERR;
12093 for (opt = 1; opt < argc; ++opt) {
12094 const char *option = Jim_String(argv[opt]);
12096 if (*option != '-')
12097 break;
12098 else if (strncmp(option, "--", 2) == 0) {
12099 ++opt;
12100 break;
12102 else if (strncmp(option, "-exact", 2) == 0)
12103 matchOpt = SWITCH_EXACT;
12104 else if (strncmp(option, "-glob", 2) == 0)
12105 matchOpt = SWITCH_GLOB;
12106 else if (strncmp(option, "-regexp", 2) == 0)
12107 matchOpt = SWITCH_RE;
12108 else if (strncmp(option, "-command", 2) == 0) {
12109 matchOpt = SWITCH_CMD;
12110 if ((argc - opt) < 2)
12111 goto wrongnumargs;
12112 command = argv[++opt];
12114 else {
12115 Jim_SetResultFormatted(interp,
12116 "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --",
12117 argv[opt]);
12118 return JIM_ERR;
12120 if ((argc - opt) < 2)
12121 goto wrongnumargs;
12123 strObj = argv[opt++];
12124 patCount = argc - opt;
12125 if (patCount == 1) {
12126 Jim_Obj **vector;
12128 JimListGetElements(interp, argv[opt], &patCount, &vector);
12129 caseList = vector;
12131 else
12132 caseList = &argv[opt];
12133 if (patCount == 0 || patCount % 2 != 0)
12134 goto wrongnumargs;
12135 for (i = 0; script == 0 && i < patCount; i += 2) {
12136 Jim_Obj *patObj = caseList[i];
12138 if (!Jim_CompareStringImmediate(interp, patObj, "default")
12139 || i < (patCount - 2)) {
12140 switch (matchOpt) {
12141 case SWITCH_EXACT:
12142 if (Jim_StringEqObj(strObj, patObj))
12143 script = caseList[i + 1];
12144 break;
12145 case SWITCH_GLOB:
12146 if (Jim_StringMatchObj(interp, patObj, strObj, 0))
12147 script = caseList[i + 1];
12148 break;
12149 case SWITCH_RE:
12150 command = Jim_NewStringObj(interp, "regexp", -1);
12151 /* Fall thru intentionally */
12152 case SWITCH_CMD:{
12153 int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
12155 /* After the execution of a command we need to
12156 * make sure to reconvert the object into a list
12157 * again. Only for the single-list style [switch]. */
12158 if (argc - opt == 1) {
12159 Jim_Obj **vector;
12161 JimListGetElements(interp, argv[opt], &patCount, &vector);
12162 caseList = vector;
12164 /* command is here already decref'd */
12165 if (rc < 0) {
12166 return -rc;
12168 if (rc)
12169 script = caseList[i + 1];
12170 break;
12174 else {
12175 script = caseList[i + 1];
12178 for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2)
12179 script = caseList[i + 1];
12180 if (script && Jim_CompareStringImmediate(interp, script, "-")) {
12181 Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]);
12182 return JIM_ERR;
12184 Jim_SetEmptyResult(interp);
12185 if (script) {
12186 return Jim_EvalObj(interp, script);
12188 return JIM_OK;
12191 /* [list] */
12192 static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12194 Jim_Obj *listObjPtr;
12196 listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1);
12197 Jim_SetResult(interp, listObjPtr);
12198 return JIM_OK;
12201 /* [lindex] */
12202 static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12204 Jim_Obj *objPtr, *listObjPtr;
12205 int i;
12206 int idx;
12208 if (argc < 3) {
12209 Jim_WrongNumArgs(interp, 1, argv, "list index ?...?");
12210 return JIM_ERR;
12212 objPtr = argv[1];
12213 Jim_IncrRefCount(objPtr);
12214 for (i = 2; i < argc; i++) {
12215 listObjPtr = objPtr;
12216 if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12217 Jim_DecrRefCount(interp, listObjPtr);
12218 return JIM_ERR;
12220 if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12221 /* Returns an empty object if the index
12222 * is out of range. */
12223 Jim_DecrRefCount(interp, listObjPtr);
12224 Jim_SetEmptyResult(interp);
12225 return JIM_OK;
12227 Jim_IncrRefCount(objPtr);
12228 Jim_DecrRefCount(interp, listObjPtr);
12230 Jim_SetResult(interp, objPtr);
12231 Jim_DecrRefCount(interp, objPtr);
12232 return JIM_OK;
12235 /* [llength] */
12236 static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12238 if (argc != 2) {
12239 Jim_WrongNumArgs(interp, 1, argv, "list");
12240 return JIM_ERR;
12242 Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1]));
12243 return JIM_OK;
12246 /* [lsearch] */
12247 static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12249 static const char * const options[] = {
12250 "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12251 NULL
12253 enum
12254 { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12255 OPT_COMMAND };
12256 int i;
12257 int opt_bool = 0;
12258 int opt_not = 0;
12259 int opt_nocase = 0;
12260 int opt_all = 0;
12261 int opt_inline = 0;
12262 int opt_match = OPT_EXACT;
12263 int listlen;
12264 int rc = JIM_OK;
12265 Jim_Obj *listObjPtr = NULL;
12266 Jim_Obj *commandObj = NULL;
12268 if (argc < 3) {
12269 wrongargs:
12270 Jim_WrongNumArgs(interp, 1, argv,
12271 "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value");
12272 return JIM_ERR;
12275 for (i = 1; i < argc - 2; i++) {
12276 int option;
12278 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
12279 return JIM_ERR;
12281 switch (option) {
12282 case OPT_BOOL:
12283 opt_bool = 1;
12284 opt_inline = 0;
12285 break;
12286 case OPT_NOT:
12287 opt_not = 1;
12288 break;
12289 case OPT_NOCASE:
12290 opt_nocase = 1;
12291 break;
12292 case OPT_INLINE:
12293 opt_inline = 1;
12294 opt_bool = 0;
12295 break;
12296 case OPT_ALL:
12297 opt_all = 1;
12298 break;
12299 case OPT_COMMAND:
12300 if (i >= argc - 2) {
12301 goto wrongargs;
12303 commandObj = argv[++i];
12304 /* fallthru */
12305 case OPT_EXACT:
12306 case OPT_GLOB:
12307 case OPT_REGEXP:
12308 opt_match = option;
12309 break;
12313 argv += i;
12315 if (opt_all) {
12316 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12318 if (opt_match == OPT_REGEXP) {
12319 commandObj = Jim_NewStringObj(interp, "regexp", -1);
12321 if (commandObj) {
12322 Jim_IncrRefCount(commandObj);
12325 listlen = Jim_ListLength(interp, argv[0]);
12326 for (i = 0; i < listlen; i++) {
12327 Jim_Obj *objPtr;
12328 int eq = 0;
12330 Jim_ListIndex(interp, argv[0], i, &objPtr, JIM_NONE);
12331 switch (opt_match) {
12332 case OPT_EXACT:
12333 eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
12334 break;
12336 case OPT_GLOB:
12337 eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
12338 break;
12340 case OPT_REGEXP:
12341 case OPT_COMMAND:
12342 eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
12343 if (eq < 0) {
12344 if (listObjPtr) {
12345 Jim_FreeNewObj(interp, listObjPtr);
12347 rc = JIM_ERR;
12348 goto done;
12350 break;
12353 /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12354 if (!eq && opt_bool && opt_not && !opt_all) {
12355 continue;
12358 if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) {
12359 /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12360 Jim_Obj *resultObj;
12362 if (opt_bool) {
12363 resultObj = Jim_NewIntObj(interp, eq ^ opt_not);
12365 else if (!opt_inline) {
12366 resultObj = Jim_NewIntObj(interp, i);
12368 else {
12369 resultObj = objPtr;
12372 if (opt_all) {
12373 Jim_ListAppendElement(interp, listObjPtr, resultObj);
12375 else {
12376 Jim_SetResult(interp, resultObj);
12377 goto done;
12382 if (opt_all) {
12383 Jim_SetResult(interp, listObjPtr);
12385 else {
12386 /* No match */
12387 if (opt_bool) {
12388 Jim_SetResultBool(interp, opt_not);
12390 else if (!opt_inline) {
12391 Jim_SetResultInt(interp, -1);
12395 done:
12396 if (commandObj) {
12397 Jim_DecrRefCount(interp, commandObj);
12399 return rc;
12402 /* [lappend] */
12403 static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12405 Jim_Obj *listObjPtr;
12406 int shared, i;
12408 if (argc < 2) {
12409 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12410 return JIM_ERR;
12412 listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12413 if (!listObjPtr) {
12414 /* Create the list if it does not exists */
12415 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12416 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12417 Jim_FreeNewObj(interp, listObjPtr);
12418 return JIM_ERR;
12421 shared = Jim_IsShared(listObjPtr);
12422 if (shared)
12423 listObjPtr = Jim_DuplicateObj(interp, listObjPtr);
12424 for (i = 2; i < argc; i++)
12425 Jim_ListAppendElement(interp, listObjPtr, argv[i]);
12426 if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) {
12427 if (shared)
12428 Jim_FreeNewObj(interp, listObjPtr);
12429 return JIM_ERR;
12431 Jim_SetResult(interp, listObjPtr);
12432 return JIM_OK;
12435 /* [linsert] */
12436 static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12438 int idx, len;
12439 Jim_Obj *listPtr;
12441 if (argc < 3) {
12442 Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?");
12443 return JIM_ERR;
12445 listPtr = argv[1];
12446 if (Jim_IsShared(listPtr))
12447 listPtr = Jim_DuplicateObj(interp, listPtr);
12448 if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK)
12449 goto err;
12450 len = Jim_ListLength(interp, listPtr);
12451 if (idx >= len)
12452 idx = len;
12453 else if (idx < 0)
12454 idx = len + idx + 1;
12455 Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]);
12456 Jim_SetResult(interp, listPtr);
12457 return JIM_OK;
12458 err:
12459 if (listPtr != argv[1]) {
12460 Jim_FreeNewObj(interp, listPtr);
12462 return JIM_ERR;
12465 /* [lreplace] */
12466 static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12468 int first, last, len, rangeLen;
12469 Jim_Obj *listObj;
12470 Jim_Obj *newListObj;
12472 if (argc < 4) {
12473 Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?");
12474 return JIM_ERR;
12476 if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK ||
12477 Jim_GetIndex(interp, argv[3], &last) != JIM_OK) {
12478 return JIM_ERR;
12481 listObj = argv[1];
12482 len = Jim_ListLength(interp, listObj);
12484 first = JimRelToAbsIndex(len, first);
12485 last = JimRelToAbsIndex(len, last);
12486 JimRelToAbsRange(len, &first, &last, &rangeLen);
12488 /* Now construct a new list which consists of:
12489 * <elements before first> <supplied elements> <elements after last>
12492 /* Check to see if trying to replace past the end of the list */
12493 if (first < len) {
12494 /* OK. Not past the end */
12496 else if (len == 0) {
12497 /* Special for empty list, adjust first to 0 */
12498 first = 0;
12500 else {
12501 Jim_SetResultString(interp, "list doesn't contain element ", -1);
12502 Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]);
12503 return JIM_ERR;
12506 /* Add the first set of elements */
12507 newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first);
12509 /* Add supplied elements */
12510 ListInsertElements(newListObj, -1, argc - 4, argv + 4);
12512 /* Add the remaining elements */
12513 ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen);
12515 Jim_SetResult(interp, newListObj);
12516 return JIM_OK;
12519 /* [lset] */
12520 static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12522 if (argc < 3) {
12523 Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
12524 return JIM_ERR;
12526 else if (argc == 3) {
12527 if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK)
12528 return JIM_ERR;
12529 Jim_SetResult(interp, argv[2]);
12530 return JIM_OK;
12532 if (Jim_SetListIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1])
12533 == JIM_ERR)
12534 return JIM_ERR;
12535 return JIM_OK;
12538 /* [lsort] */
12539 static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[])
12541 static const char * const options[] = {
12542 "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
12544 enum
12545 { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
12546 Jim_Obj *resObj;
12547 int i;
12548 int retCode;
12550 struct lsort_info info;
12552 if (argc < 2) {
12553 Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12554 return JIM_ERR;
12557 info.type = JIM_LSORT_ASCII;
12558 info.order = 1;
12559 info.indexed = 0;
12560 info.unique = 0;
12561 info.command = NULL;
12562 info.interp = interp;
12564 for (i = 1; i < (argc - 1); i++) {
12565 int option;
12567 if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG)
12568 != JIM_OK)
12569 return JIM_ERR;
12570 switch (option) {
12571 case OPT_ASCII:
12572 info.type = JIM_LSORT_ASCII;
12573 break;
12574 case OPT_NOCASE:
12575 info.type = JIM_LSORT_NOCASE;
12576 break;
12577 case OPT_INTEGER:
12578 info.type = JIM_LSORT_INTEGER;
12579 break;
12580 case OPT_REAL:
12581 info.type = JIM_LSORT_REAL;
12582 break;
12583 case OPT_INCREASING:
12584 info.order = 1;
12585 break;
12586 case OPT_DECREASING:
12587 info.order = -1;
12588 break;
12589 case OPT_UNIQUE:
12590 info.unique = 1;
12591 break;
12592 case OPT_COMMAND:
12593 if (i >= (argc - 2)) {
12594 Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1);
12595 return JIM_ERR;
12597 info.type = JIM_LSORT_COMMAND;
12598 info.command = argv[i + 1];
12599 i++;
12600 break;
12601 case OPT_INDEX:
12602 if (i >= (argc - 2)) {
12603 Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12604 return JIM_ERR;
12606 if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12607 return JIM_ERR;
12609 info.indexed = 1;
12610 i++;
12611 break;
12614 resObj = Jim_DuplicateObj(interp, argv[argc - 1]);
12615 retCode = ListSortElements(interp, resObj, &info);
12616 if (retCode == JIM_OK) {
12617 Jim_SetResult(interp, resObj);
12619 else {
12620 Jim_FreeNewObj(interp, resObj);
12622 return retCode;
12625 /* [append] */
12626 static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12628 Jim_Obj *stringObjPtr;
12629 int i;
12631 if (argc < 2) {
12632 Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?");
12633 return JIM_ERR;
12635 if (argc == 2) {
12636 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG);
12637 if (!stringObjPtr)
12638 return JIM_ERR;
12640 else {
12641 int freeobj = 0;
12642 stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
12643 if (!stringObjPtr) {
12644 /* Create the string if it doesn't exist */
12645 stringObjPtr = Jim_NewEmptyStringObj(interp);
12646 freeobj = 1;
12648 else if (Jim_IsShared(stringObjPtr)) {
12649 freeobj = 1;
12650 stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
12652 for (i = 2; i < argc; i++) {
12653 Jim_AppendObj(interp, stringObjPtr, argv[i]);
12655 if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
12656 if (freeobj) {
12657 Jim_FreeNewObj(interp, stringObjPtr);
12659 return JIM_ERR;
12662 Jim_SetResult(interp, stringObjPtr);
12663 return JIM_OK;
12666 /* [debug] */
12667 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12669 #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12670 static const char * const options[] = {
12671 "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12672 "exprbc", "show",
12673 NULL
12675 enum
12677 OPT_REFCOUNT, OPT_OBJCOUNT, OPT_OBJECTS, OPT_INVSTR, OPT_SCRIPTLEN,
12678 OPT_EXPRLEN, OPT_EXPRBC, OPT_SHOW,
12680 int option;
12682 if (argc < 2) {
12683 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?...?");
12684 return JIM_ERR;
12686 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK)
12687 return JIM_ERR;
12688 if (option == OPT_REFCOUNT) {
12689 if (argc != 3) {
12690 Jim_WrongNumArgs(interp, 2, argv, "object");
12691 return JIM_ERR;
12693 Jim_SetResultInt(interp, argv[2]->refCount);
12694 return JIM_OK;
12696 else if (option == OPT_OBJCOUNT) {
12697 int freeobj = 0, liveobj = 0;
12698 char buf[256];
12699 Jim_Obj *objPtr;
12701 if (argc != 2) {
12702 Jim_WrongNumArgs(interp, 2, argv, "");
12703 return JIM_ERR;
12705 /* Count the number of free objects. */
12706 objPtr = interp->freeList;
12707 while (objPtr) {
12708 freeobj++;
12709 objPtr = objPtr->nextObjPtr;
12711 /* Count the number of live objects. */
12712 objPtr = interp->liveList;
12713 while (objPtr) {
12714 liveobj++;
12715 objPtr = objPtr->nextObjPtr;
12717 /* Set the result string and return. */
12718 sprintf(buf, "free %d used %d", freeobj, liveobj);
12719 Jim_SetResultString(interp, buf, -1);
12720 return JIM_OK;
12722 else if (option == OPT_OBJECTS) {
12723 Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
12725 /* Count the number of live objects. */
12726 objPtr = interp->liveList;
12727 listObjPtr = Jim_NewListObj(interp, NULL, 0);
12728 while (objPtr) {
12729 char buf[128];
12730 const char *type = objPtr->typePtr ? objPtr->typePtr->name : "";
12732 subListObjPtr = Jim_NewListObj(interp, NULL, 0);
12733 sprintf(buf, "%p", objPtr);
12734 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1));
12735 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, type, -1));
12736 Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount));
12737 Jim_ListAppendElement(interp, subListObjPtr, objPtr);
12738 Jim_ListAppendElement(interp, listObjPtr, subListObjPtr);
12739 objPtr = objPtr->nextObjPtr;
12741 Jim_SetResult(interp, listObjPtr);
12742 return JIM_OK;
12744 else if (option == OPT_INVSTR) {
12745 Jim_Obj *objPtr;
12747 if (argc != 3) {
12748 Jim_WrongNumArgs(interp, 2, argv, "object");
12749 return JIM_ERR;
12751 objPtr = argv[2];
12752 if (objPtr->typePtr != NULL)
12753 Jim_InvalidateStringRep(objPtr);
12754 Jim_SetEmptyResult(interp);
12755 return JIM_OK;
12757 else if (option == OPT_SHOW) {
12758 const char *s;
12759 int len, charlen;
12761 if (argc != 3) {
12762 Jim_WrongNumArgs(interp, 2, argv, "object");
12763 return JIM_ERR;
12765 s = Jim_GetString(argv[2], &len);
12766 #ifdef JIM_UTF8
12767 charlen = utf8_strlen(s, len);
12768 #else
12769 charlen = len;
12770 #endif
12771 printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12772 printf("chars (%d): <<%s>>\n", charlen, s);
12773 printf("bytes (%d):", len);
12774 while (len--) {
12775 printf(" %02x", (unsigned char)*s++);
12777 printf("\n");
12778 return JIM_OK;
12780 else if (option == OPT_SCRIPTLEN) {
12781 ScriptObj *script;
12783 if (argc != 3) {
12784 Jim_WrongNumArgs(interp, 2, argv, "script");
12785 return JIM_ERR;
12787 script = Jim_GetScript(interp, argv[2]);
12788 Jim_SetResultInt(interp, script->len);
12789 return JIM_OK;
12791 else if (option == OPT_EXPRLEN) {
12792 ExprByteCode *expr;
12794 if (argc != 3) {
12795 Jim_WrongNumArgs(interp, 2, argv, "expression");
12796 return JIM_ERR;
12798 expr = JimGetExpression(interp, argv[2]);
12799 if (expr == NULL)
12800 return JIM_ERR;
12801 Jim_SetResultInt(interp, expr->len);
12802 return JIM_OK;
12804 else if (option == OPT_EXPRBC) {
12805 Jim_Obj *objPtr;
12806 ExprByteCode *expr;
12807 int i;
12809 if (argc != 3) {
12810 Jim_WrongNumArgs(interp, 2, argv, "expression");
12811 return JIM_ERR;
12813 expr = JimGetExpression(interp, argv[2]);
12814 if (expr == NULL)
12815 return JIM_ERR;
12816 objPtr = Jim_NewListObj(interp, NULL, 0);
12817 for (i = 0; i < expr->len; i++) {
12818 const char *type;
12819 const Jim_ExprOperator *op;
12820 Jim_Obj *obj = expr->token[i].objPtr;
12822 switch (expr->token[i].type) {
12823 case JIM_TT_EXPR_INT:
12824 type = "int";
12825 break;
12826 case JIM_TT_EXPR_DOUBLE:
12827 type = "double";
12828 break;
12829 case JIM_TT_CMD:
12830 type = "command";
12831 break;
12832 case JIM_TT_VAR:
12833 type = "variable";
12834 break;
12835 case JIM_TT_DICTSUGAR:
12836 type = "dictsugar";
12837 break;
12838 case JIM_TT_EXPRSUGAR:
12839 type = "exprsugar";
12840 break;
12841 case JIM_TT_ESC:
12842 type = "subst";
12843 break;
12844 case JIM_TT_STR:
12845 type = "string";
12846 break;
12847 default:
12848 op = JimExprOperatorInfoByOpcode(expr->token[i].type);
12849 if (op == NULL) {
12850 type = "private";
12852 else {
12853 type = "operator";
12855 obj = Jim_NewStringObj(interp, op ? op->name : "", -1);
12856 break;
12858 Jim_ListAppendElement(interp, objPtr, Jim_NewStringObj(interp, type, -1));
12859 Jim_ListAppendElement(interp, objPtr, obj);
12861 Jim_SetResult(interp, objPtr);
12862 return JIM_OK;
12864 else {
12865 Jim_SetResultString(interp,
12866 "bad option. Valid options are refcount, " "objcount, objects, invstr", -1);
12867 return JIM_ERR;
12869 /* unreached */
12870 #endif /* JIM_BOOTSTRAP */
12871 #if !defined(JIM_DEBUG_COMMAND)
12872 Jim_SetResultString(interp, "unsupported", -1);
12873 return JIM_ERR;
12874 #endif
12877 /* [eval] */
12878 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12880 int rc;
12882 if (argc < 2) {
12883 Jim_WrongNumArgs(interp, 1, argv, "script ?...?");
12884 return JIM_ERR;
12887 if (argc == 2) {
12888 rc = Jim_EvalObj(interp, argv[1]);
12890 else {
12891 rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12894 if (rc == JIM_ERR) {
12895 /* eval is "interesting", so add a stack frame here */
12896 interp->addStackTrace++;
12898 return rc;
12901 /* [uplevel] */
12902 static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12904 if (argc >= 2) {
12905 int retcode;
12906 Jim_CallFrame *savedCallFrame, *targetCallFrame;
12907 int savedTailcall;
12908 const char *str;
12910 /* Save the old callframe pointer */
12911 savedCallFrame = interp->framePtr;
12913 /* Lookup the target frame pointer */
12914 str = Jim_String(argv[1]);
12915 if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') {
12916 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
12917 argc--;
12918 argv++;
12920 else {
12921 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
12923 if (targetCallFrame == NULL) {
12924 return JIM_ERR;
12926 if (argc < 2) {
12927 Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?");
12928 return JIM_ERR;
12930 /* Eval the code in the target callframe. */
12931 interp->framePtr = targetCallFrame;
12932 /* Can't merge tailcalls across upcall */
12933 savedTailcall = interp->framePtr->tailcall;
12934 interp->framePtr->tailcall = 0;
12935 if (argc == 2) {
12936 retcode = Jim_EvalObj(interp, argv[1]);
12938 else {
12939 retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
12941 interp->framePtr->tailcall = savedTailcall;
12942 interp->framePtr = savedCallFrame;
12943 return retcode;
12945 else {
12946 Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?");
12947 return JIM_ERR;
12951 /* [expr] */
12952 static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12954 Jim_Obj *exprResultPtr;
12955 int retcode;
12957 if (argc == 2) {
12958 retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr);
12960 else if (argc > 2) {
12961 Jim_Obj *objPtr;
12963 objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1);
12964 Jim_IncrRefCount(objPtr);
12965 retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr);
12966 Jim_DecrRefCount(interp, objPtr);
12968 else {
12969 Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12970 return JIM_ERR;
12972 if (retcode != JIM_OK)
12973 return retcode;
12974 Jim_SetResult(interp, exprResultPtr);
12975 Jim_DecrRefCount(interp, exprResultPtr);
12976 return JIM_OK;
12979 /* [break] */
12980 static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12982 if (argc != 1) {
12983 Jim_WrongNumArgs(interp, 1, argv, "");
12984 return JIM_ERR;
12986 return JIM_BREAK;
12989 /* [continue] */
12990 static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
12992 if (argc != 1) {
12993 Jim_WrongNumArgs(interp, 1, argv, "");
12994 return JIM_ERR;
12996 return JIM_CONTINUE;
12999 /* [return] */
13000 static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13002 int i;
13003 Jim_Obj *stackTraceObj = NULL;
13004 Jim_Obj *errorCodeObj = NULL;
13005 int returnCode = JIM_OK;
13006 long level = 1;
13008 for (i = 1; i < argc - 1; i += 2) {
13009 if (Jim_CompareStringImmediate(interp, argv[i], "-code")) {
13010 if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) {
13011 return JIM_ERR;
13014 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) {
13015 stackTraceObj = argv[i + 1];
13017 else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) {
13018 errorCodeObj = argv[i + 1];
13020 else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) {
13021 if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) {
13022 Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]);
13023 return JIM_ERR;
13026 else {
13027 break;
13031 if (i != argc - 1 && i != argc) {
13032 Jim_WrongNumArgs(interp, 1, argv,
13033 "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?");
13036 /* If a stack trace is supplied and code is error, set the stack trace */
13037 if (stackTraceObj && returnCode == JIM_ERR) {
13038 JimSetStackTrace(interp, stackTraceObj);
13040 /* If an error code list is supplied, set the global $errorCode */
13041 if (errorCodeObj && returnCode == JIM_ERR) {
13042 Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj);
13044 interp->returnCode = returnCode;
13045 interp->returnLevel = level;
13047 if (i == argc - 1) {
13048 Jim_SetResult(interp, argv[i]);
13050 return JIM_RETURN;
13053 /* [tailcall] */
13054 static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13056 if (interp->framePtr->level == 0) {
13057 Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1);
13058 return JIM_ERR;
13060 else if (argc >= 2) {
13061 /* Need to resolve the tailcall command in the current context */
13062 Jim_CallFrame *cf = interp->framePtr->parent;
13064 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13065 if (cmdPtr == NULL) {
13066 return JIM_ERR;
13069 JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd"));
13071 /* And stash this pre-resolved command */
13072 JimIncrCmdRefCount(cmdPtr);
13073 cf->tailcallCmd = cmdPtr;
13075 /* And stash the command list */
13076 JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj"));
13078 cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1);
13079 Jim_IncrRefCount(cf->tailcallObj);
13081 /* When the stack unwinds to the previous proc, the stashed command will be evaluated */
13082 return JIM_EVAL;
13084 return JIM_OK;
13087 static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13089 Jim_Obj *cmdList;
13090 Jim_Obj *prefixListObj = Jim_CmdPrivData(interp);
13092 /* prefixListObj is a list to which the args need to be appended */
13093 cmdList = Jim_DuplicateObj(interp, prefixListObj);
13094 ListInsertElements(cmdList, -1, argc - 1, argv + 1);
13096 return JimEvalObjList(interp, cmdList);
13099 static void JimAliasCmdDelete(Jim_Interp *interp, void *privData)
13101 Jim_Obj *prefixListObj = privData;
13102 Jim_DecrRefCount(interp, prefixListObj);
13105 static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13107 Jim_Obj *prefixListObj;
13108 const char *newname;
13110 if (argc < 3) {
13111 Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");
13112 return JIM_ERR;
13115 prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13116 Jim_IncrRefCount(prefixListObj);
13117 newname = Jim_String(argv[1]);
13118 if (newname[0] == ':' && newname[1] == ':') {
13119 while (*++newname == ':') {
13123 Jim_SetResult(interp, argv[1]);
13125 return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13128 /* [proc] */
13129 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13131 Jim_Cmd *cmd;
13133 if (argc != 4 && argc != 5) {
13134 Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
13135 return JIM_ERR;
13138 if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13139 return JIM_ERR;
13142 if (argc == 4) {
13143 cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13145 else {
13146 cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL);
13149 if (cmd) {
13150 /* Add the new command */
13151 Jim_Obj *qualifiedCmdNameObj;
13152 const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13154 JimCreateCommand(interp, cmdname, cmd);
13156 /* Calculate and set the namespace for this proc */
13157 JimUpdateProcNamespace(interp, cmd, cmdname);
13159 JimFreeQualifiedName(interp, qualifiedCmdNameObj);
13161 /* Unlike Tcl, set the name of the proc as the result */
13162 Jim_SetResult(interp, argv[1]);
13163 return JIM_OK;
13165 return JIM_ERR;
13168 /* [local] */
13169 static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13171 int retcode;
13173 if (argc < 2) {
13174 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13175 return JIM_ERR;
13178 /* Evaluate the arguments with 'local' in force */
13179 interp->local++;
13180 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13181 interp->local--;
13184 /* If OK, and the result is a proc, add it to the list of local procs */
13185 if (retcode == 0) {
13186 Jim_Obj *cmdNameObj = Jim_GetResult(interp);
13188 if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) {
13189 return JIM_ERR;
13191 if (interp->framePtr->localCommands == NULL) {
13192 interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands));
13193 Jim_InitStack(interp->framePtr->localCommands);
13195 Jim_IncrRefCount(cmdNameObj);
13196 Jim_StackPush(interp->framePtr->localCommands, cmdNameObj);
13199 return retcode;
13202 /* [upcall] */
13203 static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13205 if (argc < 2) {
13206 Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
13207 return JIM_ERR;
13209 else {
13210 int retcode;
13212 Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG);
13213 if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) {
13214 Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]);
13215 return JIM_ERR;
13217 /* OK. Mark this command as being in an upcall */
13218 cmdPtr->u.proc.upcall++;
13219 JimIncrCmdRefCount(cmdPtr);
13221 /* Invoke the command as normal */
13222 retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1);
13224 /* No longer in an upcall */
13225 cmdPtr->u.proc.upcall--;
13226 JimDecrCmdRefCount(interp, cmdPtr);
13228 return retcode;
13232 /* [apply] */
13233 static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13235 if (argc < 2) {
13236 Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?");
13237 return JIM_ERR;
13239 else {
13240 int ret;
13241 Jim_Cmd *cmd;
13242 Jim_Obj *argListObjPtr;
13243 Jim_Obj *bodyObjPtr;
13244 Jim_Obj *nsObj = NULL;
13245 Jim_Obj **nargv;
13247 int len = Jim_ListLength(interp, argv[1]);
13248 if (len != 2 && len != 3) {
13249 Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]);
13250 return JIM_ERR;
13253 if (len == 3) {
13254 #ifdef jim_ext_namespace
13255 /* Need to canonicalise the given namespace. */
13256 nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
13257 #else
13258 Jim_SetResultString(interp, "namespaces not enabled", -1);
13259 return JIM_ERR;
13260 #endif
13262 argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0);
13263 bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1);
13265 cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj);
13267 if (cmd) {
13268 /* Create a new argv array with a dummy argv[0], for error messages */
13269 nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv));
13270 nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1);
13271 Jim_IncrRefCount(nargv[0]);
13272 memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv));
13273 ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv);
13274 Jim_DecrRefCount(interp, nargv[0]);
13275 Jim_Free(nargv);
13277 JimDecrCmdRefCount(interp, cmd);
13278 return ret;
13280 return JIM_ERR;
13285 /* [concat] */
13286 static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13288 Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1));
13289 return JIM_OK;
13292 /* [upvar] */
13293 static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13295 int i;
13296 Jim_CallFrame *targetCallFrame;
13298 /* Lookup the target frame pointer */
13299 if (argc > 3 && (argc % 2 == 0)) {
13300 targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]);
13301 argc--;
13302 argv++;
13304 else {
13305 targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL);
13307 if (targetCallFrame == NULL) {
13308 return JIM_ERR;
13311 /* Check for arity */
13312 if (argc < 3) {
13313 Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?");
13314 return JIM_ERR;
13317 /* Now... for every other/local couple: */
13318 for (i = 1; i < argc; i += 2) {
13319 if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK)
13320 return JIM_ERR;
13322 return JIM_OK;
13325 /* [global] */
13326 static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13328 int i;
13330 if (argc < 2) {
13331 Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?");
13332 return JIM_ERR;
13334 /* Link every var to the toplevel having the same name */
13335 if (interp->framePtr->level == 0)
13336 return JIM_OK; /* global at toplevel... */
13337 for (i = 1; i < argc; i++) {
13338 /* global ::blah does nothing */
13339 const char *name = Jim_String(argv[i]);
13340 if (name[0] != ':' || name[1] != ':') {
13341 if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK)
13342 return JIM_ERR;
13345 return JIM_OK;
13348 /* does the [string map] operation. On error NULL is returned,
13349 * otherwise a new string object with the result, having refcount = 0,
13350 * is returned. */
13351 static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr,
13352 Jim_Obj *objPtr, int nocase)
13354 int numMaps;
13355 const char *str, *noMatchStart = NULL;
13356 int strLen, i;
13357 Jim_Obj *resultObjPtr;
13359 numMaps = Jim_ListLength(interp, mapListObjPtr);
13360 if (numMaps % 2) {
13361 Jim_SetResultString(interp, "list must contain an even number of elements", -1);
13362 return NULL;
13365 str = Jim_String(objPtr);
13366 strLen = Jim_Utf8Length(interp, objPtr);
13368 /* Map it */
13369 resultObjPtr = Jim_NewStringObj(interp, "", 0);
13370 while (strLen) {
13371 for (i = 0; i < numMaps; i += 2) {
13372 Jim_Obj *objPtr;
13373 const char *k;
13374 int kl;
13376 Jim_ListIndex(interp, mapListObjPtr, i, &objPtr, JIM_NONE);
13377 k = Jim_String(objPtr);
13378 kl = Jim_Utf8Length(interp, objPtr);
13380 if (strLen >= kl && kl) {
13381 int rc;
13382 rc = JimStringCompareLen(str, k, kl, nocase);
13383 if (rc == 0) {
13384 if (noMatchStart) {
13385 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13386 noMatchStart = NULL;
13388 Jim_ListIndex(interp, mapListObjPtr, i + 1, &objPtr, JIM_NONE);
13389 Jim_AppendObj(interp, resultObjPtr, objPtr);
13390 str += utf8_index(str, kl);
13391 strLen -= kl;
13392 break;
13396 if (i == numMaps) { /* no match */
13397 int c;
13398 if (noMatchStart == NULL)
13399 noMatchStart = str;
13400 str += utf8_tounicode(str, &c);
13401 strLen--;
13404 if (noMatchStart) {
13405 Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);
13407 return resultObjPtr;
13410 /* [string] */
13411 static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13413 int len;
13414 int opt_case = 1;
13415 int option;
13416 static const char * const options[] = {
13417 "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace",
13418 "map", "repeat", "reverse", "index", "first", "last",
13419 "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL
13421 enum
13423 OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE,
13424 OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST,
13425 OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE
13427 static const char * const nocase_options[] = {
13428 "-nocase", NULL
13430 static const char * const nocase_length_options[] = {
13431 "-nocase", "-length", NULL
13434 if (argc < 2) {
13435 Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?");
13436 return JIM_ERR;
13438 if (Jim_GetEnum(interp, argv[1], options, &option, NULL,
13439 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK)
13440 return JIM_ERR;
13442 switch (option) {
13443 case OPT_LENGTH:
13444 case OPT_BYTELENGTH:
13445 if (argc != 3) {
13446 Jim_WrongNumArgs(interp, 2, argv, "string");
13447 return JIM_ERR;
13449 if (option == OPT_LENGTH) {
13450 len = Jim_Utf8Length(interp, argv[2]);
13452 else {
13453 len = Jim_Length(argv[2]);
13455 Jim_SetResultInt(interp, len);
13456 return JIM_OK;
13458 case OPT_COMPARE:
13459 case OPT_EQUAL:
13461 /* n is the number of remaining option args */
13462 long opt_length = -1;
13463 int n = argc - 4;
13464 int i = 2;
13465 while (n > 0) {
13466 int subopt;
13467 if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL,
13468 JIM_ENUM_ABBREV) != JIM_OK) {
13469 badcompareargs:
13470 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2");
13471 return JIM_ERR;
13473 if (subopt == 0) {
13474 /* -nocase */
13475 opt_case = 0;
13476 n--;
13478 else {
13479 /* -length */
13480 if (n < 2) {
13481 goto badcompareargs;
13483 if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) {
13484 return JIM_ERR;
13486 n -= 2;
13489 if (n) {
13490 goto badcompareargs;
13492 argv += argc - 2;
13493 if (opt_length < 0 && option != OPT_COMPARE && opt_case) {
13494 /* Fast version - [string equal], case sensitive, no length */
13495 Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13497 else {
13498 if (opt_length >= 0) {
13499 n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
13501 else {
13502 n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13504 Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13506 return JIM_OK;
13509 case OPT_MATCH:
13510 if (argc != 4 &&
13511 (argc != 5 ||
13512 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13513 JIM_ENUM_ABBREV) != JIM_OK)) {
13514 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string");
13515 return JIM_ERR;
13517 if (opt_case == 0) {
13518 argv++;
13520 Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case));
13521 return JIM_OK;
13523 case OPT_MAP:{
13524 Jim_Obj *objPtr;
13526 if (argc != 4 &&
13527 (argc != 5 ||
13528 Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL,
13529 JIM_ENUM_ABBREV) != JIM_OK)) {
13530 Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string");
13531 return JIM_ERR;
13534 if (opt_case == 0) {
13535 argv++;
13537 objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case);
13538 if (objPtr == NULL) {
13539 return JIM_ERR;
13541 Jim_SetResult(interp, objPtr);
13542 return JIM_OK;
13545 case OPT_RANGE:
13546 case OPT_BYTERANGE:{
13547 Jim_Obj *objPtr;
13549 if (argc != 5) {
13550 Jim_WrongNumArgs(interp, 2, argv, "string first last");
13551 return JIM_ERR;
13553 if (option == OPT_RANGE) {
13554 objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]);
13556 else
13558 objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]);
13561 if (objPtr == NULL) {
13562 return JIM_ERR;
13564 Jim_SetResult(interp, objPtr);
13565 return JIM_OK;
13568 case OPT_REPLACE:{
13569 Jim_Obj *objPtr;
13571 if (argc != 5 && argc != 6) {
13572 Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?");
13573 return JIM_ERR;
13575 objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL);
13576 if (objPtr == NULL) {
13577 return JIM_ERR;
13579 Jim_SetResult(interp, objPtr);
13580 return JIM_OK;
13584 case OPT_REPEAT:{
13585 Jim_Obj *objPtr;
13586 jim_wide count;
13588 if (argc != 4) {
13589 Jim_WrongNumArgs(interp, 2, argv, "string count");
13590 return JIM_ERR;
13592 if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
13593 return JIM_ERR;
13595 objPtr = Jim_NewStringObj(interp, "", 0);
13596 if (count > 0) {
13597 while (count--) {
13598 Jim_AppendObj(interp, objPtr, argv[2]);
13601 Jim_SetResult(interp, objPtr);
13602 return JIM_OK;
13605 case OPT_REVERSE:{
13606 char *buf, *p;
13607 const char *str;
13608 int len;
13609 int i;
13611 if (argc != 3) {
13612 Jim_WrongNumArgs(interp, 2, argv, "string");
13613 return JIM_ERR;
13616 str = Jim_GetString(argv[2], &len);
13617 buf = Jim_Alloc(len + 1);
13618 p = buf + len;
13619 *p = 0;
13620 for (i = 0; i < len; ) {
13621 int c;
13622 int l = utf8_tounicode(str, &c);
13623 memcpy(p - l, str, l);
13624 p -= l;
13625 i += l;
13626 str += l;
13628 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
13629 return JIM_OK;
13632 case OPT_INDEX:{
13633 int idx;
13634 const char *str;
13636 if (argc != 4) {
13637 Jim_WrongNumArgs(interp, 2, argv, "string index");
13638 return JIM_ERR;
13640 if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) {
13641 return JIM_ERR;
13643 str = Jim_String(argv[2]);
13644 len = Jim_Utf8Length(interp, argv[2]);
13645 if (idx != INT_MIN && idx != INT_MAX) {
13646 idx = JimRelToAbsIndex(len, idx);
13648 if (idx < 0 || idx >= len || str == NULL) {
13649 Jim_SetResultString(interp, "", 0);
13651 else if (len == Jim_Length(argv[2])) {
13652 /* ASCII optimisation */
13653 Jim_SetResultString(interp, str + idx, 1);
13655 else {
13656 int c;
13657 int i = utf8_index(str, idx);
13658 Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c));
13660 return JIM_OK;
13663 case OPT_FIRST:
13664 case OPT_LAST:{
13665 int idx = 0, l1, l2;
13666 const char *s1, *s2;
13668 if (argc != 4 && argc != 5) {
13669 Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?");
13670 return JIM_ERR;
13672 s1 = Jim_String(argv[2]);
13673 s2 = Jim_String(argv[3]);
13674 l1 = Jim_Utf8Length(interp, argv[2]);
13675 l2 = Jim_Utf8Length(interp, argv[3]);
13676 if (argc == 5) {
13677 if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) {
13678 return JIM_ERR;
13680 idx = JimRelToAbsIndex(l2, idx);
13682 else if (option == OPT_LAST) {
13683 idx = l2;
13685 if (option == OPT_FIRST) {
13686 Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx));
13688 else {
13689 #ifdef JIM_UTF8
13690 Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx));
13691 #else
13692 Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx));
13693 #endif
13695 return JIM_OK;
13698 case OPT_TRIM:
13699 case OPT_TRIMLEFT:
13700 case OPT_TRIMRIGHT:{
13701 Jim_Obj *trimchars;
13703 if (argc != 3 && argc != 4) {
13704 Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?");
13705 return JIM_ERR;
13707 trimchars = (argc == 4 ? argv[3] : NULL);
13708 if (option == OPT_TRIM) {
13709 Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars));
13711 else if (option == OPT_TRIMLEFT) {
13712 Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars));
13714 else if (option == OPT_TRIMRIGHT) {
13715 Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars));
13717 return JIM_OK;
13720 case OPT_TOLOWER:
13721 case OPT_TOUPPER:
13722 case OPT_TOTITLE:
13723 if (argc != 3) {
13724 Jim_WrongNumArgs(interp, 2, argv, "string");
13725 return JIM_ERR;
13727 if (option == OPT_TOLOWER) {
13728 Jim_SetResult(interp, JimStringToLower(interp, argv[2]));
13730 else if (option == OPT_TOUPPER) {
13731 Jim_SetResult(interp, JimStringToUpper(interp, argv[2]));
13733 else {
13734 Jim_SetResult(interp, JimStringToTitle(interp, argv[2]));
13736 return JIM_OK;
13738 case OPT_IS:
13739 if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) {
13740 return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5);
13742 Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str");
13743 return JIM_ERR;
13745 return JIM_OK;
13748 /* [time] */
13749 static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13751 long i, count = 1;
13752 jim_wide start, elapsed;
13753 char buf[60];
13754 const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13756 if (argc < 2) {
13757 Jim_WrongNumArgs(interp, 1, argv, "script ?count?");
13758 return JIM_ERR;
13760 if (argc == 3) {
13761 if (Jim_GetLong(interp, argv[2], &count) != JIM_OK)
13762 return JIM_ERR;
13764 if (count < 0)
13765 return JIM_OK;
13766 i = count;
13767 start = JimClock();
13768 while (i-- > 0) {
13769 int retval;
13771 retval = Jim_EvalObj(interp, argv[1]);
13772 if (retval != JIM_OK) {
13773 return retval;
13776 elapsed = JimClock() - start;
13777 sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13778 Jim_SetResultString(interp, buf, -1);
13779 return JIM_OK;
13782 /* [exit] */
13783 static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13785 long exitCode = 0;
13787 if (argc > 2) {
13788 Jim_WrongNumArgs(interp, 1, argv, "?exitCode?");
13789 return JIM_ERR;
13791 if (argc == 2) {
13792 if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13793 return JIM_ERR;
13795 interp->exitCode = exitCode;
13796 return JIM_EXIT;
13799 /* [catch] */
13800 static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13802 int exitCode = 0;
13803 int i;
13804 int sig = 0;
13806 /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13807 jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL);
13808 static const int max_ignore_code = sizeof(ignore_mask) * 8;
13810 /* Reset the error code before catch.
13811 * Note that this is not strictly correct.
13813 Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));
13815 for (i = 1; i < argc - 1; i++) {
13816 const char *arg = Jim_String(argv[i]);
13817 jim_wide option;
13818 int ignore;
13820 /* It's a pity we can't use Jim_GetEnum here :-( */
13821 if (strcmp(arg, "--") == 0) {
13822 i++;
13823 break;
13825 if (*arg != '-') {
13826 break;
13829 if (strncmp(arg, "-no", 3) == 0) {
13830 arg += 3;
13831 ignore = 1;
13833 else {
13834 arg++;
13835 ignore = 0;
13838 if (Jim_StringToWide(arg, &option, 10) != JIM_OK) {
13839 option = -1;
13841 if (option < 0) {
13842 option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize);
13844 if (option < 0) {
13845 goto wrongargs;
13848 if (ignore) {
13849 ignore_mask |= (1 << option);
13851 else {
13852 ignore_mask &= ~(1 << option);
13856 argc -= i;
13857 if (argc < 1 || argc > 3) {
13858 wrongargs:
13859 Jim_WrongNumArgs(interp, 1, argv,
13860 "?-?no?code ... --? script ?resultVarName? ?optionVarName?");
13861 return JIM_ERR;
13863 argv += i;
13865 if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13866 sig++;
13869 interp->signal_level += sig;
13870 if (Jim_CheckSignal(interp)) {
13871 /* If a signal is set, don't even try to execute the body */
13872 exitCode = JIM_SIGNAL;
13874 else {
13875 exitCode = Jim_EvalObj(interp, argv[0]);
13876 /* Don't want any caught error included in a later stack trace */
13877 interp->errorFlag = 0;
13879 interp->signal_level -= sig;
13881 /* Catch or pass through? Only the first 32/64 codes can be passed through */
13882 if (exitCode >= 0 && exitCode < max_ignore_code && ((1 << exitCode) & ignore_mask)) {
13883 /* Not caught, pass it up */
13884 return exitCode;
13887 if (sig && exitCode == JIM_SIGNAL) {
13888 /* Catch the signal at this level */
13889 if (interp->signal_set_result) {
13890 interp->signal_set_result(interp, interp->sigmask);
13892 else {
13893 Jim_SetResultInt(interp, interp->sigmask);
13895 interp->sigmask = 0;
13898 if (argc >= 2) {
13899 if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13900 return JIM_ERR;
13902 if (argc == 3) {
13903 Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13905 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13906 Jim_ListAppendElement(interp, optListObj,
13907 Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13908 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13909 Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13910 if (exitCode == JIM_ERR) {
13911 Jim_Obj *errorCode;
13912 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13913 -1));
13914 Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13916 errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13917 if (errorCode) {
13918 Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13919 Jim_ListAppendElement(interp, optListObj, errorCode);
13922 if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13923 return JIM_ERR;
13927 Jim_SetResultInt(interp, exitCode);
13928 return JIM_OK;
13931 #ifdef JIM_REFERENCES
13933 /* [ref] */
13934 static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13936 if (argc != 3 && argc != 4) {
13937 Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?");
13938 return JIM_ERR;
13940 if (argc == 3) {
13941 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL));
13943 else {
13944 Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3]));
13946 return JIM_OK;
13949 /* [getref] */
13950 static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13952 Jim_Reference *refPtr;
13954 if (argc != 2) {
13955 Jim_WrongNumArgs(interp, 1, argv, "reference");
13956 return JIM_ERR;
13958 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13959 return JIM_ERR;
13960 Jim_SetResult(interp, refPtr->objPtr);
13961 return JIM_OK;
13964 /* [setref] */
13965 static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13967 Jim_Reference *refPtr;
13969 if (argc != 3) {
13970 Jim_WrongNumArgs(interp, 1, argv, "reference newValue");
13971 return JIM_ERR;
13973 if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL)
13974 return JIM_ERR;
13975 Jim_IncrRefCount(argv[2]);
13976 Jim_DecrRefCount(interp, refPtr->objPtr);
13977 refPtr->objPtr = argv[2];
13978 Jim_SetResult(interp, argv[2]);
13979 return JIM_OK;
13982 /* [collect] */
13983 static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
13985 if (argc != 1) {
13986 Jim_WrongNumArgs(interp, 1, argv, "");
13987 return JIM_ERR;
13989 Jim_SetResultInt(interp, Jim_Collect(interp));
13991 /* Free all the freed objects. */
13992 while (interp->freeList) {
13993 Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr;
13994 Jim_Free(interp->freeList);
13995 interp->freeList = nextObjPtr;
13998 return JIM_OK;
14001 /* [finalize] reference ?newValue? */
14002 static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14004 if (argc != 2 && argc != 3) {
14005 Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?");
14006 return JIM_ERR;
14008 if (argc == 2) {
14009 Jim_Obj *cmdNamePtr;
14011 if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK)
14012 return JIM_ERR;
14013 if (cmdNamePtr != NULL) /* otherwise the null string is returned. */
14014 Jim_SetResult(interp, cmdNamePtr);
14016 else {
14017 if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK)
14018 return JIM_ERR;
14019 Jim_SetResult(interp, argv[2]);
14021 return JIM_OK;
14024 /* [info references] */
14025 static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14027 Jim_Obj *listObjPtr;
14028 Jim_HashTableIterator htiter;
14029 Jim_HashEntry *he;
14031 listObjPtr = Jim_NewListObj(interp, NULL, 0);
14033 JimInitHashTableIterator(&interp->references, &htiter);
14034 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14035 char buf[JIM_REFERENCE_SPACE + 1];
14036 Jim_Reference *refPtr = he->u.val;
14037 const unsigned long *refId = he->key;
14039 JimFormatReference(buf, refPtr, *refId);
14040 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1));
14042 Jim_SetResult(interp, listObjPtr);
14043 return JIM_OK;
14045 #endif
14047 /* [rename] */
14048 static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14050 if (argc != 3) {
14051 Jim_WrongNumArgs(interp, 1, argv, "oldName newName");
14052 return JIM_ERR;
14055 if (JimValidName(interp, "new procedure", argv[2])) {
14056 return JIM_ERR;
14059 return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
14062 #define JIM_DICTMATCH_VALUES 0x0001
14064 typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type);
14066 static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type)
14068 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
14069 if (type & JIM_DICTMATCH_VALUES) {
14070 Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->u.val);
14075 * Like JimHashtablePatternMatch, but for dictionaries.
14077 static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr,
14078 JimDictMatchCallbackType *callback, int type)
14080 Jim_HashEntry *he;
14081 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14083 /* Check for the non-pattern case. We can do this much more efficiently. */
14084 Jim_HashTableIterator htiter;
14085 JimInitHashTableIterator(ht, &htiter);
14086 while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14087 if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) {
14088 callback(interp, listObjPtr, he, type);
14092 return listObjPtr;
14096 int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14098 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14099 return JIM_ERR;
14101 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0));
14102 return JIM_OK;
14105 int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr)
14107 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14108 return JIM_ERR;
14110 Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES));
14111 return JIM_OK;
14114 int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr)
14116 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14117 return -1;
14119 return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
14122 int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr)
14124 Jim_HashTable *ht;
14125 unsigned int i;
14127 if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14128 return JIM_ERR;
14131 ht = (Jim_HashTable *)objPtr->internalRep.ptr;
14133 /* Note that this uses internal knowledge of the hash table */
14134 printf("%d entries in table, %d buckets\n", ht->used, ht->size);
14136 for (i = 0; i < ht->size; i++) {
14137 Jim_HashEntry *he = he = ht->table[i];
14139 if (he) {
14140 printf("%d: ", i);
14142 while (he) {
14143 printf(" %s", Jim_String(he->key));
14144 he = he->next;
14146 printf("\n");
14149 return JIM_OK;
14152 static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
14154 Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
14156 Jim_AppendString(interp, prefixObj, " ", 1);
14157 Jim_AppendString(interp, prefixObj, subcmd, -1);
14159 return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
14162 /* [dict] */
14163 static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14165 Jim_Obj *objPtr;
14166 int option;
14167 static const char * const options[] = {
14168 "create", "get", "set", "unset", "exists", "keys", "size", "info",
14169 "merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14170 "replace", "update", NULL
14172 enum
14174 OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14175 OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14176 OPT_REPLACE, OPT_UPDATE,
14179 if (argc < 2) {
14180 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?");
14181 return JIM_ERR;
14184 if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14185 return JIM_ERR;
14188 switch (option) {
14189 case OPT_GET:
14190 if (argc < 3) {
14191 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?");
14192 return JIM_ERR;
14194 if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr,
14195 JIM_ERRMSG) != JIM_OK) {
14196 return JIM_ERR;
14198 Jim_SetResult(interp, objPtr);
14199 return JIM_OK;
14201 case OPT_SET:
14202 if (argc < 5) {
14203 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");
14204 return JIM_ERR;
14206 return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG);
14208 case OPT_EXISTS:
14209 if (argc < 4) {
14210 Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?");
14211 return JIM_ERR;
14213 else {
14214 int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
14215 if (rc < 0) {
14216 return JIM_ERR;
14218 Jim_SetResultBool(interp, rc == JIM_OK);
14219 return JIM_OK;
14222 case OPT_UNSET:
14223 if (argc < 4) {
14224 Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14225 return JIM_ERR;
14227 if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
14228 return JIM_ERR;
14230 return JIM_OK;
14232 case OPT_KEYS:
14233 if (argc != 3 && argc != 4) {
14234 Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?");
14235 return JIM_ERR;
14237 return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL);
14239 case OPT_SIZE:
14240 if (argc != 3) {
14241 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14242 return JIM_ERR;
14244 else if (Jim_DictSize(interp, argv[2]) < 0) {
14245 return JIM_ERR;
14247 Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2]));
14248 return JIM_OK;
14250 case OPT_MERGE:
14251 if (argc == 2) {
14252 return JIM_OK;
14254 if (Jim_DictSize(interp, argv[2]) < 0) {
14255 return JIM_ERR;
14257 /* Handle as ensemble */
14258 break;
14260 case OPT_UPDATE:
14261 if (argc < 6 || argc % 2) {
14262 /* Better error message */
14263 argc = 2;
14265 break;
14267 case OPT_CREATE:
14268 if (argc % 2) {
14269 Jim_WrongNumArgs(interp, 2, argv, "?key value ...?");
14270 return JIM_ERR;
14272 objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2);
14273 Jim_SetResult(interp, objPtr);
14274 return JIM_OK;
14276 case OPT_INFO:
14277 if (argc != 3) {
14278 Jim_WrongNumArgs(interp, 2, argv, "dictionary");
14279 return JIM_ERR;
14281 return Jim_DictInfo(interp, argv[2]);
14283 /* Handle command as an ensemble */
14284 return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2);
14287 /* [subst] */
14288 static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14290 static const char * const options[] = {
14291 "-nobackslashes", "-nocommands", "-novariables", NULL
14293 enum
14294 { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES };
14295 int i;
14296 int flags = JIM_SUBST_FLAG;
14297 Jim_Obj *objPtr;
14299 if (argc < 2) {
14300 Jim_WrongNumArgs(interp, 1, argv, "?options? string");
14301 return JIM_ERR;
14303 for (i = 1; i < (argc - 1); i++) {
14304 int option;
14306 if (Jim_GetEnum(interp, argv[i], options, &option, NULL,
14307 JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14308 return JIM_ERR;
14310 switch (option) {
14311 case OPT_NOBACKSLASHES:
14312 flags |= JIM_SUBST_NOESC;
14313 break;
14314 case OPT_NOCOMMANDS:
14315 flags |= JIM_SUBST_NOCMD;
14316 break;
14317 case OPT_NOVARIABLES:
14318 flags |= JIM_SUBST_NOVAR;
14319 break;
14322 if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) {
14323 return JIM_ERR;
14325 Jim_SetResult(interp, objPtr);
14326 return JIM_OK;
14329 /* [info] */
14330 static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14332 int cmd;
14333 Jim_Obj *objPtr;
14334 int mode = 0;
14336 static const char * const commands[] = {
14337 "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals",
14338 "vars", "version", "patchlevel", "complete", "args", "hostname",
14339 "script", "source", "stacktrace", "nameofexecutable", "returncodes",
14340 "references", "alias", NULL
14342 enum
14343 { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
14344 INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
14345 INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE,
14346 INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS,
14349 #ifdef jim_ext_namespace
14350 int nons = 0;
14352 if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) {
14353 /* This is for internal use only */
14354 argc--;
14355 argv++;
14356 nons = 1;
14358 #endif
14360 if (argc < 2) {
14361 Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
14362 return JIM_ERR;
14364 if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV)
14365 != JIM_OK) {
14366 return JIM_ERR;
14369 /* Test for the the most common commands first, just in case it makes a difference */
14370 switch (cmd) {
14371 case INFO_EXISTS:
14372 if (argc != 3) {
14373 Jim_WrongNumArgs(interp, 2, argv, "varName");
14374 return JIM_ERR;
14376 Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL);
14377 break;
14379 case INFO_ALIAS:{
14380 Jim_Cmd *cmdPtr;
14382 if (argc != 3) {
14383 Jim_WrongNumArgs(interp, 2, argv, "command");
14384 return JIM_ERR;
14386 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14387 return JIM_ERR;
14389 if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) {
14390 Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]);
14391 return JIM_ERR;
14393 Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData);
14394 return JIM_OK;
14397 case INFO_CHANNELS:
14398 mode++; /* JIM_CMDLIST_CHANNELS */
14399 #ifndef jim_ext_aio
14400 Jim_SetResultString(interp, "aio not enabled", -1);
14401 return JIM_ERR;
14402 #endif
14403 case INFO_PROCS:
14404 mode++; /* JIM_CMDLIST_PROCS */
14405 case INFO_COMMANDS:
14406 /* mode 0 => JIM_CMDLIST_COMMANDS */
14407 if (argc != 2 && argc != 3) {
14408 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14409 return JIM_ERR;
14411 #ifdef jim_ext_namespace
14412 if (!nons) {
14413 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14414 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14417 #endif
14418 Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode));
14419 break;
14421 case INFO_VARS:
14422 mode++; /* JIM_VARLIST_VARS */
14423 case INFO_LOCALS:
14424 mode++; /* JIM_VARLIST_LOCALS */
14425 case INFO_GLOBALS:
14426 /* mode 0 => JIM_VARLIST_GLOBALS */
14427 if (argc != 2 && argc != 3) {
14428 Jim_WrongNumArgs(interp, 2, argv, "?pattern?");
14429 return JIM_ERR;
14431 #ifdef jim_ext_namespace
14432 if (!nons) {
14433 if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
14434 return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14437 #endif
14438 Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode));
14439 break;
14441 case INFO_SCRIPT:
14442 if (argc != 2) {
14443 Jim_WrongNumArgs(interp, 2, argv, "");
14444 return JIM_ERR;
14446 Jim_SetResult(interp, Jim_GetScript(interp, interp->currentScriptObj)->fileNameObj);
14447 break;
14449 case INFO_SOURCE:{
14450 int line;
14451 Jim_Obj *resObjPtr;
14452 Jim_Obj *fileNameObj;
14454 if (argc != 3) {
14455 Jim_WrongNumArgs(interp, 2, argv, "source");
14456 return JIM_ERR;
14458 if (argv[2]->typePtr == &sourceObjType) {
14459 fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
14460 line = argv[2]->internalRep.sourceValue.lineNumber;
14462 else if (argv[2]->typePtr == &scriptObjType) {
14463 ScriptObj *script = Jim_GetScript(interp, argv[2]);
14464 fileNameObj = script->fileNameObj;
14465 line = script->firstline;
14467 else {
14468 fileNameObj = interp->emptyObj;
14469 line = 1;
14471 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14472 Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
14473 Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
14474 Jim_SetResult(interp, resObjPtr);
14475 break;
14478 case INFO_STACKTRACE:
14479 Jim_SetResult(interp, interp->stackTrace);
14480 break;
14482 case INFO_LEVEL:
14483 case INFO_FRAME:
14484 switch (argc) {
14485 case 2:
14486 Jim_SetResultInt(interp, interp->framePtr->level);
14487 break;
14489 case 3:
14490 if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) {
14491 return JIM_ERR;
14493 Jim_SetResult(interp, objPtr);
14494 break;
14496 default:
14497 Jim_WrongNumArgs(interp, 2, argv, "?levelNum?");
14498 return JIM_ERR;
14500 break;
14502 case INFO_BODY:
14503 case INFO_STATICS:
14504 case INFO_ARGS:{
14505 Jim_Cmd *cmdPtr;
14507 if (argc != 3) {
14508 Jim_WrongNumArgs(interp, 2, argv, "procname");
14509 return JIM_ERR;
14511 if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) {
14512 return JIM_ERR;
14514 if (!cmdPtr->isproc) {
14515 Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]);
14516 return JIM_ERR;
14518 switch (cmd) {
14519 case INFO_BODY:
14520 Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
14521 break;
14522 case INFO_ARGS:
14523 Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
14524 break;
14525 case INFO_STATICS:
14526 if (cmdPtr->u.proc.staticVars) {
14527 int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES;
14528 Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
14529 NULL, JimVariablesMatch, mode));
14531 break;
14533 break;
14536 case INFO_VERSION:
14537 case INFO_PATCHLEVEL:{
14538 char buf[(JIM_INTEGER_SPACE * 2) + 1];
14540 sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100);
14541 Jim_SetResultString(interp, buf, -1);
14542 break;
14545 case INFO_COMPLETE:
14546 if (argc != 3 && argc != 4) {
14547 Jim_WrongNumArgs(interp, 2, argv, "script ?missing?");
14548 return JIM_ERR;
14550 else {
14551 int len;
14552 const char *s = Jim_GetString(argv[2], &len);
14553 char missing;
14555 Jim_SetResultBool(interp, Jim_ScriptIsComplete(s, len, &missing));
14556 if (missing != ' ' && argc == 4) {
14557 Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1));
14560 break;
14562 case INFO_HOSTNAME:
14563 /* Redirect to os.gethostname if it exists */
14564 return Jim_Eval(interp, "os.gethostname");
14566 case INFO_NAMEOFEXECUTABLE:
14567 /* Redirect to Tcl proc */
14568 return Jim_Eval(interp, "{info nameofexecutable}");
14570 case INFO_RETURNCODES:
14571 if (argc == 2) {
14572 int i;
14573 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14575 for (i = 0; jimReturnCodes[i]; i++) {
14576 Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i));
14577 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp,
14578 jimReturnCodes[i], -1));
14581 Jim_SetResult(interp, listObjPtr);
14583 else if (argc == 3) {
14584 long code;
14585 const char *name;
14587 if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) {
14588 return JIM_ERR;
14590 name = Jim_ReturnCode(code);
14591 if (*name == '?') {
14592 Jim_SetResultInt(interp, code);
14594 else {
14595 Jim_SetResultString(interp, name, -1);
14598 else {
14599 Jim_WrongNumArgs(interp, 2, argv, "?code?");
14600 return JIM_ERR;
14602 break;
14603 case INFO_REFERENCES:
14604 #ifdef JIM_REFERENCES
14605 return JimInfoReferences(interp, argc, argv);
14606 #else
14607 Jim_SetResultString(interp, "not supported", -1);
14608 return JIM_ERR;
14609 #endif
14611 return JIM_OK;
14614 /* [exists] */
14615 static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14617 Jim_Obj *objPtr;
14618 int result = 0;
14620 static const char * const options[] = {
14621 "-command", "-proc", "-alias", "-var", NULL
14623 enum
14625 OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR
14627 int option;
14629 if (argc == 2) {
14630 option = OPT_VAR;
14631 objPtr = argv[1];
14633 else if (argc == 3) {
14634 if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
14635 return JIM_ERR;
14637 objPtr = argv[2];
14639 else {
14640 Jim_WrongNumArgs(interp, 1, argv, "?option? name");
14641 return JIM_ERR;
14644 if (option == OPT_VAR) {
14645 result = Jim_GetVariable(interp, objPtr, 0) != NULL;
14647 else {
14648 /* Now different kinds of commands */
14649 Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE);
14651 if (cmd) {
14652 switch (option) {
14653 case OPT_COMMAND:
14654 result = 1;
14655 break;
14657 case OPT_ALIAS:
14658 result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd;
14659 break;
14661 case OPT_PROC:
14662 result = cmd->isproc;
14663 break;
14667 Jim_SetResultBool(interp, result);
14668 return JIM_OK;
14671 /* [split] */
14672 static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14674 const char *str, *splitChars, *noMatchStart;
14675 int splitLen, strLen;
14676 Jim_Obj *resObjPtr;
14677 int c;
14678 int len;
14680 if (argc != 2 && argc != 3) {
14681 Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?");
14682 return JIM_ERR;
14685 str = Jim_GetString(argv[1], &len);
14686 if (len == 0) {
14687 return JIM_OK;
14689 strLen = Jim_Utf8Length(interp, argv[1]);
14691 /* Init */
14692 if (argc == 2) {
14693 splitChars = " \n\t\r";
14694 splitLen = 4;
14696 else {
14697 splitChars = Jim_String(argv[2]);
14698 splitLen = Jim_Utf8Length(interp, argv[2]);
14701 noMatchStart = str;
14702 resObjPtr = Jim_NewListObj(interp, NULL, 0);
14704 /* Split */
14705 if (splitLen) {
14706 Jim_Obj *objPtr;
14707 while (strLen--) {
14708 const char *sc = splitChars;
14709 int scLen = splitLen;
14710 int sl = utf8_tounicode(str, &c);
14711 while (scLen--) {
14712 int pc;
14713 sc += utf8_tounicode(sc, &pc);
14714 if (c == pc) {
14715 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14716 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14717 noMatchStart = str + sl;
14718 break;
14721 str += sl;
14723 objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart));
14724 Jim_ListAppendElement(interp, resObjPtr, objPtr);
14726 else {
14727 /* This handles the special case of splitchars eq {}
14728 * Optimise by sharing common (ASCII) characters
14730 Jim_Obj **commonObj = NULL;
14731 #define NUM_COMMON (128 - 9)
14732 while (strLen--) {
14733 int n = utf8_tounicode(str, &c);
14734 #ifdef JIM_OPTIMIZATION
14735 if (c >= 9 && c < 128) {
14736 /* Common ASCII char. Note that 9 is the tab character */
14737 c -= 9;
14738 if (!commonObj) {
14739 commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON);
14740 memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON);
14742 if (!commonObj[c]) {
14743 commonObj[c] = Jim_NewStringObj(interp, str, 1);
14745 Jim_ListAppendElement(interp, resObjPtr, commonObj[c]);
14746 str++;
14747 continue;
14749 #endif
14750 Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1));
14751 str += n;
14753 Jim_Free(commonObj);
14756 Jim_SetResult(interp, resObjPtr);
14757 return JIM_OK;
14760 /* [join] */
14761 static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14763 const char *joinStr;
14764 int joinStrLen;
14766 if (argc != 2 && argc != 3) {
14767 Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?");
14768 return JIM_ERR;
14770 /* Init */
14771 if (argc == 2) {
14772 joinStr = " ";
14773 joinStrLen = 1;
14775 else {
14776 joinStr = Jim_GetString(argv[2], &joinStrLen);
14778 Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen));
14779 return JIM_OK;
14782 /* [format] */
14783 static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14785 Jim_Obj *objPtr;
14787 if (argc < 2) {
14788 Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?");
14789 return JIM_ERR;
14791 objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2);
14792 if (objPtr == NULL)
14793 return JIM_ERR;
14794 Jim_SetResult(interp, objPtr);
14795 return JIM_OK;
14798 /* [scan] */
14799 static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14801 Jim_Obj *listPtr, **outVec;
14802 int outc, i;
14804 if (argc < 3) {
14805 Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?");
14806 return JIM_ERR;
14808 if (argv[2]->typePtr != &scanFmtStringObjType)
14809 SetScanFmtFromAny(interp, argv[2]);
14810 if (FormatGetError(argv[2]) != 0) {
14811 Jim_SetResultString(interp, FormatGetError(argv[2]), -1);
14812 return JIM_ERR;
14814 if (argc > 3) {
14815 int maxPos = FormatGetMaxPos(argv[2]);
14816 int count = FormatGetCnvCount(argv[2]);
14818 if (maxPos > argc - 3) {
14819 Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1);
14820 return JIM_ERR;
14822 else if (count > argc - 3) {
14823 Jim_SetResultString(interp, "different numbers of variable names and "
14824 "field specifiers", -1);
14825 return JIM_ERR;
14827 else if (count < argc - 3) {
14828 Jim_SetResultString(interp, "variable is not assigned by any "
14829 "conversion specifiers", -1);
14830 return JIM_ERR;
14833 listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG);
14834 if (listPtr == 0)
14835 return JIM_ERR;
14836 if (argc > 3) {
14837 int rc = JIM_OK;
14838 int count = 0;
14840 if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) {
14841 int len = Jim_ListLength(interp, listPtr);
14843 if (len != 0) {
14844 JimListGetElements(interp, listPtr, &outc, &outVec);
14845 for (i = 0; i < outc; ++i) {
14846 if (Jim_Length(outVec[i]) > 0) {
14847 ++count;
14848 if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) {
14849 rc = JIM_ERR;
14854 Jim_FreeNewObj(interp, listPtr);
14856 else {
14857 count = -1;
14859 if (rc == JIM_OK) {
14860 Jim_SetResultInt(interp, count);
14862 return rc;
14864 else {
14865 if (listPtr == (Jim_Obj *)EOF) {
14866 Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0));
14867 return JIM_OK;
14869 Jim_SetResult(interp, listPtr);
14871 return JIM_OK;
14874 /* [error] */
14875 static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14877 if (argc != 2 && argc != 3) {
14878 Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?");
14879 return JIM_ERR;
14881 Jim_SetResult(interp, argv[1]);
14882 if (argc == 3) {
14883 JimSetStackTrace(interp, argv[2]);
14884 return JIM_ERR;
14886 interp->addStackTrace++;
14887 return JIM_ERR;
14890 /* [lrange] */
14891 static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14893 Jim_Obj *objPtr;
14895 if (argc != 4) {
14896 Jim_WrongNumArgs(interp, 1, argv, "list first last");
14897 return JIM_ERR;
14899 if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL)
14900 return JIM_ERR;
14901 Jim_SetResult(interp, objPtr);
14902 return JIM_OK;
14905 /* [lrepeat] */
14906 static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14908 Jim_Obj *objPtr;
14909 long count;
14911 if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) {
14912 Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
14913 return JIM_ERR;
14916 if (count == 0 || argc == 2) {
14917 return JIM_OK;
14920 argc -= 2;
14921 argv += 2;
14923 objPtr = Jim_NewListObj(interp, argv, argc);
14924 while (--count) {
14925 ListInsertElements(objPtr, -1, argc, argv);
14928 Jim_SetResult(interp, objPtr);
14929 return JIM_OK;
14932 char **Jim_GetEnviron(void)
14934 #if defined(HAVE__NSGETENVIRON)
14935 return *_NSGetEnviron();
14936 #else
14937 #if !defined(NO_ENVIRON_EXTERN)
14938 extern char **environ;
14939 #endif
14941 return environ;
14942 #endif
14945 void Jim_SetEnviron(char **env)
14947 #if defined(HAVE__NSGETENVIRON)
14948 *_NSGetEnviron() = env;
14949 #else
14950 #if !defined(NO_ENVIRON_EXTERN)
14951 extern char **environ;
14952 #endif
14954 environ = env;
14955 #endif
14958 /* [env] */
14959 static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
14961 const char *key;
14962 const char *val;
14964 if (argc == 1) {
14965 char **e = Jim_GetEnviron();
14967 int i;
14968 Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
14970 for (i = 0; e[i]; i++) {
14971 const char *equals = strchr(e[i], '=');
14973 if (equals) {
14974 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i],
14975 equals - e[i]));
14976 Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1));
14980 Jim_SetResult(interp, listObjPtr);
14981 return JIM_OK;
14984 if (argc < 2) {
14985 Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
14986 return JIM_ERR;
14988 key = Jim_String(argv[1]);
14989 val = getenv(key);
14990 if (val == NULL) {
14991 if (argc < 3) {
14992 Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]);
14993 return JIM_ERR;
14995 val = Jim_String(argv[2]);
14997 Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1));
14998 return JIM_OK;
15001 /* [source] */
15002 static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15004 int retval;
15006 if (argc != 2) {
15007 Jim_WrongNumArgs(interp, 1, argv, "fileName");
15008 return JIM_ERR;
15010 retval = Jim_EvalFile(interp, Jim_String(argv[1]));
15011 if (retval == JIM_RETURN)
15012 return JIM_OK;
15013 return retval;
15016 /* [lreverse] */
15017 static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15019 Jim_Obj *revObjPtr, **ele;
15020 int len;
15022 if (argc != 2) {
15023 Jim_WrongNumArgs(interp, 1, argv, "list");
15024 return JIM_ERR;
15026 JimListGetElements(interp, argv[1], &len, &ele);
15027 len--;
15028 revObjPtr = Jim_NewListObj(interp, NULL, 0);
15029 while (len >= 0)
15030 ListAppendElement(revObjPtr, ele[len--]);
15031 Jim_SetResult(interp, revObjPtr);
15032 return JIM_OK;
15035 static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step)
15037 jim_wide len;
15039 if (step == 0)
15040 return -1;
15041 if (start == end)
15042 return 0;
15043 else if (step > 0 && start > end)
15044 return -1;
15045 else if (step < 0 && end > start)
15046 return -1;
15047 len = end - start;
15048 if (len < 0)
15049 len = -len; /* abs(len) */
15050 if (step < 0)
15051 step = -step; /* abs(step) */
15052 len = 1 + ((len - 1) / step);
15053 /* We can truncate safely to INT_MAX, the range command
15054 * will always return an error for a such long range
15055 * because Tcl lists can't be so long. */
15056 if (len > INT_MAX)
15057 len = INT_MAX;
15058 return (int)((len < 0) ? -1 : len);
15061 /* [range] */
15062 static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15064 jim_wide start = 0, end, step = 1;
15065 int len, i;
15066 Jim_Obj *objPtr;
15068 if (argc < 2 || argc > 4) {
15069 Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?");
15070 return JIM_ERR;
15072 if (argc == 2) {
15073 if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
15074 return JIM_ERR;
15076 else {
15077 if (Jim_GetWide(interp, argv[1], &start) != JIM_OK ||
15078 Jim_GetWide(interp, argv[2], &end) != JIM_OK)
15079 return JIM_ERR;
15080 if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
15081 return JIM_ERR;
15083 if ((len = JimRangeLen(start, end, step)) == -1) {
15084 Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1);
15085 return JIM_ERR;
15087 objPtr = Jim_NewListObj(interp, NULL, 0);
15088 for (i = 0; i < len; i++)
15089 ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15090 Jim_SetResult(interp, objPtr);
15091 return JIM_OK;
15094 /* [rand] */
15095 static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
15097 jim_wide min = 0, max = 0, len, maxMul;
15099 if (argc < 1 || argc > 3) {
15100 Jim_WrongNumArgs(interp, 1, argv, "?min? max");
15101 return JIM_ERR;
15103 if (argc == 1) {
15104 max = JIM_WIDE_MAX;
15105 } else if (argc == 2) {
15106 if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
15107 return JIM_ERR;
15108 } else if (argc == 3) {
15109 if (Jim_GetWide(interp, argv[1], &min) != JIM_OK ||
15110 Jim_GetWide(interp, argv[2], &max) != JIM_OK)
15111 return JIM_ERR;
15113 len = max-min;
15114 if (len < 0) {
15115 Jim_SetResultString(interp, "Invalid arguments (max < min)", -1);
15116 return JIM_ERR;
15118 maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0);
15119 while (1) {
15120 jim_wide r;
15122 JimRandomBytes(interp, &r, sizeof(jim_wide));
15123 if (r < 0 || r >= maxMul) continue;
15124 r = (len == 0) ? 0 : r%len;
15125 Jim_SetResultInt(interp, min+r);
15126 return JIM_OK;
15130 static const struct {
15131 const char *name;
15132 Jim_CmdProc cmdProc;
15133 } Jim_CoreCommandsTable[] = {
15134 {"alias", Jim_AliasCoreCommand},
15135 {"set", Jim_SetCoreCommand},
15136 {"unset", Jim_UnsetCoreCommand},
15137 {"puts", Jim_PutsCoreCommand},
15138 {"+", Jim_AddCoreCommand},
15139 {"*", Jim_MulCoreCommand},
15140 {"-", Jim_SubCoreCommand},
15141 {"/", Jim_DivCoreCommand},
15142 {"incr", Jim_IncrCoreCommand},
15143 {"while", Jim_WhileCoreCommand},
15144 {"loop", Jim_LoopCoreCommand},
15145 {"for", Jim_ForCoreCommand},
15146 {"foreach", Jim_ForeachCoreCommand},
15147 {"lmap", Jim_LmapCoreCommand},
15148 {"lassign", Jim_LassignCoreCommand},
15149 {"if", Jim_IfCoreCommand},
15150 {"switch", Jim_SwitchCoreCommand},
15151 {"list", Jim_ListCoreCommand},
15152 {"lindex", Jim_LindexCoreCommand},
15153 {"lset", Jim_LsetCoreCommand},
15154 {"lsearch", Jim_LsearchCoreCommand},
15155 {"llength", Jim_LlengthCoreCommand},
15156 {"lappend", Jim_LappendCoreCommand},
15157 {"linsert", Jim_LinsertCoreCommand},
15158 {"lreplace", Jim_LreplaceCoreCommand},
15159 {"lsort", Jim_LsortCoreCommand},
15160 {"append", Jim_AppendCoreCommand},
15161 {"debug", Jim_DebugCoreCommand},
15162 {"eval", Jim_EvalCoreCommand},
15163 {"uplevel", Jim_UplevelCoreCommand},
15164 {"expr", Jim_ExprCoreCommand},
15165 {"break", Jim_BreakCoreCommand},
15166 {"continue", Jim_ContinueCoreCommand},
15167 {"proc", Jim_ProcCoreCommand},
15168 {"concat", Jim_ConcatCoreCommand},
15169 {"return", Jim_ReturnCoreCommand},
15170 {"upvar", Jim_UpvarCoreCommand},
15171 {"global", Jim_GlobalCoreCommand},
15172 {"string", Jim_StringCoreCommand},
15173 {"time", Jim_TimeCoreCommand},
15174 {"exit", Jim_ExitCoreCommand},
15175 {"catch", Jim_CatchCoreCommand},
15176 #ifdef JIM_REFERENCES
15177 {"ref", Jim_RefCoreCommand},
15178 {"getref", Jim_GetrefCoreCommand},
15179 {"setref", Jim_SetrefCoreCommand},
15180 {"finalize", Jim_FinalizeCoreCommand},
15181 {"collect", Jim_CollectCoreCommand},
15182 #endif
15183 {"rename", Jim_RenameCoreCommand},
15184 {"dict", Jim_DictCoreCommand},
15185 {"subst", Jim_SubstCoreCommand},
15186 {"info", Jim_InfoCoreCommand},
15187 {"exists", Jim_ExistsCoreCommand},
15188 {"split", Jim_SplitCoreCommand},
15189 {"join", Jim_JoinCoreCommand},
15190 {"format", Jim_FormatCoreCommand},
15191 {"scan", Jim_ScanCoreCommand},
15192 {"error", Jim_ErrorCoreCommand},
15193 {"lrange", Jim_LrangeCoreCommand},
15194 {"lrepeat", Jim_LrepeatCoreCommand},
15195 {"env", Jim_EnvCoreCommand},
15196 {"source", Jim_SourceCoreCommand},
15197 {"lreverse", Jim_LreverseCoreCommand},
15198 {"range", Jim_RangeCoreCommand},
15199 {"rand", Jim_RandCoreCommand},
15200 {"tailcall", Jim_TailcallCoreCommand},
15201 {"local", Jim_LocalCoreCommand},
15202 {"upcall", Jim_UpcallCoreCommand},
15203 {"apply", Jim_ApplyCoreCommand},
15204 {NULL, NULL},
15207 void Jim_RegisterCoreCommands(Jim_Interp *interp)
15209 int i = 0;
15211 while (Jim_CoreCommandsTable[i].name != NULL) {
15212 Jim_CreateCommand(interp,
15213 Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL);
15214 i++;
15218 /* -----------------------------------------------------------------------------
15219 * Interactive prompt
15220 * ---------------------------------------------------------------------------*/
15221 void Jim_MakeErrorMessage(Jim_Interp *interp)
15223 Jim_Obj *argv[2];
15225 argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
15226 argv[1] = interp->result;
15228 Jim_EvalObjVector(interp, 2, argv);
15231 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
15232 const char *prefix, const char *const *tablePtr, const char *name)
15234 int count;
15235 char **tablePtrSorted;
15236 int i;
15238 for (count = 0; tablePtr[count]; count++) {
15241 if (name == NULL) {
15242 name = "option";
15245 Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg);
15246 tablePtrSorted = Jim_Alloc(sizeof(char *) * count);
15247 memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count);
15248 qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers);
15249 for (i = 0; i < count; i++) {
15250 if (i + 1 == count && count > 1) {
15251 Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1);
15253 Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL);
15254 if (i + 1 != count) {
15255 Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1);
15258 Jim_Free(tablePtrSorted);
15261 int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr,
15262 const char *const *tablePtr, int *indexPtr, const char *name, int flags)
15264 const char *bad = "bad ";
15265 const char *const *entryPtr = NULL;
15266 int i;
15267 int match = -1;
15268 int arglen;
15269 const char *arg = Jim_GetString(objPtr, &arglen);
15271 *indexPtr = -1;
15273 for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) {
15274 if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) {
15275 /* Found an exact match */
15276 *indexPtr = i;
15277 return JIM_OK;
15279 if (flags & JIM_ENUM_ABBREV) {
15280 /* Accept an unambiguous abbreviation.
15281 * Note that '-' doesnt' consitute a valid abbreviation
15283 if (strncmp(arg, *entryPtr, arglen) == 0) {
15284 if (*arg == '-' && arglen == 1) {
15285 break;
15287 if (match >= 0) {
15288 bad = "ambiguous ";
15289 goto ambiguous;
15291 match = i;
15296 /* If we had an unambiguous partial match */
15297 if (match >= 0) {
15298 *indexPtr = match;
15299 return JIM_OK;
15302 ambiguous:
15303 if (flags & JIM_ERRMSG) {
15304 JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name);
15306 return JIM_ERR;
15309 int Jim_FindByName(const char *name, const char * const array[], size_t len)
15311 int i;
15313 for (i = 0; i < (int)len; i++) {
15314 if (array[i] && strcmp(array[i], name) == 0) {
15315 return i;
15318 return -1;
15321 int Jim_IsDict(Jim_Obj *objPtr)
15323 return objPtr->typePtr == &dictObjType;
15326 int Jim_IsList(Jim_Obj *objPtr)
15328 return objPtr->typePtr == &listObjType;
15332 * Very simple printf-like formatting, designed for error messages.
15334 * The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
15335 * The resulting string is created and set as the result.
15337 * Each '%s' should correspond to a regular string parameter.
15338 * Each '%#s' should correspond to a (Jim_Obj *) parameter.
15339 * Any other printf specifier is not allowed (but %% is allowed for the % character).
15341 * e.g. Jim_SetResultFormatted(interp, "Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
15343 * Note: We take advantage of the fact that printf has the same behaviour for both %s and %#s
15345 void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...)
15347 /* Initial space needed */
15348 int len = strlen(format);
15349 int extra = 0;
15350 int n = 0;
15351 const char *params[5];
15352 char *buf;
15353 va_list args;
15354 int i;
15356 va_start(args, format);
15358 for (i = 0; i < len && n < 5; i++) {
15359 int l;
15361 if (strncmp(format + i, "%s", 2) == 0) {
15362 params[n] = va_arg(args, char *);
15364 l = strlen(params[n]);
15366 else if (strncmp(format + i, "%#s", 3) == 0) {
15367 Jim_Obj *objPtr = va_arg(args, Jim_Obj *);
15369 params[n] = Jim_GetString(objPtr, &l);
15371 else {
15372 if (format[i] == '%') {
15373 i++;
15375 continue;
15377 n++;
15378 extra += l;
15381 len += extra;
15382 buf = Jim_Alloc(len + 1);
15383 len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]);
15385 Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len));
15388 /* stubs */
15389 #ifndef jim_ext_package
15390 int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
15392 return JIM_OK;
15394 #endif
15395 #ifndef jim_ext_aio
15396 FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj)
15398 Jim_SetResultString(interp, "aio not enabled", -1);
15399 return NULL;
15401 #endif
15405 * Local Variables: ***
15406 * c-basic-offset: 4 ***
15407 * tab-width: 4 ***
15408 * End: ***